diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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. diff --git a/shakebook.cabal b/shakebook.cabal --- a/shakebook.cabal +++ b/shakebook.cabal @@ -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 diff --git a/src/Shakebook.hs b/src/Shakebook.hs --- a/src/Shakebook.hs +++ b/src/Shakebook.hs @@ -1,3 +1,13 @@ +{- | + Module : Shakebook + Copyright : Copyright (C) 2020 Daniel Firth + Maintainer : Daniel Firth [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 diff --git a/src/Shakebook/Defaults.hs b/src/Shakebook/Defaults.hs --- a/src/Shakebook/Defaults.hs +++ b/src/Shakebook/Defaults.hs @@ -1,3 +1,13 @@ +{- | + Module : Shakebook.Defaults + Copyright : Copyright (C) 2020 Daniel Firth + Maintainer : Daniel Firth 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) diff --git a/src/Shakebook/Mustache.hs b/src/Shakebook/Mustache.hs --- a/src/Shakebook/Mustache.hs +++ b/src/Shakebook/Mustache.hs @@ -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 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 diff --git a/src/Shakebook/Pandoc.hs b/src/Shakebook/Pandoc.hs --- a/src/Shakebook/Pandoc.hs +++ b/src/Shakebook/Pandoc.hs @@ -1,21 +1,43 @@ +{- | + Module : Shakebook.Pandoc + Copyright : Copyright (C) 2020 Daniel Firth + Maintainer : Daniel Firth 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) diff --git a/src/Shakebook/Sitemap.hs b/src/Shakebook/Sitemap.hs --- a/src/Shakebook/Sitemap.hs +++ b/src/Shakebook/Sitemap.hs @@ -1,3 +1,12 @@ +{- | + Module : Shakebook.Sitemap + Copyright : Copyright (C) 2020 Daniel Firth + Maintainer : Daniel Firth 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) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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" $