knit-haskell-0.8.0.0: a minimal Rmarkdown sort-of-thing for haskell, by way of Pandoc
Copyright(c) Adam Conner-Sax 2019
LicenseBSD-3-Clause
Maintaineradam_conner_sax@yahoo.com
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010

Knit.Report

Description

This module re-exports the basic pieces to build reports using Pandoc. That is, it is intended as one-stop-shopping for using this library to produce Html from various fragments which Pandoc can read.

Examples are available, and might be useful for seeing how all this works.

Notes:

  1. You can add logging from within document creation using logLE.
  2. The Knit.Report.Input.MarkDown.PandocMarkDown module is exported so if you want to use a different markdown flavor you may need to hide "addMarkDown" when you import this module.
  3. If you use any other effects in your polysemy stack (e.g., Random or RandomFu), you will need to interpretrun them before calling knitHtmlknitHtmls.
Synopsis

Report Building

Configuraiton

data KnitConfig sc ct k Source #

Parameters for knitting. If possible, create this via, e.g.,

myConfig = (defaultKnitConfig $ Just "myCacheDir") { pandocWriterConfig = myConfig }

so that your code will still compile if parameters are added to this structure.

NB: the type parameters of this configuration specify the cache types:

  • sc :: Type -> Constraint, where c a is the constraint to be satisfied for serializable a.
  • ct :: Type, is the value type held in the in-memory cache.
  • k :: Type, is the key type of the cache.

The serializeDict field holds functions for encoding (forall a. c a=> a -> ct) and decoding (forall a. c a => ct -> Either SerializationError a).

The persistCache field holds an interpreter for the persistence layer of the cache. See AtomicCache for examples of persistence layers.

If you want to use a different serializer ("binary" or "store") and/or a different type to hold cached values in-memory, you can set these fields accordingly.

defaultKnitConfig Source #

Arguments

:: Maybe Text

Optional cache-directory. Defaults to ".knit-haskell-cache".

-> KnitConfig DefaultSerializer DefaultCacheData Text

configuration

Sensible defaults for a knit configuration.

Knit documents

knitHtml Source #

Arguments

:: (MonadIO m, Ord k, Show k) 
=> KnitConfig c ct k

configuration

-> Sem (KnitEffectDocStack c ct k m) ()

computation producing a single document

-> m (Either PandocError Text)

Resulting document or error, in base monad. Usually IO.

Create HTML Text from pandoc fragments. In use, you may need a type-application to specify m. This allows use of any underlying monad to handle the Pandoc effects. NB: Resulting document is *Lazy* Text, as produced by the Blaze render function.

knitHtmls Source #

Arguments

:: (MonadIO m, Ord k, Show k) 
=> KnitConfig c ct k

configuration

-> Sem (KnitEffectDocsStack c ct k m) ()

computation producing a list of documents

-> m (Either PandocError [DocWithInfo PandocInfo Text])

Resulting docs or error, in base monad, usually IO.

Create multiple HTML docs (as Text) from the named sets of pandoc fragments. In use, you may need a type-application to specify m. This allows use of any underlying monad to handle the Pandoc effects. NB: Resulting documents are *Lazy* Text, as produced by the Blaze render function.

helpers

liftKnit :: Member (Embed m) r => m a -> Sem r a Source #

lift an action in a base monad into a Polysemy monad. This is just a renaming of embed for convenience.

Constraints for knit-haskell actions (see examples)

type KnitEffects r = (PandocEffects r, Members [UnusedId, Logger LogEntry, PrefixLog, Async, Error CacheError, Error SomeException, Error PandocError, Embed IO] r) Source #

Constraint alias for the effects we need (and run) when calling knitHtml or knitHtmls. Anything inside a call to Knit can use any of these effects. Any other effects added to this stack will need to be run before knitHtml(s)

type CacheEffects c ct k r = Members [SerializeEnv c ct, Cache k ct] r Source #

Constraint alias for the effects we need to use the cache.

type CacheEffectsD r = CacheEffects DefaultSerializer DefaultCacheData Text r Source #

Constraint alias for the effects we need to use the default cache with Text keys.

