{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE CPP                  #-}
{-# 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.EffectStack
Description : Knit effects stack, interpreters and configuration for Html reports
Copyright   : (c) Adam Conner-Sax 2019
License     : BSD-3-Clause
Maintainer  : adam_conner_sax@yahoo.com
Stability   : experimental

This module contains the core effect stack, interpreter and configurations for building Html reports.

<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.EffectStack
  (
    -- * Configuraiton
    KnitConfig(..)
  , defaultKnitConfig

    -- * Knit documents
  , knitHtml
  , knitHtmls

    -- * helpers
  , liftKnit

    -- * Constraints for knit-haskell actions (see examples)
  , KnitEffects
  , CacheEffects
  , CacheEffectsD
  , KnitOne
  , KnitMany
  , KnitBase
  )
where

import           Control.Monad.Except           ( MonadIO )
import qualified Control.Monad.Catch as Exceptions (SomeException, displayException) 
import qualified Data.Map                      as M
import           Data.Maybe (fromMaybe)
import qualified Data.Text                     as T
--import qualified Data.Serialize                as S
import qualified Data.Text.Lazy                as TL
import qualified Polysemy                      as P
import qualified Polysemy.Async                as P
import qualified Polysemy.Error                as PE
import qualified Polysemy.IO                   as PI
import qualified System.IO.Error               as IE

import qualified Text.Pandoc                   as PA
import qualified Text.Blaze.Html.Renderer.Text as BH

import qualified Knit.Report.Output            as KO
import qualified Knit.Report.Output.Html       as KO
import qualified Knit.Effect.Docs              as KD
import qualified Knit.Effect.Pandoc            as KP
import qualified Knit.Effect.PandocMonad       as KPM
import qualified Knit.Effect.Logger            as KLog
import qualified Knit.Effect.UnusedId          as KUI
import qualified Knit.Effect.AtomicCache       as KC
import qualified Knit.Effect.Serialize         as KS

{- |
Parameters for knitting. If possible, create this via, e.g., 

@
myConfig = (defaultKnitConfig $ Just "myCacheDir") { pandocWriterConfig = myConfig }
@
so that your code will still compile if parameters are added to this structure.

NB: the type parameters of this configuration specify the cache types:

- @sc :: Type -> Constraint@, where @c a@ is the constraint to be satisfied for serializable @a@.
- @ct :: Type@, is the value type held in the in-memory cache.
- @k  :: Type@, is the key type of the cache.

The @serializeDict@ field holds functions for encoding (@forall a. c a=> a -> ct@)
and decoding (@forall a. c a => ct -> Either SerializationError a@).

The @persistCache@ field holds an interpreter for the persistence layer of
the cache. See 'Knit.AtomicCache' for examples of persistence layers.

If you want to use a different serializer ("binary" or "store") and/or a different type to hold cached
values in-memory, you can set these fields accordingly.
-}
data KnitConfig sc ct k = KnitConfig { KnitConfig sc ct k -> Maybe Text
outerLogPrefix :: Maybe T.Text
                                     , KnitConfig sc ct k -> LogSeverity -> Bool
logIf :: KLog.LogSeverity -> Bool
                                     , KnitConfig sc ct k -> PandocWriterConfig
pandocWriterConfig :: KO.PandocWriterConfig
                                     , KnitConfig sc ct k -> SerializeDict sc ct
serializeDict :: KS.SerializeDict sc ct
                                     , KnitConfig sc ct k
-> forall (r :: [(* -> *) -> * -> *]).
   (Member (Embed IO) r, MemberWithError (Error CacheError) r,
    LogWithPrefixesLE r) =>
   InterpreterFor (Cache k ct) r
persistCache :: forall r. (P.Member (P.Embed IO) r
                                                                 , P.MemberWithError (PE.Error KC.CacheError) r
                                                                 , KLog.LogWithPrefixesLE r)
                                                    => P.InterpreterFor (KC.Cache k ct) r
                                     }


-- | Sensible defaults for a knit configuration.
defaultKnitConfig :: Maybe T.Text -- ^ Optional cache-directory.  Defaults to ".knit-haskell-cache".
                  -> KnitConfig KS.DefaultSerializer KS.DefaultCacheData T.Text -- ^ configuration
defaultKnitConfig :: Maybe Text -> KnitConfig DefaultSerializer DefaultCacheData Text
defaultKnitConfig cacheDirM :: Maybe Text
cacheDirM =
  let cacheDir :: Text
cacheDir = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe ".knit-haskell-cache" Maybe Text
cacheDirM
  in Maybe Text
-> (LogSeverity -> Bool)
-> PandocWriterConfig
-> SerializeDict DefaultSerializer DefaultCacheData
-> (forall (r :: [(* -> *) -> * -> *]).
    (Member (Embed IO) r, MemberWithError (Error CacheError) r,
     LogWithPrefixesLE r) =>
    InterpreterFor (Cache Text DefaultCacheData) r)
-> KnitConfig DefaultSerializer DefaultCacheData Text
forall (sc :: * -> Constraint) ct k.
Maybe Text
-> (LogSeverity -> Bool)
-> PandocWriterConfig
-> SerializeDict sc ct
-> (forall (r :: [(* -> *) -> * -> *]).
    (Member (Embed IO) r, MemberWithError (Error CacheError) r,
     LogWithPrefixesLE r) =>
    InterpreterFor (Cache k ct) r)
-> KnitConfig sc ct k
KnitConfig
     (Text -> Maybe Text
forall a. a -> Maybe a
Just "knit-haskell")
     LogSeverity -> Bool
KLog.nonDiagnostic
     (Maybe FilePath
-> TemplateVariables -> WriterOptionsF -> PandocWriterConfig
KO.PandocWriterConfig Maybe FilePath
forall a. Maybe a
Nothing TemplateVariables
forall k a. Map k a
M.empty WriterOptionsF
forall a. a -> a
id)
     SerializeDict DefaultSerializer DefaultCacheData
KS.cerealStreamlyDict
     ((Text -> FilePath)
-> InterpreterFor (Cache Text DefaultCacheData) r
forall k (r :: [(* -> *) -> * -> *]).
(Show k, Member (Embed IO) r, MemberWithError (Error CacheError) r,
 LogWithPrefixesLE r) =>
(k -> FilePath) -> InterpreterFor (Cache k DefaultCacheData) r
KC.persistStreamlyByteArray (\t :: Text
t -> Text -> FilePath
T.unpack (Text
cacheDir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)))
{-# INLINEABLE defaultKnitConfig #-}                               

-- | Create multiple HTML docs (as Text) from the named sets of pandoc fragments.
-- In use, you may need a type-application to specify @m@.
-- This allows use of any underlying monad to handle the Pandoc effects.
-- NB: Resulting documents are *Lazy* Text, as produced by the Blaze render function.
knitHtmls
  :: (MonadIO m, Ord k, Show k)
  => KnitConfig c ct k -- ^ configuration
  -> P.Sem (KnitEffectDocsStack c ct k m) () -- ^ computation producing a list of documents
  -> m (Either PA.PandocError [KP.DocWithInfo KP.PandocInfo TL.Text]) -- ^ Resulting docs or error, in base monad, usually IO.
knitHtmls :: KnitConfig c ct k
-> Sem (KnitEffectDocsStack c ct k m) ()
-> m (Either PandocError [DocWithInfo PandocInfo Text])
knitHtmls config :: KnitConfig c ct k
config =
  let KO.PandocWriterConfig mFP :: Maybe FilePath
mFP tv :: TemplateVariables
tv oF :: WriterOptionsF
oF = KnitConfig c ct k -> PandocWriterConfig
forall (sc :: * -> Constraint) ct k.
KnitConfig sc ct k -> PandocWriterConfig
pandocWriterConfig KnitConfig c ct k
config
  in  KnitConfig c ct k
-> Sem (KnitEffectStack c ct k m) [DocWithInfo PandocInfo Text]
-> m (Either PandocError [DocWithInfo PandocInfo Text])
forall (c :: * -> Constraint) ct k (m :: * -> *) a.
(MonadIO m, Ord k, Show k) =>
KnitConfig c ct k
-> Sem (KnitEffectStack c ct k m) a -> m (Either PandocError a)
consumeKnitEffectStack KnitConfig c ct k
config (Sem (KnitEffectStack c ct k m) [DocWithInfo PandocInfo Text]
 -> m (Either PandocError [DocWithInfo PandocInfo Text]))
-> (Sem (KnitEffectDocsStack c ct k m) ()
    -> Sem (KnitEffectStack c ct k m) [DocWithInfo PandocInfo Text])
-> Sem (KnitEffectDocsStack c ct k m) ()
-> m (Either PandocError [DocWithInfo PandocInfo Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PandocInfo
 -> PandocWithRequirements -> Sem (KnitEffectStack c ct k m) Text)
-> Sem (KnitEffectDocsStack c ct k m) ()
-> Sem (KnitEffectStack c ct k m) [DocWithInfo PandocInfo Text]
forall i a (effs :: [(* -> *) -> * -> *]) b.
(i -> a -> Sem effs b)
-> Sem (Docs i a : effs) () -> Sem effs [DocWithInfo i b]
KD.toDocListWithM
        (\(KP.PandocInfo _ tv' :: TemplateVariables
tv') a :: PandocWithRequirements
a ->
          (Html -> Text)
-> Sem (KnitEffectStack c ct k m) Html
-> Sem (KnitEffectStack c ct k m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Text
BH.renderHtml
            (Sem (KnitEffectStack c ct k m) Html
 -> Sem (KnitEffectStack c ct k m) Text)
-> (PandocWithRequirements -> Sem (KnitEffectStack c ct k m) Html)
-> PandocWithRequirements
-> Sem (KnitEffectStack c ct k m) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocWriterConfig
-> PandocWithRequirements -> Sem (KnitEffectStack c ct k m) Html
forall (effs :: [(* -> *) -> * -> *]).
PandocEffects effs =>
PandocWriterConfig -> PandocWithRequirements -> Sem effs Html
KO.toBlazeDocument (Maybe FilePath
-> TemplateVariables -> WriterOptionsF -> PandocWriterConfig
KO.PandocWriterConfig Maybe FilePath
mFP (TemplateVariables
tv' TemplateVariables -> TemplateVariables -> TemplateVariables
forall a. Semigroup a => a -> a -> a
<> TemplateVariables
tv) WriterOptionsF
oF)
            (PandocWithRequirements -> Sem (KnitEffectStack c ct k m) Text)
-> PandocWithRequirements -> Sem (KnitEffectStack c ct k m) Text
forall a b. (a -> b) -> a -> b
$ PandocWithRequirements
a
        )
{-# INLINEABLE knitHtmls #-}

-- | Create HTML Text from pandoc fragments.
-- In use, you may need a type-application to specify @m@.
-- This allows use of any underlying monad to handle the Pandoc effects.
-- NB: Resulting document is *Lazy* Text, as produced by the Blaze render function.
knitHtml
  :: (MonadIO m, Ord k, Show k)
  => KnitConfig c ct k -- ^ configuration
  -> P.Sem (KnitEffectDocStack c ct k m) () -- ^ computation producing a single document
  -> m (Either PA.PandocError TL.Text) -- ^ Resulting document or error, in base monad.  Usually IO.
knitHtml :: KnitConfig c ct k
-> Sem (KnitEffectDocStack c ct k m) ()
-> m (Either PandocError Text)
knitHtml config :: KnitConfig c ct k
config =
  (m (Either PandocError Html) -> m (Either PandocError Text))
-> (Sem (KnitEffectStack c ct k m) Html
    -> m (Either PandocError Html))
-> Sem (KnitEffectStack c ct k m) Html
-> m (Either PandocError Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either PandocError Html -> Either PandocError Text)
-> m (Either PandocError Html) -> m (Either PandocError Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Html -> Text)
-> Either PandocError Html -> Either PandocError Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Text
BH.renderHtml)) (KnitConfig c ct k
-> Sem (KnitEffectStack c ct k m) Html
-> m (Either PandocError Html)
forall (c :: * -> Constraint) ct k (m :: * -> *) a.
(MonadIO m, Ord k, Show k) =>
KnitConfig c ct k
-> Sem (KnitEffectStack c ct k m) a -> m (Either PandocError a)
consumeKnitEffectStack KnitConfig c ct k
config)
    (Sem (KnitEffectStack c ct k m) Html
 -> m (Either PandocError Text))
-> (Sem (KnitEffectDocStack c ct k m) ()
    -> Sem (KnitEffectStack c ct k m) Html)
-> Sem (KnitEffectDocStack c ct k m) ()
-> m (Either PandocError Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocWriterConfig
-> Sem (KnitEffectDocStack c ct k m) ()
-> Sem (KnitEffectStack c ct k m) Html
forall (effs :: [(* -> *) -> * -> *]).
PandocEffects effs =>
PandocWriterConfig -> Sem (ToPandoc : effs) () -> Sem effs Html
KO.pandocWriterToBlazeDocument (KnitConfig c ct k -> PandocWriterConfig
forall (sc :: * -> Constraint) ct k.
KnitConfig sc ct k -> PandocWriterConfig
pandocWriterConfig KnitConfig c ct k
config)
{-# INLINEABLE knitHtml #-}                               

-- | Constraints required to knit a document using effects from a base monad m.
type KnitBase m effs = (MonadIO m, P.Member (P.Embed m) effs)

-- | lift an action in a base monad into a Polysemy monad.  This is just a renaming of `P.embed` for convenience.
liftKnit :: P.Member (P.Embed m) r => m a -> P.Sem r a
liftKnit :: m a -> Sem r a
liftKnit = m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed
{-# INLINE liftKnit #-}                               

-- | Constraint alias for the effects we need (and run)
-- when calling 'knitHtml' or 'knitHtmls'.
-- Anything inside a call to Knit can use any of these effects.
-- Any other effects added to this stack will need to be run before @knitHtml(s)@
type KnitEffects r = (KPM.PandocEffects r
                     , P.Members [ KUI.UnusedId
                                 , KLog.Logger KLog.LogEntry
                                 , KLog.PrefixLog
                                 , P.Async
                                 , PE.Error KC.CacheError
                                 , PE.Error Exceptions.SomeException
                                 , PE.Error PA.PandocError
                                 , P.Embed IO] r
                     )
                     
-- | Constraint alias for the effects we need to use the cache.
type CacheEffects c ct k r = (P.Members [KS.SerializeEnv c ct, KC.Cache k ct] r)

-- | Constraint alias for the effects we need to use the default cache with @Text@ keys.
type CacheEffectsD r = CacheEffects KS.DefaultSerializer KS.DefaultCacheData T.Text r

-- | Constraint alias for the effects we need to knit one document.
type KnitOne r = (KnitEffects r, P.Member KP.ToPandoc r)

-- | Constraint alias for the effects we need to knit multiple documents.
type KnitMany r = (KnitEffects r, P.Member KP.Pandocs r)

-- From here down is unexported.  
-- | The exact stack we are interpreting when we knit
#if MIN_VERSION_pandoc(2,8,0)
type KnitEffectStack c ct k m
  = '[ KUI.UnusedId
     , KPM.Template
     , KPM.Pandoc
     , KS.SerializeEnv c ct
     , KC.Cache k ct
     , KLog.Logger KLog.LogEntry
     , KLog.PrefixLog
     , P.Async
     , PE.Error IOError
     , PE.Error KC.CacheError
     , PE.Error Exceptions.SomeException
     , PE.Error PA.PandocError
     , P.Embed IO
     , P.Embed m
     , P.Final m]
#else
type KnitEffectStack c ct k m
  = '[ KUI.UnusedId
     , KPM.Pandoc
     , KS.SerializeEnv c ct
     , KC.Cache k ct
     , KLog.Logger KLog.LogEntry
     , KLog.PrefixLog
     , P.Async
     , PE.Error IOError
     , PE.Error KC.CacheError
     , PE.Error Exceptions.SomeException
     , PE.Error PA.PandocError
     , P.Embed IO
     , P.Embed m
     , P.Final m]
#endif

-- | Add a Multi-doc writer to the front of the effect list
type KnitEffectDocsStack c ct k m = (KP.Pandocs ': KnitEffectStack c ct k m)

-- | Add a single-doc writer to the front of the effect list
type KnitEffectDocStack c ct k m = (KP.ToPandoc ': KnitEffectStack c ct k m)

-- | run all knit-effects in @KnitEffectStack m@
#if MIN_VERSION_pandoc(2,8,0)
consumeKnitEffectStack
  :: forall c ct k m a
   . (MonadIO m, Ord k, Show k)
  => KnitConfig c ct k
  -> P.Sem (KnitEffectStack c ct k m) a
  -> m (Either PA.PandocError a)
consumeKnitEffectStack :: KnitConfig c ct k
-> Sem (KnitEffectStack c ct k m) a -> m (Either PandocError a)
consumeKnitEffectStack config :: KnitConfig c ct k
config =
  Sem '[Final m] (Either PandocError a) -> m (Either PandocError a)
forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a
P.runFinal
  (Sem '[Final m] (Either PandocError a) -> m (Either PandocError a))
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem '[Final m] (Either PandocError a))
-> Sem (KnitEffectStack c ct k m) a
-> m (Either PandocError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Embed m, Final m] (Either PandocError a)
-> Sem '[Final m] (Either PandocError a)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
P.embedToFinal
  (Sem '[Embed m, Final m] (Either PandocError a)
 -> Sem '[Final m] (Either PandocError a))
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem '[Embed m, Final m] (Either PandocError a))
-> Sem (KnitEffectStack c ct k m) a
-> Sem '[Final m] (Either PandocError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: [(* -> *) -> * -> *]) a.
(MonadIO m, Member (Embed m) r) =>
Sem (Embed IO : r) a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(MonadIO m, Member (Embed m) r) =>
Sem (Embed IO : r) a -> Sem r a
PI.embedToMonadIO @m -- interpret (Embed IO) using m
  (Sem '[Embed IO, Embed m, Final m] (Either PandocError a)
 -> Sem '[Embed m, Final m] (Either PandocError a))
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem '[Embed IO, Embed m, Final m] (Either PandocError a))
-> Sem (KnitEffectStack c ct k m) a
-> Sem '[Embed m, Final m] (Either PandocError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: [(* -> *) -> * -> *]) a.
Sem (Error PandocError : r) a -> Sem r (Either PandocError a)
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
PE.runError @KPM.PandocError
  (Sem '[Error PandocError, Embed IO, Embed m, Final m] a
 -> Sem '[Embed IO, Embed m, Final m] (Either PandocError a))
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem '[Error PandocError, Embed IO, Embed m, Final m] a)
-> Sem (KnitEffectStack c ct k m) a
-> Sem '[Embed IO, Embed m, Final m] (Either PandocError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> PandocError)
-> Sem
     '[Error SomeException, Error PandocError, Embed IO, Embed m,
       Final m]
     a
-> Sem '[Error PandocError, Embed IO, Embed m, Final m] a
forall e1 e2 (r :: [(* -> *) -> * -> *]) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
PE.mapError SomeException -> PandocError
someExceptionToPandocError
  (Sem
   '[Error SomeException, Error PandocError, Embed IO, Embed m,
     Final m]
   a
 -> Sem '[Error PandocError, Embed IO, Embed m, Final m] a)
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem
         '[Error SomeException, Error PandocError, Embed IO, Embed m,
           Final m]
         a)
-> Sem (KnitEffectStack c ct k m) a
-> Sem '[Error PandocError, Embed IO, Embed m, Final m] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CacheError -> PandocError)
-> Sem
     '[Error CacheError, Error SomeException, Error PandocError,
       Embed IO, Embed m, Final m]
     a
-> Sem
     '[Error SomeException, Error PandocError, Embed IO, Embed m,
       Final m]
     a
forall e1 e2 (r :: [(* -> *) -> * -> *]) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
PE.mapError CacheError -> PandocError
cacheErrorToPandocError
  (Sem
   '[Error CacheError, Error SomeException, Error PandocError,
     Embed IO, Embed m, Final m]
   a
 -> Sem
      '[Error SomeException, Error PandocError, Embed IO, Embed m,
        Final m]
      a)
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem
         '[Error CacheError, Error SomeException, Error PandocError,
           Embed IO, Embed m, Final m]
         a)
-> Sem (KnitEffectStack c ct k m) a
-> Sem
     '[Error SomeException, Error PandocError, Embed IO, Embed m,
       Final m]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOError -> PandocError)
-> Sem
     '[Error IOError, Error CacheError, Error SomeException,
       Error PandocError, Embed IO, Embed m, Final m]
     a
