{-# 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
(
KnitConfig(..)
, defaultKnitConfig
, knitHtml
, knitHtmls
, liftKnit
, 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.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
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
}
defaultKnitConfig :: Maybe T.Text
-> KnitConfig KS.DefaultSerializer KS.DefaultCacheData T.Text
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 #-}
knitHtmls
:: (MonadIO m, Ord k, Show k)
=> KnitConfig c ct k
-> P.Sem (KnitEffectDocsStack c ct k m) ()
-> m (Either PA.PandocError [KP.DocWithInfo KP.PandocInfo TL.Text])
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 #-}
knitHtml
:: (MonadIO m, Ord k, Show k)
=> KnitConfig c ct k
-> P.Sem (KnitEffectDocStack c ct k m) ()
-> m (Either PA.PandocError TL.Text)
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 #-}
type KnitBase m effs = (MonadIO m, P.Member (P.Embed m) effs)
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 #-}
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
)
type CacheEffects c ct k r = (P.Members [KS.SerializeEnv c ct, KC.Cache k ct] r)
type CacheEffectsD r = CacheEffects KS.DefaultSerializer KS.DefaultCacheData T.Text r
type KnitOne r = (KnitEffects r, P.Member KP.ToPandoc r)
type KnitMany r = (KnitEffects r, P.Member KP.Pandocs r)
#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
type KnitEffectDocsStack c ct k m = (KP.Pandocs ': KnitEffectStack c ct k m)
type KnitEffectDocStack c ct k m = (KP.ToPandoc ': KnitEffectStack c ct k 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
(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
(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
(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
(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
. PE.runError
. PE.mapError someExceptionToPandocError
. PE.mapError cacheErrorToPandocError
. PE.mapError ioErrorToPandocError
. P.asyncToIO
. KLog.filteredLogEntriesToIO (logIf config)
. KC.runPersistenceBackedAtomicInMemoryCache' (persistCache config)
. KS.runSerializeEnv (serializeDict config)
. KPM.interpretInIO
. 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 #-}