Permalink
Browse files

Added an interface for hash databases, and a simple one based on Data…

….Map
  • Loading branch information...
1 parent cbe6388 commit e7ad77851585b7078b4e6f995e1bc7270fb7b01c @luqui committed Nov 13, 2008
Showing with 43 additions and 1 deletion.
  1. +27 −0 Udon/Database.hs
  2. +1 −1 Udon/Hash.hs
  3. +15 −0 Udon/MapDatabase.hs
View
@@ -0,0 +1,27 @@
+module Udon.Database where
+
+import Udon.Hash
+import Udon.DataDesc
+import Data.Binary.Put (runPut)
+
+-- This class is to guarantee uniqueness of descriptors
+class Data a where
+ desc :: DataDesc a
+
+data Database m
+ = Database { fetch :: Hash -> m (Maybe (m Blob))
+ , store :: Hash -> Blob -> m ()
+ }
+
+writeDump :: (Monad m) => Database m -> Dump -> m ()
+writeDump db = \dump@(Dump put _) -> go (hashBlob (runPut put)) dump
+ where
+ go hash (Dump put subs) = do
+ exists <- fetch db hash
+ case exists of
+ Just _ -> return ()
+ Nothing -> do
+ store db hash (runPut put)
+ mapM_ (uncurry go) subs
+
+
View
@@ -9,7 +9,7 @@ import Data.Binary
type Blob = Str.ByteString
newtype Hash = Hash Blob
- deriving Eq
+ deriving (Eq,Ord)
instance Binary Hash where
put (Hash x) = put x
View
@@ -0,0 +1,15 @@
+module Udon.MapDatabase where
+
+import Udon.Hash
+import Udon.Database
+import qualified Data.Map as Map
+import Control.Monad.State
+import Control.Monad
+
+mapDatabase :: (MonadState (Map.Map Hash Blob) m) => Database m
+mapDatabase = Database {
+ fetch = \hash -> liftM (liftM return . Map.lookup hash) get,
+ store = \hash blob -> modify (Map.insert hash blob)
+ }
+
+

0 comments on commit e7ad778

Please sign in to comment.