-> Sem
     '[Error CacheError, Error SomeException, Error PandocError,
       Embed IO, Embed m, Final m]
     a
forall e1 e2 (r :: [(* -> *) -> * -> *]) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
PE.mapError IOError -> PandocError
ioErrorToPandocError -- (\e -> PA.PandocSomeError ("Exceptions.Exception thrown: " <> (T.pack $ show e)))
  (Sem
   '[Error IOError, Error CacheError, Error SomeException,
     Error PandocError, Embed IO, Embed m, Final m]
   a
 -> Sem
      '[Error CacheError, Error SomeException, Error PandocError,
        Embed IO, Embed m, Final m]
      a)
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem
         '[Error IOError, Error CacheError, Error SomeException,
           Error PandocError, Embed IO, Embed m, Final m]
         a)
-> Sem (KnitEffectStack c ct k m) a
-> Sem
     '[Error CacheError, Error SomeException, Error PandocError,
       Embed IO, Embed m, Final m]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
  '[Async, Error IOError, Error CacheError, Error SomeException,
    Error PandocError, Embed IO, Embed m, Final m]
  a
-> Sem
     '[Error IOError, Error CacheError, Error SomeException,
       Error PandocError, Embed IO, Embed m, Final m]
     a
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
Sem (Async : r) a -> Sem r a
P.asyncToIO -- this has to run after (above) the log, partly so that the prefix state is thread-local.
  (Sem
   '[Async, Error IOError, Error CacheError, Error SomeException,
     Error PandocError, Embed IO, Embed m, Final m]
   a
 -> Sem
      '[Error IOError, Error CacheError, Error SomeException,
        Error PandocError, Embed IO, Embed m, Final m]
      a)
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem
         '[Async, Error IOError, Error CacheError, Error SomeException,
           Error PandocError, Embed IO, Embed m, Final m]
         a)
