{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
{-|
Module      : Knit.Effect.Pandoc
Description : Polysemy writer-like effect
Copyright   : (c) Adam Conner-Sax 2019
License     : BSD-3-Clause
Maintainer  : adam_conner_sax@yahoo.com
Stability   : experimental

Polysemy Pandoc effect.
This is writer-like, allowing the interspersed addition of various Pandoc-readable formats into one doc and then rendering
to many Pandoc-writeable formats.  Currently only a subset of formats are supported.  Inputs can express requirements,
e.g., hvega requires html output because it uses javascript.
Those requirements are then checked before output is rendered and an error thrown if the input is not supported.
-}
module Knit.Effect.Pandoc
  (
    -- * Effects
    ToPandoc
  , FromPandoc

    -- * Requirement Support
  , Requirement(..)
  , PandocWithRequirements

    -- * Format ADTs
  , PandocReadFormat(..)
  , PandocWriteFormat(..)

    -- * Combinators
  , addFrom
  , require
  , writeTo
  , toPandoc
  , fromPandoc

    -- * Interpreters
  , runPandocWriter

    -- * Docs effect type-aliases
  , Pandocs

    -- * Pandoc Specific Info
  , PandocInfo(..)

    -- * Docs Effect Interpreters 
  , newPandoc
  , pandocsToDocs
  , fromPandocE

    -- * Re-exports
  , DocWithInfo(..)
  )
where

import qualified Text.Pandoc                   as PA
import qualified Data.Text                     as T
import           Data.ByteString.Lazy          as LBS
import qualified Data.Foldable                 as F
import qualified Data.Map                      as M
import qualified Data.Monoid                   as Mon
import           Data.Set                      as S
import qualified Text.Blaze.Html               as Blaze
import           Control.Monad.Except           ( throwError )



import qualified Polysemy                      as P
import           Polysemy.Internal              ( send )
import qualified Polysemy.Writer               as P


import qualified Knit.Effect.PandocMonad       as PM

import           Knit.Effect.Docs               ( Docs
                                                , DocWithInfo(..)
                                                , newDoc
                                                , toDocList
                                                )

-- For now, just handle the Html () case since then it's monoidal and we can interpret via writer
--newtype FreerHtml = FreerHtml { unFreer :: H.Html () }
-- | Supported formats for adding to current Pandoc
data PandocReadFormat a where
  ReadDocX :: PandocReadFormat LBS.ByteString
  ReadMarkDown :: PandocReadFormat T.Text
  ReadCommonMark :: PandocReadFormat T.Text
  ReadRST :: PandocReadFormat T.Text
  ReadLaTeX :: PandocReadFormat T.Text
  ReadHtml :: PandocReadFormat T.Text

deriving instance Show (PandocReadFormat a)

-- | Supported formats for writing current Pandoc
data PandocWriteFormat a where
  WriteDocX :: PandocWriteFormat LBS.ByteString
  WriteMarkDown :: PandocWriteFormat T.Text
  WriteCommonMark :: PandocWriteFormat T.Text
  WriteRST :: PandocWriteFormat T.Text
  WriteLaTeX :: PandocWriteFormat T.Text
  WriteHtml5 :: PandocWriteFormat Blaze.Html -- Blaze
  WriteHtml5String :: PandocWriteFormat T.Text

deriving instance Show (PandocWriteFormat a)

-- | ADT to allow inputs to request support, if necessary or possible, in the output format.
-- E.g., Latex output in Html needs MathJax. But Latex needs to nothing to output in Latex.
-- Vega-lite needs some script headers to output in Html and can't be output in other formats.
-- For now, we support all the things we can in any output format so this just results
-- in a runtime test.

-- TODO (?): Allow headers/extensions to be added/switched based on this.
data Requirement
  =
    VegaSupport -- ^ Supported only for Html output.
  | LatexSupport -- ^ Supported in Html output (via MathJax) and Latex output.
  deriving (Int -> Requirement -> ShowS
[Requirement] -> ShowS
Requirement -> String
(Int -> Requirement -> ShowS)
-> (Requirement -> String)
-> ([Requirement] -> ShowS)
-> Show Requirement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Requirement] -> ShowS
$cshowList :: [Requirement] -> ShowS
show :: Requirement -> String
$cshow :: Requirement -> String
showsPrec :: Int -> Requirement -> ShowS
$cshowsPrec :: Int -> Requirement -> ShowS
Show, Eq Requirement
Eq Requirement =>
(Requirement -> Requirement -> Ordering)
-> (Requirement -> Requirement -> Bool)
-> (Requirement -> Requirement -> Bool)
-> (Requirement -> Requirement -> Bool)
-> (Requirement -> Requirement -> Bool)
-> (Requirement -> Requirement -> Requirement)
-> (Requirement -> Requirement -> Requirement)
-> Ord Requirement
Requirement -> Requirement -> Bool
Requirement -> Requirement -> Ordering
Requirement -> Requirement -> Requirement
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Requirement -> Requirement -> Requirement
$cmin :: Requirement -> Requirement -> Requirement
max :: Requirement -> Requirement -> Requirement
$cmax :: Requirement -> Requirement -> Requirement
>= :: Requirement -> Requirement -> Bool
$c>= :: Requirement -> Requirement -> Bool
> :: Requirement -> Requirement -> Bool
$c> :: Requirement -> Requirement -> Bool
<= :: Requirement -> Requirement -> Bool
$c<= :: Requirement -> Requirement -> Bool
< :: Requirement -> Requirement -> Bool
$c< :: Requirement -> Requirement -> Bool
compare :: Requirement -> Requirement -> Ordering
$ccompare :: Requirement -> Requirement -> Ordering
$cp1Ord :: Eq Requirement
Ord, Requirement -> Requirement -> Bool
(Requirement -> Requirement -> Bool)
-> (Requirement -> Requirement -> Bool) -> Eq Requirement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Requirement -> Requirement -> Bool
$c/= :: Requirement -> Requirement -> Bool
== :: Requirement -> Requirement -> Bool
$c== :: Requirement -> Requirement -> Bool
Eq, Requirement
Requirement -> Requirement -> Bounded Requirement
forall a. a -> a -> Bounded a
maxBound :: Requirement
$cmaxBound :: Requirement
minBound :: Requirement
$cminBound :: Requirement
Bounded, Int -> Requirement
Requirement -> Int
Requirement -> [Requirement]
Requirement -> Requirement
Requirement -> Requirement -> [Requirement]
Requirement -> Requirement -> Requirement -> [Requirement]
(Requirement -> Requirement)
-> (Requirement -> Requirement)
-> (Int -> Requirement)
-> (Requirement -> Int)
-> (Requirement -> [Requirement])
-> (Requirement -> Requirement -> [Requirement])
-> (Requirement -> Requirement -> [Requirement])
-> (Requirement -> Requirement -> Requirement -> [Requirement])
-> Enum Requirement
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Requirement -> Requirement -> Requirement -> [Requirement]
$cenumFromThenTo :: Requirement -> Requirement -> Requirement -> [Requirement]
enumFromTo :: Requirement -> Requirement -> [Requirement]
$cenumFromTo :: Requirement -> Requirement -> [Requirement]
enumFromThen :: Requirement -> Requirement -> [Requirement]
$cenumFromThen :: Requirement -> Requirement -> [Requirement]
enumFrom :: Requirement -> [Requirement]
$cenumFrom :: Requirement -> [Requirement]
fromEnum :: Requirement -> Int
$cfromEnum :: Requirement -> Int
toEnum :: Int -> Requirement
$ctoEnum :: Int -> Requirement
pred :: Requirement -> Requirement
$cpred :: Requirement -> Requirement
succ :: Requirement -> Requirement
$csucc :: Requirement -> Requirement
Enum)

