{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- |
-- Copyright: (c) 2021 Xy Ren
-- License: BSD3
-- Maintainer: xy.r@outlook.com
-- Stability: experimental
-- Portability: non-portable (GHC only)
module Cleff.Fail
  ( -- * Effect
    Fail (..)
    -- * Interpretations
  , runFail
  , runFailIO
  ) where

import           Cleff
import           Cleff.Error
import qualified Control.Monad.Fail as Fail

-- * Effect

-- | An effect that expresses failure with a message. This effect allows the use of the 'MonadFail' class.
data Fail :: Effect where
  Fail :: String -> Fail m a

instance Fail :> es => Fail.MonadFail (Eff es) where
  fail :: String -> Eff es a
fail = Fail (Eff es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
(e :> es) =>
e (Eff es) ~> Eff es
send (Fail (Eff es) a -> Eff es a)
-> (String -> Fail (Eff es) a) -> String -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Fail (Eff es) a
forall (m :: Type -> Type) a. String -> Fail m a
Fail

-- * Interpretations

-- | Run a 'Fail' effect in terms of 'Error'.
runFail :: Eff (Fail ': es) a -> Eff es (Either String a)
runFail :: Eff (Fail : es) a -> Eff es (Either String a)
runFail = Eff (Error String : es) a -> Eff es (Either String a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
Eff (Error e : es) a -> Eff es (Either e a)
runError (Eff (Error String : es) a -> Eff es (Either String a))
-> (Eff (Fail : es) a -> Eff (Error String : es) a)
-> Eff (Fail : es) a
-> Eff es (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler Fail (Error String : es)
-> Eff (Fail : es) ~> Eff (Error String : es)
forall (e' :: (Type -> Type) -> Type -> Type)
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e (e' : es) -> Eff (e : es) ~> Eff (e' : es)
reinterpret \case
  Fail msg -> String -> Eff (Error String : es) a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError String
msg
{-# INLINE runFail #-}

-- | Run a 'Fail' effect in terms of throwing exceptions in 'IO'.
runFailIO :: IOE :> es => Eff (Fail ': es) ~> Eff es
runFailIO :: Eff (Fail : es) ~> Eff es
runFailIO = Handler Fail es -> Eff (Fail : es) ~> Eff es
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e es -> Eff (e : es) ~> Eff es
interpret \case
  Fail msg -> IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
Fail.fail String
msg
{-# INLINE runFailIO #-}