-> Sem (KnitEffectStack c ct k m) a
-> Sem
     '[Error IOError, Error CacheError, Error SomeException,
       Error PandocError, Embed IO, Embed m, Final m]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogSeverity -> Bool)
-> Sem
     '[Logger LogEntry, PrefixLog, Async, Error IOError,
       Error CacheError, Error SomeException, Error PandocError, Embed IO,
       Embed m, Final m]
     a
-> Sem
     '[Async, Error IOError, Error CacheError, Error SomeException,
       Error PandocError, Embed IO, Embed m, Final m]
     a
forall (r :: [(* -> *) -> * -> *]) x.
MonadIO (Sem r) =>
(LogSeverity -> Bool)
-> Sem (Logger LogEntry : PrefixLog : r) x -> Sem r x
KLog.filteredLogEntriesToIO (KnitConfig c ct k -> LogSeverity -> Bool
forall (sc :: * -> Constraint) ct k.
KnitConfig sc ct k -> LogSeverity -> Bool
logIf KnitConfig c ct k
config)
  (Sem
   '[Logger LogEntry, PrefixLog, Async, Error IOError,
     Error CacheError, Error SomeException, Error PandocError, Embed IO,
     Embed m, Final m]
   a
 -> Sem
      '[Async, Error IOError, Error CacheError, Error SomeException,
        Error PandocError, Embed IO, Embed m, Final m]
      a)
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem
         '[Logger LogEntry, PrefixLog, Async, Error IOError,
           Error CacheError, Error SomeException, Error PandocError, Embed IO,
           Embed m, Final m]
         a)