handlesAll :: PandocWriteFormat a -> S.Set Requirement -> Bool
handlesAll :: PandocWriteFormat a -> Set Requirement -> Bool
handlesAll f :: PandocWriteFormat a
f rs :: Set Requirement
rs = All -> Bool
Mon.getAll
  (All -> Bool) -> All -> Bool
forall a b. (a -> b) -> a -> b
$ [All] -> All
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold ((Requirement -> All) -> [Requirement] -> [All]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> All
Mon.All (Bool -> All) -> (Requirement -> Bool) -> Requirement -> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocWriteFormat a -> Requirement -> Bool
forall a. PandocWriteFormat a -> Requirement -> Bool
handles PandocWriteFormat a
f) ([Requirement] -> [All]) -> [Requirement] -> [All]
forall a b. (a -> b) -> a -> b
$ Set Requirement -> [Requirement]
forall a. Set a -> [a]
S.toList Set Requirement
rs)
 where
  handles :: PandocWriteFormat a -> Requirement -> Bool
  handles :: PandocWriteFormat a -> Requirement -> Bool
handles WriteHtml5       VegaSupport  = Bool
True
  handles WriteHtml5String VegaSupport  = Bool
True
  handles WriteHtml5       LatexSupport = Bool
True
  handles WriteHtml5String LatexSupport = Bool
