{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE UndecidableInstances       #-}

-- | Sometimes you need to care about the path you take.
--
-- Suppose you're parsing some data -- you're likely using the 'Either'
-- type to keep track of errors. This is good!
--
-- Unfortunately, sometimes you have weird nested data, and then when you
-- go to parse, you get this back:
--
-- @
-- 'Left' (IntParseError "c")
-- @
--
-- Now, you're left wondering: "Where is that @c@? How did it get there?
-- How can I minimally reproduce this?" And unfortunately, all of the
-- context is lost: the error has been thrown from deep in the stack, and
-- you're stuck munging around in the source data.
--
-- When you're dealing with some deeply nested data that might fail, you're
-- left wondering: How do I get there from here? Let's leave breadcrumbs
-- along the way, so that we can find our way back!
--
-- Suppose you're trying to find a specific value in a deeply nested data
-- structure. You can use 'Bread' to lay breadcrumbs and then 'exit' as
-- soon as you've found what you need, collecting the breadcrumbs along the
-- way.
module Control.Monad.Bread where

import           Control.Monad.Except
import           Control.Monad.Reader
import           Control.Monad.State
import           Control.Monad.Writer
import           Data.Functor.Identity

-- | 'BreadT' is a monad transformer that allows you to leave breadcrumbs
-- of types @crumb@ while you're performing some effects on the underlying
-- monad @m@. If you want to exit early, then @'exit' early@ will end up
-- returning a @'Left' (crumbs, early)@, where @crumbs@ is a list of all
-- breadcrumbs that you've left so far.
--
-- @since 0.1.0.0
newtype BreadT crumb exit m a
    = BreadT
    { unBreadT :: ReaderT [crumb] (ExceptT ([crumb], exit) m) a
    }
    deriving
        ( Functor
        , Applicative
        , Monad
        , MonadState s
        , MonadIO
        , MonadWriter w
        )

-- | Unwrap the 'BreadT' part of a monad transformer stack. The return type
-- contains 'Either' a pair of the breadcrumbs and the thrown error, or
-- the result value.
--
-- @since 0.1.0.0
runBreadT
    :: BreadT crumb exit m a
    -> m (Either ([crumb], exit) a)
runBreadT = runExceptT . flip runReaderT [] . unBreadT

-- | A monad that can collect breadcrumbs and exit early with them, but do
-- nothing else.
--
-- @since 0.1.0.0
type Bread crumb exit = BreadT crumb exit Identity

-- | Run a 'Bread' computation, returning either a pair of the breadcrumbs
-- and error or a successful result.
--
-- @since 0.1.0.0
runBread :: Bread crumb exit a -> Either ([crumb], exit) a
runBread = runIdentity . runBreadT

-- | Lay a breadcrumb, so you'll know where you came from.
--
-- >>> runBread (withCrumb 'a' (exit "Nope"))
-- Left ("a", "Nope")
--
-- @since 0.1.0.0
withCrumb
    :: Monad m
    => crumb
    -> BreadT crumb exit m a
    -> BreadT crumb exit m a
withCrumb crumb = BreadT . local (crumb :) . unBreadT

-- | Short circuit the 'BreadT' computation. This causes the computation to
-- exit with the provided @exit@ value and the @crumb@s collected along the
-- way.
--
-- @since 0.1.0.0
exit :: Monad m => exit -> BreadT crumb exit m a
exit err =
    BreadT
        $ ReaderT
        $ \crumb -> ExceptT
        $ pure
        $ Left (crumb, err)

-- | Sometimes, a 'BreadT' computation short-circuits with an 'exit', but
-- you don't want it to 'exit' just yet -- perhaps you want to take
-- a different path. This function lets you handle 'exit' and potentially
-- choose a different path.
--
-- @
-- 'withCrumb' 1 $ do
--      exit "I'm tired"
--          `handleExit` \reason ->
--              pure "No, let's persevere!"
-- @
--
-- @since 0.1.0.0
handleExit
    :: Monad m
    => BreadT crumb exit m a
    -> (exit -> BreadT crumb exit m a)
    -> BreadT crumb exit m a
handleExit action cb =
    BreadT
        $ ReaderT
        $ \crumb -> catchError
            (runReaderT (unBreadT action) crumb)
            (flip runReaderT crumb . unBreadT . cb . snd)

-- | Return the current collection of crumbs collected thus far.
--
-- @since 0.1.0.0
crumbs :: Monad m => BreadT crumb exit m [crumb]
crumbs = BreadT ask

-- | The 'MonadReader' instance for 'BreadT' delegates to the underlying
-- instance for @m@.
instance MonadReader r m => MonadReader r (BreadT crumb exit m) where
    ask = BreadT (lift ask)
    local f (BreadT (ReaderT crumb'ema)) =
        BreadT . ReaderT $ local f . crumb'ema

-- | The 'MonadError' instance for 'BreadT' gathers the @crumb@otations
-- collected so far, and throws the exception paired with the crumbotations.
instance (Monad m) => MonadError exit (BreadT crumb exit m) where
    throwError = exit
    catchError = handleExit

instance  MonadTrans (BreadT crumb exit) where
    lift = BreadT . lift . lift