{-# 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
(
Pandoc
, PandocEffects
, PandocEffectsIO
, lookupEnv
, getCurrentTime
, getCurrentTimeZone
, newStdGen
, newUniqueHash
, openURL
, readFileLazy
, readFileStrict
, glob
, fileExists
, getDataFileName
, getModificationTime
, getCommonState
, putCommonState
, getsCommonState
, modifyCommonState
, logOutput
, trace
, textToPandocText
, pandocTextToText
#if MIN_VERSION_pandoc(2,8,0)
, absorbTemplateMonad
, Template
, interpretTemplateIO
#endif
, interpretInPandocMonad
, interpretInIO
, absorbPandocMonad
, 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 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
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
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
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
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)
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
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
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)
#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
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)
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)
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')
type PandocEffectsIO effs = (PandocEffects effs, P.Member (P.Embed IO) effs)
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 ())
)
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
)
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
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'
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
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)