True
  handles WriteLaTeX       LatexSupport = Bool
True
  handles _                _            = Bool
False

data PandocWithRequirements = PandocWithRequirements { PandocWithRequirements -> Pandoc
doc :: PA.Pandoc, PandocWithRequirements -> Set Requirement
reqs :: S.Set Requirement }
instance Semigroup PandocWithRequirements where
  (PandocWithRequirements da :: Pandoc
da ra :: Set Requirement
ra) <> :: PandocWithRequirements
-> PandocWithRequirements -> PandocWithRequirements
<> (PandocWithRequirements db :: Pandoc
db rb :: Set Requirement
rb)
    = Pandoc -> Set Requirement -> PandocWithRequirements
PandocWithRequirements (Pandoc
da Pandoc -> Pandoc -> Pandoc
forall a. Semigroup a => a -> a -> a
<> Pandoc
db) (Set Requirement
ra Set Requirement -> Set Requirement -> Set Requirement
forall a. Semigroup a => a -> a -> a
<> Set Requirement
rb)

instance Monoid PandocWithRequirements where
  mempty :: PandocWithRequirements
mempty = Pandoc -> Set Requirement -> PandocWithRequirements
PandocWithRequirements Pandoc
forall a. Monoid a => a
mempty Set Requirement
forall a. Monoid a => a
mempty


justDoc :: PA.Pandoc -> PandocWithRequirements
justDoc :: Pandoc -> PandocWithRequirements
justDoc d :: Pandoc
d = Pandoc -> Set Requirement -> PandocWithRequirements
PandocWithRequirements Pandoc
d Set Requirement
forall a. Monoid a => a
mempty

justRequirement :: Requirement -> PandocWithRequirements
justRequirement :: Requirement -> PandocWithRequirements
justRequirement r :: Requirement
r = Pandoc -> Set Requirement -> PandocWithRequirements
PandocWithRequirements Pandoc
forall a. Monoid a => a
mempty (Requirement -> Set Requirement
forall a. a -> Set a
S.singleton Requirement
r)

-- | Pandoc writer, add any read format to current doc
data ToPandoc m r where
  AddFrom  :: PandocReadFormat a -> PA.ReaderOptions -> a -> ToPandoc m () -- ^ add to current doc
  Require :: Requirement -> ToPandoc m () -- ^ require specific support

-- | Pandoc output effect, take given doc and produce formatted output
data FromPandoc m r where
  WriteTo  :: PandocWriteFormat a -> PA.WriterOptions -> PA.Pandoc -> FromPandoc m a -- convert to given format

-- | Add a piece of a Pandoc readable type to the current doc
addFrom
  :: P.Member ToPandoc effs
  => PandocReadFormat a
  -> PA.ReaderOptions
  -> a
  -> P.Sem effs ()
addFrom :: PandocReadFormat a -> ReaderOptions -> a -> Sem effs ()
addFrom prf :: PandocReadFormat a
prf pro :: ReaderOptions
pro doc' :: a
doc' = ToPandoc (Sem effs) () -> Sem effs ()
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Member e r =>
e (Sem r) a -> Sem r a
send (ToPandoc (Sem effs) () -> Sem effs ())
-> ToPandoc (Sem effs) () -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ PandocReadFormat a -> ReaderOptions -> a -> ToPandoc (Sem effs) ()
forall k a (m :: k).
PandocReadFormat a -> ReaderOptions -> a -> ToPandoc m ()
AddFrom PandocReadFormat a
prf ReaderOptions
pro a
doc'

