knit-haskell 0.3.0.0 → 0.4.0.0
raw patch · 10 files changed
+187/−87 lines, 10 filesdep +polysemy-plugindep −plotsdep ~polysemydep ~prettyprinterdep ~random-source
Dependencies added: polysemy-plugin
Dependencies removed: plots
Dependency ranges changed: polysemy, prettyprinter, random-source
Files
- ChangeLog.md +17/−0
- examples/RandomExample.hs +19/−7
- examples/SimpleExample.hs +26/−4
- knit-haskell.cabal +21/−13
- src/Knit/Effect/Pandoc.hs +8/−3
- src/Knit/Effect/PandocMonad.hs +44/−31
- src/Knit/Effect/RandomFu.hs +50/−26
- src/Knit/Report.hs +1/−1
- src/Knit/Report/Input/Table/Colonnade.hs +0/−1
- src/Knit/Report/Output/Html.hs +1/−1
ChangeLog.md view
@@ -1,3 +1,20 @@+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+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 ()```)+* 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.++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.+ 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.
examples/RandomExample.hs view
@@ -10,15 +10,18 @@ import qualified Knit.Effect.RandomFu as KR import qualified Colonnade as C +import Control.Monad (replicateM) import Control.Monad.IO.Class (MonadIO) import qualified Data.Map as M-import qualified Data.Random as R import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import qualified Data.Text as T import Data.String.Here (here) import qualified Graphics.Vega.VegaLite as V +import Data.Random (MonadRandom, sample, stdNormal)+import Data.Random.Source.PureMT (newPureMT)+ import Control.Monad.Reader (ReaderT , ask , runReaderT@@ -47,10 +50,11 @@ main = do let pandocWriterConfig = K.PandocWriterConfig (Just "pandoc-templates/minWithVega-pandoc.html") templateVars K.mindocOptionsF+ pureMTSource <- newPureMT resE <- runExampleApp "This is from the MyApp environment." $ K.knitHtml (Just "RandomExample.Main") K.logAll pandocWriterConfig- $ KR.runRandomIOSimple $ makeDoc- case resE of+ $ KR.runRandomFuIOPureMT pureMTSource $ makeDoc+ case resE of Right htmlAsText -> T.writeFile "examples/html/random_example.html" $ TL.toStrict@@ -67,7 +71,7 @@ |] makeDoc :: ( K.KnitOne effs- , K.Member KR.Random effs -- this one needs to be handled before knitting+ , K.Member KR.RandomFu effs -- this one needs to be handled before knitting , K.KnitBase ExampleApp effs) => K.Sem effs () makeDoc = K.wrapPrefix "makeDoc" $ do K.logLE K.Info "adding some markdown..."@@ -88,11 +92,19 @@ K.addMarkDown $ envText <> "\n\n" <> (T.pack $ show curTime) K.logLE K.Info "Using another polysemy effect, here RandomFu"- let draws = [1..20 :: Int]- someNormalDoubles <- KR.sampleRVar $ mapM (const $ R.stdNormal @Double) draws+ let nDraws = 20+ someNormalDoubles <- KR.sampleRVar $ replicateM nDraws (stdNormal @Double) K.addMarkDown "## An example of using the RandomFu effect to get random numbers and using Colonnade to make tables." K.addMarkDown $ "some std normal draws: "- K.addColonnadeTextTable (C.headed "#" (T.pack . show . fst) <> C.headed "Draw" (T.pack . show . snd)) $ zip draws someNormalDoubles+ K.addColonnadeTextTable (C.headed "#" (T.pack . show . fst) <> C.headed "Draw" (T.pack . show . snd)) $ zip [1..nDraws] someNormalDoubles+ moreNormalDoubles <- KR.absorbMonadRandom (monadRandomFunction nDraws)+ K.addMarkDown "## This time, using absorbMonadRandom to interoperate with a function using the MonadRandom constraint."+ K.addMarkDown $ "some std normal draws: "+ K.addColonnadeTextTable (C.headed "#" (T.pack . show . fst) <> C.headed "Draw" (T.pack . show . snd)) $ zip [1..nDraws] moreNormalDoubles+++monadRandomFunction :: MonadRandom m => Int -> m [Double]+monadRandomFunction = sample . flip replicateM (stdNormal @Double) exampleVis :: V.VegaLite exampleVis =
examples/SimpleExample.hs view
@@ -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@@ -55,8 +55,9 @@ 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.addDiagramAsSVG Nothing (Just "Example diagrams visualization using the Plots library") 300 300 samplePlot+ K.logLE K.Info "adding a Diagrams plot..."+ _ <- K.addDiagramAsSVG Nothing (Just "Example diagram") 300 300 exampleDiagram+-- _ <- K.addDiagramAsSVG Nothing (Just "Example diagrams visualization using the Plots library") 300 300 samplePlot return () -- example using HVega @@ -71,6 +72,27 @@ in V.toVegaLite [ bkg, cars, V.mark V.Circle [], enc [] ] +--sampleDiagram+-- from <https://archives.haskell.org/projects.haskell.org/diagrams/gallery/Hilbert.html>++hilbert 0 = mempty+hilbert n = hilbert' (n-1) K.# K.reflectY <> K.vrule 1+ <> hilbert (n-1) <> K.hrule 1+ <> hilbert (n-1) <> K.vrule (-1)+ <> hilbert' (n-1) K.# K.reflectX+ where+ hilbert' m = hilbert m K.# K.rotateBy (1/4)++exampleDiagram :: K.Diagram K.SVG +exampleDiagram = K.frame 1 . K.lw K.medium . K.lc K.darkred+ . 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@@ -87,4 +109,4 @@ P.majorTicksFunction K..= P.logMajorTicks 5 -- <> pure [1] -- minorTicksFunction .= minorTicksHelper 5 ---exampleDiagram :: +-}
knit-haskell.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: knit-haskell-version: 0.3.0.0+version: 0.4.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.@@ -27,15 +27,17 @@ copyright: 2019 Adam Conner-Sax category: Text extra-source-files: ChangeLog.md-tested-with: GHC ==8.6.4 || ==8.6.2 +tested-with: GHC ==8.6.4 Build-type: Simple source-repository head Type: git Location: https://github.com/adamConnerSax/knit-haskell- +++ library- ghc-options: -Wall -fno-warn-unused-top-binds -funbox-strict-fields+ ghc-options: -Wall -fplugin=Polysemy.Plugin -fno-warn-unused-top-binds -funbox-strict-fields exposed-modules: Knit.Effect.Logger , Knit.Effect.Docs , Knit.Effect.Html@@ -81,8 +83,9 @@ hvega >= 0.1.0 && <= 0.2.0.0, logging-effect >= 1.3.3 && < 1.4, mtl >= 2.2.2 && < 2.3,- polysemy >= 0.1.2.0 && < 0.2.0.0,- prettyprinter >= 1.2.1 && < 1.3,+ polysemy >= 0.2.0.0 && < 0.3.0.0,+ polysemy-plugin >= 0.2.0.0 && < 0.3.0.0,+ prettyprinter >= 1.2.1 && < 1.4, lucid >= 2.9.11 && < 2.10, pandoc >= 2.7.2 && < 2.8, random-fu >= 0.2.7 && < 0.3,@@ -93,22 +96,23 @@ default-language: Haskell2010 -executable SimpleExample+test-suite SimpleExample+ type: exitcode-stdio-1.0 main-is: SimpleExample.hs hs-source-dirs: examples- ghc-options: -Wall + ghc-options: -Wall build-depends: base, blaze-html, containers, here >= 1.2.10 && < 1.3.0, hvega, knit-haskell -any,- plots, polysemy, text default-language: Haskell2010 -executable ErrorExample+test-suite ErrorExample+ type: exitcode-stdio-1.0 main-is: ErrorExample.hs hs-source-dirs: examples ghc-options: -Wall @@ -122,7 +126,8 @@ text default-language: Haskell2010 -executable MultiDocExample+test-suite MultiDocExample+ type: exitcode-stdio-1.0 main-is: MultiDocExample.hs hs-source-dirs: examples ghc-options: -Wall @@ -136,7 +141,8 @@ text default-language: Haskell2010 -executable MtlExample+test-suite MtlExample+ type: exitcode-stdio-1.0 main-is: MtlExample.hs hs-source-dirs: examples ghc-options: -Wall @@ -151,7 +157,8 @@ text default-language: Haskell2010 -executable RandomExample+test-suite RandomExample+ type: exitcode-stdio-1.0 main-is: RandomExample.hs hs-source-dirs: examples ghc-options: -Wall @@ -165,5 +172,6 @@ mtl, polysemy, random-fu,+ random-source, text default-language: Haskell2010
src/Knit/Effect/Pandoc.hs view
@@ -228,7 +228,8 @@ -> P.Sem (P.Writer PandocWithRequirements ': effs) a toWriter = P.reinterpret $ \case (AddFrom rf ro x) ->- P.raise (fmap justDoc $ toPandoc rf ro x) >>= P.tell @PandocWithRequirements+ P.raise (fmap justDoc $ PM.absorbPandocMonad $ toPandoc rf ro x)+ >>= P.tell @PandocWithRequirements (Require r) -> P.tell (justRequirement r) -- | Run ToPandoc by interpreting in Writer and then running that Writer.@@ -277,7 +278,8 @@ -> 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 (namedPandocFrom pwf pwo) =<<) . toNamedDocList+ (traverse (\x -> PM.absorbPandocMonad $ namedPandocFrom pwf pwo x) =<<)+ . toNamedDocList -- | Given a write format and options, run the writer-style ToPandoc effect and produce a doc of requested type fromPandocE@@ -286,5 +288,8 @@ -> 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 pwf pwo = ((fromPandoc pwf pwo . fst) =<<) . P.runWriter . toWriter+fromPandocE pwf pwo =+ (((\x -> PM.absorbPandocMonad $ fromPandoc pwf pwo x) . fst) =<<)+ . P.runWriter+ . toWriter
src/Knit/Effect/PandocMonad.hs view
@@ -16,6 +16,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} {-| Module : Knit.Effect.PandocMonad@@ -26,10 +27,9 @@ Stability : experimental Polysemy PandocMonad effect.-Allows a polysemy "stack" to satisfy a PandocMonad constraint.-This still needs to run on top of PandocIO-but that will likely be addressed at some point in the future,-just requiring IO at base and the Logging and Random effects.+Allows a polysemy monad to handle functions+actions with a PandocMonad contraint via+polysemy effects and IO. -} module Knit.Effect.PandocMonad (@@ -65,6 +65,9 @@ -- * Runners , runIO + -- * Interop+ , absorbPandocMonad+ -- * Re-Exports , PA.PandocError )@@ -73,14 +76,12 @@ import qualified Knit.Effect.Logger as Log import qualified Polysemy as P---import qualified Polysemy.IO as P import Polysemy.Internal ( send ) import Polysemy.Internal.Combinators ( stateful ) import qualified Polysemy.Error as P import qualified Text.Pandoc as PA import qualified Text.Pandoc.MIME as PA import qualified Text.Pandoc.UTF8 as UTF8---import qualified Text.Pandoc.Logging as PA import qualified Data.ByteString as BS import Data.ByteString.Lazy as LBS@@ -151,11 +152,6 @@ P.makeSem ''Pandoc --- TODO: Understand the error pieces better. Some things are thrown in IO, not sure we catch those??--- | Split off the error piece. We will handle directly with the polysemy @Error@ effect-instance (P.Member (P.Error PA.PandocError) effs) => MonadError PA.PandocError (P.Sem effs) where- throwError = P.throw- catchError = P.catch -- we handle logging within the existing effect system -- | Map pandoc severities to our logging system.@@ -179,26 +175,43 @@ , P.Member Log.PrefixLog effs , P.Member (Log.Logger Log.LogEntry) effs) --- | PandocMonad instance so that pandoc functions can be run in the polysemy union effect-instance PandocEffects effs => PA.PandocMonad (P.Sem effs) where- lookupEnv = lookupEnv- getCurrentTime = getCurrentTime- getCurrentTimeZone = getCurrentTimeZone- newStdGen = newStdGen- newUniqueHash = newUniqueHash- openURL = openURL- readFileLazy = readFileLazy- readFileStrict = readFileStrict- glob = glob- fileExists = fileExists- getDataFileName = getDataFileName- getModificationTime = getModificationTime- getCommonState = getCommonState- putCommonState = putCommonState- getsCommonState = getsCommonState- modifyCommonState = modifyCommonState- logOutput = logOutput --logPandocMessage- trace = trace+-- | Unexported newtype for creating instances which we then discharge with absorbPandocMonad+newtype PandocMonadSem r a = PandocMonadSem { unPandocMonadSem :: P.Sem r a } deriving (Functor, Applicative, Monad)++instance (P.Member (P.Error PA.PandocError) r) => MonadError PA.PandocError (PandocMonadSem r) where+ throwError = PandocMonadSem . P.throw+ catchError (PandocMonadSem sa) h = PandocMonadSem $ P.catch sa (unPandocMonadSem . h)++instance (P.Member (P.Error PA.PandocError) r, PandocEffects r) => PA.PandocMonad (PandocMonadSem r) where+ lookupEnv = PandocMonadSem . lookupEnv+ getCurrentTime = PandocMonadSem $ getCurrentTime+ getCurrentTimeZone = PandocMonadSem $ getCurrentTimeZone+ newStdGen = PandocMonadSem $ newStdGen+ newUniqueHash = PandocMonadSem $ newUniqueHash+ openURL = PandocMonadSem . openURL+ readFileLazy = PandocMonadSem . readFileLazy+ readFileStrict = PandocMonadSem . readFileStrict+ glob = PandocMonadSem . glob+ fileExists = PandocMonadSem . fileExists+ getDataFileName = PandocMonadSem . getDataFileName+ getModificationTime = PandocMonadSem . getModificationTime+ getCommonState = PandocMonadSem $ getCommonState+ putCommonState = PandocMonadSem . putCommonState+ getsCommonState = PandocMonadSem . getsCommonState+ modifyCommonState = PandocMonadSem . modifyCommonState+ logOutput = PandocMonadSem . logOutput+ trace = PandocMonadSem . trace+++{- | Given an action constrained only by a PandocMonad constraint, +absorb it into a Polysemy monad whose+effect list contains the required effects.+-}+absorbPandocMonad+ :: (P.Member (P.Error PA.PandocError) r, PandocEffects r)+ => (forall m . PA.PandocMonad m => m a)+ -> P.Sem r a+absorbPandocMonad = unPandocMonadSem -- | Constraint helper for using this set of effects in IO.
src/Knit/Effect/RandomFu.hs view
@@ -11,6 +11,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} {-| Module : Knit.Effect.RandomFu@@ -31,16 +34,22 @@ module Knit.Effect.RandomFu ( -- * Effect- Random+ RandomFu -- * Actions , sampleRVar , sampleDist -- * Interpretations - , runRandomIOSimple- , runRandomIOPureMT- , runRandomFromSource+ , runRandomFuIOSimple+ , runRandomFuIOPureMT+ , runRandomFuFromSource++ -- * Interop + , absorbMonadRandom++ -- * Deprecated, will be removed in next release+ , Random ) where @@ -53,63 +62,78 @@ import qualified Data.Random.Internal.Source as R import qualified Data.Random.Source.PureMT as R - import Control.Monad.IO.Class ( MonadIO(..) ) +--import Data.Kind ( Constraint )+ -- | Random Effect-data Random m r where- SampleRVar :: R.RVar t -> Random m t- GetRandomPrim :: R.Prim t -> Random m t+data RandomFu m r where+ SampleRVar :: R.RVar t -> RandomFu m t+ GetRandomPrim :: R.Prim t -> RandomFu m t +type Random = RandomFu+{-# DEPRECATED Random "Use RandomFu instead" #-}+ -- | Convert a random-fu RVar to the Random Effect-sampleRVar :: (P.Member Random effs) => R.RVar t -> P.Sem effs t+sampleRVar :: (P.Member RandomFu effs) => R.RVar t -> P.Sem effs t sampleRVar = send . SampleRVar -- | Convert a random-fu Distribution to the Random Effect-sampleDist :: (P.Member Random effs, R.Distribution d t) => d t -> P.Sem effs t+sampleDist+ :: (P.Member RandomFu effs, R.Distribution d t) => d t -> P.Sem effs t sampleDist = sampleRVar . R.rvar -getRandomPrim :: P.Member Random effs => R.Prim t -> P.Sem effs t+getRandomPrim :: P.Member RandomFu effs => R.Prim t -> P.Sem effs t getRandomPrim = send . GetRandomPrim -- | Run in IO using default random-fu IO source-runRandomIOSimple+runRandomFuIOSimple :: forall effs a . MonadIO (P.Sem effs)- => P.Sem (Random ': effs) a+ => P.Sem (RandomFu ': effs) a -> P.Sem effs a-runRandomIOSimple = P.interpret f+runRandomFuIOSimple = P.interpret f where- f :: forall m x . (Random m x -> P.Sem effs x)+ f :: forall m x . (RandomFu m x -> P.Sem effs x) f r = case r of SampleRVar rv -> liftIO $ R.sample rv GetRandomPrim pt -> liftIO $ R.getRandomPrim pt -- | Run using the given source-runRandomFromSource+runRandomFuFromSource :: forall s effs a . R.RandomSource (P.Sem effs) s => s- -> P.Sem (Random ': effs) a+ -> P.Sem (RandomFu ': effs) a -> P.Sem effs a-runRandomFromSource source = P.interpret f+runRandomFuFromSource source = P.interpret f where- f :: forall m x . (Random m x -> P.Sem effs x)+ f :: forall m x . (RandomFu m x -> P.Sem effs x) f r = case r of SampleRVar rv -> R.runRVar (R.sample rv) source GetRandomPrim pt -> R.runRVar (R.getRandomPrim pt) source -- | Run in 'IO', using the given 'PureMT' source stored in an 'IORef'-runRandomIOPureMT+runRandomFuIOPureMT :: MonadIO (P.Sem effs) => R.PureMT- -> P.Sem (Random ': effs) a+ -> P.Sem (RandomFu ': effs) a -> P.Sem effs a-runRandomIOPureMT source re =- liftIO (newIORef source) >>= flip runRandomFromSource re+runRandomFuIOPureMT source re =+ liftIO (newIORef source) >>= flip runRandomFuFromSource re --- | supply instance of MonadRandom for functions which require it+newtype RandomFuSem r a = RandomFuSem { unRandomFuSem :: P.Sem r a } deriving (Functor, Applicative, Monad)+ $(R.monadRandom [d|- instance P.Member Random effs => R.MonadRandom (P.Sem effs) where- getRandomPrim = getRandomPrim+ instance P.Member RandomFu r => R.MonadRandom (RandomFuSem r) where+ getRandomPrim = RandomFuSem . getRandomPrim |])++{- | Given a function that uses the random-fu package and produces a result thusly+constrained by 'MonadRandom', absorb it into a Polysemy monad whose+effect list contains the RandomFu effect.+-}+absorbMonadRandom+ :: P.Member RandomFu r => (forall m . R.MonadRandom m => m a) -> P.Sem r a+absorbMonadRandom = unRandomFuSem+
src/Knit/Report.hs view
@@ -173,7 +173,7 @@ -- | 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.-knitError :: P.Member (PE.Error PA.PandocError) r => T.Text -> P.Sem r ()+knitError :: P.Member (PE.Error PA.PandocError) r => T.Text -> P.Sem r a knitError msg = PE.throw (PA.PandocSomeError $ "Knit User Error: " ++ T.unpack msg)
src/Knit/Report/Input/Table/Colonnade.hs view
@@ -29,7 +29,6 @@ ) where - import qualified Colonnade as C import Colonnade import qualified Text.Blaze.Colonnade as BC
src/Knit/Report/Output/Html.hs view
@@ -92,7 +92,7 @@ => PandocWriterConfig -> PE.PandocWithRequirements -- ^ Document and union of input requirements -> P.Sem effs BH.Html-toBlazeDocument writeConfig pdocWR = do+toBlazeDocument writeConfig pdocWR = PM.absorbPandocMonad $ do writerOptions <- htmlFullDocWriterOptions (templateFP writeConfig) (templateVars writeConfig) PE.fromPandoc PE.WriteHtml5 (optionsF writeConfig writerOptions) pdocWR