content: 
  module CFTT.Improve where
  
  import Control.Monad.Identity
  import Control.Monad.Except
  import Control.Monad.Reader
  import Control.Monad.State.Strict
  import Control.Monad.Trans.Maybe
  
  import CFTT.Up
  import CFTT.Gen
  import CFTT.Split
  
  class MonadGen n => Improve m n | m -> n, n -> m where
    up   :: Up (m a) -> n (Up a)
    down :: n (Up a) -> Up (m a)
  
  instance Improve Identity Gen where
    up x = Gen \k -> k [||runIdentity $$x||]
    down x = unGen x \a -> [||Identity $$a||]
  
  instance (Improve m n) => Improve (StateT s m) (StateT (Up s) n) where
  
    up x = StateT \s ->
      do as <- up [|| runStateT $$x $$s ||]
         split as
  
    down x = [|| StateT \s -> $$(down
      do (a, s) <- runStateT x [||s||]
         pure [||($$a, $$s)||]
         )||]
  
  instance (Improve m n) => Improve (ExceptT e m) (ExceptT (Up e) n) where
    up x = ExceptT do
      ea <- up [||runExceptT $$x||]
      split ea
  
    down (ExceptT x) =
      [|| ExceptT $$(down (x >>= \case
            Left e  -> pure [||Left $$e||]
            Right a -> pure [||Right $$a||]
                          )) ||]
  
  instance Improve m n => Improve (MaybeT m) (MaybeT n) where
    up x = MaybeT do
      ma <- up [||runMaybeT $$x||]
      split ma
  
    down (MaybeT x) =
      [|| MaybeT $$(down (x >>= \case
            Nothing -> pure [||Nothing||]
            Just a -> pure [||Just $$a||])) ||]
  
  instance Improve m n => Improve (ReaderT r m) (ReaderT (Up r) n) where
    up   x = ReaderT \r -> up [||runReaderT $$x $$r||]
    down x = [|| ReaderT \r -> $$(down (runReaderT x [||r||])) ||]
  