{-# LANGUAGE FlexibleContexts #-}

-- | This module provides helpers for converting partiality types into
-- 'MonadFail' computations.
--
-- 'MonadFail''s purpose is to handle pattern-match failures in
-- @do@-expressions, and not to be a general-purpose error-handling
-- mechanism. Despite this, some libraries use it as one, and this
-- module can help you report errors via 'MonadFail'.
--
-- The operator mnemonics are the same as in
-- "Control.Monad.Error.Hoist", but with @#@ in place of @?@. You can
-- imagine a hastily-written @F@ looking kinda-sorta like a @#@, if it
-- helps.

module Control.Monad.Fail.Hoist
  ( hoistFail
  , hoistFail'
  , hoistFailM
  , hoistFailM'
  -- ** Operators
  , (<%#>)
  , (<%!#>)
  , (<#>)
  , (<!#>)
  ) where

import           Control.Monad.Error.Hoist  (PluckError(..))

-- | Given a conversion from the error in @t a@ to @String@, we can hoist the
-- computation into @m@.
--
-- @
-- 'hoistFail' :: 'MonadFail' m => (() -> String) -> 'Maybe'    a -> m a
-- 'hoistFail' :: 'MonadFail' m => (a  -> String) -> 'Either' a b -> m b
-- @
hoistFail
  :: (PluckError e t m, MonadFail m)
  => (e -> String)
  -> t a
  -> m a
hoistFail :: forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
(e -> String) -> t a -> m a
hoistFail e -> String
f = (e -> m a) -> (a -> m a) -> t a -> m a
forall r a. (e -> m r) -> (a -> m r) -> t a -> m r
forall e (t :: * -> *) (m :: * -> *) r a.
PluckError e t m =>
(e -> m r) -> (a -> m r) -> t a -> m r
foldError (String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> (e -> String) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
f) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Hoist computations whose error type is already 'String'.
hoistFail' :: (PluckError String t m, MonadFail m) => t a -> m a
hoistFail' :: forall (t :: * -> *) (m :: * -> *) a.
(PluckError String t m, MonadFail m) =>
t a -> m a
hoistFail' = (String -> String) -> t a -> m a
forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
(e -> String) -> t a -> m a
hoistFail String -> String
forall a. a -> a
id

-- | A version of 'hoistFail' that operates on values already in the monad.
--
-- @
-- 'hoistFailM' :: 'MonadFail' m => (() -> String) -> m ('Maybe'       a) ->           m a
-- 'hoistFailM' :: 'MonadFail' m => (a  -> String) -> m ('Either'  a   b) ->           m b
-- 'hoistFailM' :: 'MonadFail' m => (a  -> String) ->    'ExceptT' a m b  -> 'ExceptT' a m b
-- @
hoistFailM
  :: (PluckError e t m, MonadFail m)
  => (e -> String)
  -> m (t a)
  -> m a
hoistFailM :: forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
(e -> String) -> m (t a) -> m a
hoistFailM e -> String
f m (t a)
m = m (t a)
m m (t a) -> (t a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> String) -> t a -> m a
forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
(e -> String) -> t a -> m a
hoistFail e -> String
f

-- | A version of 'hoistFail'' that operates on values already in the monad.
--
-- @
-- 'hoistFailM'' :: 'MonadFail' m => m ('Maybe'       a) ->           m a
-- 'hoistFailM'' :: 'MonadFail' m => m ('Either'  a   b) ->           m b
-- 'hoistFailM'' :: 'MonadFail' m =>    'ExceptT' a m b  -> 'ExceptT' a m b
-- @
hoistFailM'
  :: (PluckError String t m, MonadFail m)
  => m (t a)
  -> m a
hoistFailM' :: forall (t :: * -> *) (m :: * -> *) a.
(PluckError String t m, MonadFail m) =>
m (t a) -> m a
hoistFailM' = (String -> String) -> m (t a) -> m a
forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
(e -> String) -> m (t a) -> m a
hoistFailM String -> String
forall a. a -> a
id

-- | A flipped synonym for 'hoistFail'. Mnemonic: @#@ looks a bit like @F@.
--
-- @
-- ('<%#>') :: 'MonadFail' m => 'Maybe'    a -> (() -> e) -> m a
-- ('<%#>') :: 'MonadFail' m => 'Either' a b -> (a  -> e) -> m b
-- @
(<%#>)
  :: (PluckError e t m, MonadFail m)
  => t a
  -> (e -> String)
  -> m a
<%#> :: forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
t a -> (e -> String) -> m a
(<%#>) = ((e -> String) -> t a -> m a) -> t a -> (e -> String) -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (e -> String) -> t a -> m a
forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
(e -> String) -> t a -> m a
hoistFail

infixl 8 <%#>
{-# INLINE (<%#>) #-}

-- | A flipped synonym for 'hoistFailM'.
--
-- @
-- ('<%!#>') :: 'MonadError' e m => m ('Maybe'       a) -> (() -> e) ->           m a
-- ('<%!#>') :: 'MonadError' e m => m ('Either'  a   b) -> (a  -> e) ->           m b
-- ('<%!#>') :: 'MonadError' e m =>    'ExceptT' a m b  -> (a  -> e) -> 'ExceptT' a m b
-- @
(<%!#>)
  :: (PluckError e t m, MonadFail m)
  => m (t a)
  -> (e -> String)
  -> m a
<%!#> :: forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
m (t a) -> (e -> String) -> m a
(<%!#>) = ((e -> String) -> m (t a) -> m a)
-> m (t a) -> (e -> String) -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (e -> String) -> m (t a) -> m a
forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
(e -> String) -> m (t a) -> m a
hoistFailM

infixl 8 <%!#>
{-# INLINE (<%!#>) #-}

-- | A version of '<%#>' that ignores the error in @t a@ and fails
-- with a new one.
--
-- @
-- ('<#>') :: 'MonadFail' m => 'Maybe'    a -> String -> m a
-- ('<#>') :: 'MonadFail' m => 'Either' a b -> String -> m b
-- @
(<#>)
  :: (PluckError e t m, MonadFail m)
  => t a
  -> String
  -> m a
t a
m <#> :: forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
t a -> String -> m a
<#> String
e = t a
m t a -> (e -> String) -> m a
forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
t a -> (e -> String) -> m a
<%#> String -> e -> String
forall a b. a -> b -> a
const String
e

infixl 8 <#>
{-# INLINE (<#>) #-}

-- | A version of '<#>' that operates on values already in the monad.
--
-- @
-- ('<!#>') :: 'MonadFail m => m ('Maybe'       a) -> String ->           m a
-- ('<!#>') :: 'MonadFail m => m ('Either'  a   b) -> String ->           m b
-- ('<!#>') :: 'MonadFail m =>    'ExceptT' a m b  -> String -> 'ExceptT' a m b
-- @
(<!#>)
  :: (PluckError e t m, MonadFail m)
  => m (t a)
  -> String
  -> m a
m (t a)
m <!#> :: forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
m (t a) -> String -> m a
<!#> String
e = m (t a)
m m (t a) -> (t a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> String) -> t a -> m a
forall e (t :: * -> *) (m :: * -> *) a.
(PluckError e t m, MonadFail m) =>
(e -> String) -> t a -> m a
hoistFail (String -> e -> String
forall a b. a -> b -> a
const String
e)

infixl 8 <!#>
{-# INLINE (<!#>) #-}