type KnitOne r = (KnitEffects r, Member ToPandoc r) Source #

Constraint alias for the effects we need to knit one document.

type KnitMany r = (KnitEffects r, Member Pandocs r) Source #

Constraint alias for the effects we need to knit multiple documents.

type KnitBase m effs = (MonadIO m, Member (Embed m) effs) Source #

Constraints required to knit a document using effects from a base monad m.

Error combinators

knitError :: Member (Error PandocError) r => Text -> Sem r a Source #

Throw an error with a specific message. This will emerge as a PandocSomeError in order to avoid complicating the error type. NB: The Member constraint is satisfied by KnitEffectStack m.

knitMaybe :: Member (Error PandocError) r => Text -> Maybe a -> Sem r a Source #

Throw on Nothing with given message. This will emerge as a PandocSomeError in order to avoid complicating the error type.

knitEither :: Member (Error PandocError) r => Either Text a -> Sem r a Source #

Throw on Left with message. This will emerge as a PandocSomeError in order to avoid complicating the error type.

knitMapError :: forall e r a. KnitEffects r => (e -> Text) -> Sem (Error e ': r) a -> Sem r a Source #

Map an error type, @e, into a PandocError so it will be handled in this stack

Inputs

addMarkDown :: (PandocEffects effs, Member ToPandoc effs) => Text -> Sem effs () Source #

Add a Pandoc MarkDown fragment with default options

addStrictTextHtml :: (PandocEffects effs, Member ToPandoc effs) => Text -> Sem effs () Source #

Add Strict Text Html to current Pandoc

addLazyTextHtml :: (PandocEffects effs, Member ToPandoc effs) => Text -> Sem effs () Source #

Add Lazy Text Html to current Pandoc

addBlaze :: (PandocEffects effs, Member ToPandoc effs) => Html -> Sem effs () Source #

Add Blaze Html

addLucid :: (PandocEffects effs, Member ToPandoc effs) => Html () -> Sem effs () Source #

Add Lucid Html

addLatex :: (PandocEffects effs, Member ToPandoc effs) => Text -> Sem effs () Source #

Add LaTeX

addHvega Source #

Arguments

:: (PandocEffects effs, Member ToPandoc effs, Member UnusedId effs) 
=> Maybe Text

figure id, will get next unused with prefix "figure" if Nothing

-> Maybe Text

figure caption, none if Nothing

-> VegaLite 
-> Sem effs Text 

Add hvega (via html). Requires html since vega-lite renders using javascript.

Output

pandocWriterToBlazeDocument Source #

Arguments

:: PandocEffects effs 
=> PandocWriterConfig

Configuration info for the Pandoc writer

-> Sem (ToPandoc ': effs) ()

Effects stack to run to get Pandoc

-> Sem effs Html

Blaze Html (in remaining effects)

Convert given Pandoc to Blaze Html.

Convert current Pandoc document (from the ToPandoc effect) into a Blaze Html document. Incudes support for template and template variables and changes to the default writer options.

mindocOptionsF :: WriterOptions -> WriterOptions Source #

options for the mindoc template

writeAllPandocResultsWithInfoAsHtml :: Text -> [DocWithInfo PandocInfo Text] -> IO () Source #

Write each lazy text from a list of DocWithInfo to disk. File names come from the PandocInfo Directory is a function arguments. File extension is "html"

writePandocResultWithInfoAsHtml :: Text -> DocWithInfo PandocInfo Text -> IO () Source #

Write the Lazy Text in a DocWithInfo to disk, Name comes from the PandocInfo Directory is an argument to the function File extension is "html" Create the parent directory or directories, if necessary.

Effects

data Sem (r :: EffectRow) a #

The Sem monad handles computations of arbitrary extensible effects. A value of type Sem r describes a program with the capabilities of r. For best results, r should always be kept polymorphic, but you can add capabilities via the Member constraint.

The value of the Sem monad is that it allows you to write programs against a set of effects without a predefined meaning, and provide that meaning later. For example, unlike with mtl, you can decide to interpret an Error effect traditionally as an Either, or instead as (a significantly faster) IO Exception. These interpretations (and others that you might add) may be used interchangeably without needing to write any newtypes or Monad instances. The only change needed to swap interpretations is to change a call from runError to errorToIOFinal.

The effect stack r can contain arbitrary other monads inside of it. These monads are lifted into effects via the Embed effect. Monadic values can be lifted into a Sem via embed.

Higher-order actions of another monad can be lifted into higher-order actions of Sem via the Final effect, which is more powerful than Embed, but also less flexible to interpret.

A Sem can be interpreted as a pure value (via run) or as any traditional Monad (via runM or runFinal). Each effect E comes equipped with some interpreters of the form:

runE :: Sem (E ': r) a -> Sem r a

which is responsible for removing the effect E from the effect stack. It is the order in which you call the interpreters that determines the monomorphic representation of the r parameter.

Order of interpreters can be important - it determines behaviour of effects that manipulate state or change control flow. For example, when interpreting this action:

>>> :{
  example :: Members '[State String, Error String] r => Sem r String
  example = do
    put "start"
    let throwing, catching :: Members '[State String, Error String] r => Sem r String
        throwing = do
          modify (++"-throw")
          throw "error"
          get
        catching = do
          modify (++"-catch")
          get
    catch @String throwing (\ _ -> catching)
:}

when handling Error first, state is preserved after error occurs:

>>> :{
  example
    & runError
    & fmap (either id id)
    & evalState ""
    & runM
    & (print =<<)
:}
"start-throw-catch"

while handling State first discards state in such cases:

>>> :{
  example
    & evalState ""
    & runError
    & fmap (either id id)
    & runM
    & (print =<<)
:}
"start-catch"

A good rule of thumb is to handle effects which should have "global" behaviour over other effects later in the chain.

After all of your effects are handled, you'll be left with either a Sem '[] a, a Sem '[ Embed m ] a, or a Sem '[ Final m ] a value, which can be consumed respectively by run, runM, and runFinal.

Examples

As an example of keeping r polymorphic, we can consider the type

Member (State String) r => Sem r ()

to be a program with access to

get :: Sem r String
put :: String -> Sem r ()

methods.

By also adding a

Member (Error Bool) r

constraint on r, we gain access to the

throw :: Bool -> Sem r a
catch :: Sem r a -> (Bool -> Sem r a) -> Sem r a

functions as well.

In this sense, a Member (State s) r constraint is analogous to mtl's MonadState s m and should be thought of as such. However, unlike mtl, a Sem monad may have an arbitrary number of the same effect.

For example, we can write a Sem program which can output either Ints or Bools:

foo :: ( Member (Output Int) r
       , Member (Output Bool) r
       )
    => Sem r ()
foo = do
  output @Int  5
  output True

Notice that we must use -XTypeApplications to specify that we'd like to use the (Output Int) effect.

Since: polysemy-0.1.2.0

Instances

Instances details
Monad (Sem f) 
Instance details

Defined in Polysemy.Internal

Methods

(>>=) :: Sem f a -> (a -> Sem f b) -> Sem f b #

(>>) :: Sem f a -> Sem f b -> Sem f b #

return :: a -> Sem f a #

Functor (Sem f) 
Instance details

Defined in Polysemy.Internal

Methods

fmap :: (a -> b) -> Sem f a -> Sem f b #

(<$) :: a -> Sem f b -> Sem f a #

Member Fixpoint r => MonadFix (Sem r) 
Instance details

Defined in Polysemy.Internal

Methods

mfix :: (a -> Sem r a) -> Sem r a #

Member (Fail :: (Type -> Type) -> Type -> Type) r => MonadFail (Sem r)

Since: polysemy-1.1.0.0

Instance details

Defined in Polysemy.Internal

Methods

fail :: String -> Sem r a #

Applicative (Sem f) 
Instance details

Defined in Polysemy.Internal

Methods

pure :: a -> Sem f a #

(<*>) :: Sem f (a -> b) -> Sem f a -> Sem f b #

liftA2 :: (a -> b -> c) -> Sem f a -> Sem f b -> Sem f c #

(*>) :: Sem f a -> Sem f b -> Sem f b #

(<*) :: Sem f a -> Sem f b -> Sem f a #

Member NonDet r => MonadPlus (Sem r)

Since: polysemy-0.2.1.0

Instance details

Defined in Polysemy.Internal

Methods

mzero :: Sem r a #

mplus :: Sem r a -> Sem r a -> Sem r a #

Member NonDet r => Alternative (Sem r) 
Instance details

Defined in Polysemy.Internal

Methods

empty :: Sem r a #

(<|>) :: Sem r a -> Sem r a -> Sem r a #

some :: Sem r a -> Sem r [a] #

many :: Sem r a -> Sem r [a] #

Member (Embed IO) r => MonadIO (Sem r)

This instance will only lift IO actions. If you want to lift into some other MonadIO type, use this instance, and handle it via the embedToMonadIO interpretation.

Instance details

Defined in Polysemy.Internal

Methods

liftIO :: IO a -> Sem r a #

type family Members (es :: [k]) (r :: [k]) where ... #

Makes constraints of functions that use multiple effects shorter by translating single list of effects into multiple Member constraints:

foo :: Members '[ Output Int
                , Output Bool
                , State String
                ] r
    => Sem r ()

translates into:

foo :: ( Member (Output Int) r
       , Member (Output Bool) r
       , Member (State String) r
       )
    => Sem r ()

Since: polysemy-0.1.2.0

Equations

Members ('[] :: [k]) (r :: [k]) = () 
Members (e ': es :: [k]) (r :: [k]) = (Member e r, Members es r) 

type Member (e :: k) (r :: [k]) = MemberNoError e r #

A proof that the effect e is available somewhere inside of the effect stack r.

type Pandocs = Docs PandocInfo PandocWithRequirements Source #

Type-alias for use with the Docs effect.

data PandocInfo Source #

Type to hold info about each document that will be required for rendering and output

Constructors

PandocInfo 

data ToPandoc m r Source #

Pandoc writer, add any read format to current doc

data Requirement Source #

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.

Constructors

VegaSupport

Supported only for Html output.

LatexSupport

Supported in Html output (via MathJax) and Latex output.

newPandoc Source #

Arguments

:: (PandocEffects effs, Member Pandocs effs) 
=> PandocInfo

name and template variables for document

-> Sem (ToPandoc ': effs) () 
-> Sem effs () 

Add the Pandoc stored in the writer-style ToPandoc effect to the named docs collection with the given name.

data DocWithInfo i a Source #

Data type to hold one document with info of type i and doc of type a.

Constructors

DocWithInfo 

Fields

Instances

Instances details
Functor (DocWithInfo i) Source # 
Instance details

Defined in Knit.Effect.Docs

Methods

fmap :: (a -> b) -> DocWithInfo i a -> DocWithInfo i b #

(<$) :: a -> DocWithInfo i b -> DocWithInfo i a #

Foldable (DocWithInfo i) Source # 
Instance details

Defined in Knit.Effect.Docs

Methods

fold :: Monoid m => DocWithInfo i m -> m #

foldMap :: Monoid m => (a -> m) -> DocWithInfo i a -> m #

foldMap' :: Monoid m => (a -> m) -> DocWithInfo i a -> m #

foldr :: (a -> b -> b) -> b -> DocWithInfo i a -> b #

foldr' :: (a -> b -> b) -> b -> DocWithInfo i a -> b #

foldl :: (b -> a -> b) -> b -> DocWithInfo i a -> b #

foldl' :: (b -> a -> b) -> b -> DocWithInfo i a -> b #

foldr1 :: (a -> a -> a) -> DocWithInfo i a -> a #

foldl1 :: (a -> a -> a) -> DocWithInfo i a -> a #

toList :: DocWithInfo i a -> [a] #

null :: DocWithInfo i a -> Bool #

length :: DocWithInfo i a -> Int #

elem :: Eq a => a -> DocWithInfo i a -> Bool #

maximum :: Ord a => DocWithInfo i a -> a #

minimum :: Ord a => DocWithInfo i a -> a #

sum :: Num a => DocWithInfo i a -> a #

product :: Num a => DocWithInfo i a -> a #

Traversable (DocWithInfo i) Source # 
Instance details

Defined in Knit.Effect.Docs

Methods

traverse :: Applicative f => (a -> f b) -> DocWithInfo i a -> f (DocWithInfo i b) #

sequenceA :: Applicative f => DocWithInfo i (f a) -> f (DocWithInfo i a) #

mapM :: Monad m => (a -> m b) -> DocWithInfo i a -> m (DocWithInfo i b) #

sequence :: Monad m => DocWithInfo i (m a) -> m (DocWithInfo i a) #

type LogWithPrefixesLE effs = LogWithPrefixes LogEntry effs Source #

Constraint helper for LogEntry type with prefixes

type PrefixedLogEffectsLE = PrefixedLogEffects LogEntry Source #

List of Logger effects for a prefixed log of type LogEntry

data LogSeverity Source #

Severity/importance of message.

Constructors

Debug Int

Most detailed levels of logging. Int argument can be used adding fine distinctions between debug levels.

Diagnostic

Minimal details about effects and what is being called.

Info

Informational messages about progress of compuation or document knitting.

Warning

Messages intended to alert the user to an issue in the computation or document production.

Error

Likely unrecoverable issue in computation or document production.

Instances

Instances details
Eq LogSeverity Source # 
Instance details

Defined in Knit.Effect.Logger

Data LogSeverity Source # 
Instance details

Defined in Knit.Effect.Logger

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> LogSeverity -> c LogSeverity #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c LogSeverity #

toConstr :: LogSeverity -> Constr #

dataTypeOf :: LogSeverity -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c LogSeverity) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LogSeverity) #

gmapT :: (forall b. Data b => b -> b) -> LogSeverity -> LogSeverity #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LogSeverity -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LogSeverity -> r #

gmapQ :: (forall d. Data d => d -> u) -> LogSeverity -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> LogSeverity -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> LogSeverity -> m LogSeverity #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> LogSeverity -> m LogSeverity #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> LogSeverity -> m LogSeverity #

Ord LogSeverity Source # 
Instance details

Defined in Knit.Effect.Logger

Show LogSeverity Source # 
Instance details

Defined in Knit.Effect.Logger

Pretty LogSeverity Source # 
Instance details

Defined in Knit.Effect.Logger

Methods

pretty :: LogSeverity -> Doc ann #

prettyList :: [LogSeverity] -> Doc ann #

logAll :: LogSeverity -> Bool Source #

log everything.

logDiagnostic :: LogSeverity -> Bool Source #

log all but Debug messages.

nonDiagnostic :: LogSeverity -> Bool Source #

log everything above Diagnostic.

logDebug :: Int -> LogSeverity -> Bool Source #

log debug messages with level lower than or equal to the given Int.

logLE :: Member (Logger LogEntry) effs => LogSeverity -> Text -> Sem effs () Source #

Add one log-entry of the LogEntry type.

wrapPrefix :: Member PrefixLog effs => Text -> Sem effs a -> Sem effs a Source #

Add a prefix for the block of code.

filteredLogEntriesToIO :: MonadIO (Sem r) => (LogSeverity -> Bool) -> Sem (Logger LogEntry ': (PrefixLog ': r)) x -> Sem r x Source #

Run the Logger and PrefixLog effects in IO: filtered via the severity of the message and formatted using "prettyprinter".

getNextUnusedId :: Member UnusedId r => Text -> Sem r Text Source #

Get an unused id with prefix as specified. Useful for figures, etc.

type DefaultSerializer = Serialize Source #

type-alias for default Serializer

type DefaultCacheData = Array Word8 Source #

type-alias for default in-memory storage type.

sequenceConcurrently :: forall t (r :: [(Type -> Type) -> Type -> Type]) a. (Traversable t, Member Async r) => t (Sem r a) -> Sem r (t (Maybe a)) #

Perform a sequence of effectful actions concurrently.

Since: polysemy-1.2.2.0

await :: forall (r :: [Effect]) a. MemberWithError Async r => Async a -> Sem r a #

async :: forall (r :: [Effect]) a. MemberWithError Async r => Sem r a -> Sem r (Async (Maybe a)) #