-> Sem (KnitEffectStack c ct k m) a
-> Sem
     '[Async, Error IOError, Error CacheError, Error SomeException,
       Error PandocError, Embed IO, Embed m, Final m]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpreterFor
  (Cache k ct)
  '[Logger LogEntry, PrefixLog, Async, Error IOError,
    Error CacheError, Error SomeException, Error PandocError, Embed IO,
    Embed m, Final m]
-> InterpreterFor
     (Cache k ct)
     '[Logger LogEntry, PrefixLog, Async, Error IOError,
       Error CacheError, Error SomeException, Error PandocError, Embed IO,
       Embed m, Final m]
forall k (r :: [(* -> *) -> * -> *]) ct.
(Ord k, Show k, Member (Embed IO) r,
 MemberWithError (Error CacheError) r, LogWithPrefixesLE r) =>
InterpreterFor (Cache k ct) r -> InterpreterFor (Cache k ct) r
KC.runPersistenceBackedAtomicInMemoryCache' (KnitConfig c ct k
-> forall (r :: [(* -> *) -> * -> *]).
   (Member (Embed IO) r, MemberWithError (Error CacheError) r,
    LogWithPrefixesLE r) =>
   InterpreterFor (Cache k ct) r
forall (sc :: * -> Constraint) ct k.
KnitConfig sc ct k
-> forall (r :: [(* -> *) -> * -> *]).
   (Member (Embed IO) r, MemberWithError (Error CacheError) r,
    LogWithPrefixesLE r) =>
   InterpreterFor (Cache k ct) r
