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

module Game.Antisplice.Utils.ListBuilder where

import Control.Arrow
import Control.Monad.Trans.Class
import Control.Monad.Identity

class Monad l => ListBuilder l i | l -> i where
  li :: i -> l ()
  buildList :: l () -> [i]

newtype StrictBuilderT i m a = StrictBuilder { runStrictBuilderT :: [i] -> m (a,[i]) }
type StrictBuilder i = StrictBuilderT i Identity

instance Functor m => Functor (StrictBuilderT i m) where
  fmap f a = StrictBuilder $ \s -> fmap (first f) $ runStrictBuilderT a s

instance Monad m => Monad (StrictBuilderT i m) where
  return a = StrictBuilder $ \s -> return (a,s)
  m >>= f = StrictBuilder $ \s -> do (a,s') <- runStrictBuilderT m s; runStrictBuilderT (f a) s'

instance MonadTrans (StrictBuilderT i) where
  lift m = StrictBuilder $ \s -> do a <- m; return (a,s)

instance ListBuilder (StrictBuilder i) i where
  li a = seq a $ StrictBuilder $ \s -> return ((),s++[a])
  buildList m = snd $ runIdentity $ runStrictBuilderT m []

strictBuild :: StrictBuilderT i Identity () -> [i]
strictBuild = buildList

newtype LazyBuilderT i m a = LazyBuilder { runLazyBuilderT :: ([i] -> [i]) -> m (a,[i] -> [i]) }
type LazyBuilder i = LazyBuilderT i Identity

instance Functor m => Functor (LazyBuilderT i m) where
  fmap f a = LazyBuilder $ \s -> fmap (first f) $ runLazyBuilderT a s

instance Monad m => Monad (LazyBuilderT i m) where
  return a = LazyBuilder $ \s -> return (a,s)
  m >>= f = LazyBuilder $ \s -> do (a,s') <- runLazyBuilderT m s; runLazyBuilderT (f a) s'

instance MonadTrans (LazyBuilderT i) where
  lift m = LazyBuilder $ \s -> do a <- m; return (a,s)

instance ListBuilder (LazyBuilder i) i where
  li a = LazyBuilder $ \s -> return ((),s.([a]++))
  buildList m = ($[]) $ snd $ runIdentity $ runLazyBuilderT m ([]++)

lazyBuild :: LazyBuilderT i Identity () -> [i]
lazyBuild = buildList

lis :: ListBuilder l i => [i] -> l ()
lis = mapM_ li

lit :: ListBuilder l (a,b) => a -> b -> l ()
lit a b = li (a,b)