module Data.Generics.Serialization.Streams
(MonadWStream(..), ListBuild, buildList, MonadRStream(..), ListRead,
withList) where
class Monad m => MonadWStream m e | m -> e where
putv :: [e] -> m ()
class Monad m => MonadRStream m e | m -> e where
getv :: m e
peekv :: m (Maybe e)
data ListBuild e a = LB ([e] -> [e]) a
instance Monad (ListBuild e) where
return x = LB id x
(LB l1 _) >> (LB l2 a) = LB (l1 . l2) a
(LB l1 x) >>= fn = case fn x of (LB l2 y) -> LB (l1 . l2) y
instance MonadWStream (ListBuild e) e where
putv l = LB (l++) ()
buildList :: ListBuild e () -> [e]
buildList (LB fn _) = fn []
data ListRead e a = LR { unLR :: [e] -> Maybe ([e], a) }
instance Monad (ListRead e) where
fail _ = LR (\_ -> Nothing)
return x = LR (\l -> Just (l, x))
(LR th) >>= fn = LR (\l -> case th l of Just (l', x) -> unLR (fn x) l'
Nothing -> Nothing)
instance MonadRStream (ListRead e) e where
getv = LR (\l -> case l of (x:xs) -> Just (xs, x)
[] -> Nothing)
peekv = LR (\l -> Just (l, case l of (x:_) -> Just x
[] -> Nothing))
withList :: ListRead e a -> [e] -> Maybe a
withList a l = case unLR a l of Just ([], x) -> Just x
_ -> Nothing