-- | Add a requirement that the output format must satisfy.
require :: P.Member ToPandoc effs => Requirement -> P.Sem effs ()
require :: Requirement -> Sem effs ()
require r :: Requirement
r = ToPandoc (Sem effs) () -> Sem effs ()
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Member e r =>
e (Sem r) a -> Sem r a
send (ToPandoc (Sem effs) () -> Sem effs ())
-> ToPandoc (Sem effs) () -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ Requirement -> ToPandoc (Sem effs) ()
forall k (m :: k). Requirement -> ToPandoc m ()
Require Requirement
r

-- | Write given doc in requested format
writeTo
  :: P.Member FromPandoc effs
  => PandocWriteFormat a
  -> PA.WriterOptions
  -> PA.Pandoc
  -> P.Sem effs a
writeTo :: PandocWriteFormat a -> WriterOptions -> Pandoc -> Sem effs a
writeTo pwf :: PandocWriteFormat a
pwf pwo :: WriterOptions
pwo pdoc :: Pandoc
pdoc = FromPandoc (Sem effs) a -> Sem effs a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Member e r =>
e (Sem r) a -> Sem r a
send (FromPandoc (Sem effs) a -> Sem effs a)
-> FromPandoc (Sem effs) a -> Sem effs a
forall a b. (a -> b) -> a -> b
$ PandocWriteFormat a
-> WriterOptions -> Pandoc -> FromPandoc (Sem effs) a
forall k a (m :: k).
PandocWriteFormat a -> WriterOptions -> Pandoc -> FromPandoc m a
WriteTo PandocWriteFormat a
pwf WriterOptions
pwo Pandoc
pdoc

-- | Convert a to Pandoc with the given options
toPandoc
  :: PA.PandocMonad m
  => PandocReadFormat a
  -> PA.ReaderOptions
  -> a
  -> m PA.Pandoc
toPandoc :: PandocReadFormat a -> ReaderOptions -> a -> m Pandoc
toPandoc prf :: PandocReadFormat a
prf pro :: ReaderOptions
pro x :: a
x = ReaderOptions -> a -> m Pandoc
readF ReaderOptions
pro a
x
 where
  readF :: ReaderOptions -> a -> m Pandoc
readF = case PandocReadFormat a
prf of
    ReadDocX       -> ReaderOptions -> a -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> ByteString -> m Pandoc
PA.readDocx
    ReadMarkDown   -> ReaderOptions -> a -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
PA.readMarkdown
    ReadCommonMark -> ReaderOptions -> a -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
PA.readCommonMark
    ReadRST        -> ReaderOptions -> a -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
PA.readRST
    ReadLaTeX      -> ReaderOptions -> a -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
PA.readLaTeX
    ReadHtml       -> ReaderOptions -> a -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
PA.readHtml

-- | Convert Pandoc to requested format with the given options.
-- | Throw a PandocError if the output format is unsupported given the inputs.
fromPandoc
  :: PA.PandocMonad m
  => PandocWriteFormat a
  -> PA.WriterOptions
  -> PandocWithRequirements
  -> m a
fromPandoc :: PandocWriteFormat a
-> WriterOptions -> PandocWithRequirements -> m a
fromPandoc pwf :: PandocWriteFormat a
pwf pwo :: WriterOptions
pwo (PandocWithRequirements pdoc :: Pandoc
pdoc rs :: Set Requirement
rs) = case PandocWriteFormat a -> Set Requirement -> Bool
forall a. PandocWriteFormat a -> Set Requirement -> Bool
handlesAll PandocWriteFormat a
pwf Set Requirement
rs of
  False ->
    PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
      (PandocError -> m a) -> PandocError -> m a
forall a b. (a -> b) -> a -> b
$  Text -> PandocError
PA.PandocSomeError
      (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$  Text -> Text
PM.textToPandocText
      (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$  "One of "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [Requirement] -> String
forall a. Show a => a -> String
show ([Requirement] -> String) -> [Requirement] -> String
forall a b. (a -> b) -> a -> b
$ Set Requirement -> [Requirement]
forall a. Set a -> [a]
S.toList Set Requirement
rs)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " cannot be output to "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PandocWriteFormat a -> String
forall a. Show a => a -> String
show PandocWriteFormat a
pwf)
  True -> WriterOptions -> Pandoc -> m a
write WriterOptions
pwo Pandoc
pdoc
   where
    write :: WriterOptions -> Pandoc -> m a
