{-# LANGUAGE FunctionalDependencies, FlexibleInstances, MultiParamTypeClasses #-}

-- |This module provides a limited form of stream used by the serializers,
-- and utility functions for using serializers on lists.

module Data.Generics.Serialization.Streams
    (MonadWStream(..), ListBuild, buildList, MonadRStream(..), ListRead,
     withList) where

-- |The class of streams that support write operations.  e is the type
-- of elements written.
class Monad m => MonadWStream m e | m -> e where
    putv :: [e] -> m ()

-- |The class of readable streams.
class Monad m => MonadRStream m e | m -> e where
    -- |Read one element.  Invokes 'fail' if there are no more to read.
    getv :: m e
    -- |Examine the next element without removing it.
    peekv :: m (Maybe e)

-- |An implementation of 'MonadWStream' using difference lists.
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++) ()

-- |Run an action in a 'MonadWStream' to produce a list, using 'ListBuild'.
buildList :: ListBuild e () -> [e]
buildList (LB fn _) = fn []

-- |An implementation of 'MonadRStream' using lists.
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))
-- |Run an action in a 'MonadRStream' to consume a list, using 'ListRead'.
withList :: ListRead e a -> [e] -> Maybe a
withList a l = case unLR a l of Just ([], x) -> Just x
                                _            -> Nothing