1 files changed, 41 insertions, 35 deletions

diff --git a/src/Erebos/Storage/Internal.hs b/src/Erebos/Storage/Internal.hs
index 6df1410..db211bb 100644
--- a/src/Erebos/Storage/Internal.hs
+++ b/src/Erebos/Storage/Internal.hs
@@ -1,32 +1,55 @@
-module Erebos.Storage.Internal where
+module Erebos.Storage.Internal (
+    Storage'(..), Storage, PartialStorage,
+    Ref'(..), Ref, PartialRef,
+    RefDigest(..),
+    WatchID, startWatchID, nextWatchID,
+    WatchList(..), WatchListItem(..), watchListAdd, watchListDel,
+
+    refStorage,
+    refDigest, refDigestFromByteString,
+    showRef, showRefDigest, showRefDigestParts,
+    readRefDigest,
+    hashToRefDigest,
+
+    StorageCompleteness(..),
+    StorageBackend(..),
+    Complete, Partial,
+
+    unsafeStoreRawBytes,
+    ioLoadBytesFromStorage,
+
+    Generation(..),
+    HeadID(..), HeadTypeID(..),
+    Stored(..), storedStorage,
+) where
 
 import Control.Arrow
 import Control.Concurrent
 import Control.DeepSeq
 import Control.Exception
-import Control.Monad
 import Control.Monad.Identity
 
 import Crypto.Hash
 
 import Data.Bits
-import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
+import Data.ByteArray (ByteArrayAccess, ScrubbedBytes)
 import Data.ByteArray qualified as BA
 import Data.ByteString (ByteString)
-import Data.ByteString qualified as B
 import Data.ByteString.Char8 qualified as BC
 import Data.ByteString.Lazy qualified as BL
-import Data.Char
+import Data.Function
 import Data.HashTable.IO qualified as HT
 import Data.Hashable
 import Data.Kind
 import Data.Typeable
-import Data.UUID (UUID)
 
 import Foreign.Storable (peek)
 
 import System.IO.Unsafe (unsafePerformIO)
 
+import Erebos.UUID (UUID)
+import Erebos.Util
+
 
 data Storage' c = forall bck. (StorageBackend bck, BackendCompleteness bck ~ c) => Storage
     { stBackend :: bck
@@ -196,35 +219,15 @@ showRefDigest = showRefDigestParts >>> \(alg, hex) -> alg <> BC.pack "#" <> hex
 readRefDigest :: ByteString -> Maybe RefDigest
 readRefDigest x = case BC.split '#' x of
                        [alg, dgst] | BA.convert alg == BC.pack "blake2" ->
-                           refDigestFromByteString =<< readHex @ByteString dgst
+                           refDigestFromByteString =<< readHex dgst
                        _ -> Nothing
 
-refDigestFromByteString :: ByteArrayAccess ba => ba -> Maybe RefDigest
+refDigestFromByteString :: ByteString -> Maybe RefDigest
 refDigestFromByteString = fmap RefDigest . digestFromByteString
 
 hashToRefDigest :: BL.ByteString -> RefDigest
 hashToRefDigest = RefDigest . hashFinalize . hashUpdates hashInit . BL.toChunks
 
-showHex :: ByteArrayAccess ba => ba -> ByteString
-showHex = B.concat . map showHexByte . BA.unpack
-    where showHexChar x | x < 10    = x + o '0'
-                        | otherwise = x + o 'a' - 10
-          showHexByte x = B.pack [ showHexChar (x `div` 16), showHexChar (x `mod` 16) ]
-          o = fromIntegral . ord
-
-readHex :: ByteArray ba => ByteString -> Maybe ba
-readHex = return . BA.concat <=< readHex'
-    where readHex' bs | B.null bs = Just []
-          readHex' bs = do (bx, bs') <- B.uncons bs
-                           (by, bs'') <- B.uncons bs'
-                           x <- hexDigit bx
-                           y <- hexDigit by
-                           (B.singleton (x * 16 + y) :) <$> readHex' bs''
-          hexDigit x | x >= o '0' && x <= o '9' = Just $ x - o '0'
-                     | x >= o 'a' && x <= o 'z' = Just $ x - o 'a' + 10
-                     | otherwise                = Nothing
-          o = fromIntegral . ord
-
 
 newtype Generation = Generation Int
     deriving (Eq, Show)
@@ -237,17 +240,20 @@ newtype HeadID = HeadID UUID
 newtype HeadTypeID = HeadTypeID UUID
     deriving (Eq, Ord)
 
-data Stored' c a = Stored (Ref' c) a
+data Stored a = Stored
+    { storedRef' :: Ref
+    , storedObject' :: a
+    }
     deriving (Show)
 
-instance Eq (Stored' c a) where
-    Stored r1 _ == Stored r2 _  =  refDigest r1 == refDigest r2
+instance Eq (Stored a) where
+    (==)  =  (==) `on` (refDigest . storedRef')
 
-instance Ord (Stored' c a) where
-    compare (Stored r1 _) (Stored r2 _) = compare (refDigest r1) (refDigest r2)
+instance Ord (Stored a) where
+    compare  =  compare `on` (refDigest . storedRef')
 
-storedStorage :: Stored' c a -> Storage' c
-storedStorage (Stored (Ref st _) _) = st
+storedStorage :: Stored a -> Storage
+storedStorage = refStorage . storedRef'
 
 
 type Complete = Identity