write = case PandocWriteFormat a
pwf of
      WriteDocX        -> WriterOptions -> Pandoc -> m a
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
PA.writeDocx
      WriteMarkDown    -> WriterOptions -> Pandoc -> m a
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
PA.writeMarkdown
      WriteCommonMark  -> WriterOptions -> Pandoc -> m a
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
PA.writeCommonMark
      WriteRST         -> WriterOptions -> Pandoc -> m a
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
PA.writeRST
      WriteLaTeX       -> WriterOptions -> Pandoc -> m a
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
PA.writeLaTeX
      WriteHtml5       -> WriterOptions -> Pandoc -> m a
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Html
PA.writeHtml5
      WriteHtml5String -> WriterOptions -> Pandoc -> m a
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
PA.writeHtml5String

-- | Re-interpret ToPandoc in Writer
toWriter
  :: PM.PandocEffects effs
  => P.Sem (ToPandoc ': effs) a
  -> P.Sem (P.Writer PandocWithRequirements ': effs) a
toWriter :: Sem (ToPandoc : effs) a
-> Sem (Writer PandocWithRequirements : effs) a
toWriter = (forall (m :: * -> *) x.
 ToPandoc m x -> Sem (Writer PandocWithRequirements : effs) x)
-> Sem (ToPandoc : effs) a
-> Sem (Writer PandocWithRequirements : effs) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret" =>
(forall (m :: * -> *) x. e1 m x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
P.reinterpret ((forall (m :: * -> *) x.
  ToPandoc m x -> Sem (Writer PandocWithRequirements : effs) x)
 -> Sem (ToPandoc : effs) a
 -> Sem (Writer PandocWithRequirements : effs) a)
-> (forall (m :: * -> *) x.
    ToPandoc m x -> Sem (Writer PandocWithRequirements : effs) x)
-> Sem (ToPandoc : effs) a
-> Sem (Writer PandocWithRequirements : effs) a
forall a b. (a -> b) -> a -> b
$ \case
  (AddFrom rf ro x) ->
    Sem effs PandocWithRequirements
-> Sem
     (Writer PandocWithRequirements : effs) PandocWithRequirements
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
P.raise ((Pandoc -> PandocWithRequirements)
-> Sem effs Pandoc -> Sem effs PandocWithRequirements
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pandoc -> PandocWithRequirements
justDoc (Sem effs Pandoc -> Sem effs PandocWithRequirements)
-> Sem effs Pandoc -> Sem effs PandocWithRequirements
forall a b. (a -> b) -> a -> b
$ (PandocMonad (Sem effs) => Sem effs Pandoc) -> Sem effs Pandoc
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error PandocError, Pandoc] r =>
(PandocMonad (Sem r) => Sem r a) -> Sem r a
PM.absorbPandocMonad ((PandocMonad (Sem effs) => Sem effs Pandoc) -> Sem effs Pandoc)
-> (PandocMonad (Sem effs) => Sem effs Pandoc) -> Sem effs Pandoc
forall a b. (a -> b) -> a -> b
$ PandocReadFormat a -> ReaderOptions -> a -> Sem effs Pandoc
forall (m :: * -> *) a.
PandocMonad m =>
PandocReadFormat a -> ReaderOptions -> a -> m Pandoc
toPandoc PandocReadFormat a
rf ReaderOptions
ro a
x)
      Sem (Writer PandocWithRequirements : effs) PandocWithRequirements
-> (PandocWithRequirements
    -> Sem (Writer PandocWithRequirements : effs) ())
-> Sem (Writer PandocWithRequirements : effs) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Writer PandocWithRequirements) r =>
PandocWithRequirements -> Sem r ()
forall o (r :: [(* -> *) -> * -> *]).
MemberWithError (Writer o) r =>
o -> Sem r ()
P.tell @PandocWithRequirements
  (Require r) -> PandocWithRequirements
-> Sem (Writer PandocWithRequirements : effs) ()
forall o (r :: [(* -> *) -> * -> *]).
MemberWithError (Writer o) r =>
o -> Sem r ()
P.tell (Requirement -> PandocWithRequirements
justRequirement Requirement
r)

-- | Run ToPandoc by interpreting in Writer and then running that Writer.
runPandocWriter
  :: PM.PandocEffects effs
  => P.Sem (ToPandoc ': effs) ()
  -> P.Sem effs PandocWithRequirements
runPandocWriter :: Sem (ToPandoc : effs) () -> Sem effs PandocWithRequirements
runPandocWriter = ((PandocWithRequirements, ()) -> PandocWithRequirements)
-> Sem effs (PandocWithRequirements, ())
-> Sem effs PandocWithRequirements
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PandocWithRequirements, ()) -> PandocWithRequirements
forall a b. (a, b) -> a
fst (Sem effs (PandocWithRequirements, ())
 -> Sem effs PandocWithRequirements)
-> (Sem (ToPandoc : effs) ()
    -> Sem effs (PandocWithRequirements, ()))
-> Sem (ToPandoc : effs) ()
-> Sem effs PandocWithRequirements
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Writer PandocWithRequirements : effs) ()
-> Sem effs (PandocWithRequirements, ())
forall o (r :: [(* -> *) -> * -> *]) a.
Monoid o =>
Sem (Writer o : r) a -> Sem r (o, a)
P.runWriter (Sem (Writer PandocWithRequirements : effs) ()
 -> Sem effs (PandocWithRequirements, ()))
-> (Sem (ToPandoc : effs) ()
    -> Sem (Writer PandocWithRequirements : effs) ())
-> Sem (ToPandoc : effs) ()
-> Sem effs (PandocWithRequirements, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (ToPandoc : effs) ()
-> Sem (Writer PandocWithRequirements : effs) ()
forall (effs :: [(* -> *) -> * -> *]) a.
PandocEffects effs =>
Sem (ToPandoc : effs) a
-> Sem (Writer PandocWithRequirements : effs) a
toWriter

-- | Type to hold info about each document that will be required for rendering and output
data PandocInfo = PandocInfo { PandocInfo -> Text
pdiName :: T.Text, PandocInfo -> Map String String
pdiTemplateVars :: M.Map String String }

-- | Type-alias for use with the @Docs@ effect.
type Pandocs = Docs PandocInfo PandocWithRequirements


-- | Add a new named Pandoc to a Pandoc Docs collection.
newPandocPure
  :: P.Member Pandocs effs
  => PandocInfo  -- ^ name and template variables for document
  -> PandocWithRequirements -- ^ document and union of all input requirements
  -> P.Sem effs ()
newPandocPure :: PandocInfo -> PandocWithRequirements -> Sem effs ()
newPandocPure = PandocInfo -> PandocWithRequirements -> Sem effs ()
forall i a (effs :: [(* -> *) -> * -> *]).
Member (Docs i a) effs =>
i -> a -> Sem effs ()
newDoc

-- | Add the Pandoc stored in the writer-style ToPandoc effect to the named docs collection with the given name.
newPandoc
  :: (PM.PandocEffects effs, P.Member Pandocs effs)
  => PandocInfo  -- ^ name and template variables for document
  -> P.Sem (ToPandoc ': effs) ()
  -> P.Sem effs ()
newPandoc :: PandocInfo -> Sem (ToPandoc : effs) () -> Sem effs ()
newPandoc n :: PandocInfo
n l :: Sem (ToPandoc : effs) ()
l = ((PandocWithRequirements, ()) -> PandocWithRequirements)
-> Sem effs (PandocWithRequirements, ())
-> Sem effs PandocWithRequirements
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PandocWithRequirements, ()) -> PandocWithRequirements
forall a b. (a, b) -> a
fst (Sem (Writer PandocWithRequirements : effs) ()
-> Sem effs (PandocWithRequirements, ())
forall o (r :: [(* -> *) -> * -> *]) a.
Monoid o =>
Sem (Writer o : r) a -> Sem r (o, a)
P.runWriter (Sem (Writer PandocWithRequirements : effs) ()
 -> Sem effs (PandocWithRequirements, ()))
-> Sem (Writer PandocWithRequirements : effs) ()
-> Sem effs (PandocWithRequirements, ())
forall a b. (a -> b) -> a -> b
$ Sem (ToPandoc : effs) ()
-> Sem (Writer PandocWithRequirements : effs) ()
forall (effs :: [(* -> *) -> * -> *]) a.
PandocEffects effs =>
Sem (ToPandoc : effs) a
-> Sem (Writer PandocWithRequirements : effs) a
toWriter Sem (ToPandoc : effs) ()
l) Sem effs PandocWithRequirements
-> (PandocWithRequirements -> Sem effs ()) -> Sem effs ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PandocInfo -> PandocWithRequirements -> Sem effs ()
forall (effs :: [(* -> *) -> * -> *]).
Member Pandocs effs =>
PandocInfo -> PandocWithRequirements -> Sem effs ()
newPandocPure PandocInfo
n

-- | Given a write format and options, convert the NamedDoc to the requested format
pandocFrom
  :: PA.PandocMonad m
  => PandocWriteFormat a -- ^ format for Pandoc output
  -> PA.WriterOptions -- ^ options for the Pandoc Writer
  -> DocWithInfo PandocInfo PandocWithRequirements -- ^ named Pandoc with its union of requirements
  -> m (DocWithInfo PandocInfo a) -- ^ document in output format (in the effects monad).
pandocFrom :: PandocWriteFormat a
-> WriterOptions
-> DocWithInfo PandocInfo PandocWithRequirements
-> m (DocWithInfo PandocInfo a)
pandocFrom pwf :: PandocWriteFormat a
pwf pwo :: WriterOptions
pwo (DocWithInfo i :: PandocInfo
i pdoc :: PandocWithRequirements
pdoc) = do
  a
doc' <- PandocWriteFormat a
-> WriterOptions -> PandocWithRequirements -> m a
forall (m :: * -> *) a.
PandocMonad m =>
PandocWriteFormat a
-> WriterOptions -> PandocWithRequirements -> m a
fromPandoc PandocWriteFormat a
pwf WriterOptions
pwo PandocWithRequirements
pdoc
  DocWithInfo PandocInfo a -> m (DocWithInfo PandocInfo a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocWithInfo PandocInfo a -> m (DocWithInfo PandocInfo a))
-> DocWithInfo PandocInfo a -> m (DocWithInfo PandocInfo a)
forall a b. (a -> b) -> a -> b
$ PandocInfo -> a -> DocWithInfo PandocInfo a
forall i a. i -> a -> DocWithInfo i a
DocWithInfo PandocInfo
i a
doc'

-- | Given a write format and options,
-- convert a list of named Pandocs to a list of named docs in the requested format
pandocsToDocs
  :: PM.PandocEffects effs
  => PandocWriteFormat a -- ^ format for Pandoc output
  -> PA.WriterOptions -- ^ options for the Pandoc Writer
  -> P.Sem (Pandocs ': effs) () -- ^ effects stack to be (partially) run to get documents
  -> P.Sem effs [DocWithInfo PandocInfo a] -- ^ documents in requested format, within the effects monad
pandocsToDocs :: PandocWriteFormat a
-> WriterOptions
-> Sem (Pandocs : effs) ()
-> Sem effs [DocWithInfo PandocInfo a]
pandocsToDocs pwf :: PandocWriteFormat a
pwf pwo :: WriterOptions
pwo =
  ((DocWithInfo PandocInfo PandocWithRequirements
 -> Sem effs (DocWithInfo PandocInfo a))
-> [DocWithInfo PandocInfo PandocWithRequirements]
-> Sem effs [DocWithInfo PandocInfo a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\x :: DocWithInfo PandocInfo PandocWithRequirements
x -> (PandocMonad (Sem effs) => Sem effs (DocWithInfo PandocInfo a))
-> Sem effs (DocWithInfo PandocInfo a)
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error PandocError, Pandoc] r =>
(PandocMonad (Sem r) => Sem r a) -> Sem r a
PM.absorbPandocMonad ((PandocMonad (Sem effs) => Sem effs (DocWithInfo PandocInfo a))
 -> Sem effs (DocWithInfo PandocInfo a))
-> (PandocMonad (Sem effs) => Sem effs (DocWithInfo PandocInfo a))
-> Sem effs (DocWithInfo PandocInfo a)
forall a b. (a -> b) -> a -> b
$ PandocWriteFormat a
-> WriterOptions
-> DocWithInfo PandocInfo PandocWithRequirements
-> Sem effs (DocWithInfo PandocInfo a)
forall (m :: * -> *) a.
PandocMonad m =>
PandocWriteFormat a
-> WriterOptions
-> DocWithInfo PandocInfo PandocWithRequirements
-> m (DocWithInfo PandocInfo a)
pandocFrom PandocWriteFormat a
pwf WriterOptions
pwo DocWithInfo PandocInfo PandocWithRequirements
x) ([DocWithInfo PandocInfo PandocWithRequirements]
 -> Sem effs [DocWithInfo PandocInfo a])
-> Sem effs [DocWithInfo PandocInfo PandocWithRequirements]
-> Sem effs [DocWithInfo PandocInfo a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Sem effs [DocWithInfo PandocInfo PandocWithRequirements]
 -> Sem effs [DocWithInfo PandocInfo a])
-> (Sem (Pandocs : effs) ()
    -> Sem effs [DocWithInfo PandocInfo PandocWithRequirements])
-> Sem (Pandocs : effs) ()
-> Sem effs [DocWithInfo PandocInfo a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Pandocs : effs) ()
-> Sem effs [DocWithInfo PandocInfo PandocWithRequirements]
forall i a (effs :: [(* -> *) -> * -> *]).
Sem (Docs i a : effs) () -> Sem effs [DocWithInfo i a]
toDocList

-- | Given a write format and options, run the writer-style ToPandoc effect and produce a doc of requested type
fromPandocE
  :: PM.PandocEffects effs
  => PandocWriteFormat a -- ^ format for Pandoc output
  -> PA.WriterOptions -- ^ options for the Pandoc Writer
  -> P.Sem (ToPandoc ': effs) () -- ^ effects stack to be (partially) run to get document
  -> P.Sem effs a -- ^ document in requested format, within the effects monad
fromPandocE :: PandocWriteFormat a
-> WriterOptions -> Sem (ToPandoc : effs) () -> Sem effs a
fromPandocE pwf :: PandocWriteFormat a
pwf pwo :: WriterOptions
pwo =
  (((\x :: PandocWithRequirements
x -> (PandocMonad (Sem effs) => Sem effs a) -> Sem effs a
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error PandocError, Pandoc] r =>
(PandocMonad (Sem r) => Sem r a) -> Sem r a
PM.absorbPandocMonad ((PandocMonad (Sem effs) => Sem effs a) -> Sem effs a)
-> (PandocMonad (Sem effs) => Sem effs a) -> Sem effs a
forall a b. (a -> b) -> a -> b
$ PandocWriteFormat a
-> WriterOptions -> PandocWithRequirements -> Sem effs a
forall (m :: * -> *) a.
PandocMonad m =>
PandocWriteFormat a
-> WriterOptions -> PandocWithRequirements -> m a
fromPandoc PandocWriteFormat a
pwf WriterOptions
pwo PandocWithRequirements
x) (PandocWithRequirements -> Sem effs a)
-> ((PandocWithRequirements, ()) -> PandocWithRequirements)
-> (PandocWithRequirements, ())
-> Sem effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PandocWithRequirements, ()) -> PandocWithRequirements
forall a b. (a, b) -> a
fst) ((PandocWithRequirements, ()) -> Sem effs a)
-> Sem effs (PandocWithRequirements, ()) -> Sem effs a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
    (Sem effs (PandocWithRequirements, ()) -> Sem effs a)
-> (Sem (ToPandoc : effs) ()
    -> Sem effs (PandocWithRequirements, ()))
-> Sem (ToPandoc : effs) ()
-> Sem effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Writer PandocWithRequirements : effs) ()
-> Sem effs (PandocWithRequirements, ())
forall o (r :: [(* -> *) -> * -> *]) a.
Monoid o =>
Sem (Writer o : r) a -> Sem r (o, a)
P.runWriter
    (Sem (Writer PandocWithRequirements : effs) ()
 -> Sem effs (PandocWithRequirements, ()))
-> (Sem (ToPandoc : effs) ()
    -> Sem (Writer PandocWithRequirements : effs) ())
-> Sem (ToPandoc : effs) ()
-> Sem effs (PandocWithRequirements, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (ToPandoc : effs) ()
-> Sem (Writer PandocWithRequirements : effs) ()
forall (effs :: [(* -> *) -> * -> *]) a.
PandocEffects effs =>
Sem (ToPandoc : effs) a
-> Sem (Writer PandocWithRequirements : effs) a
toWriter