persistCache KnitConfig c ct k
config)
  (Sem
   '[Cache k ct, Logger LogEntry, PrefixLog, Async, Error IOError,
     Error CacheError, Error SomeException, Error PandocError, Embed IO,
     Embed m, Final m]
   a
 -> Sem
      '[Logger LogEntry, PrefixLog, Async, Error IOError,
        Error CacheError, Error SomeException, Error PandocError, Embed IO,
        Embed m, Final m]
      a)
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem
         '[Cache k ct, Logger LogEntry, PrefixLog, Async, Error IOError,
           Error CacheError, Error SomeException, Error PandocError, Embed IO,
           Embed m, Final m]
         a)
-> Sem (KnitEffectStack c ct k m) a
-> Sem
     '[Logger LogEntry, PrefixLog, Async, Error IOError,
       Error CacheError, Error SomeException, Error PandocError, Embed IO,
       Embed m, Final m]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerializeDict c ct
-> InterpreterFor
     (SerializeEnv c ct)
     '[Cache k ct, Logger LogEntry, PrefixLog, Async, Error IOError,
       Error CacheError, Error SomeException, Error PandocError, Embed IO,
       Embed m, Final m]
forall (c :: * -> Constraint) ct (r :: [(* -> *) -> * -> *]).
SerializeDict c ct -> InterpreterFor (SerializeEnv c ct) r
KS.runSerializeEnv (KnitConfig c ct k -> SerializeDict c ct
forall (sc :: * -> Constraint) ct k.
KnitConfig sc ct k -> SerializeDict sc ct
serializeDict KnitConfig c ct k
config)
  (Sem
   '[SerializeEnv c ct, Cache k ct, Logger LogEntry, PrefixLog, Async,
     Error IOError, Error CacheError, Error SomeException,
     Error PandocError, Embed IO, Embed m, Final m]
   a
 -> Sem
      '[Cache k ct, Logger LogEntry, PrefixLog, Async, Error IOError,
        Error CacheError, Error SomeException, Error PandocError, Embed IO,
        Embed m, Final m]
      a)
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem
         '[SerializeEnv c ct, Cache k ct, Logger LogEntry, PrefixLog, Async,
           Error IOError, Error CacheError, Error SomeException,
           Error PandocError, Embed IO, Embed m, Final m]
         a)
