--------------------------------------------------------------------------------
--                                                                            --
--  monad transformers                                                        --
--                                                                            --
--------------------------------------------------------------------------------

class MonadT t where
  lift :: Monad m => m v -> t m v

--------------------------------------------------------------------------------
--                                                                            --
-- classes which are used to compose monads                                   --
--                                                                            --
--------------------------------------------------------------------------------

class Monad n => SwapL n where
  swapl :: Monad m => m (n x) -> n (m x)

class Monad n => SwapR n where
  swapr :: Monad m => n (m x) -> m (n x)
  
--------------------------------------------------------------------------------
--                                                                            --
--  monad specialisations                                                     --
--                                                                            --
--------------------------------------------------------------------------------

-- ErrMonad

class Monad m => ErrMonad m where
  err :: Msg -> m x

instance (ErrMonad m, MonadT t) => ErrMonad (t m) where
  err = lift . err
  
-- EnvMonad

class ErrMonad m => EnvMonad env m where
  read :: m env
  with :: env -> m x -> m x

-- GenMonad
    
class (Monad m, Monoid s) => GenMonad s m where
  gen :: s -> m ()

instance (GenMonad s m, MonadT t) => GenMonad s (t m) where
  gen = lift . gen
  
-- StateMonad

class ErrMonad m => StateMonad state m where
  act :: (state -> state) -> m state

instance StateMonad state m => EnvMonad state m where
  read = act id
  with state m = do { act (\_ -> state) ; m }

instance (StateMonad state m, MonadT t) => StateMonad state (t m) where
  act = lift . act
    
takeFirst :: (Monad0 m, StateMonad [x] m) => m x
takeFirst = do { (x:_) <- act id ; result x }

dropFirst :: StateMonad [x] m => m [x]
dropFirst = act (\(_:xs) -> xs) 

-- ListMonad

class Monad m => ListMonad m where
  amb :: List (m x) -> m x

--------------------------------------------------------------------------------
--                                                                            -- -- IMPORTANT REMARK:                                                          --
--                                                                            --
-- there is a better way to do what follows                                   --
-- using monad transformer composition!                                       --
--                                                                            --
-- However, this composition does not seem to                                 --
-- work with restricted type synonyms and I                                   --
-- prefer not to use a qualified data definition ...                          --
--                                                                            --
--                                                                            --
--------------------------------------------------------------------------------

instance MonadT t 
        => ListMonad (t List) where
  amb = join . lift
 
instance (MonadT t1, MonadT t2, 
          Monad (t1 List)) 
        => ListMonad (t2 (t1 List)) where
  amb = join . lift . lift
  
instance (MonadT t1, MonadT t2, MonadT t3,
          Monad (t1 List), 
          Monad (t2 (t1 List))) 
        => ListMonad (t3 (t2 (t1 List))) where
  amb = join . lift . lift . lift
 
instance (MonadT t1, MonadT t2, MonadT t3, MonadT t4,
          Monad (t1 List), 
          Monad (t2 (t1 List)), 
          Monad (t3 (t2 (t1 List)))) 
        => ListMonad (t4 (t3 (t2 (t1 List)))) where
  amb = join . lift . lift . lift . lift
  
instance (MonadT t1, MonadT t2, MonadT t3, MonadT t4, MonadT t5,
          Monad (t1 List), 
          Monad (t2 (t1 List)), 
          Monad (t3 (t2 (t1 List))), 
          Monad (t4 (t3 (t2 (t1 List))))) 
        => ListMonad (t5 (t4 (t3 (t2 (t1 List))))) where
  amb = join . lift . lift . lift . lift . lift

-- ...

--------------------------------------------------------------------------------
