Browse files

Renamed External to DataDesc.

  • Loading branch information...
1 parent 5910c52 commit cbe6388e946dad80246e31183a7e575d10ef6034 @luqui committed Nov 13, 2008
Showing with 62 additions and 62 deletions.
  1. +62 −0 Udon/DataDesc.hs
  2. +0 −62 Udon/External.hs
View
62 Udon/DataDesc.hs
@@ -0,0 +1,62 @@
+module Udon.DataDesc
+ ( ExtRef
+ , DataDesc, ddDump, ddGC, ddRead
+ , Dump(..)
+ , GCQueue(..)
+ , pure, sequ, ref, binary
+ )
+where
+
+import Udon.Hash
+import Data.Binary
+import Data.Maybe
+import Data.Binary
+import Data.Binary.Get (runGet)
+import Data.Monoid
+
+data ExtRef a = ExtRef Hash (Maybe a)
+
+data DataDesc a
+ = DataDesc { ddDump :: a -> Dump
+ , ddGC :: a -> GCQueue
+ , ddRead :: Get a
+ }
+
+data Dump = Dump Put [(Hash, Dump)]
+
+instance Monoid Dump where
+ mempty = Dump (return ()) []
+ mappend (Dump p xs) (Dump p' ys) = Dump (p >> p') (xs ++ ys)
+
+newtype GCQueue = GCQueue [(Hash, Blob -> GCQueue)]
+
+instance Monoid GCQueue where
+ mempty = GCQueue []
+ mappend (GCQueue xs) (GCQueue ys) = GCQueue (xs ++ ys)
+
+pure :: a -> DataDesc a
+pure x = DataDesc {
+ ddDump = \_ -> mempty,
+ ddGC = \_ -> mempty,
+ ddRead = return x }
+
+sequ :: (b -> a) -> DataDesc a -> (a -> DataDesc b) -> DataDesc b
+sequ i pa j = DataDesc {
+ ddDump = \b -> let a = i b in ddDump pa a `mappend` ddDump (j a) b,
+ ddGC = \b -> let a = i b in ddGC pa a `mappend` ddGC (j a) b,
+ ddRead = ddRead pa >>= ddRead . j }
+
+ref :: DataDesc a -> DataDesc (ExtRef a)
+ref pa = DataDesc {
+ ddDump = \(ExtRef h v) -> Dump (put h) $ case v of
+ Nothing -> []
+ Just x -> [(h, ddDump pa x)],
+ -- The ddRead in this entry is why we cannot do typeclasses
+ ddGC = \(ExtRef h v) -> GCQueue [(h, \blob -> ddGC pa (runGet (ddRead pa) blob))],
+ ddRead = fmap (\h -> ExtRef h Nothing) get }
+
+binary :: Binary a => DataDesc a
+binary = DataDesc {
+ ddDump = \a -> Dump (put a) [],
+ ddGC = \_ -> mempty,
+ ddRead = get }
View
62 Udon/External.hs
@@ -1,62 +0,0 @@
-module Udon.External
- ( ExtRef
- , External, extDump, extGC, extRead
- , Dump(..)
- , GCQueue(..)
- , pure, sequ, ref, binary
- )
-where
-
-import Udon.Hash
-import Data.Binary
-import Data.Maybe
-import Data.Binary
-import Data.Binary.Get (runGet)
-import Data.Monoid
-
-data ExtRef a = ExtRef Hash (Maybe a)
-
-data External a
- = External { extDump :: a -> Dump
- , extGC :: a -> GCQueue
- , extRead :: Get a
- }
-
-data Dump = Dump Put [(Hash, Dump)]
-
-instance Monoid Dump where
- mempty = Dump (return ()) []
- mappend (Dump p xs) (Dump p' ys) = Dump (p >> p') (xs ++ ys)
-
-newtype GCQueue = GCQueue [(Hash, Blob -> GCQueue)]
-
-instance Monoid GCQueue where
- mempty = GCQueue []
- mappend (GCQueue xs) (GCQueue ys) = GCQueue (xs ++ ys)
-
-pure :: a -> External a
-pure x = External {
- extDump = \_ -> mempty,
- extGC = \_ -> mempty,
- extRead = return x }
-
-sequ :: (b -> a) -> External a -> (a -> External b) -> External b
-sequ i pa j = External {
- extDump = \b -> let a = i b in extDump pa a `mappend` extDump (j a) b,
- extGC = \b -> let a = i b in extGC pa a `mappend` extGC (j a) b,
- extRead = extRead pa >>= extRead . j }
-
-ref :: External a -> External (ExtRef a)
-ref pa = External {
- extDump = \(ExtRef h v) -> Dump (put h) $ case v of
- Nothing -> []
- Just x -> [(h, extDump pa x)],
- -- The extRead in this entry is why we cannot do typeclasses
- extGC = \(ExtRef h v) -> GCQueue [(h, \blob -> extGC pa (runGet (extRead pa) blob))],
- extRead = fmap (\h -> ExtRef h Nothing) get }
-
-binary :: Binary a => External a
-binary = External {
- extDump = \a -> Dump (put a) [],
- extGC = \_ -> mempty,
- extRead = get }

0 comments on commit cbe6388

Please sign in to comment.