-> Sem (KnitEffectStack c ct k m) a
-> Sem
     '[Cache k ct, Logger LogEntry, PrefixLog, Async, Error IOError,
       Error CacheError, Error SomeException, Error PandocError, Embed IO,
       Embed m, Final m]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
  '[Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
    PrefixLog, Async, Error IOError, Error CacheError,
    Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
  a
-> Sem
     '[SerializeEnv c ct, Cache k ct, Logger LogEntry, PrefixLog, Async,
       Error IOError, Error CacheError, Error SomeException,
       Error PandocError, Embed IO, Embed m, Final m]
     a
forall (effs :: [(* -> *) -> * -> *]) a.
(Member (Logger LogEntry) effs, Member (Embed IO) effs,
 Member (Error PandocError) effs) =>
Sem (Pandoc : effs) a -> Sem effs a
KPM.interpretInIO -- PA.PandocIO
  (Sem
   '[Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
     PrefixLog, Async, Error IOError, Error CacheError,
     Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
   a
 -> Sem
      '[SerializeEnv c ct, Cache k ct, Logger LogEntry, PrefixLog, Async,
        Error IOError, Error CacheError, Error SomeException,
        Error PandocError, Embed IO, Embed m, Final m]
      a)
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem
         '[Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
           PrefixLog, Async, Error IOError, Error CacheError,
           Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
         a)
