packages feed

shakebook 0.8.1.0 → 0.9.0.0

raw patch · 11 files changed

+183/−87 lines, 11 filesdep +withindep ~shake-plus

Dependencies added: within

Dependency ranges changed: shake-plus

Files

ChangeLog.md view
@@ -1,6 +1,12 @@ # Changelog for Shakebook -## v(0.8.1.0)+## (v0.9.0.0)++* Upgrade shake-plus to v0.2.0.0.+* Change `readmarkdownFile` to use `FileLike`.+* Add `readMediaWikiFile` and `readLaTeXFile`.++## (v0.8.1.0)  * Update pandoc to v2.10. * Strengthen aeson bound to v1.5.2.0.
shakebook.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 906f57ec18aa5bc09a9c3e308666053637e90caaf5e331dbf925212ca43390fa+-- hash: d51cba8eefdc72fd7c27853b87aa1102c72c70eca86771288580e17b499255cf  name:           shakebook-version:        0.8.1.0+version:        0.9.0.0 synopsis:       Shake-based technical documentation generator; HTML & PDF description:    Shakebook is a documentation generator aimed at covering all the bases for mathematical, technical and scientific diagrams and typesetting. Shakebook provides combinators for taking markdown files and combining them into documents, but allowing the user to control how. Shakebook provides general combinators for templating single pages, cofree comonads for representing tables of contents, and zipper comonads for representing pagers. category:       Web@@ -56,11 +56,12 @@     , pandoc-types     , path-extensions >=0.1.0.1     , rio-    , shake-plus >=0.1.9.0+    , shake-plus >=0.2.0.0     , sitemap-gen     , slick >=1.0.1.1     , split     , text-time+    , within >=0.2.0.0     , zipper-extra >=0.1.3.0   default-language: Haskell2010 @@ -92,7 +93,7 @@     , pandoc-types     , path-extensions >=0.1.0.1     , rio-    , shake-plus >=0.1.9.0+    , shake-plus >=0.2.0.0     , shakebook     , sitemap-gen     , slick >=1.0.1.1@@ -100,5 +101,6 @@     , tasty     , tasty-golden     , text-time+    , within >=0.2.0.0     , zipper-extra >=0.1.3.0   default-language: Haskell2010
src/Shakebook.hs view
@@ -1,3 +1,13 @@+{- |+   Module     : Shakebook+   Copyright  : Copyright (C) 2020 Daniel Firth+   Maintainer : Daniel Firth <dan.firth@homotopic.tech+   License    : MIT+   Stability  : experimental++Module exports for Shakebook. Re-exports everything in this package+as well as shake-plus, aeson and comonad utilities.+-} module Shakebook (   module Control.Comonad.Cofree , module Control.Comonad.Store
src/Shakebook/Conduit.hs view
@@ -1,3 +1,13 @@+{- |+   Module     : Shakebook.Conduit+   Copyright  : Copyright (C) 2020 Daniel Firth+   Maintainer : Daniel Firth <dan.firth@homotopic.tech+   License    : MIT+   Stability  : experimental++Utilities for using conduit to store remote caches.+-}+ module Shakebook.Conduit (   RemoteJSONLookup(..) , addRemoteJSONOracleCache
src/Shakebook/Conventions.hs view
@@ -1,6 +1,12 @@-{-| Conventions used for common shakebook projects, lenses, enrichments, affixes.--}+{- |+   Module     : Shakebook.Conventions+   Copyright  : Copyright (C) 2020 Daniel Firth+   Maintainer : Daniel Firth <dan.firth@homotopic.tech+   License    : MIT+   Stability  : experimental +Conventions used in Shakebook projects, common lenses, generators, and indexing wrappers over Values.+-} module Shakebook.Conventions (   -- * Lenses   viewImage@@ -280,11 +286,11 @@                       . withPosts (extract xs) $ Object mempty  genIndexPageData :: (MonadThrow m, ToJSON a)-                 => [a]-                 -> Text+                 => Text                  -> (Text -> Text)                  -> Int+                 -> [a]                  -> m (Zipper [] Value)-genIndexPageData xs g h n = do+genIndexPageData g h n xs = do  zs <- paginate' n $ sortOn (Down . viewPostTime) xs  return $ extend (genPageData g h) zs
src/Shakebook/Defaults.hs view
@@ -1,3 +1,13 @@+{- |+   Module     : Shakebook.Defaults+   Copyright  : Copyright (C) 2020 Daniel Firth+   Maintainer : Daniel Firth <dan.firth@homotopic.tech+   License    : MIT+   Stability  : experimental++Seom sensible default settings for certain shakebook functions.+-}+ {-# LANGUAGE TemplateHaskell #-} module Shakebook.Defaults where
src/Shakebook/Feed.hs view
@@ -1,3 +1,12 @@+{- |+   Module     : Shakebook.Feed+   Copyright  : Copyright (C) 2020 Daniel Firth+   Maintainer : Daniel Firth <dan.firth@homotopic.tech+   License    : MIT+   Stability  : experimental++Utilities from "Text.Atom.Feed" lifted to `MonadAction` and `FileLike`.+-} module Shakebook.Feed (   asAtomEntry , buildFeed@@ -15,12 +24,12 @@ import           Text.Atom.Feed.Export  -- | Convert a Post to an Atom Entry-asAtomEntry :: Value -> Atom.Entry+asAtomEntry :: ToJSON a => a -> Atom.Entry asAtomEntry x = (Atom.nullEntry (viewUrl x) (Atom.TextString $ viewTitle x) (viewPostTimeRaw x)) {                        Atom.entryContent = Just $ Atom.TextContent (viewContent x) }  -- | Build an Atom Feed from a list of posts.-buildFeed :: MonadAction m => Text -> Text -> [Value] -> Path Rel File -> m ()+buildFeed :: (MonadAction m, FileLike b a, ToJSON a) => Text -> Text -> [a] -> a -> m () buildFeed title baseUrl xs out = do   let fs = asAtomEntry <$> sortOn (Down . viewPostTime) xs   let t = Atom.nullFeed baseUrl (Atom.TextString title) $ Atom.entryUpdated (head fs)
src/Shakebook/Mustache.hs view
@@ -1,14 +1,17 @@-{-|-Module      : Shakebook.Mustache-Description : Slick mustache utilities re-exported to use `Path`-Copyright   : (c) Daniel Firth 2020-License     : MIT+{- |+   Module     : Shakebook.Mustahce+   Copyright  : Copyright (C) 2020 Daniel Firth+   Maintainer : Daniel Firth <dan.firth@homotopic.tech+   License    : MIT+   Stability  : experimental++Utilities from "Slick.Mustache" lifted to `MonadAction` and `FileLike`. -}  module Shakebook.Mustache (   Text.Mustache.Template , buildPageAction-, buildPageActionWithin+, buildPageAction' , compileTemplate' ) where @@ -19,23 +22,19 @@ import           Text.Mustache  -- | Lifted version of `Slick.Mustache.compileTemplate'` with well-typed `Path`.-compileTemplate' :: MonadAction m => Path Rel File -> m Template-compileTemplate' = liftAction . Slick.Mustache.compileTemplate' . toFilePath+compileTemplate' :: (MonadAction m, FileLike b a) => a -> m Template+compileTemplate' = liftAction . Slick.Mustache.compileTemplate' . toFilePath . toFile  -- | Build a single page straight from a template.-buildPageAction :: MonadAction m-                => Path Rel File -- ^ The HTML templatate.+buildPageAction :: (MonadAction m, FileLike b a, FileLike b' a')+                => a -- ^ The HTML templatate.                 -> Value -- ^ A JSON value.-                -> Path Rel File -- ^ The out filepath.+                -> a' -- ^ The out filepath.                 -> m () buildPageAction template value out = do   pageT <- compileTemplate' template   writeFile' out $ substitute pageT value --- | Like `buildPageAction`, but uses `Within` values.-buildPageActionWithin :: MonadAction m-                      => Within Rel (Path Rel File)-                      -> Value-                      -> Within Rel (Path Rel File)-                      -> m ()-buildPageActionWithin template value out = buildPageAction (fromWithin template) value (fromWithin out)++buildPageAction' :: (MonadAction m, FileLike b a) => a -> Value -> a -> m ()+buildPageAction' = buildPageAction
src/Shakebook/Pandoc.hs view
@@ -1,21 +1,43 @@+{- |+   Module     : Shakebook.Pandoc+   Copyright  : Copyright (C) 2020 Daniel Firth+   Maintainer : Daniel Firth <dan.firth@homotopic.tech+   License    : MIT+   Stability  : experimental++Pandoc utilities lifted to `MonadAction`.+-} {-# LANGUAGE TemplateHaskell #-}  module Shakebook.Pandoc (+-- * runPandocA   runPandocA , PandocActionException(..)-, readMDFile-, readMDFileIn-, readMDFileWithin-, needPandocImagesIn++-- * Readers+, readFilePandoc+, readCSVFile+, readLaTeXFile+, readMarkdownFile+, readMediaWikiFile+, loadMarkdownAsJSON++-- * Writers , makePDFLaTeX++-- * File Rules+, needPandocImagesIn++-- * Filters+, flattenMeta+, prefixAllImages , progressivelyDemoteHeaders , replaceUnusableImages-, prefixAllImages-, flattenMeta++-- * Lenses , viewContent , viewSrcPath , viewUrl-, loadMarkdownAsJSON ) where  import           Control.Comonad@@ -50,18 +72,26 @@   result <- liftIO $ runIO p   either throwM return result --- | Read a markdown file as an Action.-readMDFile :: (MonadAction m, MonadThrow m) => ReaderOptions -> Path Rel File -> m Pandoc-readMDFile ropts src = readFile' src >>= runPandocA . readMarkdown ropts+-- | Run a Pandoc reader as a Shake action.+readFilePandoc :: (MonadAction m, MonadThrow m, FileLike b a) => (ReaderOptions -> Text -> PandocIO Pandoc) -> ReaderOptions -> a -> m Pandoc+readFilePandoc run ropts src = readFile' src >>= runPandocA . run ropts --- | Read a markdown file as an Action.-readMDFileIn :: (MonadAction m, MonadThrow m) => ReaderOptions -> Path Rel Dir -> Path Rel File -> m Pandoc-readMDFileIn ropts dir src = readFile' (dir </> src) >>= runPandocA . readMarkdown ropts+-- | Read a markdown file and return a `Pandoc` as an Action.+readMarkdownFile :: (MonadAction m, MonadThrow m, FileLike b a) => ReaderOptions -> a -> m Pandoc+readMarkdownFile = readFilePandoc readMarkdown --- | Like `readMDFile` but accepts a `Within`-readMDFileWithin :: (MonadAction m, MonadThrow m) => ReaderOptions -> Within Rel (Path Rel File) -> m Pandoc-readMDFileWithin ropts src = readMDFile ropts (fromWithin src)+-- | Read a mediawiki file and return a `Pandoc` as an Action.+readMediaWikiFile :: (MonadAction m, MonadThrow m, FileLike b a) => ReaderOptions -> a -> m Pandoc+readMediaWikiFile = readFilePandoc readMediaWiki +-- | Read a LaTeX file and return a `Pandoc` as an Action.+readLaTeXFile :: (MonadAction m, MonadThrow m, FileLike b a) => ReaderOptions -> a -> m Pandoc+readLaTeXFile = readFilePandoc readLaTeX++-- | Read a CSV file and return a `Pandoc` as an Action.+readCSVFile :: (MonadAction m, MonadThrow m, FileLike b a) => ReaderOptions -> a -> m Pandoc+readCSVFile = readFilePandoc readCSV+ -- | Find all the images in a `Pandoc` data structure and call `Development.Shake.Plus.need` on them. needPandocImagesIn :: (MonadAction m, MonadThrow m) => Path Rel Dir -> Pandoc -> m () needPandocImagesIn outDir pdoc =@@ -146,7 +176,7 @@                    -> Within Rel (Path Rel File)                    -> m Value loadMarkdownAsJSON ropts wopts srcPath = do-  pdoc@(Pandoc meta _) <- readMDFileWithin ropts srcPath+  pdoc@(Pandoc meta _) <- readMarkdownFile ropts srcPath   meta' <- flattenMeta (writeHtml5String wopts) meta   outText <- runPandocA $ writeHtml5String wopts pdoc   supposedUrl <- toGroundedUrl <$> withHtmlExtension (extract srcPath)
src/Shakebook/Sitemap.hs view
@@ -1,3 +1,12 @@+{- |+   Module     : Shakebook.Sitemap+   Copyright  : Copyright (C) 2020 Daniel Firth+   Maintainer : Daniel Firth <dan.firth@homotopic.tech+   License    : MIT+   Stability  : experimental++Utilities from "Web.Sitemap.Gen" lifted to `MonadAction` and `FileLike`.+-} module Shakebook.Sitemap where  import Data.Aeson@@ -15,6 +24,6 @@                  , sitemapChangeFrequency = Nothing                  , sitemapPriority = Nothing } -buildSitemap :: MonadAction m => Text -> [Value] -> Path Rel File -> m ()+buildSitemap :: (MonadAction m, FileLike b a, ToJSON v) => Text -> [v] -> a -> m () buildSitemap baseUrl xs out = do-  LBS.writeFile (toFilePath out) $ renderSitemap $ Sitemap $ fmap (asSitemapUrl baseUrl) xs+  LBS.writeFile (toFilePath . toFile $ out) $ renderSitemap $ Sitemap $ fmap (asSitemapUrl baseUrl) (toJSON <$> xs)
test/Spec.hs view
@@ -49,38 +49,40 @@                                    ,("youtube", "http://youtube.com/blanky-site-nowhere")                                    ,("gitlab", "http://gitlab.com/blanky-site-nowhere")] +myBlogNav :: Ix.IsIndexOf YearMonth xs => Ix.IxSet xs Post -> Value+myBlogNav = genBlogNavbarData "Blog" "/posts/" defaultPrettyMonthFormat defaultMonthUrlFragment++myDocNav :: Cofree [] Value -> Value+myDocNav = genTocNavbarData+ rules :: HasLogFunc r => ShakePlus r () rules = do -  readMDC <- newCache $ loadMarkdownAsJSON defaultMarkdownReaderOptions defaultHtml5WriterOptions+  readMDC   <- newCache $ loadMarkdownAsJSON defaultMarkdownReaderOptions defaultHtml5WriterOptions -  postsIx <- newCache $ postIndex $ fmap defaultEnrichPost . readMDC+  postsIx   <- newCache $ postIndex $ readMDC >=> return . defaultEnrichPost -  blogNav <- newCache $ \fp -> do-    xs <- postsIx fp-    return $ genBlogNavbarData "Blog" "/posts/" defaultPrettyMonthFormat defaultMonthUrlFragment xs+  blogNav   <- newCache $ postsIx >=> return . myBlogNav -  postsZ <- newCache $ postsIx >=> postZipper+  postsZ    <- newCache $ postsIx >=> postZipper -  blogIndexPageData <- newCache $ \fp -> do-    xs <- postsIx fp-    genIndexPageData (Ix.toList xs) "Posts" ("/posts/pages/" <>) postsPerPage+  blogIndex <- newCache $ postsIx >=> genIndexPageData "Posts" ("/posts/pages/" <>) postsPerPage . Ix.toList -  blogTagIndexPageData <- newCache $ \fp -> do+  blogTagIndex <- newCache $ \fp -> do     xs <- postsIx fp     k <- forM (Ix.groupDescBy xs) $ \(Tag t, ys) -> do-      z <- genIndexPageData ys ("Posts tagged " <> t) (("/posts/tags/" <> t <> "/pages/") <>) postsPerPage+      z <- genIndexPageData ("Posts tagged " <> t) (("/posts/tags/" <> t <> "/pages/") <>) postsPerPage ys       return (t, z)     return $ HM.fromList k -  blogMonthIndexPageData <- newCache $ \fp -> do+  blogMonthIndex <- newCache $ \fp -> do     xs <- postsIx fp     k <- forM (Ix.groupDescBy xs) $ \(YearMonth (y,m), ys) -> do       let t' = UTCTime (fromGregorian y m 1) 0-      z <- genIndexPageData ys-                            (("Posts from " <>) . defaultPrettyMonthFormat $ t')+      z <- genIndexPageData (("Posts from " <>) . defaultPrettyMonthFormat $ t')                             (("/posts/months/"  <> defaultMonthUrlFormat t' <> "/pages/") <>)                             postsPerPage+                            ys       return (defaultMonthUrlFormat t', z)     return $ HM.fromList k @@ -95,7 +97,7 @@                . withSocialLinks mySocial                . withSiteTitle siteTitle                . withRecentPosts (take numRecentPosts (unzipper rs)) $ v-        buildPageActionWithin (s' tmpl) v' out+        buildPageAction' (s' tmpl) v' out        myBuildBlogPage tmpl v out = do         k <- blogNav myPosts@@ -122,64 +124,67 @@     ys <- mapM getDoc toc'     zs <- mapM getDoc (fmap extract . unwrap $ xs)     v  <- getDoc out-    let v' = withJSON (genTocNavbarData ys) . withSubsections zs $ v+    let v' = withJSON (myDocNav ys) . withSubsections zs $ v     myBuildPage $(mkRelFile "templates/docs.html") v' out    o' "posts/index.html" %^>-    copyFileChangedWithin (o' $(mkRelFile "posts/pages/1/index.html"))+    copyFileChanged (o' ($(mkRelFile "posts/pages/1/index.html") :: Path Rel File))    o' "posts/pages/*/index.html" %^> \out -> do-    let n = (+ (-1)) . read . (!! 2) . splitOn "/" . toFilePath . extract $ out-    xs <- blogIndexPageData myPosts-    myBuildPostListPage (seek n xs) out+    let n = read . (!! 2) . splitOn "/" . toFilePath . extract $ out+    xs <- blogIndex myPosts+    myBuildPostListPage (seek (n -1) xs) out    o' "posts/tags/*/index.html" %^> \out -> do     let t = (!! 2) . splitOn "/" . toFilePath . extract $ out     i <- parseRelFile $ "posts/tags/" <> t <> "/pages/1/index.html"-    copyFileChangedWithin (o' i) out+    copyFileChanged (o' i) out    o' "posts/tags/*/pages/*/index.html" %^> \out -> do-     let t = T.pack          . (!! 2) . splitOn "/" . toFilePath . extract $ out-     let n = (+ (-1)) . read . (!! 4) . splitOn "/" . toFilePath . extract $ out-     xs <- blogTagIndexPageData myPosts+     let zs = splitOn "/" . toFilePath . extract $ out+     let t = T.pack $ zs !! 2+     let n = read   $ zs !! 4+     xs <- blogTagIndex myPosts      case HM.lookup t xs of        Nothing -> logError $ "Attempting to lookup non-existant tag " <> display t-       Just x  -> myBuildPostListPage (seek n x) out+       Just x  -> myBuildPostListPage (seek (n - 1) x) out    o' "posts/months/*/index.html" %^> \out -> do     let t = (!! 2) . splitOn "/" . toFilePath . extract $ out     i <- parseRelFile $ "posts/months/" <> t <> "/pages/1/index.html"-    copyFileChangedWithin (o' i) out+    copyFileChanged (o' i) out    o' "posts/months/*/pages/*/index.html" %^> \out -> do-     let t = T.pack . (!! 2) . splitOn "/" . toFilePath . extract $ out-     let n = (+ (-1)) . read  . (!! 4) . splitOn "/" . toFilePath . extract $ out-     xs <- blogMonthIndexPageData myPosts+     let zs = splitOn "/" . toFilePath . extract $ out+     let t = T.pack $ zs !! 2+     let n = read   $ zs !! 4+     xs <- blogMonthIndex myPosts      case HM.lookup t xs of        Nothing -> logError $ "Attempting to lookup non-existant month " <> displayShow t-       Just x  -> myBuildPostListPage (seek n x) out+       Just x  -> myBuildPostListPage (seek (n - 1) x) out    o' ["css//*", "js//*", "webfonts//*", "images//*"] |%^> \out ->-    copyFileChangedWithin (blinkLocalDir sourceFolder out) out+    copyFileChanged (blinkLocalDir sourceFolder out) out    o' "sitemap.xml" %^> \out -> do     xs <- postsZ myPosts-    buildSitemap baseUrl (unzipper $ unPost <$> xs) (fromWithin out)+    buildSitemap baseUrl (unzipper xs) out    let simplePipeline f = getDirectoryFiles sourceFolder >=> mapM f >=> needIn outputFolder       verbatimPipeline = simplePipeline return    phony "statics" $ verbatimPipeline ["css//*", "js//*", "webfonts//*", "images//*"] -  phony "index" $ needIn outputFolder [$(mkRelFile "index.html")]+  phony "index" $ needIn outputFolder [$(mkRelFile "index.html") :: Path Rel File]    phony "post-index" $ do-     ps <- blogIndexPageData myPosts+     ps <- blogIndex myPosts      fs <- defaultPagePaths [1..size ps]-     needIn (outputFolder </> $(mkRelDir "posts")) ($(mkRelFile "index.html") : fs)+     let postFolder = (outputFolder </> $(mkRelDir "posts") :: Path Rel Dir)+     needIn postFolder ($(mkRelFile "index.html") : fs)    phony "by-tag-index" $ do-     ps <- blogTagIndexPageData myPosts+     ps <- blogTagIndex myPosts      void $ flip HM.traverseWithKey ps $ \t z -> do        u  <- parseRelDir $ T.unpack t        fs <- defaultPagePaths [1..size z]@@ -187,7 +192,7 @@        needIn tagFolder ($(mkRelFile "index.html") : fs)    phony "by-month-index" $ do-     ps <- blogMonthIndexPageData myPosts+     ps <- blogMonthIndex myPosts      void $ flip HM.traverseWithKey ps $ \t z -> do        u  <- parseRelDir $ T.unpack t        fs <- defaultPagePaths [1..size z]@@ -203,7 +208,7 @@     logInfo $ "Cleaning files in " <> displayShow outputFolder     removeFilesAfter outputFolder ["//*"] -  phony "sitemap" $ needIn outputFolder [$(mkRelFile "sitemap.xml")]+  phony "sitemap" $ needIn outputFolder [$(mkRelFile "sitemap.xml") :: Path Rel File]  tests :: [FilePath] -> TestTree tests xs = testGroup "Rendering Tests" $