{-# LANGUAGE RankNTypes, TypeFamilies, FlexibleContexts, ScopedTypeVariables, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances, DataKinds, GADTs #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Control.Effects.Early
( module Control.Effects, Early(..)
, earlyReturn, handleEarly, onlyDo, ifNothingEarlyReturn, ifNothingDo
, ifLeftEarlyReturn, ifLeftDo ) where
import Import
import Control.Effects
newtype EarlyValue a = EarlyValue { getEarlyValue :: a }
newtype Early a m = EarlyMethods
{ _earlyReturn :: forall b. a -> m b }
instance Effect (Early a) where
liftThrough (EarlyMethods f) = EarlyMethods (lift . f)
mergeContext m = EarlyMethods (\a -> do
f <- _earlyReturn <$> m
f a)
instance (Monad m, a ~ b) => MonadEffect (Early a) (ExceptT (EarlyValue b) m) where
effect = EarlyMethods (throwE . EarlyValue)
earlyReturn :: forall a b m. MonadEffect (Early a) m => a -> m b
EarlyMethods earlyReturn = effect
handleEarly :: Monad m => ExceptT (EarlyValue a) m a -> m a
handleEarly = fmap (either getEarlyValue id)
. runExceptT
onlyDo :: MonadEffect (Early a) m => m a -> m b
onlyDo m = m >>= earlyReturn
ifNothingEarlyReturn :: MonadEffect (Early a) m => a -> Maybe b -> m b
ifNothingEarlyReturn a = maybe (earlyReturn a) return
ifNothingDo :: MonadEffect (Early a) m => m a -> Maybe b -> m b
ifNothingDo m = maybe (onlyDo m) return
ifLeftEarlyReturn :: MonadEffect (Early c) m => (a -> c) -> Either a b -> m b
ifLeftEarlyReturn f = either (earlyReturn . f) return
ifLeftDo :: MonadEffect (Early c) m => (a -> m c) -> Either a b -> m b
ifLeftDo f = either (onlyDo . f) return