module Yhc.Core.Internal.Binary where
import System.IO
import Data.Char
import Control.Monad
class Binary a where
put_ :: Handle -> a -> IO ()
get :: Handle -> IO a
writeBinary :: Binary a => FilePath -> a -> IO ()
writeBinary file x = do
hndl <- openBinaryFile file WriteMode
put_ hndl x
hClose hndl
readBinary :: Binary a => FilePath -> IO a
readBinary file = do
hndl <- openBinaryFile file ReadMode
res <- get hndl
hClose hndl
return res
putByte :: Handle -> Int -> IO ()
putByte hndl x = hPutChar hndl (chr x)
getByte :: Handle -> IO Int
getByte hndl = liftM ord $ hGetChar hndl
instance Binary a => Binary [a] where
put_ bh [] = putByte bh 0
put_ bh xs = do putByte bh (length a); mapM_ (put_ bh) a; put_ bh b
where (a,b) = splitAt 100 xs
get bh = do h <- getByte bh
case h of
0 -> return []
_ -> do xs <- replicateM h (get bh)
ys <- get bh
return (xs ++ ys)
instance Binary a => Binary (Maybe a) where
put_ bh Nothing = putByte bh 0
put_ bh (Just x) = putByte bh 1 >> put_ bh x
get bh = do h <- getByte bh
case h of
0 -> return Nothing
1 -> liftM Just $ get bh
instance (Binary a, Binary b) => Binary (a,b) where
put_ h (a,b) = put_ h a >> put_ h b
get h = do a <- get h
b <- get h
return (a,b)
instance (Binary a, Binary b, Binary c) => Binary (a,b, c) where
put_ h (a,b,c) = put_ h a >> put_ h b >> put_ h c
get h = do a <- get h
b <- get h
c <- get h
return (a,b,c)
instance Binary Bool where
put_ hndl x = hPutChar hndl (if x then '1' else '0')
get hndl = hGetChar hndl >>= return . (== '1')
instance Binary Char where
put_ = hPutChar
get = hGetChar
showPut :: Show a => Handle -> a -> IO ()
showPut h x = put_ h (show x)
showGet :: Read a => Handle -> IO a
showGet h = liftM read $ get h
instance Binary Int where{put_ = showPut; get = showGet}
instance Binary Integer where{put_ = showPut; get = showGet}
instance Binary Float where{put_ = showPut; get = showGet}
instance Binary Double where{put_ = showPut; get = showGet}