-> Sem (KnitEffectStack c ct k m) a
-> Sem
     '[SerializeEnv c ct, Cache k ct, Logger LogEntry, PrefixLog, Async,
       Error IOError, Error CacheError, Error SomeException,
       Error PandocError, Embed IO, Embed m, Final m]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
  '[Template, Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
    PrefixLog, Async, Error IOError, Error CacheError,
    Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
  a
-> Sem
     '[Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
       PrefixLog, Async, Error IOError, Error CacheError,
       Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
     a
forall (effs :: [(* -> *) -> * -> *]) a.
Member (Embed IO) effs =>
Sem (Template : effs) a -> Sem effs a
KPM.interpretTemplateIO    
  (Sem
   '[Template, Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
     PrefixLog, Async, Error IOError, Error CacheError,
     Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
   a
 -> Sem
      '[Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
        PrefixLog, Async, Error IOError, Error CacheError,
        Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
      a)
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem
         '[Template, Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
           PrefixLog, Async, Error IOError, Error CacheError,
           Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
         a)
-> Sem (KnitEffectStack c ct k m) a
-> Sem
     '[Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
       PrefixLog, Async, Error IOError, Error CacheError,
       Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (KnitEffectStack c ct k m) a
-> Sem
     '[Template, Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
       PrefixLog, Async, Error IOError, Error CacheError,
       Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
     a
