module MonadFunctorInstances where
import ArrowClasses
import ArrowTypes(MonadArrT(..), ReaderArrT)
import Tools(pair)
import MonadTools(liftM0,liftM,liftM2)
import ReaderMonad()

instance (Monad m, Arrow q) => Arrow (MonadArrT m q) where
  arr f                       = MonadArrT (liftM0 (arr f)) -- = lift (arr f)
  MonadArrT f >>> MonadArrT g = MonadArrT (liftM2 (>>>) f g)
  MonadArrT f <<< MonadArrT g = MonadArrT (liftM2 (<<<) f g)
  first  (MonadArrT f)        = MonadArrT (liftM first f)
  second (MonadArrT f)        = MonadArrT (liftM second f)

instance ArrowChoice q => ArrowChoice (ReaderArrT r q) where
  MonadArrT f ||| MonadArrT g = MonadArrT (liftM2 (|||) f g)

instance ArrowZero q => ArrowZero (ReaderArrT r q) where
  zeroA = MonadArrT (liftM0 zeroA)

instance ArrowPlus q => ArrowPlus (ReaderArrT r q) where
  MonadArrT f <|> MonadArrT g = MonadArrT (liftM2 (<|>) f g)
  MonadArrT f <+> MonadArrT g = MonadArrT (liftM2 (<+>) f g)

-- ----------------------------------------------------------------
instance Arrow q => ReaderArrow r (ReaderArrT r q) where
  peek = MonadArrT (\r-> arr (pair r))
  poke g (MonadArrT f) = MonadArrT (\r-> f (g r))

instance (ArrowChoice q, ReaderArrow r q) => ReaderArrowChoice r q 

instance (StateArrow s q, Monad m) => StateArrow s (MonadArrT m q) where
  update f = lift (update f)

instance (Arrow q, Monad m) => ArrowTransformer (MonadArrT m) q where
  lift f = MonadArrT (liftM0 f)