{-# LANGUAGE LambdaCase, Safe #-}
-- | Eta inverses for some vernacular monads.
module Control.Monad.EtaInverse where
import Control.Monad.Writer
import Control.Monad.Trans.Maybe
import Control.Monad.Free
import qualified Control.Monad.Trans.Free as TF
import Control.Monad.Identity

class (Monad f) => EtaInverse f where
        -- Laws:
        --
        -- * etaInv.return = return.
        --
        -- * For 'x' not in the range of 'eta', etaInv x = mzero.
        etaInv :: f t -> Maybe t

instance EtaInverse Identity where
        etaInv = return.runIdentity

instance (Monoid s, Eq s) => EtaInverse((,) s) where
        etaInv (x,x2) = do
                -- Eta attaches an "empty" monoid result to its output; this situation
                -- can be detected by comparing against the empty monoid value.
                guard(x==mempty)
                return x2

instance (Monoid s, Eq s, EtaInverse f) => EtaInverse(WriterT s f) where
        etaInv x = do
                (x,x2) <- etaInv(runWriterT x)
                guard(x2==mempty)
                return x

instance EtaInverse Maybe where
        etaInv = id

instance EtaInverse [] where
        etaInv = \ case
                [x] -> return x
                _ -> mzero


instance (EtaInverse f) => EtaInverse(MaybeT f) where
        etaInv x =
                join(etaInv(runMaybeT x))

instance (Functor f) => EtaInverse(Free f) where
        etaInv (Pure x) = return x
        etaInv _ = mzero

instance (Functor f, EtaInverse f2) => EtaInverse(TF.FreeT f f2) where
        etaInv (TF.FreeT x) = case etaInv x of
                Just(TF.Pure x) -> return x
                _ -> mzero