{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE Rank2Types           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
{-|
Module      : Knit.Report.Error
Description : knit-haskell functions to handle and raise errors in knit-haskell reports.
Copyright   : (c) Adam Conner-Sax 2019
License     : BSD-3-Clause
Maintainer  : adam_conner_sax@yahoo.com
Stability   : experimental

This module has various combinators for simplifying the throwing of Errors in knit-haskell.

<https://github.com/adamConnerSax/knit-haskell/tree/master/examples Examples> are available, and might be useful for seeing how all this works.

-}
module Knit.Report.Error
  (
    -- * Error combinators
    knitError
  , knitMaybe
  , knitEither
  , knitMapError
  )
where

import qualified Knit.Report.EffectStack       as K
import qualified Text.Pandoc.Error             as PA
import           Knit.Effect.PandocMonad        ( textToPandocText )

import qualified Data.Text                     as T

import qualified Polysemy                      as P
import qualified Polysemy.Error                as PE



-- | Throw an error with a specific message.  This will emerge as a 'PandocSomeError' in order
-- to avoid complicating the error type.
-- NB: The Member constraint is satisfied by KnitEffectStack m.
knitError :: P.Member (PE.Error PA.PandocError) r => T.Text -> P.Sem r a
knitError :: Text -> Sem r a
knitError msg :: Text
msg =
  PandocError -> Sem r a
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
PE.throw (Text -> PandocError
PA.PandocSomeError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ Text -> Text
textToPandocText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ "Knit User Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg)

-- | Throw on 'Nothing' with given message.  This will emerge as a 'PandocSomeError' in order
-- to avoid complicating the error type.
knitMaybe
  :: P.Member (PE.Error PA.PandocError) r => T.Text -> Maybe a -> P.Sem r a
knitMaybe :: Text -> Maybe a -> Sem r a
knitMaybe msg :: Text
msg = Sem r a -> (a -> Sem r a) -> Maybe a -> Sem r a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Sem r a
forall (r :: [Effect]) a.
Member (Error PandocError) r =>
Text -> Sem r a
knitError Text
msg) a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Throw on 'Left' with message.  This will emerge as a 'PandocSomeError' in order
-- to avoid complicating the error type.
knitEither
  :: P.Member (PE.Error PA.PandocError) r => Either T.Text a -> P.Sem r a
knitEither :: Either Text a -> Sem r a
knitEither = (Text -> Sem r a) -> (a -> Sem r a) -> Either Text a -> Sem r a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Sem r a
forall (r :: [Effect]) a.
Member (Error PandocError) r =>
Text -> Sem r a
knitError a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Map an error type, @e, into a 'PandocError' so it will be handled in this stack
knitMapError
  :: forall e r a
   . K.KnitEffects r
  => (e -> T.Text)
  -> P.Sem (PE.Error e ': r) a
  -> P.Sem r a
knitMapError :: (e -> Text) -> Sem (Error e : r) a -> Sem r a
knitMapError f :: e -> Text
f = (e -> PandocError) -> Sem (Error e : r) a -> Sem r a
forall e1 e2 (r :: [Effect]) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
PE.mapError ((e -> PandocError) -> Sem (Error e : r) a -> Sem r a)
-> (e -> PandocError) -> Sem (Error e : r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PA.PandocSomeError (Text -> PandocError) -> (e -> Text) -> e -> PandocError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
textToPandocText (Text -> Text) -> (e -> Text) -> e -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Text
f