rib 0.5.0.0 → 0.6.0.0

raw patch · 15 files changed

+517/−596 lines, 15 filesdep −nameddep ~pathdep ~shakePVP ok

version bump matches the API change (PVP)

Dependencies removed: named

Dependency ranges changed: path, shake

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• README.md +43/−39
• rib.cabal +7/−9
• src/Prelude.hs +0/−6
• src/Rib.hs +8/−13
• src/Rib/App.hs +26/−14
• src/Rib/Document.hs +0/−115
• src/Rib/Markup.hs +0/−51
• src/Rib/Markup/MMark.hs +0/−87
• src/Rib/Markup/Pandoc.hs +0/−185
• src/Rib/Parser/MMark.hs +93/−0
• src/Rib/Parser/Pandoc.hs +147/−0
• src/Rib/Server.hs +5/−8
• src/Rib/Shake.hs +119/−69
• src/Rib/Source.hs +56/−0

@@ -1,5 +1,18 @@ # Change Log for rib +## 0.6.0.0++- Advance nixpkgs; require Shake >=0.18.4+- Major API simplication: no more type class!+  - Allow user to specify their own source parser as a Haskell function+  - Removed types `Document` and `Markup` in favour of `Source`+  - Expose `ribInputDir` and `ribOutputDir` for use in custom Shake actions+- Bug fixes:+  - #63: create intermediate directories when generating post HTML+  - #70: Don't crash on Shake errors+  - Fix unnecessary rebuild of all files when only one file changed+    - #66: Use caching (via Shake's `cacheActionWith`), to avoid writing HTML to disk until it has changed.+ ## 0.5.0.0  This release comes with a major API refactor. Key changes:

