{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
{-|
Module      : Knit.Effect.PandocMonad
Description : Polysemy PandocMonad effect
Copyright   : (c) Adam Conner-Sax 2019
License     : BSD-3-Clause
Maintainer  : adam_conner_sax@yahoo.com
Stability   : experimental

Polysemy PandocMonad effect.
Allows a polysemy monad to handle
actions with a PandocMonad contraint via
polysemy effects and IO.
Has an "absorber" to convert functions with a @PandocMonad@ constraint. 
-}
module Knit.Effect.PandocMonad
  (
    -- * Types
    Pandoc
  , PandocEffects
  , PandocEffectsIO

    -- * Actions
  , lookupEnv
  , getCurrentTime
  , getCurrentTimeZone
  , newStdGen
  , newUniqueHash
  , openURL
  , readFileLazy
  , readFileStrict
  , glob
  , fileExists
  , getDataFileName
  , getModificationTime
  , getCommonState
  , putCommonState
  , getsCommonState
  , modifyCommonState
  , logOutput
  , trace

    -- * Pandoc <2.8 compatibility
  , textToPandocText
  , pandocTextToText
#if   MIN_VERSION_pandoc(2,8,0) 
  , absorbTemplateMonad
  , Template
  , interpretTemplateIO
#endif  
  
    -- * Interpreters
  , interpretInPandocMonad
  , interpretInIO

    -- * Runners
--  , runIO

    -- * Interop
  , absorbPandocMonad

    -- * Re-Exports
  , PA.PandocError
  )
where

import Prelude hiding (takeWhile, dropWhile,drop)
import qualified Knit.Effect.Logger            as Log
import qualified Paths_knit_haskell            as Paths

import qualified Polysemy                      as P
import           Polysemy.Internal              ( send )
import           Polysemy.Internal.Combinators  ( stateful )
import qualified Polysemy.Error                as P
import qualified Polysemy.ConstraintAbsorber   as P

import qualified Text.Pandoc                   as PA
import qualified Text.Pandoc.MIME              as PA
import qualified Text.Pandoc.UTF8              as UTF8


import qualified Data.ByteString               as BS
import qualified Data.ByteString.Lazy          as LBS
import           Data.ByteString.Base64         ( decodeLenient )
import qualified Data.CaseInsensitive          as CI

import qualified Data.Text                     as T
import           Control.Monad                  ( when )
import           Control.Monad.Except           ( MonadError(..)
                                                , liftIO
                                                )

--import qualified Data.Constraint               as C

import qualified Network.URI                   as NU
import           Network.Socket                 ( withSocketsDo )
import qualified Network.HTTP.Client           as NHC
import qualified Network.HTTP.Client.TLS       as NHC
                                                ( tlsManagerSettings )
import qualified Network.HTTP.Client.Internal  as NHC
                                                ( addProxy )
import qualified Network.HTTP.Types.Header     as NH
                                                ( hContentType )

import qualified System.Environment            as IO
                                                ( lookupEnv
                                                , getEnv
                                                )
import qualified System.IO.Error               as IO
                                                ( tryIOError )
import qualified Data.Time                     as IO
                                                ( getCurrentTime )
import           Data.Time.Clock                ( UTCTime )
import           Data.Time.LocalTime            ( TimeZone )
import qualified Data.Time.LocalTime           as IO
                                                ( getCurrentTimeZone )
import           System.Random                  ( StdGen )
import qualified System.Random                 as IO
                                                ( newStdGen )
import           Data.Unique                    ( hashUnique )
import qualified Data.Unique                   as IO
                                                ( newUnique )
import qualified System.FilePath.Glob          as IO
                                                ( glob )
import qualified System.Directory              as IO
                                                ( getModificationTime )
import qualified System.Directory              as Directory
import qualified Debug.Trace
import qualified Control.Exception             as E

#if MIN_VERSION_pandoc(2,8,0)
import qualified Text.DocTemplates             as DT
import           Data.Functor.Identity          (runIdentity)
#else
import qualified Data.List as L
#endif

#if MIN_VERSION_pandoc(2,8,0)
type PandocText = T.Text

pandocTextToText :: PandocText -> T.Text
pandocTextToText :: PandocText -> PandocText
pandocTextToText = PandocText -> PandocText
forall a. a -> a
id

textToPandocText :: T.Text -> PandocText
textToPandocText :: PandocText -> PandocText
textToPandocText = PandocText -> PandocText
forall a. a -> a
id

pandocTextToString :: PandocText -> String
pandocTextToString :: PandocText -> String
pandocTextToString = PandocText -> String
T.unpack

stringToPandocText :: String -> PandocText
stringToPandocText :: String -> PandocText
stringToPandocText = String -> PandocText
T.pack

pandocTextToBS :: PandocText -> BS.ByteString
pandocTextToBS :: PandocText -> ByteString
pandocTextToBS = PandocText -> ByteString
UTF8.fromText

stripPrefix :: T.Text -> T.Text -> Maybe T.Text 
stripPrefix :: PandocText -> PandocText -> Maybe PandocText
stripPrefix = PandocText -> PandocText -> Maybe PandocText
T.stripPrefix

takeWhile :: (Char -> Bool) -> T.Text -> T.Text
takeWhile :: (Char -> Bool) -> PandocText -> PandocText
takeWhile = (Char -> Bool) -> PandocText -> PandocText
T.takeWhile

drop :: Int -> T.Text -> T.Text
drop :: Int -> PandocText -> PandocText
drop = Int -> PandocText -> PandocText
T.drop

dropWhile :: (Char -> Bool) -> T.Text -> T.Text
dropWhile :: (Char -> Bool) -> PandocText -> PandocText
dropWhile = (Char -> Bool) -> PandocText -> PandocText
T.dropWhile

#else
type PandocText = String

pandocTextToText :: PandocText -> T.Text
pandocTextToText = T.pack

textToPandocText :: T.Text -> PandocText
textToPandocText = T.unpack

pandocTextToString :: PandocText -> String
pandocTextToString = id

stringToPandocText :: String -> PandocText
stringToPandocText = id

pandocTextToBS :: PandocText -> BS.ByteString
pandocTextToBS = UTF8.fromString

stripPrefix :: String -> String -> Maybe String 
stripPrefix = L.stripPrefix

takeWhile :: (Char -> Bool) -> String -> String
takeWhile = L.takeWhile

drop :: Int -> String -> String
drop = L.drop

dropWhile :: (Char -> Bool) -> String -> String
dropWhile = L.dropWhile

#endif

-- | Pandoc Effect
data Pandoc m r where
  LookupEnv :: PandocText -> Pandoc m (Maybe PandocText)
  GetCurrentTime :: Pandoc m UTCTime
  GetCurrentTimeZone :: Pandoc m TimeZone
  NewStdGen :: Pandoc m StdGen
  NewUniqueHash :: Pandoc m Int
  OpenURL :: PandocText -> Pandoc m (BS.ByteString, Maybe PA.MimeType)
  ReadFileLazy :: FilePath -> Pandoc m LBS.ByteString
  ReadFileStrict ::FilePath -> Pandoc m BS.ByteString
  Glob ::String -> Pandoc m [FilePath]
  FileExists :: FilePath -> Pandoc m Bool
  GetDataFileName :: FilePath -> Pandoc m FilePath
  GetModificationTime :: FilePath -> Pandoc m UTCTime
  GetCommonState :: Pandoc m PA.CommonState
  PutCommonState :: PA.CommonState -> Pandoc m ()
  GetsCommonState ::(PA.CommonState -> a) -> Pandoc m a
  ModifyCommonState ::(PA.CommonState -> PA.CommonState) -> Pandoc m  ()
  LogOutput ::PA.LogMessage -> Pandoc m ()
  Trace :: PandocText -> Pandoc m ()

P.makeSem ''Pandoc

#if MIN_VERSION_pandoc(2,8,0)
data Template m a where
  GetPartial :: FilePath -> Template m T.Text

P.makeSem ''Template

-- | Interpret a Template effect in any stack with IO (via the IO instance in DocTemplates)
interpretTemplateIO
  :: forall effs a
  . P.Member (P.Embed IO) effs
  => P.Sem (Template ': effs) a
  -> P.Sem effs a
interpretTemplateIO :: Sem (Template : effs) a -> Sem effs a
interpretTemplateIO =  (forall x (m :: * -> *). Template m x -> Sem effs x)
-> Sem (Template : effs) a -> Sem effs a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
P.interpret ((forall x (m :: * -> *). Template m x -> Sem effs x)
 -> Sem (Template : effs) a -> Sem effs a)
-> (forall x (m :: * -> *). Template m x -> Sem effs x)
-> Sem (Template : effs) a
-> Sem effs a
forall a b. (a -> b) -> a -> b
$ \case
  GetPartial x -> IO PandocText -> Sem effs x
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO PandocText -> Sem effs x) -> IO PandocText -> Sem effs x
forall a b. (a -> b) -> a -> b
$ String -> IO PandocText
forall (m :: * -> *). TemplateMonad m => String -> m PandocText
DT.getPartial String
x

-- NB: This one ignores whatever getPartial is supposed to do but that's the only non-IO intepretation, I think?
-- | Interpret a Template effect in any stack (via the identity instance in DocTemplates)
interpretTemplatePure
  :: P.Sem (Template ': effs) a -> P.Sem effs a
interpretTemplatePure :: Sem (Template : effs) a -> Sem effs a
interpretTemplatePure = (forall x (m :: * -> *). Template m x -> Sem effs x)
-> Sem (Template : effs) a -> Sem effs a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
P.interpret ((forall x (m :: * -> *). Template m x -> Sem effs x)
 -> Sem (Template : effs) a -> Sem effs a)
-> (forall x (m :: * -> *). Template m x -> Sem effs x)
-> Sem (Template : effs) a
-> Sem effs a
forall a b. (a -> b) -> a -> b
$ \case
  GetPartial x -> PandocText -> Sem effs PandocText
forall (m :: * -> *) a. Monad m => a -> m a
return (PandocText -> Sem effs PandocText)
-> (Identity PandocText -> PandocText)
-> Identity PandocText
-> Sem effs PandocText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity PandocText -> PandocText
forall a. Identity a -> a
runIdentity (Identity PandocText -> Sem effs x)
-> Identity PandocText -> Sem effs x
forall a b. (a -> b) -> a -> b
$ String -> Identity PandocText
forall (m :: * -> *). TemplateMonad m => String -> m PandocText
DT.getPartial String
x

-- | use a Polysemy stack containing the 'Template` effect to run an TemplateMonad m action.
absorbTemplateMonad
  :: P.Member Template r => (DT.TemplateMonad (P.Sem r) => P.Sem r a) -> P.Sem r a
absorbTemplateMonad :: (TemplateMonad (Sem r) => Sem r a) -> Sem r a
absorbTemplateMonad = TemplateDict (Sem r)
-> (forall s.
    Reifies s (TemplateDict (Sem r))
    :- TemplateMonad (TemplateAction (Sem r) s))
-> (TemplateMonad (Sem r) => Sem r a)
-> Sem r a
forall (p :: (* -> *) -> Constraint) (x :: (* -> *) -> * -> * -> *)
       d (r :: [(* -> *) -> * -> *]) a.
d
-> (forall s. Reifies s d :- p (x (Sem r) s))
-> (p (Sem r) => Sem r a)
-> Sem r a
P.absorbWithSem @DT.TemplateMonad @TemplateAction ((String -> Sem r PandocText) -> TemplateDict (Sem r)
forall (m :: * -> *). (String -> m PandocText) -> TemplateDict m
TemplateDict String -> Sem r PandocText
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Template r =>
String -> Sem r PandocText
getPartial) ((Reifies s (TemplateDict (Sem r)) =>
 Dict (TemplateMonad (TemplateAction (Sem r) s)))
-> Reifies s (TemplateDict (Sem r))
   :- TemplateMonad (TemplateAction (Sem r) s)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
P.Sub Reifies s (TemplateDict (Sem r)) =>
Dict (TemplateMonad (TemplateAction (Sem r) s))
forall (a :: Constraint). a => Dict a
P.Dict)

-- | absorption gear for Template
newtype TemplateAction m s' a =
  TemplateAction { TemplateAction m s' a -> m a
templateAction :: m a} deriving (a -> TemplateAction m s' b -> TemplateAction m s' a
(a -> b) -> TemplateAction m s' a -> TemplateAction m s' b
(forall a b.
 (a -> b) -> TemplateAction m s' a -> TemplateAction m s' b)
-> (forall a b.
    a -> TemplateAction m s' b -> TemplateAction m s' a)
-> Functor (TemplateAction m s')
forall a b. a -> TemplateAction m s' b -> TemplateAction m s' a
forall a b.
(a -> b) -> TemplateAction m s' a -> TemplateAction m s' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
a -> TemplateAction m s' b -> TemplateAction m s' a
forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
(a -> b) -> TemplateAction m s' a -> TemplateAction m s' b
<$ :: a -> TemplateAction m s' b -> TemplateAction m s' a
$c<$ :: forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
a -> TemplateAction m s' b -> TemplateAction m s' a
fmap :: (a -> b) -> TemplateAction m s' a -> TemplateAction m s' b
$cfmap :: forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
(a -> b) -> TemplateAction m s' a -> TemplateAction m s' b
Functor, Functor (TemplateAction m s')
a -> TemplateAction m s' a
Functor (TemplateAction m s') =>
(forall a. a -> TemplateAction m s' a)
-> (forall a b.
    TemplateAction m s' (a -> b)
    -> TemplateAction m s' a -> TemplateAction m s' b)
-> (forall a b c.
    (a -> b -> c)
    -> TemplateAction m s' a
    -> TemplateAction m s' b
    -> TemplateAction m s' c)
-> (forall a b.
    TemplateAction m s' a
    -> TemplateAction m s' b -> TemplateAction m s' b)
-> (forall a b.
    TemplateAction m s' a
    -> TemplateAction m s' b -> TemplateAction m s' a)
-> Applicative (TemplateAction m s')
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' b
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' a
TemplateAction m s' (a -> b)
-> TemplateAction m s' a -> TemplateAction m s' b
(a -> b -> c)
-> TemplateAction m s' a
-> TemplateAction m s' b
-> TemplateAction m s' c
forall a. a -> TemplateAction m s' a
forall a b.
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' a
forall a b.
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' b
forall a b.
TemplateAction m s' (a -> b)
-> TemplateAction m s' a -> TemplateAction m s' b
forall a b c.
(a -> b -> c)
-> TemplateAction m s' a
-> TemplateAction m s' b
-> TemplateAction m s' c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *) k (s' :: k).
Applicative m =>
Functor (TemplateAction m s')
forall (m :: * -> *) k (s' :: k) a.
Applicative m =>
a -> TemplateAction m s' a
forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' a
forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' b
forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
TemplateAction m s' (a -> b)
-> TemplateAction m s' a -> TemplateAction m s' b
forall (m :: * -> *) k (s' :: k) a b c.
Applicative m =>
(a -> b -> c)
-> TemplateAction m s' a
-> TemplateAction m s' b
-> TemplateAction m s' c
<* :: TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' a
$c<* :: forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' a
*> :: TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' b
$c*> :: forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' b
liftA2 :: (a -> b -> c)
-> TemplateAction m s' a
-> TemplateAction m s' b
-> TemplateAction m s' c
$cliftA2 :: forall (m :: * -> *) k (s' :: k) a b c.
Applicative m =>
(a -> b -> c)
-> TemplateAction m s' a
-> TemplateAction m s' b
-> TemplateAction m s' c
<*> :: TemplateAction m s' (a -> b)
-> TemplateAction m s' a -> TemplateAction m s' b
$c<*> :: forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
TemplateAction m s' (a -> b)
-> TemplateAction m s' a -> TemplateAction m s' b
pure :: a -> TemplateAction m s' a
$cpure :: forall (m :: * -> *) k (s' :: k) a.
Applicative m =>
a -> TemplateAction m s' a
$cp1Applicative :: forall (m :: * -> *) k (s' :: k).
Applicative m =>
Functor (TemplateAction m s')
Applicative, Applicative (TemplateAction m s')
a -> TemplateAction m s' a
Applicative (TemplateAction m s') =>
(forall a b.
 TemplateAction m s' a
 -> (a -> TemplateAction m s' b) -> TemplateAction m s' b)
-> (forall a b.
    TemplateAction m s' a
    -> TemplateAction m s' b -> TemplateAction m s' b)
-> (forall a. a -> TemplateAction m s' a)
-> Monad (TemplateAction m s')
TemplateAction m s' a
-> (a -> TemplateAction m s' b) -> TemplateAction m s' b
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' b
forall a. a -> TemplateAction m s' a
forall a b.
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' b
forall a b.
TemplateAction m s' a
-> (a -> TemplateAction m s' b) -> TemplateAction m s' b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (m :: * -> *) k (s' :: k).
Monad m =>
Applicative (TemplateAction m s')
forall (m :: * -> *) k (s' :: k) a.
Monad m =>
a -> TemplateAction m s' a
forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' b
forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
TemplateAction m s' a
-> (a -> TemplateAction m s' b) -> TemplateAction m s' b
return :: a -> TemplateAction m s' a
$creturn :: forall (m :: * -> *) k (s' :: k) a.
Monad m =>
a -> TemplateAction m s' a
>> :: TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' b
$c>> :: forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
TemplateAction m s' a
-> TemplateAction m s' b -> TemplateAction m s' b
>>= :: TemplateAction m s' a
-> (a -> TemplateAction m s' b) -> TemplateAction m s' b
$c>>= :: forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
TemplateAction m s' a
-> (a -> TemplateAction m s' b) -> TemplateAction m s' b
$cp1Monad :: forall (m :: * -> *) k (s' :: k).
Monad m =>
Applicative (TemplateAction m s')
Monad)

data TemplateDict m = TemplateDict { TemplateDict m -> String -> m PandocText
getPartial_ :: FilePath -> m T.Text }

instance (Monad m, P.Reifies s' (TemplateDict m)) => DT.TemplateMonad (TemplateAction m s') where
  getPartial :: String -> TemplateAction m s' PandocText
getPartial = m PandocText -> TemplateAction m s' PandocText
forall k k (m :: k -> *) (s' :: k) (a :: k).
m a -> TemplateAction m s' a
TemplateAction (m PandocText -> TemplateAction m s' PandocText)
-> (String -> m PandocText)
-> String
-> TemplateAction m s' PandocText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateDict m -> String -> m PandocText
forall (m :: * -> *). TemplateDict m -> String -> m PandocText
getPartial_ (Proxy s' -> TemplateDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> TemplateDict m) -> Proxy s' -> TemplateDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')

#endif
  
-- we handle logging within the existing effect system
-- | Map pandoc severities to our logging system.
pandocSeverity :: PA.LogMessage -> Log.LogSeverity
pandocSeverity :: LogMessage -> LogSeverity
pandocSeverity lm :: LogMessage
lm = case LogMessage -> Verbosity
PA.messageVerbosity LogMessage
lm of
  PA.ERROR   -> LogSeverity
Log.Error
  PA.WARNING -> LogSeverity
Log.Warning
  PA.INFO    -> LogSeverity
Log.Info

-- | Handle the logging with the knit-haskell logging effect.
logPandocMessage
  :: P.Member (Log.Logger Log.LogEntry) effs => PA.LogMessage -> P.Sem effs ()
logPandocMessage :: LogMessage -> Sem effs ()
logPandocMessage lm :: LogMessage
lm = Logger LogEntry (Sem effs) () -> Sem effs ()
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Member e r =>
e (Sem r) a -> Sem r a
send (Logger LogEntry (Sem effs) () -> Sem effs ())
-> Logger LogEntry (Sem effs) () -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ LogEntry -> Logger LogEntry (Sem effs) ()
forall k a (m :: k). a -> Logger a m ()
Log.Log (LogEntry -> Logger LogEntry (Sem effs) ())
-> LogEntry -> Logger LogEntry (Sem effs) ()
forall a b. (a -> b) -> a -> b
$ LogSeverity -> PandocText -> LogEntry
Log.LogEntry
  (LogMessage -> LogSeverity
pandocSeverity LogMessage
lm)
  (PandocText -> PandocText
pandocTextToText (PandocText -> PandocText)
-> (LogMessage -> PandocText) -> LogMessage -> PandocText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage -> PandocText
PA.showLogMessage (LogMessage -> PandocText) -> LogMessage -> PandocText
forall a b. (a -> b) -> a -> b
$ LogMessage
lm)

-- | Constraint helper for using this set of effects in IO.
#if MIN_VERSION_pandoc(2,8,0)
type PandocEffects effs
  = ( P.Member Pandoc effs
    , P.Member Template effs
    , P.Member (P.Error PA.PandocError) effs
    , P.Member Log.PrefixLog effs
    , P.Member (Log.Logger Log.LogEntry) effs
    )
#else
type PandocEffects effs
  = ( P.Member Pandoc effs
    , P.Member (P.Error PA.PandocError) effs
    , P.Member Log.PrefixLog effs
    , P.Member (Log.Logger Log.LogEntry) effs
    )
#endif    
-- absorption gear
-- | absorb a @PandocMonad@ constraint into
--  @Members [Pandoc, Error PandocError] r => Sem r@
absorbPandocMonad
  :: P.Members '[P.Error PA.PandocError, Pandoc] r
  => (PA.PandocMonad (P.Sem r) => P.Sem r a)
  -> P.Sem r a
absorbPandocMonad :: (PandocMonad (Sem r) => Sem r a) -> Sem r a
absorbPandocMonad = PandocDict (Sem r)
-> (forall s.
    Reifies s (PandocDict (Sem r)) :- PandocMonad (Action (Sem r) s))
-> (PandocMonad (Sem r) => Sem r a)
-> Sem r a
forall (p :: (* -> *) -> Constraint) (x :: (* -> *) -> * -> * -> *)
       d (r :: [(* -> *) -> * -> *]) a.
d
-> (forall s. Reifies s d :- p (x (Sem r) s))
-> (p (Sem r) => Sem r a)
-> Sem r a
P.absorbWithSem @PA.PandocMonad @Action
  ((PandocText -> Sem r (Maybe PandocText))
-> Sem r UTCTime
-> Sem r TimeZone
-> Sem r StdGen
-> Sem r Int
-> (PandocText -> Sem r (ByteString, Maybe PandocText))
-> (String -> Sem r ByteString)
-> (String -> Sem r ByteString)
-> (String -> Sem r [String])
-> (String -> Sem r Bool)
-> (String -> Sem r String)
-> (String -> Sem r UTCTime)
-> Sem r CommonState
-> (CommonState -> Sem r ())
-> (forall a. (CommonState -> a) -> Sem r a)
-> ((CommonState -> CommonState) -> Sem r ())
-> (LogMessage -> Sem r ())
-> (PandocText -> Sem r ())
-> (forall a. PandocError -> Sem r a)
-> (forall a. Sem r a -> (PandocError -> Sem r a) -> Sem r a)
-> PandocDict (Sem r)
forall (m :: * -> *).
(PandocText -> m (Maybe PandocText))
-> m UTCTime
-> m TimeZone
-> m StdGen
-> m Int
-> (PandocText -> m (ByteString, Maybe PandocText))
-> (String -> m ByteString)
-> (String -> m ByteString)
-> (String -> m [String])
-> (String -> m Bool)
-> (String -> m String)
-> (String -> m UTCTime)
-> m CommonState
-> (CommonState -> m ())
-> (forall a. (CommonState -> a) -> m a)
-> ((CommonState -> CommonState) -> m ())
-> (LogMessage -> m ())
-> (PandocText -> m ())
-> (forall a. PandocError -> m a)
-> (forall a. m a -> (PandocError -> m a) -> m a)
-> PandocDict m
PandocDict PandocText -> Sem r (Maybe PandocText)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
PandocText -> Sem r (Maybe PandocText)
lookupEnv
              Sem r UTCTime
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
Sem r UTCTime
getCurrentTime
              Sem r TimeZone
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
Sem r TimeZone
getCurrentTimeZone
              Sem r StdGen
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
Sem r StdGen
newStdGen
              Sem r Int
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
Sem r Int
newUniqueHash
              PandocText -> Sem r (ByteString, Maybe PandocText)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
PandocText -> Sem r (ByteString, Maybe PandocText)
openURL
              String -> Sem r ByteString
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
String -> Sem r ByteString
readFileLazy
              String -> Sem r ByteString
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
String -> Sem r ByteString
readFileStrict
              String -> Sem r [String]
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
String -> Sem r [String]
glob
              String -> Sem r Bool
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
String -> Sem r Bool
fileExists
              String -> Sem r String
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
String -> Sem r String
getDataFileName
              String -> Sem r UTCTime
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
String -> Sem r UTCTime
getModificationTime
              Sem r CommonState
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
Sem r CommonState
getCommonState
              CommonState -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
CommonState -> Sem r ()
putCommonState
              forall (r :: [(* -> *) -> * -> *]) a.
MemberWithError Pandoc r =>
(CommonState -> a) -> Sem r a
forall a. (CommonState -> a) -> Sem r a
getsCommonState
              (CommonState -> CommonState) -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
(CommonState -> CommonState) -> Sem r ()
modifyCommonState
              LogMessage -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
LogMessage -> Sem r ()
logOutput
              PandocText -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Pandoc r =>
PandocText -> Sem r ()
trace
              forall a. PandocError -> Sem r a
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw
              forall a. Sem r a -> (PandocError -> Sem r a) -> Sem r a
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
P.catch
  )
  ((Reifies s (PandocDict (Sem r)) =>
 Dict (PandocMonad (Action (Sem r) s)))
-> Reifies s (PandocDict (Sem r)) :- PandocMonad (Action (Sem r) s)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
P.Sub Reifies s (PandocDict (Sem r)) =>
Dict (PandocMonad (Action (Sem r) s))
forall (a :: Constraint). a => Dict a
P.Dict)

-- | wrapper for the PandocMonad constrained action 
newtype Action m s' a = Action
    { Action m s' a -> m a
action :: m a
    } deriving (a -> Action m s' b -> Action m s' a
(a -> b) -> Action m s' a -> Action m s' b
(forall a b. (a -> b) -> Action m s' a -> Action m s' b)
-> (forall a b. a -> Action m s' b -> Action m s' a)
-> Functor (Action m s')
forall a b. a -> Action m s' b -> Action m s' a
forall a b. (a -> b) -> Action m s' a -> Action m s' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
a -> Action m s' b -> Action m s' a
forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
(a -> b) -> Action m s' a -> Action m s' b
<$ :: a -> Action m s' b -> Action m s' a
$c<$ :: forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
a -> Action m s' b -> Action m s' a
fmap :: (a -> b) -> Action m s' a -> Action m s' b
$cfmap :: forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
(a -> b) -> Action m s' a -> Action m s' b
Functor, Functor (Action m s')
a -> Action m s' a
Functor (Action m s') =>
(forall a. a -> Action m s' a)
-> (forall a b.
    Action m s' (a -> b) -> Action m s' a -> Action m s' b)
-> (forall a b c.
    (a -> b -> c) -> Action m s' a -> Action m s' b -> Action m s' c)
-> (forall a b. Action m s' a -> Action m s' b -> Action m s' b)
-> (forall a b. Action m s' a -> Action m s' b -> Action m s' a)
-> Applicative (Action m s')
Action m s' a -> Action m s' b -> Action m s' b
Action m s' a -> Action m s' b -> Action m s' a
Action m s' (a -> b) -> Action m s' a -> Action m s' b
(a -> b -> c) -> Action m s' a -> Action m s' b -> Action m s' c
forall a. a -> Action m s' a
forall a b. Action m s' a -> Action m s' b -> Action m s' a
forall a b. Action m s' a -> Action m s' b -> Action m s' b
forall a b. Action m s' (a -> b) -> Action m s' a -> Action m s' b
forall a b c.
(a -> b -> c) -> Action m s' a -> Action m s' b -> Action m s' c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *) k (s' :: k).
Applicative m =>
Functor (Action m s')
forall (m :: * -> *) k (s' :: k) a.
Applicative m =>
a -> Action m s' a
forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' a -> Action m s' b -> Action m s' a
forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' a -> Action m s' b -> Action m s' b
forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' (a -> b) -> Action m s' a -> Action m s' b
forall (m :: * -> *) k (s' :: k) a b c.
Applicative m =>
(a -> b -> c) -> Action m s' a -> Action m s' b -> Action m s' c
<* :: Action m s' a -> Action m s' b -> Action m s' a
$c<* :: forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' a -> Action m s' b -> Action m s' a
*> :: Action m s' a -> Action m s' b -> Action m s' b
$c*> :: forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' a -> Action m s' b -> Action m s' b
liftA2 :: (a -> b -> c) -> Action m s' a -> Action m s' b -> Action m s' c
$cliftA2 :: forall (m :: * -> *) k (s' :: k) a b c.
Applicative m =>
(a -> b -> c) -> Action m s' a -> Action m s' b -> Action m s' c
<*> :: Action m s' (a -> b) -> Action m s' a -> Action m s' b
$c<*> :: forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' (a -> b) -> Action m s' a -> Action m s' b
pure :: a -> Action m s' a
$cpure :: forall (m :: * -> *) k (s' :: k) a.
Applicative m =>
a -> Action m s' a
$cp1Applicative :: forall (m :: * -> *) k (s' :: k).
Applicative m =>
Functor (Action m s')
Applicative, Applicative (Action m s')
a -> Action m s' a
Applicative (Action m s') =>
(forall a b.
 Action m s' a -> (a -> Action m s' b) -> Action m s' b)
-> (forall a b. Action m s' a -> Action m s' b -> Action m s' b)
-> (forall a. a -> Action m s' a)
-> Monad (Action m s')
Action m s' a -> (a -> Action m s' b) -> Action m s' b
Action m s' a -> Action m s' b -> Action m s' b
forall a. a -> Action m s' a
forall a b. Action m s' a -> Action m s' b -> Action m s' b
forall a b. Action m s' a -> (a -> Action m s' b) -> Action m s' b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (m :: * -> *) k (s' :: k).
Monad m =>
Applicative (Action m s')
forall (m :: * -> *) k (s' :: k) a. Monad m => a -> Action m s' a
forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
Action m s' a -> Action m s' b -> Action m s' b
forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
Action m s' a -> (a -> Action m s' b) -> Action m s' b
return :: a -> Action m s' a
$creturn :: forall (m :: * -> *) k (s' :: k) a. Monad m => a -> Action m s' a
>> :: Action m s' a -> Action m s' b -> Action m s' b
$c>> :: forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
Action m s' a -> Action m s' b -> Action m s' b
>>= :: Action m s' a -> (a -> Action m s' b) -> Action m s' b
$c>>= :: forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
Action m s' a -> (a -> Action m s' b) -> Action m s' b
$cp1Monad :: forall (m :: * -> *) k (s' :: k).
Monad m =>
Applicative (Action m s')
Monad)

-- | A dictionary of the functions we need to supply
-- to make an instance of PandocMonad
-- NB: the presence of @throwError@ and @catchError_@
-- which we need because of the MonadError superclass.
data PandocDict m = PandocDict
  {
    PandocDict m -> PandocText -> m (Maybe PandocText)
lookupEnv_ :: PandocText -> m (Maybe PandocText)
  , PandocDict m -> m UTCTime
getCurrentTime_ :: m UTCTime
  , PandocDict m -> m TimeZone
getCurrentTimeZone_ :: m TimeZone
  , PandocDict m -> m StdGen
newStdGen_ ::m StdGen
  , PandocDict m -> m Int
newUniqueHash_ :: m Int
  , PandocDict m -> PandocText -> m (ByteString, Maybe PandocText)
openURL_ :: PandocText ->  m (BS.ByteString, Maybe PA.MimeType)
  , PandocDict m -> String -> m ByteString
readFileLazy_ :: FilePath ->  m LBS.ByteString
  , PandocDict m -> String -> m ByteString
readFileStrict_ :: FilePath ->  m BS.ByteString
  , PandocDict m -> String -> m [String]
glob_ :: String ->  m [FilePath]
  , PandocDict m -> String -> m Bool
fileExists_ :: FilePath ->  m Bool
  , PandocDict m -> String -> m String
getDataFileName_ :: FilePath ->  m FilePath
  , PandocDict m -> String -> m UTCTime
getModificationTime_ :: FilePath ->  m UTCTime
  , PandocDict m -> m CommonState
getCommonState_ :: m PA.CommonState
  , PandocDict m -> CommonState -> m ()
putCommonState_ :: PA.CommonState ->  m ()
  , PandocDict m -> forall a. (CommonState -> a) -> m a
getsCommonState_ :: forall a. (PA.CommonState -> a) ->  m a
  , PandocDict m -> (CommonState -> CommonState) -> m ()
modifyCommonState_ :: (PA.CommonState -> PA.CommonState) ->  m  ()
  , PandocDict m -> LogMessage -> m ()
logOutput_ :: PA.LogMessage ->  m ()
  , PandocDict m -> PandocText -> m ()
trace_ :: PandocText ->  m ()
  , PandocDict m -> forall a. PandocError -> m a
throwError_ :: forall a. PA.PandocError -> m a
  , PandocDict m -> forall a. m a -> (PandocError -> m a) -> m a
catchError_ :: forall a. m a -> (PA.PandocError -> m a) -> m a
  }


instance (Monad m
         , P.Reifies s' (PandocDict m)) => MonadError PA.PandocError (Action m s') where
  throwError :: PandocError -> Action m s' a
throwError e :: PandocError
e = m a -> Action m s' a
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m a -> Action m s' a) -> m a -> Action m s' a
forall a b. (a -> b) -> a -> b
$ PandocDict m -> PandocError -> m a
forall (m :: * -> *). PandocDict m -> forall a. PandocError -> m a
throwError_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s') PandocError
e
  catchError :: Action m s' a -> (PandocError -> Action m s' a) -> Action m s' a
catchError x :: Action m s' a
x f :: PandocError -> Action m s' a
f =
    m a -> Action m s' a
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m a -> Action m s' a) -> m a -> Action m s' a
forall a b. (a -> b) -> a -> b
$ PandocDict m -> m a -> (PandocError -> m a) -> m a
forall (m :: * -> *).
PandocDict m -> forall a. m a -> (PandocError -> m a) -> m a
catchError_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s') (Action m s' a -> m a
forall k (m :: k -> *) k (s' :: k) (a :: k). Action m s' a -> m a
action Action m s' a
x) (Action m s' a -> m a
forall k (m :: k -> *) k (s' :: k) (a :: k). Action m s' a -> m a
action (Action m s' a -> m a)
-> (PandocError -> Action m s' a) -> PandocError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocError -> Action m s' a
f)

instance (Monad m
         , MonadError PA.PandocError (Action m s')
         , P.Reifies s' (PandocDict m)) => PA.PandocMonad (Action m s') where
  lookupEnv :: PandocText -> Action m s' (Maybe PandocText)
lookupEnv           = m (Maybe PandocText) -> Action m s' (Maybe PandocText)
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m (Maybe PandocText) -> Action m s' (Maybe PandocText))
-> (PandocText -> m (Maybe PandocText))
-> PandocText
-> Action m s' (Maybe PandocText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> PandocText -> m (Maybe PandocText)
forall (m :: * -> *).
PandocDict m -> PandocText -> m (Maybe PandocText)
lookupEnv_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  getCurrentTime :: Action m s' UTCTime
getCurrentTime      = m UTCTime -> Action m s' UTCTime
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m UTCTime -> Action m s' UTCTime)
-> m UTCTime -> Action m s' UTCTime
forall a b. (a -> b) -> a -> b
$ PandocDict m -> m UTCTime
forall (m :: * -> *). PandocDict m -> m UTCTime
getCurrentTime_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  getCurrentTimeZone :: Action m s' TimeZone
getCurrentTimeZone  = m TimeZone -> Action m s' TimeZone
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m TimeZone -> Action m s' TimeZone)
-> m TimeZone -> Action m s' TimeZone
forall a b. (a -> b) -> a -> b
$ PandocDict m -> m TimeZone
forall (m :: * -> *). PandocDict m -> m TimeZone
getCurrentTimeZone_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  newStdGen :: Action m s' StdGen
newStdGen           = m StdGen -> Action m s' StdGen
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m StdGen -> Action m s' StdGen) -> m StdGen -> Action m s' StdGen
forall a b. (a -> b) -> a -> b
$ PandocDict m -> m StdGen
forall (m :: * -> *). PandocDict m -> m StdGen
newStdGen_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  newUniqueHash :: Action m s' Int
newUniqueHash       = m Int -> Action m s' Int
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m Int -> Action m s' Int) -> m Int -> Action m s' Int
forall a b. (a -> b) -> a -> b
$ PandocDict m -> m Int
forall (m :: * -> *). PandocDict m -> m Int
newUniqueHash_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  openURL :: PandocText -> Action m s' (ByteString, Maybe PandocText)
openURL             = m (ByteString, Maybe PandocText)
-> Action m s' (ByteString, Maybe PandocText)
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m (ByteString, Maybe PandocText)
 -> Action m s' (ByteString, Maybe PandocText))
-> (PandocText -> m (ByteString, Maybe PandocText))
-> PandocText
-> Action m s' (ByteString, Maybe PandocText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> PandocText -> m (ByteString, Maybe PandocText)
forall (m :: * -> *).
PandocDict m -> PandocText -> m (ByteString, Maybe PandocText)
openURL_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  readFileLazy :: String -> Action m s' ByteString
readFileLazy        = m ByteString -> Action m s' ByteString
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m ByteString -> Action m s' ByteString)
-> (String -> m ByteString) -> String -> Action m s' ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> String -> m ByteString
forall (m :: * -> *). PandocDict m -> String -> m ByteString
readFileLazy_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  readFileStrict :: String -> Action m s' ByteString
readFileStrict      = m ByteString -> Action m s' ByteString
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m ByteString -> Action m s' ByteString)
-> (String -> m ByteString) -> String -> Action m s' ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> String -> m ByteString
forall (m :: * -> *). PandocDict m -> String -> m ByteString
readFileStrict_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  glob :: String -> Action m s' [String]
glob                = m [String] -> Action m s' [String]
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m [String] -> Action m s' [String])
-> (String -> m [String]) -> String -> Action m s' [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> String -> m [String]
forall (m :: * -> *). PandocDict m -> String -> m [String]
glob_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  fileExists :: String -> Action m s' Bool
fileExists          = m Bool -> Action m s' Bool
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m Bool -> Action m s' Bool)
-> (String -> m Bool) -> String -> Action m s' Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> String -> m Bool
forall (m :: * -> *). PandocDict m -> String -> m Bool
fileExists_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  getDataFileName :: String -> Action m s' String
getDataFileName     = m String -> Action m s' String
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m String -> Action m s' String)
-> (String -> m String) -> String -> Action m s' String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> String -> m String
forall (m :: * -> *). PandocDict m -> String -> m String
getDataFileName_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  getModificationTime :: String -> Action m s' UTCTime
getModificationTime = m UTCTime -> Action m s' UTCTime
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m UTCTime -> Action m s' UTCTime)
-> (String -> m UTCTime) -> String -> Action m s' UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> String -> m UTCTime
forall (m :: * -> *). PandocDict m -> String -> m UTCTime
getModificationTime_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  getCommonState :: Action m s' CommonState
getCommonState      = m CommonState -> Action m s' CommonState
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m CommonState -> Action m s' CommonState)
-> m CommonState -> Action m s' CommonState
forall a b. (a -> b) -> a -> b
$ PandocDict m -> m CommonState
forall (m :: * -> *). PandocDict m -> m CommonState
getCommonState_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  putCommonState :: CommonState -> Action m s' ()
putCommonState      = m () -> Action m s' ()
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m () -> Action m s' ())
-> (CommonState -> m ()) -> CommonState -> Action m s' ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> CommonState -> m ()
forall (m :: * -> *). PandocDict m -> CommonState -> m ()
putCommonState_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  getsCommonState :: (CommonState -> a) -> Action m s' a
getsCommonState     = m a -> Action m s' a
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m a -> Action m s' a)
-> ((CommonState -> a) -> m a)
-> (CommonState -> a)
-> Action m s' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> forall a. (CommonState -> a) -> m a
forall (m :: * -> *).
PandocDict m -> forall a. (CommonState -> a) -> m a
getsCommonState_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  modifyCommonState :: (CommonState -> CommonState) -> Action m s' ()
modifyCommonState   = m () -> Action m s' ()
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m () -> Action m s' ())
-> ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState)
-> Action m s' ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocDict m -> (CommonState -> CommonState) -> m ()
modifyCommonState_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  logOutput :: LogMessage -> Action m s' ()
logOutput           = m () -> Action m s' ()
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m () -> Action m s' ())
-> (LogMessage -> m ()) -> LogMessage -> Action m s' ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> LogMessage -> m ()
forall (m :: * -> *). PandocDict m -> LogMessage -> m ()
logOutput_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')
  trace :: PandocText -> Action m s' ()
trace               = m () -> Action m s' ()
forall k k (m :: k -> *) (s' :: k) (a :: k). m a -> Action m s' a
Action (m () -> Action m s' ())
-> (PandocText -> m ()) -> PandocText -> Action m s' ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocDict m -> PandocText -> m ()
forall (m :: * -> *). PandocDict m -> PandocText -> m ()
trace_ (Proxy s' -> PandocDict m
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
P.reflect (Proxy s' -> PandocDict m) -> Proxy s' -> PandocDict m
forall a b. (a -> b) -> a -> b
$ Proxy s'
forall k (t :: k). Proxy t
P.Proxy @s')

-- | Constraint helper for using this set of effects in IO.
type PandocEffectsIO effs = (PandocEffects effs, P.Member (P.Embed IO) effs)

-- | Interpret the Pandoc effect using @IO@, @Knit.Effect.Logger@ and @PolySemy.Error PandocError@ 
interpretInIO
  :: forall effs a
   . ( P.Member (Log.Logger Log.LogEntry) effs
     , P.Member (P.Embed IO) effs
     , P.Member (P.Error PA.PandocError) effs
     )
  => P.Sem (Pandoc ': effs) a
  -> P.Sem effs a
interpretInIO :: Sem (Pandoc : effs) a -> Sem effs a
interpretInIO = ((CommonState, a) -> a) -> Sem effs (CommonState, a) -> Sem effs a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CommonState, a) -> a
forall a b. (a, b) -> b
snd (Sem effs (CommonState, a) -> Sem effs a)
-> (Sem (Pandoc : effs) a -> Sem effs (CommonState, a))
-> Sem (Pandoc : effs) a
-> Sem effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x (m :: * -> *).
 Pandoc m x -> CommonState -> Sem effs (CommonState, x))
-> CommonState
-> Sem (Pandoc : effs) a
-> Sem effs (CommonState, a)
forall (e :: (* -> *) -> * -> *) s (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> s -> Sem r (s, x))
-> s -> Sem (e : r) a -> Sem r (s, a)
stateful forall k (m :: k) x.
Pandoc m x -> CommonState -> Sem effs (CommonState, x)
forall x (m :: * -> *).
Pandoc m x -> CommonState -> Sem effs (CommonState, x)
f CommonState
forall a. Default a => a
PA.def
 where
  liftPair :: forall f x y . Functor f => (x, f y) -> f (x, y)
  liftPair :: (x, f y) -> f (x, y)
liftPair (x :: x
x, fy :: f y
fy) = (y -> (x, y)) -> f y -> f (x, y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x
x, ) f y
fy
  f :: Pandoc m x -> PA.CommonState -> P.Sem effs (PA.CommonState, x)
  f :: Pandoc m x -> CommonState -> Sem effs (CommonState, x)
f (LookupEnv s :: PandocText
s)         cs :: CommonState
cs = (CommonState, Sem effs (Maybe PandocText))
-> Sem effs (CommonState, Maybe PandocText)
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, IO (Maybe PandocText) -> Sem effs (Maybe PandocText)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PandocText) -> Sem effs (Maybe PandocText))
-> IO (Maybe PandocText) -> Sem effs (Maybe PandocText)
forall a b. (a -> b) -> a -> b
$ (Maybe String -> Maybe PandocText)
-> IO (Maybe String) -> IO (Maybe PandocText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> PandocText) -> Maybe String -> Maybe PandocText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> PandocText
stringToPandocText) (IO (Maybe String) -> IO (Maybe PandocText))
-> IO (Maybe String) -> IO (Maybe PandocText)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
IO.lookupEnv (PandocText -> String
pandocTextToString PandocText
s))
  f GetCurrentTime        cs :: CommonState
cs = (CommonState, Sem effs UTCTime) -> Sem effs (CommonState, UTCTime)
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, IO UTCTime -> Sem effs UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> Sem effs UTCTime) -> IO UTCTime -> Sem effs UTCTime
forall a b. (a -> b) -> a -> b
$ IO UTCTime
IO.getCurrentTime)
  f GetCurrentTimeZone    cs :: CommonState
cs = (CommonState, Sem effs TimeZone)
-> Sem effs (CommonState, TimeZone)
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, IO TimeZone -> Sem effs TimeZone
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO TimeZone
IO.getCurrentTimeZone)
  f NewStdGen             cs :: CommonState
cs = (CommonState, Sem effs StdGen) -> Sem effs (CommonState, StdGen)
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, IO StdGen -> Sem effs StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
IO.newStdGen)
  f NewUniqueHash         cs :: CommonState
cs = (CommonState, Sem effs Int) -> Sem effs (CommonState, Int)
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, Unique -> Int
hashUnique (Unique -> Int) -> Sem effs Unique -> Sem effs Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique -> Sem effs Unique
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Unique
IO.newUnique)
  f (OpenURL         url :: PandocText
url) cs :: CommonState
cs = CommonState
-> PandocText
-> Sem effs (CommonState, (ByteString, Maybe PandocText))
forall (effs :: [(* -> *) -> * -> *]).
(Member (Logger LogEntry) effs, Member (Embed IO) effs,
 Member (Error PandocError) effs) =>
CommonState
-> PandocText
-> Sem effs (CommonState, (ByteString, Maybe PandocText))
openURLWithState CommonState
cs PandocText
url
  f (ReadFileLazy    fp :: String
fp ) cs :: CommonState
cs = (CommonState, Sem effs ByteString)
-> Sem effs (CommonState, ByteString)
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, (String -> IO ByteString) -> String -> Sem effs ByteString
forall (effs :: [(* -> *) -> * -> *]) a.
(Member (Error PandocError) effs, Member (Embed IO) effs) =>
(String -> IO a) -> String -> Sem effs a
liftIOError String -> IO ByteString
LBS.readFile String
fp)
  f (ReadFileStrict  fp :: String
fp ) cs :: CommonState
cs = (CommonState, Sem effs ByteString)
-> Sem effs (CommonState, ByteString)
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, (String -> IO ByteString) -> String -> Sem effs ByteString
forall (effs :: [(* -> *) -> * -> *]) a.
(Member (Error PandocError) effs, Member (Embed IO) effs) =>
(String -> IO a) -> String -> Sem effs a
liftIOError String -> IO ByteString
BS.readFile String
fp)
  f (Glob            s :: String
s  ) cs :: CommonState
cs = (CommonState, Sem effs [String])
-> Sem effs (CommonState, [String])
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, (String -> IO [String]) -> String -> Sem effs [String]
forall (effs :: [(* -> *) -> * -> *]) a.
(Member (Error PandocError) effs, Member (Embed IO) effs) =>
(String -> IO a) -> String -> Sem effs a
liftIOError String -> IO [String]
IO.glob String
s)
  f (FileExists fp :: String
fp) cs :: CommonState
cs = (CommonState, Sem effs Bool) -> Sem effs (CommonState, Bool)
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, (String -> IO Bool) -> String -> Sem effs Bool
forall (effs :: [(* -> *) -> * -> *]) a.
(Member (Error PandocError) effs, Member (Embed IO) effs) =>
(String -> IO a) -> String -> Sem effs a
liftIOError String -> IO Bool
Directory.doesFileExist String
fp)
  f (GetDataFileName s :: String
s  ) cs :: CommonState
cs = (CommonState, Sem effs String) -> Sem effs (CommonState, String)
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, (String -> IO String) -> String -> Sem effs String
forall (effs :: [(* -> *) -> * -> *]) a.
(Member (Error PandocError) effs, Member (Embed IO) effs) =>
(String -> IO a) -> String -> Sem effs a
liftIOError String -> IO String
getDataFileName' String
s)
  f (GetModificationTime fp :: String
fp) cs :: CommonState
cs =
    (CommonState, Sem effs UTCTime) -> Sem effs (CommonState, UTCTime)
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, (String -> IO UTCTime) -> String -> Sem effs UTCTime
forall (effs :: [(* -> *) -> * -> *]) a.
(Member (Error PandocError) effs, Member (Embed IO) effs) =>
(String -> IO a) -> String -> Sem effs a
liftIOError String -> IO UTCTime
IO.getModificationTime String
fp)
  f GetCommonState          cs :: CommonState
cs = (CommonState, CommonState) -> Sem effs (CommonState, CommonState)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommonState
cs, CommonState
cs)
  f (GetsCommonState   g :: CommonState -> x
g  ) cs :: CommonState
cs = (CommonState, x) -> Sem effs (CommonState, x)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommonState
cs, CommonState -> x
g CommonState
cs)
  f (ModifyCommonState g :: CommonState -> CommonState
g  ) cs :: CommonState
cs = (CommonState, ()) -> Sem effs (CommonState, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CommonState -> CommonState
g CommonState
cs, ())
  f (PutCommonState    cs' :: CommonState
cs') _  = (CommonState, ()) -> Sem effs (CommonState, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CommonState
cs', ())
  f (LogOutput         msg :: LogMessage
msg) cs :: CommonState
cs = (CommonState, Sem effs ()) -> Sem effs (CommonState, ())
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair (CommonState
cs, LogMessage -> Sem effs ()
forall (effs :: [(* -> *) -> * -> *]).
Member (Logger LogEntry) effs =>
LogMessage -> Sem effs ()
logPandocMessage LogMessage
msg)
  f (Trace             msg :: PandocText
msg) cs :: CommonState
cs = (CommonState, Sem effs ()) -> Sem effs (CommonState, ())
forall (f :: * -> *) x y. Functor f => (x, f y) -> f (x, y)
liftPair
    ( CommonState
cs
    , Bool -> Sem effs () -> Sem effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CommonState -> Bool
PA.stTrace CommonState
cs) (Sem effs () -> Sem effs ()) -> Sem effs () -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ String -> Sem effs () -> Sem effs ()
forall a. String -> a -> a
Debug.Trace.trace ("[trace]" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (PandocText -> String
pandocTextToString PandocText
msg)) (() -> Sem effs ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    )


-- | Interpret the Pandoc effect in another monad (which must satisy the PandocMonad constraint) and @Knit.Effect.Logger@
interpretInPandocMonad
  :: forall m effs a
   . ( PA.PandocMonad m
     , P.Member (P.Embed m) effs
     , P.Member (Log.Logger Log.LogEntry) effs
     )
  => P.Sem (Pandoc ': effs) a
  -> P.Sem effs a
interpretInPandocMonad :: Sem (Pandoc : effs) a -> Sem effs a
interpretInPandocMonad = (forall x (m :: * -> *). Pandoc m x -> Sem effs x)
-> Sem (Pandoc : effs) a -> Sem effs a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
P.interpret
  (\case
    LookupEnv s            -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m (Maybe PandocText) -> Sem effs x)
-> m (Maybe PandocText) -> Sem effs x
forall a b. (a -> b) -> a -> b
$ PandocText -> m (Maybe PandocText)
forall (m :: * -> *).
PandocMonad m =>
PandocText -> m (Maybe PandocText)
PA.lookupEnv PandocText
s
    GetCurrentTime         -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m UTCTime -> Sem effs x) -> m UTCTime -> Sem effs x
forall a b. (a -> b) -> a -> b
$ m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
PA.getCurrentTime
    GetCurrentTimeZone     -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m TimeZone -> Sem effs x) -> m TimeZone -> Sem effs x
forall a b. (a -> b) -> a -> b
$ m TimeZone
forall (m :: * -> *). PandocMonad m => m TimeZone
PA.getCurrentTimeZone
    NewStdGen              -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m StdGen -> Sem effs x) -> m StdGen -> Sem effs x
forall a b. (a -> b) -> a -> b
$ m StdGen
forall (m :: * -> *). PandocMonad m => m StdGen
PA.newStdGen
    NewUniqueHash          -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m Int -> Sem effs x) -> m Int -> Sem effs x
forall a b. (a -> b) -> a -> b
$ m Int
forall (m :: * -> *). PandocMonad m => m Int
PA.newUniqueHash
    OpenURL             s  -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m (ByteString, Maybe PandocText) -> Sem effs x)
-> m (ByteString, Maybe PandocText) -> Sem effs x
forall a b. (a -> b) -> a -> b
$ PandocText -> m (ByteString, Maybe PandocText)
forall (m :: * -> *).
PandocMonad m =>
PandocText -> m (ByteString, Maybe PandocText)
PA.openURL PandocText
s
    ReadFileLazy        fp -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m ByteString -> Sem effs x) -> m ByteString -> Sem effs x
forall a b. (a -> b) -> a -> b
$ String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
PA.readFileLazy String
fp
    ReadFileStrict      fp -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m ByteString -> Sem effs x) -> m ByteString -> Sem effs x
forall a b. (a -> b) -> a -> b
$ String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
PA.readFileStrict String
fp
    Glob                fp -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m [String] -> Sem effs x) -> m [String] -> Sem effs x
forall a b. (a -> b) -> a -> b
$ String -> m [String]
forall (m :: * -> *). PandocMonad m => String -> m [String]
PA.glob String
fp
    FileExists          fp -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m Bool -> Sem effs x) -> m Bool -> Sem effs x
forall a b. (a -> b) -> a -> b
$ String -> m Bool
forall (m :: * -> *). PandocMonad m => String -> m Bool
PA.fileExists String
fp
    GetDataFileName     fp -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m String -> Sem effs x) -> m String -> Sem effs x
forall a b. (a -> b) -> a -> b
$ String -> m String
forall (m :: * -> *). PandocMonad m => String -> m String
PA.getDataFileName String
fp
    GetModificationTime fp -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m UTCTime -> Sem effs x) -> m UTCTime -> Sem effs x
forall a b. (a -> b) -> a -> b
$ String -> m UTCTime
forall (m :: * -> *). PandocMonad m => String -> m UTCTime
PA.getModificationTime String
fp
    GetCommonState         -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m CommonState -> Sem effs x) -> m CommonState -> Sem effs x
forall a b. (a -> b) -> a -> b
$ m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
PA.getCommonState
    PutCommonState    cs   -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m () -> Sem effs x) -> m () -> Sem effs x
forall a b. (a -> b) -> a -> b
$ CommonState -> m ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
PA.putCommonState CommonState
cs
    GetsCommonState   f    -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m x -> Sem effs x) -> m x -> Sem effs x
forall a b. (a -> b) -> a -> b
$ (CommonState -> x) -> m x
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
PA.getsCommonState CommonState -> x
f
    ModifyCommonState f    -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m () -> Sem effs x) -> m () -> Sem effs x
forall a b. (a -> b) -> a -> b
$ (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
PA.modifyCommonState CommonState -> CommonState
f
    LogOutput         msg  -> LogMessage -> Sem effs ()
forall (effs :: [(* -> *) -> * -> *]).
Member (Logger LogEntry) effs =>
LogMessage -> Sem effs ()
logPandocMessage LogMessage
msg
    Trace             s    -> forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed @m (m () -> Sem effs x) -> m () -> Sem effs x
forall a b. (a -> b) -> a -> b
$ PandocText -> m ()
forall (m :: * -> *). PandocMonad m => PandocText -> m ()
PA.trace PandocText
s
  )

{-
-- | Run the Pandoc effects,
-- and log messages with the given severity, over IO.
-- If there is a Pandoc error, you will get a Left in the resulting Either.
#if MIN_VERSION_pandoc(2,8,0)
runIO
  :: (Log.LogSeverity -> Bool)
  -> P.Sem
     '[Template
      , Pandoc
      , P.Reader Log.LogWithPrefixIO
      , Log.Logger Log.LogEntry
      , Log.PrefixLog
      , P.Error PA.PandocError
      , P.Embed IO]
     a
  -> IO (Either PA.PandocError a)
runIO logIf =
  P.runM . P.runError . Log.filteredLogEntriesToIO logIf . interpretInIO . interpretTemplateIO
#else
runIO
  :: (Log.LogSeverity -> Bool)
  -> P.Sem
     '[Pandoc
      , P.Reader Log.LogWithPrefixIO
      , Log.Logger Log.LogEntry
      , Log.PrefixLog
      , P.Error PA.PandocError
      , P.Embed IO]
     a
  -> IO (Either PA.PandocError a)
runIO logIf =
  P.runM . P.runError . Log.filteredLogEntriesToIO logIf . interpretInIO
#endif
-}

-- copied from Pandoc code and modified as needed for Polysemy and my implementation of interpretInIO (PandocIO)
openURLWithState
  :: forall effs
   . ( P.Member (Log.Logger Log.LogEntry) effs
     , P.Member (P.Embed IO) effs
     , P.Member (P.Error PA.PandocError) effs
     )
  => PA.CommonState
  -> PandocText
  -> P.Sem effs (PA.CommonState, (BS.ByteString, Maybe PA.MimeType))
openURLWithState :: CommonState
-> PandocText
-> Sem effs (CommonState, (ByteString, Maybe PandocText))
openURLWithState cs :: CommonState
cs u :: PandocText
u
  | Just u'' :: PandocText
u'' <- PandocText -> PandocText -> Maybe PandocText
stripPrefix "data:" PandocText
u = do
    let mime :: PandocText
mime = (Char -> Bool) -> PandocText -> PandocText
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ',') PandocText
u''
    let contents :: ByteString
contents = String -> ByteString
UTF8.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ (String -> String
NU.unEscapeString (String -> String)
-> (PandocText -> String) -> PandocText -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocText -> String
pandocTextToString) (PandocText -> String) -> PandocText -> String
forall a b. (a -> b) -> a -> b
$ Int -> PandocText -> PandocText
drop 1 (PandocText -> PandocText) -> PandocText -> PandocText
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> PandocText -> PandocText
dropWhile
          (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ',')
          PandocText
u''
    (CommonState, (ByteString, Maybe PandocText))
-> Sem effs (CommonState, (ByteString, Maybe PandocText))
forall (m :: * -> *) a. Monad m => a -> m a
return (CommonState
cs, (ByteString -> ByteString
decodeLenient ByteString
contents, PandocText -> Maybe PandocText
forall a. a -> Maybe a
Just PandocText
mime))
  | Bool
otherwise = do
    let toReqHeader :: (PandocText, PandocText) -> (CI ByteString, ByteString)
toReqHeader (n :: PandocText
n, v :: PandocText
v) = (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (PandocText -> ByteString
pandocTextToBS PandocText
n), PandocText -> ByteString
pandocTextToBS PandocText
v)
        customHeaders :: [(CI ByteString, ByteString)]
customHeaders = ((PandocText, PandocText) -> (CI ByteString, ByteString))
-> [(PandocText, PandocText)] -> [(CI ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PandocText, PandocText) -> (CI ByteString, ByteString)
toReqHeader ([(PandocText, PandocText)] -> [(CI ByteString, ByteString)])
-> [(PandocText, PandocText)] -> [(CI ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ CommonState -> [(PandocText, PandocText)]
PA.stRequestHeaders CommonState
cs
    CommonState
cs' <- CommonState -> LogMessage -> Sem effs CommonState
forall (effs :: [(* -> *) -> * -> *]).
Member (Logger LogEntry) effs =>
CommonState -> LogMessage -> Sem effs CommonState
report CommonState
cs (LogMessage -> Sem effs CommonState)
-> LogMessage -> Sem effs CommonState
forall a b. (a -> b) -> a -> b
$ PandocText -> LogMessage
PA.Fetching PandocText
u
    Either HttpException (ByteString, Maybe String)
res <- IO (Either HttpException (ByteString, Maybe String))
-> Sem effs (Either HttpException (ByteString, Maybe String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HttpException (ByteString, Maybe String))
 -> Sem effs (Either HttpException (ByteString, Maybe String)))
-> IO (Either HttpException (ByteString, Maybe String))
-> Sem effs (Either HttpException (ByteString, Maybe String))
forall a b. (a -> b) -> a -> b
$ IO (ByteString, Maybe String)
-> IO (Either HttpException (ByteString, Maybe String))
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO (ByteString, Maybe String)
 -> IO (Either HttpException (ByteString, Maybe String)))
-> IO (ByteString, Maybe String)
-> IO (Either HttpException (ByteString, Maybe String))
forall a b. (a -> b) -> a -> b
$ IO (ByteString, Maybe String) -> IO (ByteString, Maybe String)
forall a. IO a -> IO a
withSocketsDo (IO (ByteString, Maybe String) -> IO (ByteString, Maybe String))
-> IO (ByteString, Maybe String) -> IO (ByteString, Maybe String)
forall a b. (a -> b) -> a -> b
$ do
      let parseReq :: String -> IO Request
parseReq = String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
NHC.parseRequest
      Either IOError String
proxy <- IO String -> IO (Either IOError String)
forall a. IO a -> IO (Either IOError a)
IO.tryIOError (String -> IO String
IO.getEnv "http_proxy")
      let addProxy' :: Request -> IO Request
addProxy' x :: Request
x = case Either IOError String
proxy of
            Left  _  -> Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return Request
x
            Right pr :: String
pr -> String -> IO Request
parseReq String
pr
              IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r :: Request
r -> Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Int -> Request -> Request
NHC.addProxy (Request -> ByteString
NHC.host Request
r) (Request -> Int
NHC.port Request
r) Request
x)
      Request
req <- String -> IO Request
parseReq (PandocText -> String
pandocTextToString PandocText
u) IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO Request
addProxy'
      let req' :: Request
req' = Request
req
            { requestHeaders :: [(CI ByteString, ByteString)]
NHC.requestHeaders = [(CI ByteString, ByteString)]
customHeaders [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. [a] -> [a] -> [a]
++ Request -> [(CI ByteString, ByteString)]
NHC.requestHeaders Request
req
            }
      Response ByteString
resp <- ManagerSettings -> IO Manager
NHC.newManager ManagerSettings
NHC.tlsManagerSettings IO Manager
-> (Manager -> IO (Response ByteString))
-> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> Manager -> IO (Response ByteString)
NHC.httpLbs Request
req'
      (ByteString, Maybe String) -> IO (ByteString, Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
LBS.toChunks (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
NHC.responseBody Response ByteString
resp
        , ByteString -> String
UTF8.toString (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
NH.hContentType (Response ByteString -> [(CI ByteString, ByteString)]
forall body. Response body -> [(CI ByteString, ByteString)]
NHC.responseHeaders Response ByteString
resp)
        )
    case Either HttpException (ByteString, Maybe String)
res of
      Right r :: (ByteString, Maybe String)
r -> (CommonState, (ByteString, Maybe PandocText))
-> Sem effs (CommonState, (ByteString, Maybe PandocText))
forall (m :: * -> *) a. Monad m => a -> m a
return (CommonState
cs', (\(x :: ByteString
x,y :: Maybe String
y) -> (ByteString
x, String -> PandocText
stringToPandocText (String -> PandocText) -> Maybe String -> Maybe PandocText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
y))  (ByteString, Maybe String)
r)
      Left  e :: HttpException
e -> PandocError
-> Sem effs (CommonState, (ByteString, Maybe PandocText))
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw (PandocError
 -> Sem effs (CommonState, (ByteString, Maybe PandocText)))
-> PandocError
-> Sem effs (CommonState, (ByteString, Maybe PandocText))
forall a b. (a -> b) -> a -> b
$ PandocText -> HttpException -> PandocError
PA.PandocHttpError PandocText
u HttpException
e

-- | Stateful version of the Pandoc @report@ function, outputting relevant log messages
-- and adding them to the log kept in the state.
report
  :: (P.Member (Log.Logger Log.LogEntry) effs)
  => PA.CommonState
  -> PA.LogMessage
  -> P.Sem effs PA.CommonState
report :: CommonState -> LogMessage -> Sem effs CommonState
report cs :: CommonState
cs msg :: LogMessage
msg = do
  let verbosity :: Verbosity
verbosity = CommonState -> Verbosity
PA.stVerbosity CommonState
cs
      level :: Verbosity
level     = LogMessage -> Verbosity
PA.messageVerbosity LogMessage
msg
  Bool -> Sem effs () -> Sem effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
level Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
<= Verbosity
verbosity) (Sem effs () -> Sem effs ()) -> Sem effs () -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> Sem effs ()
forall (effs :: [(* -> *) -> * -> *]).
Member (Logger LogEntry) effs =>
LogMessage -> Sem effs ()
logPandocMessage LogMessage
msg
  let stLog' :: [LogMessage]
stLog' = LogMessage
msg LogMessage -> [LogMessage] -> [LogMessage]
forall a. a -> [a] -> [a]
: (CommonState -> [LogMessage]
PA.stLog CommonState
cs)
      cs' :: CommonState
cs'    = CommonState
cs { stLog :: [LogMessage]
PA.stLog = [LogMessage]
stLog' }
  CommonState -> Sem effs CommonState
forall (m :: * -> *) a. Monad m => a -> m a
return CommonState
cs'

-- | Utility function to lift IO errors into Sem
liftIOError
  :: (P.Member (P.Error PA.PandocError) effs, P.Member (P.Embed IO) effs)
  => (String -> IO a)
  -> String
  -> P.Sem effs a
liftIOError :: (String -> IO a) -> String -> Sem effs a
liftIOError f :: String -> IO a
f u :: String
u = do
  Either IOError a
res <- IO (Either IOError a) -> Sem effs (Either IOError a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOError a) -> Sem effs (Either IOError a))
-> IO (Either IOError a) -> Sem effs (Either IOError a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either IOError a)
forall a. IO a -> IO (Either IOError a)
IO.tryIOError (IO a -> IO (Either IOError a)) -> IO a -> IO (Either IOError a)
forall a b. (a -> b) -> a -> b
$ String -> IO a
f String
u
  case Either IOError a
res of
    Left  e :: IOError
e -> PandocError -> Sem effs a
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw (PandocError -> Sem effs a) -> PandocError -> Sem effs a
forall a b. (a -> b) -> a -> b
$ PandocText -> IOError -> PandocError
PA.PandocIOError (String -> PandocText
stringToPandocText String
u) IOError
e
    Right r :: a
r -> a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | adjust the directory the PandocMonad sees so that it will get
-- the right files when it falls back to default.  Knit-haskell installs
-- differently than pandoc does so that it can have its own templates as
-- well.
getDataFileName' :: FilePath -> IO FilePath
getDataFileName' :: String -> IO String
getDataFileName' fp :: String
fp = do
  String
dir <- IO String -> (IOError -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch @E.IOException (String -> IO String
IO.getEnv "pandoc_datadir")
                                (\_ -> IO String
Paths.getDataDir)
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/pandoc-data/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp)