diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,40 +1,71 @@ +* v 0.5.0.0 +* Added plots example back since there is a version of plots on hackage with +a relaxed upper bound on containers. +* Changed the Doc effect so that instead of Text name, it carries a polymorphic info type. +This is then specified in the Pandoc case to be a Text name and set of template var overrides. +This creates several other changes and will break any multi-doc examples since now +"newPandoc" takes a first argument of the type ```PandocInfo``` (which is just a +product of a ```Text``` and a ```Map String String```). +* raised lower bound and relaxed upper bound on polysemy + v 0.4.0.0 -* Added ```absorbPandocMonad :: PandocEffects r => (forall m. PandocMonad m => m a) -> Sem r a``` to Knit.Effect.PandocMonad -* Removed (orphan) instances: ```PandocMonad (Sem r)``` and ```MonadError PandocError (Sem r)``` in favor -of using ```absorbPandocMonad``` when required. -* Deprecated name "Random" in favor of "RandomFu" for clarity and eventual consistency with Polysemy -* Added ```absorbMonadRandom :: Member RandomFu r => (forall m. MonadRandom m => m a) -> Sem r a``` to allow some +* Added +```absorbPandocMonad :: PandocEffects r => (forall m. PandocMonad m => m a) -> Sem r a``` +to ```Knit.Effect.PandocMonad``` +* Removed (orphan) instances: ```PandocMonad (Sem r)``` and +```MonadError PandocError (Sem r)``` in favor of using +```absorbPandocMonad``` when required. +* Deprecated name "Random" in favor of "RandomFu" for clarity and +eventual consistency with Polysemy +* Added +```absorbMonadRandom :: Member RandomFu r => (forall m. MonadRandom m => m a) -> Sem r a``` +to allow some interoperation with actions constrained by ```MonadRandom``` -* Removed orphan ```Random.MonadRandom``` instance from ```Knit.Effect.RandomFu``` because orphan instances are bad. -* Changed return type of ```Knit.Report.knitError``` to ```Sem r a``` (from ```Sem r ()```) +* Removed orphan ```Random.MonadRandom``` instance from +```Knit.Effect.RandomFu``` because orphan instances are bad. +* Changed return type of ```Knit.Report.knitError``` to ```Sem r a``` +(from ```Sem r ()```) * Bumped lower bound on polysemy-plugin (because of a buggy version) * Bumped lower bound on polysemy -* Removed plots example in "SimpleExample" and added a diagrams one. Will add plots back once a version issue -with containers is resolved. +* Removed plots example in "SimpleExample" and added a diagrams one. +Will add plots back once a version issue with containers is resolved. v 0.3.0.1 -* Examples were "executables" and are now "tests" so that depending on knit-haskell does not pull in the dependencies of the examples. +* Examples were "executables" and are now "tests" so that depending on +knit-haskell does not pull in the dependencies of the examples. v 0.3.0.0 -* Added exports of "Colonnade" and "Text.Blaze.Colonnade" to "Knit.Report.Input.Table.Colonnade" -* Added "knitError" function to Knit.Report to allow user throwing of errors. These will become PandocSomeError and handled as a PandocError. +* Added exports of "Colonnade" and "Text.Blaze.Colonnade" to +"Knit.Report.Input.Table.Colonnade" +* Added "knitError" function to Knit.Report to allow user throwing of errors. +These will become PandocSomeError and handled as a PandocError. * Lowered bound on containers (to 0.5.0) to accomodate use of Plots. -* Added Knit.Report.Input.Visualization.Diagrams. Adds Diagrams from diagrams-lib via SVG backend. -* Added some more re-exports (Colonnade, Diagrams.Prelude) from Knit.Report to simplify imports on use. -* Added an optional figure caption argument to Hvega and Diagrams inputs. (this is a breaking change since it requires another argument). +* Added Knit.Report.Input.Visualization.Diagrams. +Adds Diagrams from diagrams-lib via SVG backend. +* Added some more re-exports (Colonnade, Diagrams.Prelude) +from Knit.Report to simplify imports on use. +* Added an optional figure caption argument to Hvega and Diagrams inputs. +(this is a breaking change since it requires another argument). * Added a state effect wrapper to facilitate getting unused ids for figures, etc. -* Changed id argument for Hvega and Diagrams visualizations to "Maybe Text" from Text. Will use built-in facilities for unique ids when set to Nothing. -* Visualization "addXXX" functions now return the figure id (as "Sem r Text") so it can be referred to elsewhere. -* Added KnitOne and KnitMany constraint-type-aliases to Knit.Report to simplify constraining doc producing functions. -* Updated examples. Added a diagrams example to SimpleExample and fixed id and caption arguments throughout. +* Changed id argument for Hvega and Diagrams +visualizations to "Maybe Text" from Text. +Will use built-in facilities for unique ids when set to Nothing. +* Visualization "addXXX" functions now return the figure id (as "Sem r Text") +so it can be referred to elsewhere. +* Added KnitOne and KnitMany constraint-type-aliases to Knit.Report +to simplify constraining doc producing functions. +* Updated examples. Added a diagrams example to SimpleExample +and fixed id and caption arguments throughout. * Bumped upper bounds (network) v 0.2.0.0 * Documentation Fixes -* Added export of newPandoc and NamedDoc to Knit.Report to facilitate multi-doc use. +* Added export of newPandoc and NamedDoc to Knit.Report to +facilitate multi-doc use. * Removed redundant imports from Knit.Report.Input.Table.Colonnade * Added a multi-doc example -* (internal) Removed odd, and no longer necessary, "LastMember" constraint from knit functions. +* (internal) Removed odd, and no longer necessary, "LastMember" +constraint from knit functions. * Updated effects for polysemy 1.2 v 0.1.0.0 diff --git a/examples/MultiDocExample.hs b/examples/MultiDocExample.hs --- a/examples/MultiDocExample.hs +++ b/examples/MultiDocExample.hs @@ -24,12 +24,13 @@ main :: IO () main = do - let writeNamedHtml (K.NamedDoc n lt) = T.writeFile (T.unpack $ "examples/html/" <> n <> ".html") $ TL.toStrict lt + let writeNamedHtml (K.DocWithInfo (K.PandocInfo n _) lt) + = T.writeFile (T.unpack $ "examples/html/" <> n <> ".html") $ TL.toStrict lt writeAllHtml = fmap (const ()) . traverse writeNamedHtml pandocWriterConfig = K.PandocWriterConfig (Just "pandoc-templates/minWithVega-pandoc.html") templateVars K.mindocOptionsF resE <- K.knitHtmls (Just "SimpleExample.Main") K.logAll pandocWriterConfig $ do - K.newPandoc "multi_doc1" makeDoc1 - K.newPandoc "multi_doc2" makeDoc2 + K.newPandoc (K.PandocInfo "multi_doc1" M.empty) makeDoc1 + K.newPandoc (K.PandocInfo "multi_doc2" M.empty) makeDoc2 case resE of Right namedDocs -> writeAllHtml namedDocs Left err -> putStrLn $ "pandoc error: " ++ show err diff --git a/examples/SimpleExample.hs b/examples/SimpleExample.hs --- a/examples/SimpleExample.hs +++ b/examples/SimpleExample.hs @@ -14,7 +14,7 @@ import Data.String.Here (here) import qualified Graphics.Vega.VegaLite as V ---import qualified Plots as P +import qualified Plots as P templateVars :: M.Map String String templateVars = M.fromList @@ -54,10 +54,10 @@ K.logLE K.Info "adding a visualization..." K.addMarkDown "## An example hvega visualization" _ <- K.addHvega Nothing (Just "From the cars data-set") exampleVis - K.addMarkDown "## An example Diagrams visualization" - K.logLE K.Info "adding a Diagrams plot..." + K.addMarkDown "## Example Diagrams visualizations, the lsecond using the plots library." + K.logLE K.Info "adding a Diagrams example and plots example..." _ <- K.addDiagramAsSVG Nothing (Just "Example diagram") 300 300 exampleDiagram --- _ <- K.addDiagramAsSVG Nothing (Just "Example diagrams visualization using the Plots library") 300 300 samplePlot + _ <- K.addDiagramAsSVG Nothing (Just "Example diagrams visualization using the Plots library") 300 300 samplePlot return () -- example using HVega @@ -72,7 +72,7 @@ in V.toVegaLite [ bkg, cars, V.mark V.Circle [], enc [] ] ---sampleDiagram +-- sampleDiagram -- from hilbert 0 = mempty @@ -88,11 +88,6 @@ . K.strokeT $ hilbert 5 -{- -This plot example requires the plots library which cannot currently -be compiled with the polysemy plugin unless you use cabal.project -and add "allow-newer : plots:containers" - -- example using Plots (as an example of using Diagrams) samplePlot :: K.Diagram K.SVG samplePlot = P.renderAxis logAxis @@ -102,11 +97,8 @@ logAxis :: P.Axis K.SVG K.V2 Double logAxis = P.r2Axis K.&~ do P.scatterPlot' logData - -- yMin ?= 200 P.yAxis P.&= do P.logScale K..= P.LogAxis P.majorTicksFunction K..= P.logMajorTicks 5 -- <> pure [1] - -- minorTicksFunction .= minorTicksHelper 5 --} diff --git a/knit-haskell.cabal b/knit-haskell.cabal --- a/knit-haskell.cabal +++ b/knit-haskell.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: knit-haskell -version: 0.4.0.0 +version: 0.5.0.0 synopsis: a minimal Rmarkdown sort-of-thing for haskell, by way of Pandoc description: knit-haskell is a beginning attempt at bringing some of the benefits of Rmarkdown to Haskell. @@ -17,7 +17,9 @@ latex and or html. Support is also included for including - visualizations. + visualizations + and diagrams from the + package. More information is available in the . bug-reports: https://github.com/adamConnerSax/knit-haskell/issues license: BSD-3-Clause @@ -83,7 +85,7 @@ hvega >= 0.1.0 && <= 0.2.0.0, logging-effect >= 1.3.3 && < 1.4, mtl >= 2.2.2 && < 2.3, - polysemy >= 0.2.0.0 && < 0.3.0.0, + polysemy >= 0.3.0.0 && < 0.5.0.0, polysemy-plugin >= 0.2.0.0 && < 0.3.0.0, prettyprinter >= 1.2.1 && < 1.4, lucid >= 2.9.11 && < 2.10, @@ -107,6 +109,7 @@ here >= 1.2.10 && < 1.3.0, hvega, knit-haskell -any, + plots >= 0.1.1.0 && <= 0.2, polysemy, text default-language: Haskell2010 diff --git a/src/Knit/Effect/Docs.hs b/src/Knit/Effect/Docs.hs --- a/src/Knit/Effect/Docs.hs +++ b/src/Knit/Effect/Docs.hs @@ -1,12 +1,14 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} + {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} {-| Module : Knit.Effect.Docs @@ -30,63 +32,68 @@ , newDoc -- * Interpretations - , toNamedDocList - , toNamedDocListWith - , toNamedDocListWithM + , toDocList + , toDocListWith + , toDocListWithM -- * Helper Types - , NamedDoc(..) + , DocWithInfo(..) -- * Helper Functions - , mapNamedDocs - , mapNamedDocsM + , mapDocs + , mapDocsM ) where -import qualified Data.Text as T import qualified Polysemy as P import Polysemy.Internal ( send ) import qualified Polysemy.Writer as P +import Control.Monad (sequence, join) --- | GADT to represent storing a named document. -data Docs a m r where - NewDoc :: T.Text -> a -> Docs a m () +-- | GADT to represent storing a document and some info for processing it. +data Docs i a m r where + NewDoc :: i -> a -> Docs i a m () --- | Action of the 'Docs' Effect. Store a named document. -newDoc :: P.Member (Docs a) effs => T.Text -> a -> P.Sem effs () -newDoc name doc = send $ NewDoc name doc +-- | Action of the 'Docs' Effect. Store a document. +newDoc :: P.Member (Docs i a) effs => i -> a -> P.Sem effs () +newDoc info doc = send $ NewDoc info doc --- | Data type to hold one named document of type @a@. -data NamedDoc a = NamedDoc { ndName :: T.Text, ndDoc :: a } deriving (Functor, Foldable, Traversable) +-- | Data type to hold one document with info of typ @i@ and doc of type @a@. +data DocWithInfo i a = DocWithInfo { dwiInfo :: i, dwiDoc :: a } +deriving instance Functor (DocWithInfo i) +deriving instance Foldable (DocWithInfo i) +deriving instance Traversable (DocWithInfo i) --- | Intepret 'Docs' in @Polysemy.Writer [NamedDoc a]' +-- | Intepret 'Docs' in @Polysemy.Writer [DocWithInfo i a]' toWriter - :: P.Sem (Docs a ': effs) () -> P.Sem (P.Writer [NamedDoc a] ': effs) () + :: P.Sem (Docs i a ': effs) () -> P.Sem (P.Writer [DocWithInfo i a] ': effs) () toWriter = P.reinterpret f where - f :: Docs a m x -> P.Sem (P.Writer [NamedDoc a] ': effs) x - f (NewDoc n d) = P.tell [NamedDoc n d] + f :: Docs i a m x -> P.Sem (P.Writer [DocWithInfo i a] ': effs) x + f (NewDoc i d) = P.tell [DocWithInfo i d] --- | Interpret 'Docs' (via 'Polysemy.Writer'), producing a list of @NamedDoc a@ -toNamedDocList :: P.Sem (Docs a ': effs) () -> P.Sem effs [NamedDoc a] -toNamedDocList = fmap fst . P.runWriter . toWriter +-- | Interpret 'Docs' (via 'Polysemy.Writer'), producing a list of @DocWithInfo i a@ +toDocList :: P.Sem (Docs i a ': effs) () -> P.Sem effs [DocWithInfo i a] +toDocList = fmap fst . P.runWriter . toWriter --- | Map over the doc part of @Functor m => m [NamedDoc a]@ with an @a->b@ resulting in @m [NamedDoc b]@ -mapNamedDocs :: Monad m => (a -> b) -> m [NamedDoc a] -> m [NamedDoc b] -mapNamedDocs f = fmap (fmap (fmap f)) +-- | Map over the doc part of @Functor m => m [DocWithInfo i a]@ with an @a->b@ resulting in @m [DocWithInfo i b]@ +mapDocs :: Monad m => (i -> a -> b) -> m [DocWithInfo i a] -> m [DocWithInfo i b] +mapDocs f = fmap (fmap (\(DocWithInfo i a) -> DocWithInfo i (f i a))) --- | Map over the doc part of @Monad m => m [NamedDoc a]@ with @a -> m b@ resulting in @m [NamedDoc b]@ -mapNamedDocsM :: Monad m => (a -> m b) -> m [NamedDoc a] -> m [NamedDoc b] -mapNamedDocsM f = (traverse (traverse f) =<<) +-- | Map over the doc part of @Monad m => m [DocWithInfo i a]@ with @a -> m b@ resulting in @m [DocWithInfo i b]@ +mapDocsM :: Monad m => (i -> a -> m b) -> m [DocWithInfo i a] -> m [DocWithInfo i b] +mapDocsM f = join . fmap (sequence . fmap (traverse id)) . mapDocs f --(traverse (traverse f) =<<) --- | Combine the interpretation and mapping step. Commonly used to "run" the effect and map the results to your deisred output format. -toNamedDocListWith - :: (a -> b) -> P.Sem (Docs a ': effs) () -> P.Sem effs [NamedDoc b] -toNamedDocListWith f = mapNamedDocs f . toNamedDocList +-- | Combine the interpretation and mapping step. +-- Commonly used to "run" the effect and map the results to your desired output format. +toDocListWith + :: (i -> a -> b) -> P.Sem (Docs i a ': effs) () -> P.Sem effs [DocWithInfo i b] +toDocListWith f = mapDocs f . toDocList --- | Combine the interpretation and effectful mapping step. Commonly used to "run" the effect and map the results to your deisred output format. -toNamedDocListWithM - :: (a -> P.Sem effs b) -> P.Sem (Docs a ': effs) () -> P.Sem effs [NamedDoc b] -toNamedDocListWithM f = mapNamedDocsM f . toNamedDocList +-- | Combine the interpretation and effectful mapping step. +-- Commonly used to "run" the effect and map the results to your deisred output format. +toDocListWithM + :: (i -> a -> P.Sem effs b) -> P.Sem (Docs i a ': effs) () -> P.Sem effs [DocWithInfo i b] +toDocListWithM f = mapDocsM f . toDocList diff --git a/src/Knit/Effect/Html.hs b/src/Knit/Effect/Html.hs --- a/src/Knit/Effect/Html.hs +++ b/src/Knit/Effect/Html.hs @@ -49,7 +49,7 @@ , newBlazeDoc -- * Re-exports - , NamedDoc(..) + , DocWithInfo(..) ) where @@ -63,9 +63,9 @@ import qualified Data.Text as T import Knit.Effect.Docs ( Docs - , NamedDoc(..) + , DocWithInfo(..) , newDoc - , toNamedDocList + , toDocList ) -- For now, just handle the Html () case since then it's monoidal and we can interpret via writer @@ -87,11 +87,11 @@ -- | Type-Alias for the 'Knit.Effects.Docs' effect (multi-document Writer), specialized to Lucid docs. -- To be used in an app that produces multiple html outputs, built up from Lucid bits. -type LucidDocs = Docs (LH.Html ()) +type LucidDocs = Docs T.Text (LH.Html ()) -- | Type-Alias for the 'Knit.Effects.Docs' effect (multi-document Writer) specialized to Blaze docs. -- To be used in an app that produces multiple html outputs, built up from Blaze bits. -type BlazeDocs = Docs BH.Html +type BlazeDocs = Docs T.Text BH.Html -- | Take the current Lucid HTML in the writer and add it to the set of named docs with the given name. -- NB: Only use this function for making sets of documents built exclusively from Lucid. Otherwise use the more general Pandoc infrastructure in @@ -115,13 +115,13 @@ -- | Interpret the LucidDocs effect (via Writer), producing a list of named Lucid docs, suitable for writing to disk. lucidToNamedText - :: P.Sem (LucidDocs ': effs) () -> P.Sem effs [NamedDoc TL.Text] -lucidToNamedText = fmap (fmap (fmap LH.renderText)) . toNamedDocList -- monad, list, NamedDoc itself + :: P.Sem (LucidDocs ': effs) () -> P.Sem effs [DocWithInfo T.Text TL.Text] +lucidToNamedText = fmap (fmap (fmap LH.renderText)) . toDocList -- monad, list, NamedDoc itself -- | Interpret the BlazeDocs effect (via Writer), producing a list of named Blaze docs. blazeToNamedText - :: P.Sem (BlazeDocs ': effs) () -> P.Sem effs [NamedDoc TL.Text] -blazeToNamedText = fmap (fmap (fmap BH.renderHtml)) . toNamedDocList -- monad, list, NamedDoc itself + :: P.Sem (BlazeDocs ': effs) () -> P.Sem effs [DocWithInfo T.Text TL.Text] +blazeToNamedText = fmap (fmap (fmap BH.renderHtml)) . toDocList -- monad, list, NamedDoc itself -- | Interprest the Lucid effect (via Writer), producing a Lucid @Html ()@ from the currently written doc lucidHtml :: P.Sem (Lucid ': effs) () -> P.Sem effs (LH.Html ()) diff --git a/src/Knit/Effect/Pandoc.hs b/src/Knit/Effect/Pandoc.hs --- a/src/Knit/Effect/Pandoc.hs +++ b/src/Knit/Effect/Pandoc.hs @@ -29,31 +29,38 @@ ToPandoc , FromPandoc - -- * Requirement Support + -- * Requirement Support , Requirement(..) , PandocWithRequirements - -- * Format ADTs + + -- * Format ADTs , PandocReadFormat(..) , PandocWriteFormat(..) - -- * Combinators + -- * Combinators , addFrom , require , writeTo , toPandoc , fromPandoc - -- * Interpreters + -- * Interpreters , runPandocWriter - -- * Docs effect type-aliases + -- * Docs effect type-aliases , Pandocs - , NamedDoc(..) - -- * Docs Effect Interpreters + -- * Pandoc Specific Info + , PandocInfo(..) + + -- * Docs Effect Interpreters , newPandoc - , pandocsToNamed + , pandocsToDocs , fromPandocE + + -- * Re-exports + , DocWithInfo(..) + ) where @@ -61,6 +68,7 @@ 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 @@ -76,9 +84,9 @@ import qualified Knit.Effect.PandocMonad as PM import Knit.Effect.Docs ( Docs - , NamedDoc(..) + , DocWithInfo(..) , newDoc - , toNamedDocList + , toDocList ) -- For now, just handle the Html () case since then it's monoidal and we can interpret via writer @@ -239,13 +247,17 @@ -> P.Sem effs PandocWithRequirements runPandocWriter = fmap fst . P.runWriter . toWriter +-- | Type to hold info about each document that will be required for rendering and output +data PandocInfo = PandocInfo { pdiName :: T.Text, pdiTemplateVars :: M.Map String String } + -- | Type-alias for use with the @Docs@ effect. -type Pandocs = Docs PandocWithRequirements +type Pandocs = Docs PandocInfo PandocWithRequirements + -- | Add a new named Pandoc to a Pandoc Docs collection. newPandocPure :: P.Member Pandocs effs - => T.Text -- ^ name for document + => PandocInfo -- ^ name and template variables for document -> PandocWithRequirements -- ^ document and union of all input requirements -> P.Sem effs () newPandocPure = newDoc @@ -253,33 +265,33 @@ -- | 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) - => T.Text -- ^ name of document + => PandocInfo -- ^ name and template variables for document -> P.Sem (ToPandoc ': effs) () -> P.Sem effs () newPandoc n l = fmap fst (P.runWriter $ toWriter l) >>= newPandocPure n -- | Given a write format and options, convert the NamedDoc to the requested format -namedPandocFrom +pandocFrom :: PA.PandocMonad m => PandocWriteFormat a -- ^ format for Pandoc output -> PA.WriterOptions -- ^ options for the Pandoc Writer - -> NamedDoc PandocWithRequirements -- ^ named Pandoc with its union of requirements - -> m (NamedDoc a) -- ^ document in output format (in the effects monad). -namedPandocFrom pwf pwo (NamedDoc n pdoc) = do + -> DocWithInfo PandocInfo PandocWithRequirements -- ^ named Pandoc with its union of requirements + -> m (DocWithInfo PandocInfo a) -- ^ document in output format (in the effects monad). +pandocFrom pwf pwo (DocWithInfo i pdoc) = do doc' <- fromPandoc pwf pwo pdoc - return $ NamedDoc n doc' + return $ DocWithInfo i doc' -- | Given a write format and options, -- convert a list of named Pandocs to a list of named docs in the requested format -pandocsToNamed +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 [NamedDoc a] -- ^ documents in requested format, within the effects monad -pandocsToNamed pwf pwo = - (traverse (\x -> PM.absorbPandocMonad $ namedPandocFrom pwf pwo x) =<<) - . toNamedDocList + -> P.Sem effs [DocWithInfo PandocInfo a] -- ^ documents in requested format, within the effects monad +pandocsToDocs pwf pwo = + (traverse (\x -> PM.absorbPandocMonad $ pandocFrom pwf pwo x) =<<) + . toDocList -- | Given a write format and options, run the writer-style ToPandoc effect and produce a doc of requested type fromPandocE diff --git a/src/Knit/Report.hs b/src/Knit/Report.hs --- a/src/Knit/Report.hs +++ b/src/Knit/Report.hs @@ -79,9 +79,10 @@ , PandocReadFormat(..) , PandocWriteFormat(..) , Pandocs + , PandocInfo (..) , newPandoc ) -import Knit.Effect.Docs ( NamedDoc(..) ) +import Knit.Effect.Docs ( DocWithInfo(..) ) import Knit.Effect.PandocMonad import Knit.Effect.Logger ( LogSeverity(..) , logAll @@ -143,10 +144,10 @@ -> [KLog.LogSeverity] -- ^ what to output in log -> PandocWriterConfig -- ^ configuration for the Pandoc Html Writer -> P.Sem (KnitEffectDocsStack m) () - -> m (Either PA.PandocError [KP.NamedDoc TL.Text]) -knitHtmls loggingPrefixM ls writeConfig = - consumeKnitEffectStack loggingPrefixM ls . KD.toNamedDocListWithM - (fmap BH.renderHtml . KO.toBlazeDocument writeConfig) + -> m (Either PA.PandocError [KP.DocWithInfo KP.PandocInfo TL.Text]) +knitHtmls loggingPrefixM ls (PandocWriterConfig mFP tv oF) = + consumeKnitEffectStack loggingPrefixM ls . KD.toDocListWithM + (\(KP.PandocInfo _ tv') a -> fmap BH.renderHtml . KO.toBlazeDocument (PandocWriterConfig mFP (tv' <> tv) oF) $ a) -- | Create HTML Text from pandoc fragments -- In use, you may need a type-application to specify m. @@ -184,7 +185,7 @@ type KnitOne r = (KnitEffects r, P.Member KP.ToPandoc r) -- | Constraint alias for the effects we need to knit multiple documents. -type KnitMany r = (KnitEffects r, P.Member (KD.Docs KP.PandocWithRequirements) r) +type KnitMany r = (KnitEffects r, P.Member KP.Pandocs r) -- From here down is unexported. -- | The exact stack we are interpreting when we knit @@ -198,7 +199,7 @@ , P.Lift m ] -- | Add a Multi-doc writer to the front of the effect list -type KnitEffectDocsStack m = (KD.Docs KP.PandocWithRequirements ': KnitEffectStack m) +type KnitEffectDocsStack m = (KP.Pandocs ': KnitEffectStack m) -- | Add a single-doc writer to the front of the effect list type KnitEffectDocStack m = (KP.ToPandoc ': KnitEffectStack m) diff --git a/src/Knit/Report/Output/Html.hs b/src/Knit/Report/Output/Html.hs --- a/src/Knit/Report/Output/Html.hs +++ b/src/Knit/Report/Output/Html.hs @@ -101,7 +101,7 @@ -- Incudes support for template and template variables and changes to the default writer options. pandocWriterToBlazeDocument :: PM.PandocEffects effs - => PandocWriterConfig -- ^ Configuration info for the Pandoc writer + => PandocWriterConfig -- ^ Configuration info for the Pandoc writer -> P.Sem (PE.ToPandoc ': effs) () -- ^ Effects stack to run to get Pandoc -> P.Sem effs BH.Html -- ^ Blaze Html (in remaining effects) pandocWriterToBlazeDocument writeConfig pw =