module Control.Monad.Trace where

import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
import Control.Monad.Trans.Writer.Strict (Writer, runWriter)
import Control.Monad.Writer.Class (tell)
import Data.Monoid (Last (Last))

------------------------------------------------------------
-- | `Trace` is a neat way to run a `Maybe` monad, but leave a trail behind
-- so that if it fails, we know what step it failed at.
type TraceMaybe a = MaybeT (Writer (Last a))

withTrace :: Monad m => Maybe a -> MaybeT m a
withTrace :: Maybe a -> MaybeT m a
withTrace = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a)
-> (Maybe a -> m (Maybe a)) -> Maybe a -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

attempt :: a -> TraceMaybe a ()
attempt :: a -> TraceMaybe a ()
attempt = Writer (Last a) () -> TraceMaybe a ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer (Last a) () -> TraceMaybe a ())
-> (a -> Writer (Last a) ()) -> a -> TraceMaybe a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last a -> Writer (Last a) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Last a -> Writer (Last a) ())
-> (a -> Last a) -> a -> Writer (Last a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Last a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

runTrace :: e -> TraceMaybe e a -> Either e a
runTrace :: e -> TraceMaybe e a -> Either e a
runTrace e
def TraceMaybe e a
trace =
  case Writer (Last e) (Maybe a) -> (Maybe a, Last e)
forall w a. Writer w a -> (a, w)
runWriter (Writer (Last e) (Maybe a) -> (Maybe a, Last e))
-> Writer (Last e) (Maybe a) -> (Maybe a, Last e)
forall a b. (a -> b) -> a -> b
$ TraceMaybe e a -> Writer (Last e) (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT TraceMaybe e a
trace of
    (Just a
value, Last e
_)            -> a -> Either e a
forall a b. b -> Either a b
Right a
value
    (Maybe a
Nothing, Last (Just e
msg)) -> e -> Either e a
forall a b. a -> Either a b
Left e
msg
    (Maybe a
Nothing, Last Maybe e
Nothing)    -> e -> Either e a
forall a b. a -> Either a b
Left e
def