{-# LANGUAGE GADTs #-}
{- |
Module: Control.Monad.Failable
Description: Yet another error monad but for people who are not crazy
Copyright: (c) Erick Gonzalez, 2019
License: BSD3
Maintainer: erick@codemonkeylabs.de

This library provides a 'Failable' error monad class to unify errors across monads and
transformers most commonly used to implement pipelines that can fail.

-}

module Control.Monad.Failable (
-- |
-- I am sure a lot of ink has been spilled in forums and around water coolers all around the
-- world, debating the merits and fallacies of one approach or the other. The reason for this
-- package is not to participate in this discussion but rather to provide a simple no nonsense
-- means of signaling a computation "failure" in those monads that provide the inherent means
-- to do so, and to do it in a consistent manner.
--
-- When triggering a failure in a monadic context which is an instance of this class, simply
-- define your custom exception type and abort the computation with 'failure'. For example:
--
-- @
-- data MyException = SomeProblem
--                  | AnotherProblem
--                  deriving (Show, Typeable)
--
-- instance Exception MyException
--
-- foo :: (Failable m) => Int -> m Int
-- foo x = do
--   y <- bar x
--   if y < 0
--     then failure SomeProblem
--     else return y
-- @
--
--
-- if foo is then called in a 'Maybe' Monad, it would return @Nothing@ in case of error
-- or @Just ()@ of course if succesful. In an @Either SomeException@ context, it would
-- return @Left SomeProblem@ in case of error or @Right ()@ upon success, etc.
-- When it comes to monad transformers incorporating the concept of failure, such as 'MaybeT' or
-- 'ExceptT', it preserves the expected semantics upon failure of yielding an @m Nothing@ or
-- @m (Either SomeException a)@ when the transformer is "ran", instead of adopting the strategy
-- of passing the failure to the underlying monad (transformer) which might for example, throw
-- an async exception (as is the case of IO). Since the reason d'etre for something like runMaybeT
-- is to provide the underlying monad (transformer) with `Maybe` like behaviour, i.e. have
-- @Nothing@ be returned in case of aborting the 'Maybe' pipeline so to speak, then throwing an
-- exception defeats IMHO the purpose of using 'MaybeT' in the first place.
--
-- >>> foo 2 :: Maybe Int
-- >>> Nothing
--
-- >>> foo 2 :: Either SomeException Int
-- >>> Left SomeProblem
--
-- >>> foo 2 :: IO Int
-- >>> * * * Exception: SomeProblem
--
-- >>> runMaybeT $ foo 2 :: IO (Maybe Int)
-- >>> Nothing
--
                               Failable(..), failableIO) where

import Control.Exception            (Exception(..), SomeException, throw)
import Control.Monad.Except         (ExceptT, throwError)
import Control.Monad.IO.Class       (MonadIO, liftIO)
import Control.Monad.Trans.Maybe    (MaybeT(..))
import System.IO.Error              (tryIOError)


-- | The 'Failable' class. A Monad which is an instance of this class can be used as a context
-- in a function running in one with this class constraint, in order to report error conditions

class (Monad m) => Failable m where
    -- | trigger a failure. It takes an exception value as argument and it returns whatever
    -- might be used to abort a monadic computation in the monad instantiating this class.
    failure :: (Exception e) => e -> m a

instance Failable IO where
    failure = throw

instance Failable [] where
    failure _ = []

instance Failable Maybe where
    failure _ = Nothing

instance e ~ SomeException => Failable (Either e) where
    failure = Left . toException

instance (Monad m) => Failable (MaybeT m) where
    failure _ = MaybeT $ pure Nothing

instance (Monad m, e ~ SomeException) => Failable (ExceptT e m) where
    failure = throwError . toException

-- | Perform a set of IO actions in a 'Failable' 'MonadIO' instance, triggering a
-- 'failure' upon an IO exception, instead of blindly triggering an asynchronos exception. This
-- serves ultimately to unify error handling in the 'Failable' context. For example:
--
-- @
-- foo :: (Failable m, MonadIO m) => m ()
-- foo = do
--   failableIO $ do
--     txt <- readFile "foo.txt"
--     putStrLn txt
-- @
--
-- >>> λ> runExceptT foo
-- >>> Left foo.txt: openFile: does not exist (No such file or directory)
-- >>>
-- >>> λ> runMaybeT foo
-- >>> Nothing
-- >>>
-- >>> λ> foo
-- >>> *** Exception: foo.txt: openFile: does not exist (No such file or directory)
--
failableIO :: (Failable m, MonadIO m) => IO a -> m a
failableIO actions = do
  result <- liftIO . tryIOError $ actions
  either failure return result