@@ -5,19 +5,18 @@ [![BSD3](https://img.shields.io/badge/License-BSD-blue.svg)](https://en.wikipedia.org/wiki/BSD_License) [![Hackage](https://img.shields.io/hackage/v/rib.svg)](https://hackage.haskell.org/package/rib) [![built with nix](https://builtwithnix.org/badge.svg)](https://builtwithnix.org)+[![Zulip chat](https://img.shields.io/badge/zulip-join_chat-brightgreen.svg)](https://funprog.zulipchat.com/#narrow/stream/218047-Rib)  Rib is a Haskell library for writing your own **static site generator**.  How does it compare to Hakyll? -- Use the [Shake](https://shakebuild.com/) build system-- Builtin support for using Haskell DSL to define the HTML-  ([Lucid](https://chrisdone.com/posts/lucid2/)) & CSS-  ([Clay](http://fvisser.nl/clay/)) of your site -  - Like Hakyll, Rib uses [Pandoc](https://pandoc.org/) for parsing the source-    documents. It also supports [MMark](https://github.com/mmark-md/mmark) if you need a lightweight alternative.+- Uses the [Shake](https://shakebuild.com/) build system at its core.+- Allows writing Haskell DSL to define HTML ([Lucid](https://chrisdone.com/posts/lucid2/)) & CSS ([Clay](http://fvisser.nl/clay/))+- Built-in support for [Pandoc](https://pandoc.org/) and [MMark](https://github.com/mmark-md/mmark), while also supporting custom parsers (eg: [Dhall](https://github.com/srid/website/pull/6), [TOML](https://github.com/srid/website/pull/7)) - Remain as simple as possible to use (see example below)-- Optional Nix based workflow for easily reproducible environment+- Nix-based environment for reproducibility+- `ghcid` and fsnotify for "hot reload"  Rib prioritizes the use of *existing* tools over reinventing them, and enables the user to compose them as they wish instead of having to write code to fit a@@ -42,24 +41,20 @@ using Rib:  ``` haskell--- First we shall define two datatypes to represent our pages. One, the page--- itself. Second, the metadata associated with each document.---- | A generated page is either an index of documents, or an individual document.+-- | A generated page corresponds to either an index of sources, or an+-- individual source. ----- The `Document` type takes two type variables:--- 1. The first type variable specifies the parser to use: MMark or Pandoc--- 2. The second type variable should be your metadata record+-- Each `Source` specifies the parser type to use. Rib provides `MMark` and+-- `Pandoc`; but you may define your own as well. data Page-  = Page_Index [Document MMark DocMeta]-  | Page_Doc (Document MMark DocMeta)+  = Page_Index [Source M.MMark]+  | Page_Single (Source M.MMark) --- | Type representing the metadata in our Markdown documents------ Note that if a field is not optional (i.e., not Maybe) it must be present.-data DocMeta-  = DocMeta+-- | Metadata in our markdown sources. Parsed as JSON.+data SrcMeta+  = SrcMeta       { title :: Text,+        -- | Description is optional, hence it is a `Maybe`         description :: Maybe Text       }   deriving (Show, Eq, Generic, FromJSON)@@ -82,14 +77,17 @@     generateSite = do       -- Copy over the static files       Rib.buildStaticFiles [[relfile|static/**|]]-      -- Build individual markdown files, generating .html for each.-      docs <--        Rib.buildHtmlMulti [relfile|*.md|] $-          renderPage . Page_Doc-      -- Build an index.html linking to the aforementioned files.-      Rib.buildHtml [relfile|index.html|]-        $ renderPage-        $ Page_Index docs+      -- Build individual sources, generating .html for each.+      -- The function `buildHtmlMulti` takes the following arguments:+      -- - File patterns to build+      -- - Function that will parse the file (here we use mmark)+      -- - Function that will generate the HTML (see below)+      srcs <-+        Rib.buildHtmlMulti M.parse [[relfile|*.md|]] $+          renderPage . Page_Single+      -- Write an index.html linking to the aforementioned files.+      Rib.writeHtml [relfile|index.html|] $+        renderPage (Page_Index srcs)     -- Define your site HTML here     renderPage :: Page -> Html ()     renderPage page = with html_ [lang_ "en"] $ do@@ -97,7 +95,7 @@         meta_ [httpEquiv_ "Content-Type", content_ "text/html; charset=utf-8"]         title_ $ case page of           Page_Index _ -> "My website!"-          Page_Doc doc -> toHtml $ title $ Rib.documentMeta doc+          Page_Single src -> toHtml $ title $ getMeta src         style_ [type_ "text/css"] $ Clay.render pageStyle       body_         $ with div_ [id_ "thesite"]@@ -105,16 +103,22 @@           with a_ [href_ "/"] "Back to Home"           hr_ []           case page of-            Page_Index docs ->-              div_ $ forM_ docs $ \doc -> with li_ [class_ "links"] $ do-                let meta = Rib.documentMeta doc-                b_ $ with a_ [href_ (Rib.documentUrl doc)] $ toHtml $ title meta-                maybe mempty Rib.renderMarkdown $-                  description meta-            Page_Doc doc ->+            Page_Index srcs ->+              div_ $ forM_ srcs $ \src -> with li_ [class_ "links"] $ do+                let meta = getMeta src+                b_ $ with a_ [href_ (Rib.sourceUrl src)] $ toHtml $ title meta+                maybe mempty (M.render . either (error . T.unpack) id . M.parsePure "<desc>") $ description meta+            Page_Single src ->               with article_ [class_ "post"] $ do-                h1_ $ toHtml $ title $ Rib.documentMeta doc-                Rib.documentHtml doc+                h1_ $ toHtml $ title $ getMeta src+                M.render $ Rib.sourceVal src+    -- Get metadata from Markdown YAML block+    getMeta :: Source M.MMark -> SrcMeta+    getMeta src = case M.projectYaml (Rib.sourceVal src) of+      Nothing -> error "No YAML metadata"+      Just val -> case fromJSON val of+        Aeson.Error e -> error $ "JSON error: " <> e+        Aeson.Success v -> v     -- Define your site CSS here     pageStyle :: Css     pageStyle = "div#thesite" ? do

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: rib-version: 0.5.0.0+version: 0.6.0.0 license: BSD-3-Clause copyright: 2019 Sridhar Ratnakumar maintainer: srid@srid.ca@@ -25,16 +25,15 @@     exposed-modules:         Rib         Rib.App-        Rib.Document-        Rib.Markup.MMark-        Rib.Markup.Pandoc+        Rib.Source+        Rib.Parser.MMark+        Rib.Parser.Pandoc         Rib.Shake     other-modules:-        Prelude-        Rib.Markup         Rib.Server     hs-source-dirs: src     default-language: Haskell2010+    default-extensions: NoImplicitPrelude     ghc-options:         -Wall         -Wincomplete-record-updates@@ -57,14 +56,13 @@         mmark-ext,         modern-uri,         mtl >=2.2.2 && <2.3,-        named,         pandoc >=2.7 && <3,         pandoc-include-code >=1.4.0 && <1.5,         pandoc-types >=1.17.5 && <1.18,-        path,+        path >= 0.7.0,         path-io,         relude >= 0.6 && < 0.7,-        shake,+        shake >= 0.18.4,         text >=1.2.3 && <1.3,         wai >=3.2.2 && <3.3,         wai-app-static >=3.1.6 && <3.2,

@@ -1,6 +0,0 @@-module Prelude-  ( module Relude,-  )-where--import Relude

@@ -2,23 +2,18 @@ module Rib   ( module Rib.App,     module Rib.Shake,-    module Rib.Server,-    Document,-    documentPath,-    documentVal,-    documentHtml,-    documentMeta,-    documentUrl,+    Source,+    SourceReader,+    sourcePath,+    sourceVal,+    sourceUrl,     MMark,-    renderMarkdown,     Pandoc,-    renderPandoc,   ) where  import Rib.App-import Rib.Document-import Rib.Markup.MMark (MMark, renderMarkdown)-import Rib.Markup.Pandoc (Pandoc, renderPandoc)-import Rib.Server+import Rib.Source+import Rib.Parser.MMark (MMark)+import Rib.Parser.Pandoc (Pandoc) import Rib.Shake

@@ -5,7 +5,7 @@  -- | CLI interface for Rib. ----- Typically you would call `Rib.App.run` passing your Shake build action.+-- Mostly you would only need `Rib.App.run`, passing it your Shake build action. module Rib.App   ( App (..),     run,@@ -19,8 +19,9 @@ import Development.Shake import Development.Shake.Forward (shakeForward) import Path+import Relude import qualified Rib.Server as Server-import Rib.Shake (Dirs (..))+import Rib.Shake (RibSettings (..)) import System.Console.CmdArgs import System.FSNotify (watchTree, withManager) @@ -80,23 +81,34 @@ runWith src dst buildAction = \case   WatchAndGenerate -> withManager $ \mgr -> do     -- Begin with a *full* generation as the HTML layout may have been changed.-    runWith src dst buildAction $ Generate True+    -- TODO: This assumption is not true when running the program from compiled+    -- binary (as opposed to say via ghcid) as the HTML layout has become fixed+    -- by being part of the binary. In this scenario, we should not do full+    -- generation (i.e., toggle the bool here to False). Perhaps provide a CLI+    -- flag to disable this.+    runShake True     -- And then every time a file changes under the current directory-    putStrLn $ "[Rib] Watching " <> toFilePath src+    putStrLn $ "[Rib] Watching " <> toFilePath src <> " for changes"     void $ watchTree mgr (toFilePath src) (const True) $ \_ -> do-      runWith src dst buildAction (Generate False)-        `catch` \(e :: SomeException) -> putStrLn $ show e+      runShake False     -- Wait forever, effectively.     forever $ threadDelay maxBound   Serve p dw ->     concurrently_       (unless dw $ runWith src dst buildAction WatchAndGenerate)       (Server.serve p $ toFilePath dst)-  Generate fullGen ->-    let opts =-          shakeOptions-            { shakeVerbosity = Chatty,-              shakeRebuild = bool [] [(RebuildNow, "**")] fullGen,-              shakeExtra = addShakeExtra (Dirs (src, dst)) (shakeExtra shakeOptions)-            }-     in shakeForward opts buildAction+  Generate fullGen -> do+    runShake fullGen+  where+    runShake fullGen =+      shakeForward (ribShakeOptions fullGen) buildAction+        -- Gracefully handle any exceptions when running Shake actions. We want+        -- Rib to keep running instead of crashing abruptly.+        `catch` \(e :: SomeException) -> putStrLn $ "[Rib] Shake error: " <> show e+    ribShakeOptions fullGen =+      shakeOptions+        { shakeVerbosity = Verbose,+          shakeRebuild = bool [] [(RebuildNow, "**")] fullGen,+          shakeLintInside = [""],+          shakeExtra = addShakeExtra (RibSettings src dst) (shakeExtra shakeOptions)+        }

@@ -1,115 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedLabels #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE ViewPatterns #-}--module Rib.Document-  ( -- * Document type-    Document,-    mkDocumentFrom,--    -- * Document properties-    documentPath,-    documentVal,-    documentHtml,-    documentMeta,-    documentUrl,-  )-where--import Control.Monad.Except hiding (fail)-import Data.Aeson-import Development.Shake.FilePath ((-<.>))-import Lucid (Html)-import Named-import Path hiding ((-<.>))-import Rib.Markup-import qualified Text.Show---- | A document written in a lightweight markup language (LML)------ The type variable `repr` indicates the representation type of the Markup--- parser to be used.-data Document repr meta-  = Document-      { -- | Path to the document; relative to the source directory.-        _document_path :: Path Rel File,-        -- | Parsed representation of the document.-        _document_val :: repr,-        -- | HTML rendering of the parsed representation.-        _document_html :: Html (),-        -- | The parsed metadata.-        _document_meta :: meta-      }-  deriving (Generic, Show)--documentPath :: Document repr meta -> Path Rel File-documentPath = _document_path--documentVal :: Document repr meta -> repr-documentVal = _document_val--documentHtml :: Document repr meta -> Html ()-documentHtml = _document_html--documentMeta :: Document repr meta -> meta-documentMeta = _document_meta---- | Return the URL for the given @.html@ file under serve directory------ File path must be relative to the serve directory.------ You may also pass source paths as long as they map directly to destination--- path except for file extension.-documentUrl :: Document repr meta -> Text-documentUrl doc = toText $ toFilePath ([absdir|/|] </> (documentPath doc)) -<.> ".html"--data DocumentError-  = DocumentError_MarkupError Text-  | DocumentError_MetadataMissing-  | DocumentError_MetadataMalformed Text--instance Show DocumentError where-  show = \case-    DocumentError_MarkupError e -> toString e-    DocumentError_MetadataMissing -> "Metadata missing"-    DocumentError_MetadataMalformed msg -> "Bad metadata JSON: " <> toString msg---- | Parse, render to HTML and extract metadata from the given file.------ Return the Document type containing converted values.-mkDocumentFrom ::-  forall m b repr meta.-  (MonadError DocumentError m, MonadIO m, Markup repr, FromJSON meta) =>-  -- | File path, used only to identify (not access) the document-  "relpath" :! Path Rel File ->-  -- | Actual file path, for access and reading-  "path" :! Path b File ->-  m (Document repr meta)-mkDocumentFrom k@(arg #relpath -> k') f = do-  v <--    liftEither . first DocumentError_MarkupError-      =<< readDoc k f-  html <--    liftEither . first DocumentError_MarkupError $-      renderDoc v-  metaValue <--    liftEither . (first DocumentError_MetadataMalformed)-      =<< maybeToEither DocumentError_MetadataMissing (extractMeta v)-  meta <--    liftEither . first (DocumentError_MetadataMalformed . toText) $-      resultToEither (fromJSON metaValue)-  pure $ Document k' v html meta-  where-    maybeToEither e = liftEither . maybeToRight e-    resultToEither = \case-      Error e -> Left e-      Success v -> Right v

@@ -1,51 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--module Rib.Markup-  ( -- * Type class-    Markup (..),-  )-where--import Data.Aeson (Value)-import Lucid (Html)-import Named-import Path---- | Class for denoting Markup representations.------ See `Rib.Markup.Pandoc` and `Rib.Markup.MMark` for two available instances.-class Markup repr where--  -- | Parse the given markup text-  parseDoc ::-    -- | File path, used to identify the document only.-    Path Rel File ->-    -- | Markup text to parse-    Text ->-    Either Text repr--  -- | Like `parseDoc` but take the actual filepath instead of text.-  readDoc ::-    forall m b.-    MonadIO m =>-    -- | File path, used to identify the document only.-    "relpath" :! Path Rel File ->-    -- | Actual path to the file to parse.-    "path" :! Path b File ->-    m (Either Text repr)--  extractMeta ::-    repr ->-    Maybe (Either Text Value)--  -- | Render the document as Lucid HTML-  renderDoc ::-    repr ->-    Either Text (Html ())

@@ -1,87 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---- Suppressing orphans warning for `Markup MMark` instance--module Rib.Markup.MMark-  ( -- * Manual rendering-    renderMarkdown,--    -- * Extracting information-    getFirstImg,--    -- * Re-exports-    MMark,-  )-where--import Control.Foldl (Fold (..))-import Control.Monad.Except-import Lucid (Html)-import Named-import Path-import Rib.Markup-import Text.MMark (MMark)-import qualified Text.MMark as MMark-import qualified Text.MMark.Extension as Ext-import qualified Text.MMark.Extension.Common as Ext-import qualified Text.Megaparsec as M-import Text.URI (URI)--instance Markup MMark where--  parseDoc f s = case MMark.parse (toFilePath f) s of-    Left e -> Left $ toText $ M.errorBundlePretty e-    Right doc -> Right $ MMark.useExtensions exts $ useTocExt doc--  readDoc (Arg k) (Arg f) = do-    content <- readFileText (toFilePath f)-    pure $ parseDoc k content--  extractMeta = fmap Right . MMark.projectYaml--  renderDoc = Right . MMark.render---- | Parse and render the markup directly to HTML-renderMarkdown :: Text -> Html ()-renderMarkdown s = either error id $ runExcept $ do-  doc <- liftEither $ parseDoc @MMark [relfile|<memory>.md|] s-  liftEither $ renderDoc doc---- | Get the first image in the document if one exists-getFirstImg :: MMark -> Maybe URI-getFirstImg = flip MMark.runScanner $ Fold f Nothing id-  where-    f acc blk = acc <|> listToMaybe (mapMaybe getImgUri (inlinesContainingImg blk))-    getImgUri = \case-      Ext.Image _ uri _ -> Just uri-      _ -> Nothing-    inlinesContainingImg :: Ext.Bni -> [Ext.Inline]-    inlinesContainingImg = \case-      Ext.Naked xs -> toList xs-      Ext.Paragraph xs -> toList xs-      _ -> []--exts :: [MMark.Extension]-exts =-  [ Ext.fontAwesome,-    Ext.footnotes,-    Ext.kbd,-    Ext.linkTarget,-    Ext.mathJax (Just '$'),-    Ext.obfuscateEmail "protected-email",-    Ext.punctuationPrettifier,-    Ext.ghcSyntaxHighlighter,-    Ext.skylighting-  ]--useTocExt :: MMark -> MMark-useTocExt doc = MMark.useExtension (Ext.toc "toc" toc) doc-  where-    toc = MMark.runScanner doc $ Ext.tocScanner (\x -> x > 1 && x < 5)

@@ -1,185 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---- Suppressing orphans warning for `Markup Pandoc` instance---- | Helpers for working with Pandoc documents-module Rib.Markup.Pandoc-  ( -- * Manual rendering-    renderPandoc,-    renderPandocInlines,--    -- * Extracting information-    getH1,-    getFirstImg,--    -- * Re-exports-    Pandoc,-  )-where--import Control.Monad.Except-import Data.Aeson-import Lucid (Html, toHtmlRaw)-import Named-import Path-import Relude.Extra.Map ((!?))-import Rib.Markup-import Text.Pandoc-import Text.Pandoc.Filter.IncludeCode (includeCode)-import Text.Pandoc.Walk (query, walkM)-import qualified Text.Show--data RibPandocError-  = RibPandocError_PandocError PandocError-  | RibPandocError_UnknownFormat UnknownExtension--instance Show RibPandocError where-  show = \case-    RibPandocError_PandocError e ->-      show e-    RibPandocError_UnknownFormat s ->-      "Unsupported extension: " <> show s--instance Markup Pandoc where--  parseDoc k s = first show $ runExcept $ do-    r <--      withExcept RibPandocError_UnknownFormat $-        detectReader k-    withExcept RibPandocError_PandocError-      $ runPure'-      $ r readerSettings s--  readDoc (Arg k) (Arg f) = fmap (first show) $ runExceptT $ do-    content <- readFileText (toFilePath f)-    r <--      withExceptT RibPandocError_UnknownFormat $-        detectReader k-    withExceptT RibPandocError_PandocError $ do-      v' <- runIO' $ r readerSettings content-      liftIO $ walkM includeSources v'-    where-      includeSources = includeCode $ Just $ Format "html5"--  extractMeta (Pandoc meta _) = flattenMeta meta--  renderDoc doc = first show $ runExcept $ do-    withExcept RibPandocError_PandocError-      $ runPure'-      $ fmap toHtmlRaw-      $ writeHtml5String writerSettings doc--runPure' :: MonadError PandocError m => PandocPure a -> m a-runPure' = liftEither . runPure--runIO' :: (MonadError PandocError m, MonadIO m) => PandocIO a -> m a-runIO' = liftEither <=< liftIO . runIO---- | Parse and render the markup directly to HTML-renderPandoc :: Path Rel File -> Text -> Html ()-renderPandoc f s = either (error . show) id $ runExcept $ do-  doc <- liftEither $ parseDoc @Pandoc f s-  liftEither $ renderDoc doc---- | Render a list of Pandoc `Text.Pandoc.Inline` values as Lucid HTML------ Useful when working with `Text.Pandoc.Meta` values from the document metadata.-renderPandocInlines :: [Inline] -> Html ()-renderPandocInlines =-  either (error . show) toHtmlRaw-    . renderDoc-    . Pandoc mempty-    . pure-    . Plain---- | Get the top-level heading as Lucid HTML-getH1 :: Pandoc -> Maybe (Html ())-getH1 (Pandoc _ bs) = fmap renderPandocInlines $ flip query bs $ \case-  Header 1 _ xs -> Just xs-  _ -> Nothing---- | Get the first image in the document if one exists-getFirstImg ::-  Pandoc ->-  -- | Relative URL path to the image-  Maybe Text-getFirstImg (Pandoc _ bs) = listToMaybe $ flip query bs $ \case-  Image _ _ (url, _) -> [toText url]-  _ -> []--exts :: Extensions-exts =-  mconcat-    [ extensionsFromList-        [ Ext_yaml_metadata_block,-          Ext_fenced_code_attributes,-          Ext_auto_identifiers,-          Ext_smart-        ],-      githubMarkdownExtensions-    ]--readerSettings :: ReaderOptions-readerSettings = def {readerExtensions = exts}--writerSettings :: WriterOptions-writerSettings = def {writerExtensions = exts}---- Internal code--data UnknownExtension-  = UnknownExtension String-  deriving (Show, Eq)---- | Detect the Pandoc reader to use based on file extension-detectReader ::-  forall m m1.-  (MonadError UnknownExtension m, PandocMonad m1) =>-  Path Rel File ->-  m (ReaderOptions -> Text -> m1 Pandoc)-detectReader f = do-  ext <--    liftEither . first (UnknownExtension . show) $-      fileExtension f-  liftEither . maybeToRight (UnknownExtension ext) $-    formats !? ext-  where-    formats :: Map String (ReaderOptions -> Text -> m1 Pandoc)-    formats =-      fromList-        [ (".md", readMarkdown),-          (".rst", readRST),-          (".org", readOrg),-          (".tex", readLaTeX),-          (".ipynb", readIpynb)-        ]---- | Flatten a Pandoc 'Meta' into a well-structured JSON object.------ Renders Pandoc text objects into plain strings along the way.-flattenMeta :: Meta -> Maybe (Either Text Value)-flattenMeta (Meta meta) = fmap toJSON . traverse go <$> guarded null meta-  where-    go :: MetaValue -> Either Text Value-    go (MetaMap m) = toJSON <$> traverse go m-    go (MetaList m) = toJSONList <$> traverse go m-    go (MetaBool m) = pure $ toJSON m-    go (MetaString m) = pure $ toJSON m-    go (MetaInlines m) =-      bimap show toJSON-        $ runPure . plainWriter-        $ Pandoc mempty [Plain m]-    go (MetaBlocks m) =-      bimap show toJSON-        $ runPure . plainWriter-        $ Pandoc mempty m-    plainWriter = writePlain def

@@ -0,0 +1,93 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++-- | Parsing Markdown using the mmark parser.+module Rib.Parser.MMark+  ( -- * Parsing+    parse,+    parsePure,++    -- * Rendering+    render,++    -- * Extracting information+    getFirstImg,+    projectYaml,++    -- * Re-exports+    MMark,+  )+where++import Control.Foldl (Fold (..))+import Development.Shake (readFile')+import Lucid (Html)+import Path+import Relude+import Rib.Source (SourceReader)+import Text.MMark (MMark, projectYaml)+import qualified Text.MMark as MMark+import qualified Text.MMark.Extension as Ext+import qualified Text.MMark.Extension.Common as Ext+import qualified Text.Megaparsec as M+import Text.URI (URI)++-- | Render a MMark document as HTML+render :: MMark -> Html ()+render = MMark.render++-- | Pure version of `parse`+parsePure ::+  -- | Filepath corresponding to the text to be parsed (used only in parse errors)+  FilePath ->+  -- | Text to be parsed+  Text ->+  Either Text MMark+parsePure k s = case MMark.parse k s of+  Left e -> Left $ toText $ M.errorBundlePretty e+  Right doc -> Right $ MMark.useExtensions exts $ useTocExt doc++-- | `SourceReader` for parsing Markdown using mmark+parse :: SourceReader MMark+parse (toFilePath -> f) = do+  s <- toText <$> readFile' f+  pure $ parsePure f s++-- | Get the first image in the document if one exists+getFirstImg :: MMark -> Maybe URI+getFirstImg = flip MMark.runScanner $ Fold f Nothing id+  where+    f acc blk = acc <|> listToMaybe (mapMaybe getImgUri (inlinesContainingImg blk))+    getImgUri = \case+      Ext.Image _ uri _ -> Just uri+      _ -> Nothing+    inlinesContainingImg :: Ext.Bni -> [Ext.Inline]+    inlinesContainingImg = \case+      Ext.Naked xs -> toList xs+      Ext.Paragraph xs -> toList xs+      _ -> []++exts :: [MMark.Extension]+exts =+  [ Ext.fontAwesome,+    Ext.footnotes,+    Ext.kbd,+    Ext.linkTarget,+    Ext.mathJax (Just '$'),+    Ext.obfuscateEmail "protected-email",+    Ext.punctuationPrettifier,+    Ext.ghcSyntaxHighlighter,+    Ext.skylighting+  ]++useTocExt :: MMark -> MMark+useTocExt doc = MMark.useExtension (Ext.toc "toc" toc) doc+  where+    toc = MMark.runScanner doc $ Ext.tocScanner (\x -> x > 1 && x < 5)

@@ -0,0 +1,147 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++-- | Helpers for working with Pandoc documents+module Rib.Parser.Pandoc+  ( -- * Parsing+    parse,+    parsePure,++    -- * Rendering+    render,+    renderPandocInlines,++    -- * Extracting information+    extractMeta,+    getH1,+    getFirstImg,++    -- * Re-exports+    Pandoc,+    module Text.Pandoc.Readers,+  )+where++import Control.Monad.Except+import Data.Aeson+import Development.Shake (readFile')+import Lucid (Html, toHtmlRaw)+import Path+import Relude+import Rib.Source (SourceReader)+import Text.Pandoc+import Text.Pandoc.Filter.IncludeCode (includeCode)+import qualified Text.Pandoc.Readers+import Text.Pandoc.Walk (query, walkM)++-- | Pure version of `parse`+parsePure ::+  (ReaderOptions -> Text -> PandocPure Pandoc) ->+  Text ->+  Either Text Pandoc+parsePure textReader s =+  first show $ runExcept $ do+    runPure' $ textReader readerSettings s++-- | `SourceReader` for parsing a lightweight markup language using Pandoc+parse ::+  -- | The pandoc text reader function to use, eg: `readMarkdown`+  (ReaderOptions -> Text -> PandocIO Pandoc) ->+  SourceReader Pandoc+parse textReader (toFilePath -> f) = do+  content <- toText <$> readFile' f+  fmap (first show) $ runExceptT $ do+    v' <- runIO' $ textReader readerSettings content+    liftIO $ walkM includeSources v'+  where+    includeSources = includeCode $ Just $ Format "html5"++-- | Render a Pandoc document to HTML+render :: Pandoc -> Html ()+render doc =+  either error id $ first show $ runExcept $ do+    runPure'+    $ fmap toHtmlRaw+    $ writeHtml5String writerSettings doc++-- | Extract the Pandoc metadata as JSON value+extractMeta :: Pandoc -> Maybe (Either Text Value)+extractMeta (Pandoc meta _) = flattenMeta meta++runPure' :: MonadError PandocError m => PandocPure a -> m a+runPure' = liftEither . runPure++runIO' :: (MonadError PandocError m, MonadIO m) => PandocIO a -> m a+runIO' = liftEither <=< liftIO . runIO++-- | Render a list of Pandoc `Text.Pandoc.Inline` values as Lucid HTML+--+-- Useful when working with `Text.Pandoc.Meta` values from the document metadata.+renderPandocInlines :: [Inline] -> Html ()+renderPandocInlines =+  toHtmlRaw+    . render+    . Pandoc mempty+    . pure+    . Plain++-- | Get the top-level heading as Lucid HTML+getH1 :: Pandoc -> Maybe (Html ())+getH1 (Pandoc _ bs) = fmap renderPandocInlines $ flip query bs $ \case+  Header 1 _ xs -> Just xs+  _ -> Nothing++-- | Get the first image in the document if one exists+getFirstImg ::+  Pandoc ->+  -- | Relative URL path to the image+  Maybe Text+getFirstImg (Pandoc _ bs) = listToMaybe $ flip query bs $ \case+  Image _ _ (url, _) -> [toText url]+  _ -> []++exts :: Extensions+exts =+  mconcat+    [ extensionsFromList+        [ Ext_yaml_metadata_block,+          Ext_fenced_code_attributes,+          Ext_auto_identifiers,+          Ext_smart+        ],+      githubMarkdownExtensions+    ]++readerSettings :: ReaderOptions+readerSettings = def {readerExtensions = exts}++writerSettings :: WriterOptions+writerSettings = def {writerExtensions = exts}++-- Internal code++-- | Flatten a Pandoc 'Meta' into a well-structured JSON object.+--+-- Renders Pandoc text objects into plain strings along the way.+flattenMeta :: Meta -> Maybe (Either Text Value)+flattenMeta (Meta meta) = fmap toJSON . traverse go <$> guarded null meta+  where+    go :: MetaValue -> Either Text Value+    go (MetaMap m) = toJSON <$> traverse go m+    go (MetaList m) = toJSONList <$> traverse go m+    go (MetaBool m) = pure $ toJSON m+    go (MetaString m) = pure $ toJSON m+    go (MetaInlines m) =+      bimap show toJSON+        $ runPure . plainWriter+        $ Pandoc mempty [Plain m]+    go (MetaBlocks m) =+      bimap show toJSON+        $ runPure . plainWriter+        $ Pandoc mempty m+    plainWriter = writePlain def

@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}  -- | Serve generated static files with HTTP module Rib.Server@@ -7,23 +6,21 @@   ) where -import Network.Wai.Application.Static (defaultFileServerSettings, ssListing, ssLookupFile, staticApp)+import Network.Wai.Application.Static (defaultFileServerSettings, ssListing, staticApp) import qualified Network.Wai.Handler.Warp as Warp+import Relude import WaiAppStatic.Types (StaticSettings)  -- | WAI Settings suited for serving statically generated websites. staticSiteServerSettings :: FilePath -> StaticSettings staticSiteServerSettings root =-  settings-    { ssLookupFile = ssLookupFile settings,-      ssListing = Nothing -- Disable directory listings+  defaultSettings+    { ssListing = Nothing -- Disable directory listings     }   where-    settings = defaultFileServerSettings root+    defaultSettings = defaultFileServerSettings root  -- | Run a HTTP server to serve a directory of static files------ Allow URLs of the form @//foo//bar@ to serve @${path}//foo//bar.html@ serve ::   -- | Port number to bind to   Int ->

@@ -1,56 +1,71 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}  -- | Combinators for working with Shake.------ See the source of `Rib.Simple.buildAction` for example usage. module Rib.Shake   ( -- * Basic helpers+    buildStaticFiles,     buildHtmlMulti,     buildHtml,+    buildHtml_, -    -- * Read helpers-    readDocMulti,+    -- * Reading only+    readSource, +    -- * Writing only+    writeHtml,+     -- * Misc-    buildStaticFiles,-    Dirs (..),+    RibSettings (..),+    ribInputDir,+    ribOutputDir,+    getDirectoryFiles',   ) where -import Data.Aeson import Development.Shake+import Development.Shake.Forward import Lucid (Html) import qualified Lucid-import Named import Path import Path.IO-import Rib.Document-import Rib.Markup (Markup)+import Relude+import Rib.Source -data Dirs = Dirs (Path Rel Dir, Path Rel Dir)+-- | RibSettings is initialized with the values passed to `Rib.App.run`+data RibSettings+  = RibSettings+      { _ribSettings_inputDir :: Path Rel Dir,+        _ribSettings_outputDir :: Path Rel Dir+      }   deriving (Typeable) -getDirs :: Action (Path Rel Dir, Path Rel Dir)-getDirs = getShakeExtra >>= \case-  Just (Dirs d) -> return d-  Nothing -> fail "Input output directories are not initialized"+-- | Get rib settings from a shake Action monad.+ribSettings :: Action RibSettings+ribSettings = getShakeExtra >>= \case+  Just v -> pure v+  Nothing -> fail "RibSettings not initialized" +-- | Input directory containing source files+--+-- This is same as the first argument to `Rib.App.run` ribInputDir :: Action (Path Rel Dir)-ribInputDir = fst <$> getDirs+ribInputDir = _ribSettings_inputDir <$> ribSettings +-- Output directory containing generated files+--+-- This is same as the second argument to `Rib.App.run` ribOutputDir :: Action (Path Rel Dir) ribOutputDir = do-  output <- snd <$> getDirs+  output <- _ribSettings_outputDir <$> ribSettings   liftIO $ createDirIfMissing True output   return output --- | Shake action to copy static files as is+-- | Shake action to copy static files as is. buildStaticFiles :: [Path Rel File] -> Action () buildStaticFiles staticFilePatterns = do   input <- ribInputDir@@ -59,59 +74,94 @@   void $ forP files $ \f ->     copyFileChanged' (input </> f) (output </> f)   where-    copyFileChanged' old new =-      copyFileChanged (toFilePath old) (toFilePath new)+    copyFileChanged' (toFilePath -> old) (toFilePath -> new) =+      copyFileChanged old new +-- | Read and parse an individual source file+readSource ::+  -- | How to parse the source+  SourceReader repr ->+  -- | Path to the source file (relative to `ribInputDir`)+  Path Rel File ->+  Action repr+readSource sourceReader k = do+  f <- (</> k) <$> ribInputDir+  -- NOTE: We don't really use cacheActionWith prior to parsing content,+  -- because the parsed representation (`repr`) may not always have instances+  -- for Typeable/Binary/Generic (for example, MMark does not expose its+  -- structure.). Consequently we are forced to cache merely the HTML writing+  -- stage (see buildHtml').+  need [toFilePath f]+  sourceReader f >>= \case+    Left e ->+      fail $ "Error parsing source " <> toFilePath k <> ": " <> show e+    Right v ->+      pure v+ -- | Convert the given pattern of source files into their HTML. buildHtmlMulti ::-  forall repr meta.-  (Markup repr, FromJSON meta) =>-  -- | Source file patterns+  -- | How to parse the source file+  SourceReader repr ->+  -- | Source file patterns (relative to `ribInputDir`)+  [Path Rel File] ->+  -- | How to render the given source to HTML+  (Source repr -> Html ()) ->+  -- | Result+  Action [Source repr]+buildHtmlMulti parser pats r = do+  input <- ribInputDir+  fs <- getDirectoryFiles' input pats+  forP fs $ \k -> do+    outfile <- liftIO $ replaceExtension ".html" k+    buildHtml parser outfile k r++-- | Like `buildHtmlMulti` but operate on a single file.+--+-- Also explicitly takes the output file path.+buildHtml ::+  SourceReader repr ->+  -- | Path to the output HTML file (relative to `ribOutputDir`)   Path Rel File ->-  -- | How to render the given document to HTML-  (Document repr meta -> Html ()) ->-  -- | List of relative path to generated HTML and the associated document-  Action [Document repr meta]-buildHtmlMulti pat r = do-  xs <- readDocMulti pat-  void $ forP xs $ \x -> do-    outfile <- liftIO $ replaceExtension ".html" $ documentPath x-    buildHtml outfile (r x)-  pure xs+  -- | Path to the source file (relative to `ribInputDir`)+  Path Rel File ->+  (Source repr -> Html ()) ->+  Action (Source repr)+buildHtml parser outfile k r = do+  src <- Source k outfile <$> readSource parser k+  writeHtml outfile $ r src+  pure src --- | Like `readDoc'` but operates on multiple files-readDocMulti ::-  forall repr meta.-  (Markup repr, FromJSON meta) =>-  -- | Source file patterns+-- | Like `buildHtml` but discards its result.+buildHtml_ ::+  SourceReader repr ->   Path Rel File ->-  Action [Document repr meta]-readDocMulti pat = do-  input <- ribInputDir-  fs <- getDirectoryFiles' input [pat]-  forP fs $ \f -> do-    need $ toFilePath <$> [input </> f]-    result <--      runExceptT $-        mkDocumentFrom-          ! #relpath f-          ! #path (input </> f)-    case result of-      Left e ->-        fail $ "Error converting " <> toFilePath f <> " to HTML: " <> show e-      Right v -> pure v+  Path Rel File ->+  (Source repr -> Html ()) ->+  Action ()+buildHtml_ parser outfile k = void . buildHtml parser outfile k --- | Build a single HTML file with the given value-buildHtml :: Path Rel File -> Html () -> Action ()-buildHtml f html = do-  output <- ribOutputDir-  writeHtml (output </> f) html-  where-    writeHtml :: MonadIO m => Path b File -> Html () -> m ()-    writeHtml p htmlVal =-      writeFileLText (toFilePath p) $! Lucid.renderText htmlVal+-- | Write a single HTML file with the given HTML value+--+-- The HTML text value will be cached, so subsequent writes of the same value+-- will be skipped.+writeHtml :: Path Rel File -> Html () -> Action ()+writeHtml f = writeFileCached f . toString . Lucid.renderText --- | Like `getDirectoryFiles` but work with `Path`+-- | Like writeFile' but uses `cacheAction`.+--+-- Also, always writes under ribOutputDir+writeFileCached :: Path Rel File -> String -> Action ()+writeFileCached k s = do+  f <- fmap (toFilePath . (</> k)) ribOutputDir+  let cacheClosure = (f, s)+      cacheKey = ("writeFileCached" :: Text, f)+  cacheActionWith cacheKey cacheClosure $ do+    writeFile' f $! s+    -- Use a character (like +) that contrasts with what Shake uses (#) for+    -- logging modified files being read.+    putInfo $ "+ " <> f++-- | Like `getDirectoryFiles` but works with `Path` getDirectoryFiles' :: Path b Dir -> [Path Rel File] -> Action [Path Rel File]-getDirectoryFiles' dir pat =-  traverse (liftIO . parseRelFile) =<< getDirectoryFiles (toFilePath dir) (toFilePath <$> pat)+getDirectoryFiles' (toFilePath -> dir) (fmap toFilePath -> pat) =+  traverse (liftIO . parseRelFile) =<< getDirectoryFiles dir pat

@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Rib.Source+  ( -- * Source type+    Source (..),+    SourceReader,++    -- * Source properties+    sourcePath,+    sourceUrl,+    sourceVal,+  )+where++import qualified Data.Text as T+import Development.Shake (Action)+import Path+import Relude++-- | A source file on disk+data Source repr+  = Source+      { _source_path :: Path Rel File,+        -- | Path to the generated HTML file (relative to `Rib.Shake.ribOutputDir`)+        _source_builtPath :: Path Rel File,+        _source_val :: repr+      }+  deriving (Generic, Functor)++-- | Path to the source file (relative to `Rib.Shake.ribInputDir`)+sourcePath :: Source repr -> Path Rel File+sourcePath = _source_path++-- | Relative URL to the generated source HTML.+sourceUrl :: Source repr -> Text+sourceUrl = stripIndexHtml . relPathToUrl . _source_builtPath+  where+    relPathToUrl = toText . toFilePath . ([absdir|/|] </>)+    stripIndexHtml s =+      if T.isSuffixOf "index.html" s+        then T.dropEnd (T.length $ "index.html") s+        else s++-- | Parsed representation of the source.+sourceVal :: Source repr -> repr+sourceVal = _source_val++-- | A function that parses a source representation out of the given file+type SourceReader repr = forall b. Path b File -> Action (Either Text repr)