aboutsummaryrefslogtreecommitdiff
path: root/src/HaddockUtil.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/HaddockUtil.hs')
-rw-r--r--src/HaddockUtil.hs35
1 files changed, 35 insertions, 0 deletions
diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs
index b0ad3544..27a83770 100644
--- a/src/HaddockUtil.hs
+++ b/src/HaddockUtil.hs
@@ -26,6 +26,8 @@ import List ( intersect )
import IO ( hPutStr, stderr )
import System
import RegexString
+import Binary
+import IOExts
-- -----------------------------------------------------------------------------
-- Some Utilities
@@ -220,3 +222,36 @@ mapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
mapMaybeM f Nothing = return Nothing
mapMaybeM f (Just a) = f a >>= return . Just
+-----------------------------------------------------------------------------
+-- Binary instances for stuff
+
+instance Binary Module where
+ put_ bh (Module m) = putString bh m
+ get bh = do m <- getString bh; return $! (Module m)
+
+instance Binary HsQName where
+ put_ bh (Qual m s) = do putByte bh 0; put_ bh m; put_ bh s
+ put_ bh (UnQual s) = do putByte bh 1; put_ bh s
+ get bh = do b <- getByte bh
+ case b of
+ 0 -> do m <- get bh; s <- get bh; return (Qual m s)
+ _ -> do s <- get bh; return (UnQual s)
+
+instance Binary HsName where
+ put_ bh (HsTyClsName s) = do putByte bh 0; put_ bh s
+ put_ bh (HsVarName s) = do putByte bh 1; put_ bh s
+ get bh = do b <- getByte bh
+ case b of
+ 0 -> do s <- get bh; return (HsTyClsName s)
+ _ -> do s <- get bh; return (HsVarName s)
+
+instance Binary HsIdentifier where
+ put_ bh (HsIdent s) = do putByte bh 0; putString bh s
+ put_ bh (HsSymbol s) = do putByte bh 1; putString bh s
+ put_ bh (HsSpecial s) = do putByte bh 2; putString bh s
+ get bh = do b <- getByte bh
+ case b of
+ 0 -> do s <- getString bh; return (HsIdent s)
+ 1 -> do s <- getString bh; return (HsSymbol s)
+ _ -> do s <- getString bh; return (HsSpecial s)
+