forall (r :: [(* -> *) -> * -> *]) a.
Sem (UnusedId : r) a -> Sem r a
KUI.runUnusedId
  (Sem (KnitEffectStack c ct k m) a
 -> Sem
      '[Template, Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
        PrefixLog, Async, Error IOError, Error CacheError,
        Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
      a)
-> (Sem (KnitEffectStack c ct k m) a
    -> Sem (KnitEffectStack c ct k m) a)
-> Sem (KnitEffectStack c ct k m) a
-> Sem
     '[Template, Pandoc, SerializeEnv c ct, Cache k ct, Logger LogEntry,
       PrefixLog, Async, Error IOError, Error CacheError,
       Error SomeException, Error PandocError, Embed IO, Embed m, Final m]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sem (KnitEffectStack c ct k m) a
 -> Sem (KnitEffectStack c ct k m) a)
-> (Text
    -> Sem (KnitEffectStack c ct k m) a
    -> Sem (KnitEffectStack c ct k m) a)
-> Maybe Text
-> Sem (KnitEffectStack c ct k m) a
-> Sem (KnitEffectStack c ct k m) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sem (KnitEffectStack c ct k m) a
-> Sem (KnitEffectStack c ct k m) a
forall a. a -> a
id Text
-> Sem (KnitEffectStack c ct k m) a
-> Sem (KnitEffectStack c ct k m) a
forall (effs :: [(* -> *) -> * -> *]) a.
Member PrefixLog effs =>
Text -> Sem effs a -> Sem effs a
KLog.wrapPrefix (KnitConfig c ct k -> Maybe Text
forall (sc :: * -> Constraint) ct k.
KnitConfig sc ct k -> Maybe Text
outerLogPrefix KnitConfig c ct k
config)
#else
consumeKnitEffectStack
  :: forall c ct k m a
   . (MonadIO m, Ord k, Show k)
  => KnitConfig c ct k
  -> P.Sem (KnitEffectStack c ct k m) a
  -> m (Either PA.PandocError a)
consumeKnitEffectStack config =
  P.runFinal
  . P.embedToFinal
  . PI.embedToMonadIO @m -- interpret (Embed IO) using m
  . PE.runError
  . PE.mapError someExceptionToPandocError
  . PE.mapError cacheErrorToPandocError
  . PE.mapError ioErrorToPandocError -- (\e -> PA.PandocSomeError ("Exceptions.Exception thrown: " <> (T.pack $ show e)))
  . P.asyncToIO -- this has to run after (above) the log, partly so that the prefix state is thread-local.
  . KLog.filteredLogEntriesToIO (logIf config)
  . KC.runPersistenceBackedAtomicInMemoryCache' (persistCache config)
  . KS.runSerializeEnv (serializeDict config)
  . KPM.interpretInIO -- PA.PandocIO        
  . KUI.runUnusedId
  . maybe id KLog.wrapPrefix (outerLogPrefix config)
#endif
{-# INLINEABLE consumeKnitEffectStack #-}


ioErrorToPandocError :: IE.IOError -> KPM.PandocError
ioErrorToPandocError :: IOError -> PandocError
ioErrorToPandocError e :: IOError
e = Text -> IOError -> PandocError
PA.PandocIOError (Text -> Text
KPM.textToPandocText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ("IOError: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ IOError -> FilePath
forall a. Show a => a -> FilePath
show IOError
e))) IOError
e
{-# INLINEABLE ioErrorToPandocError #-}

cacheErrorToPandocError :: KC.CacheError -> KPM.PandocError
cacheErrorToPandocError :: CacheError -> PandocError
cacheErrorToPandocError e :: CacheError
e = Text -> PandocError
PA.PandocSomeError (Text -> Text
KPM.textToPandocText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ("CacheError: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ CacheError -> FilePath
forall a. Show a => a -> FilePath
show CacheError
e)))
{-# INLINEABLE cacheErrorToPandocError #-}

someExceptionToPandocError :: Exceptions.SomeException -> KPM.PandocError
someExceptionToPandocError :: SomeException -> PandocError
someExceptionToPandocError = Text -> PandocError
PA.PandocSomeError (Text -> PandocError)
-> (SomeException -> Text) -> SomeException -> PandocError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
KPM.textToPandocText (Text -> Text) -> (SomeException -> Text) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text)
-> (SomeException -> FilePath) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> FilePath
forall e. Exception e => e -> FilePath
Exceptions.displayException 
{-# INLINEABLE someExceptionToPandocError #-}