EtaInverse.hs

{-# 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