rib 0.4.1.0 → 0.5.0.0

raw patch · 15 files changed

+782/−461 lines, 15 filesdep +base-nopreludedep +exceptionsdep +foldldep −basedep −bytestringdep −data-defaultsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: base-noprelude, exceptions, foldl, megaparsec, mmark, mmark-ext, modern-uri, named, path, path-io, relude

Dependencies removed: base, bytestring, data-default, http-types, lens, lens-aeson, safe, skylighting, time, wai-extra

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−1
• README.md +109/−29
• Setup.hs +0/−2
• rib.cabal +32/−24
• src/Prelude.hs +6/−0
• src/Rib.hs +24/−0
• src/Rib/App.hs +65/−62
• src/Rib/Document.hs +115/−0
• src/Rib/Markup.hs +51/−0
• src/Rib/Markup/MMark.hs +87/−0
• src/Rib/Markup/Pandoc.hs +185/−0
• src/Rib/Pandoc.hs +0/−159
• src/Rib/Server.hs +13/−32
• src/Rib/Shake.hs +75/−102
• src/Rib/Simple.hs +0/−50

@@ -1,5 +1,25 @@ # Change Log for rib +## 0.5.0.0++This release comes with a major API refactor. Key changes:++- Added MMark support, as an alternative to Pandoc+- Allows using arbitrary records to load metadata+  - This replaces the previous complex metadata API+- Added `Document` type that uses the custom metadata record+- Add top-level `Rib` import namespace for ease of use+- Remove the following:+  - JSON cache+  - `Rib.Simple`+- Support for Table of Contents via MMark++Other changes:++- Use type-safe path types using the [path](http://hackage.haskell.org/package/path) library.+- Fix #40: Gracefully handle rendering/ parsing errors, without dying.+- Misc error reporting improvements+ ## 0.4.1.0  - `Rib.Pandoc`: @@ -16,4 +36,3 @@ ## 0.2.0.0  - Initial release.-

@@ -4,6 +4,7 @@  [![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)  Rib is a Haskell library for writing your own **static site generator**. @@ -14,25 +15,127 @@   ([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-- Remain as simple as possible to use (see screenshot below)+    documents. It also supports [MMark](https://github.com/mmark-md/mmark) if you need a lightweight alternative.+- Remain as simple as possible to use (see example below) - Optional Nix based workflow for easily reproducible environment  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 custom framework. +**Table of Contents**++- [rib](#rib)+    - [Quick Preview](#quick-preview)+    - [Getting Started](#getting-started)+    - [Concepts](#concepts)+        - [Directory structure](#directory-structure)+        - [Run the site](#run-the-site)+        - [How Rib works](#how-rib-works)+        - [Editing workflow](#editing-workflow)+        - [What's next?](#whats-next)+    - [Examples](#examples)++## Quick Preview+ Here is how your code may look like if you were to generate your static site using Rib: -![Example](https://raw.githubusercontent.com/srid/rib/master/assets/rib-sample-main.png)+``` 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.+--+-- 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+data Page+  = Page_Index [Document MMark DocMeta]+  | Page_Doc (Document MMark DocMeta)++-- | 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+      { title :: Text,+        description :: Maybe Text+      }+  deriving (Show, Eq, Generic, FromJSON)++-- | Main entry point to our generator.+--+-- `Rib.run` handles CLI arguments, and takes three parameters here.+--+-- 1. Directory `a`, from which static files will be read.+-- 2. Directory `b`, under which target files will be generated.+-- 3. Shake build action to run.+--+-- In the shake build action you would expect to use the utility functions+-- provided by Rib to do the actual generation of your static site.+main :: IO ()+main = Rib.run [reldir|a|] [reldir|b|] generateSite+  where+    -- Shake Action for generating the static site+    generateSite :: Action ()+    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+    -- Define your site HTML here+    renderPage :: Page -> Html ()+    renderPage page = with html_ [lang_ "en"] $ do+      head_ $ do+        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+        style_ [type_ "text/css"] $ Clay.render pageStyle+      body_+        $ with div_ [id_ "thesite"]+        $ do+          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 ->+              with article_ [class_ "post"] $ do+                h1_ $ toHtml $ title $ Rib.documentMeta doc+                Rib.documentHtml doc+    -- Define your site CSS here+    pageStyle :: Css+    pageStyle = "div#thesite" ? do+      margin (em 4) (pc 20) (em 1) (pc 20)+      "li.links" ? do+        listStyleType none+        marginTop $ em 1+        "b" ? fontSize (em 1.2)+        "p" ? sym margin (px 0)+```++(View full [`Main.hs`](https://github.com/srid/rib-sample/blob/master/Main.hs) at rib-sample)+ ## Getting Started  The easiest way to get started with [Rib](/) is to [use the template](https://help.github.com/en/articles/creating-a-repository-from-a-template) repository, [**rib-sample**](https://github.com/srid/rib-sample), from Github. +## Concepts+ ### Directory structure  Let's look at what's in the template repository:@@ -86,10 +189,7 @@ 1. [`ghcid`](https://github.com/ndmitchell/ghcid) will compile your `Main.hs`    and run its `main` function. -1. `Main.hs:main` in turn calls the Shake build action (via `Rib.App.run`)-   defined in `Rib.Simple.buildAction` passing it your function `renderPage`.--There is quite a bit going on in that step 3! Let's break it down:+1. `Main.hs:main` in turn calls `Rib.App.run` which takes as argument your custom Shake action that will build the static site.  1. `Rib.App.run`: this parses the CLI arguments and runs the rib CLI "app" which    can be run in one of a few modes --- generating static files, watching the@@ -97,11 +197,6 @@    default---without any explicit arguments---this will run the Shake build    action passed as argument on every file change and spin up a HTTP server.    -1. `Rib.Simple.buildAction`: The `run` function takes a Shake build action to-   run on file change. `Rib.Simple` provides a very simple build action for-   generating the most simple static site --- a list of posts with static assets-   --- which the sample repository uses.-    Run that command, and visit http://localhost:8080 to view your site.  ### Editing workflow@@ -115,24 +210,9 @@  Great, by now you should have your static site generator ready and running! What more can you do? Surely you may have specific needs; and this usually translates-to running custom Shake actions during the build.--Rib provides helper functions in `Rib.Shake` and `Rib.Pandoc` to make this-easier. Indeed the `Rib.Simple.buildAction` function which the sample project-readily uses makes use of these functions.--In order to customize your site's build actions,--1. Copy the source for `buildAction` from the-[`Rib.Simple`](https://github.com/srid/rib/blob/master/src/Rib/Simple.hs) module-to your `Main.hs`--1. Make any customizations you want in *your* `buildAction` function. Refer to-   [Hackage](http://hackage.haskell.org/package/rib) for API docs.--1. Use that as the argument to the `Rib.App.run` function in your `main`+to running custom Shake actions during the build. Rib provides helper functions in `Rib.Shake` to make this easier.  -Notice how Rib's builtin `buildAction` is +Rib recommends writing your Shake actions in the style of being  [forward-defined](http://hackage.haskell.org/package/shake-0.18.3/docs/Development-Shake-Forward.html) which adds to the simplicity of the entire thing. 

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: rib-version: 0.4.1.0+version: 0.5.0.0 license: BSD-3-Clause copyright: 2019 Sridhar Ratnakumar maintainer: srid@srid.ca@@ -23,41 +23,49 @@  library     exposed-modules:+        Rib         Rib.App-        Rib.Pandoc-        Rib.Server+        Rib.Document+        Rib.Markup.MMark+        Rib.Markup.Pandoc         Rib.Shake-        Rib.Simple+    other-modules:+        Prelude+        Rib.Markup+        Rib.Server     hs-source-dirs: src     default-language: Haskell2010-    ghc-options: -Wall -Wincomplete-uni-patterns-                 -Wincomplete-record-updates+    ghc-options:+        -Wall+        -Wincomplete-record-updates+        -Wincomplete-uni-patterns     build-depends:         aeson >=1.4.2 && <1.5,-        bytestring >=0.10.8 && <0.11,-        containers >=0.6.0 && <0.7,-        binary >=0.8.6 && <0.9,-        text >=1.2.3 && <1.3,-        time >=1.8.0 && <1.9,         async,+        base-noprelude >=4.7 && <5,+        binary >=0.8.6 && <0.9,         clay >=0.13.1 && <0.14,-        mtl >=2.2.2 && <2.3,         cmdargs >=0.10.20 && <0.11,-        data-default >=0.7.1 && <0.8,+        containers >=0.6.0 && <0.7,+        directory >= 1.0 && <2.0,+        exceptions,+        foldl,         fsnotify >=0.3.0 && <0.4,-        http-types >=0.12.3 && <0.13,-        lens,-        lens-aeson >=1.0.2 && <1.1,         lucid >=2.9.11 && <2.10,-        pandoc-types >=1.17.5 && <1.18,-        safe >=0.3.17 && <0.4,-        skylighting,+        megaparsec,+        mmark,+        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-io,+        relude >= 0.6 && < 0.7,         shake,+        text >=1.2.3 && <1.3,         wai >=3.2.2 && <3.3,         wai-app-static >=3.1.6 && <3.2,-        wai-extra,-        warp,-        base >=4.7 && <5,-        pandoc >=2.7 && <3,-        directory >= 1.0 && <2.0+        warp

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

@@ -0,0 +1,24 @@+-- |+module Rib+  ( module Rib.App,+    module Rib.Shake,+    module Rib.Server,+    Document,+    documentPath,+    documentVal,+    documentHtml,+    documentMeta,+    documentUrl,+    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.Shake

@@ -1,99 +1,102 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}  -- | CLI interface for Rib. -- -- Typically you would call `Rib.App.run` passing your Shake build action. module Rib.App-  ( App(..)-  , run-  , runWith-  ) where+  ( App (..),+    run,+    runWith,+  )+where  import Control.Concurrent (threadDelay) import Control.Concurrent.Async (concurrently_)-import Control.Monad-import Data.Bool (bool)-+import Control.Exception (catch) import Development.Shake import Development.Shake.Forward (shakeForward)-import System.Console.CmdArgs-import System.FSNotify (watchTree, withManager)-+import Path import qualified Rib.Server as Server import Rib.Shake (Dirs (..))+import System.Console.CmdArgs+import System.FSNotify (watchTree, withManager)  -- | Application modes -- -- The mode in which to run the Rib CLI data App-  = Generate-    { force :: Bool-      -- ^ Force generation of /all/ files-    }-  -- ^ Generate static files once.-  | WatchAndGenerate-  -- ^ Watch for changes in the input directory and run `Generate`-  | Serve-    { port :: Int-      -- ^ Port to bind the server-    , dontWatch :: Bool-      -- ^ Unless set run `WatchAndGenerate` automatically-    }-  -- ^ Run a HTTP server serving content from the output directory-  deriving (Data,Typeable,Show,Eq)-+  = -- | Generate static files once.+    Generate+      { -- | Force a full generation of /all/ files even if they were not modified+        full :: Bool+      }+  | -- | Watch for changes in the input directory and run `Generate`+    WatchAndGenerate+  | -- | Run a HTTP server serving content from the output directory+    Serve+      { -- | Port to bind the server+        port :: Int,+        -- | Unless set run `WatchAndGenerate` automatically+        dontWatch :: Bool+      }+  deriving (Data, Typeable, Show, Eq)  -- | Run Rib using arguments passed in the command line.-run-  :: FilePath-  -- ^ Directory from which source content will be read.+run ::+  -- | Directory from which source content will be read.   --   -- NOTE: This should ideally *not* be `"."` as our use of watchTree (of   -- `runWith`) can interfere with Shake's file scaning.-  -> FilePath-  -- ^ The path where static files will be generated.  Rib's server uses this+  Path Rel Dir ->+  -- | The path where static files will be generated.  Rib's server uses this   -- directory when serving files.-  -> Action ()-  -- ^ Shake build rules for building the static site-  -> IO ()+  Path Rel Dir ->+  -- | Shake build rules for building the static site+  Action () ->+  IO () run src dst buildAction = runWith src dst buildAction =<< cmdArgs ribCli   where-    ribCli = modes-      [ Serve-          { port = 8080 &= help "Port to bind to"-          , dontWatch = False &= help "Do not watch in addition to serving generated files"-          } &= help "Serve the generated site"-            &= auto-      , WatchAndGenerate-          &= help "Watch for changes and generate"-      , Generate-          { force = False &= help "Force generation of all files"-          } &= help "Generate the site"-      ]+    ribCli =+      modes+        [ Serve+            { port = 8080 &= help "Port to bind to",+              dontWatch = False &= help "Do not watch in addition to serving generated files"+            }+            &= help "Serve the generated site"+            &= auto,+          WatchAndGenerate+            &= help "Watch for changes and generate",+          Generate+            { full = False &= help "Force a full generation of all files"+            }+            &= help "Generate the site"+        ]  -- | Like `run` but with an explicitly passed `App` mode-runWith :: FilePath -> FilePath -> Action () -> App -> IO ()+runWith :: Path Rel Dir -> Path Rel Dir -> Action () -> App -> IO () 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     -- And then every time a file changes under the current directory-    putStrLn $ "[Rib] Watching " <> src-    void $ watchTree mgr src (const True) $ const $-      runWith src dst buildAction $ Generate False+    putStrLn $ "[Rib] Watching " <> toFilePath src+    void $ watchTree mgr (toFilePath src) (const True) $ \_ -> do+      runWith src dst buildAction (Generate False)+        `catch` \(e :: SomeException) -> putStrLn $ show e     -- Wait forever, effectively.     forever $ threadDelay maxBound--  Serve p dw -> concurrently_-    (unless dw $ runWith src dst buildAction WatchAndGenerate)-    (Server.serve p dst)--  Generate forceGen ->-    let opts = shakeOptions-          { shakeVerbosity = Chatty-          , shakeRebuild = bool [] [(RebuildNow, "**")] forceGen-          , shakeExtra = addShakeExtra (Dirs (src, dst)) (shakeExtra shakeOptions)-          }-    in shakeForward opts buildAction+  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

@@ -0,0 +1,115 @@+{-# 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

@@ -0,0 +1,51 @@+{-# 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 ())

@@ -0,0 +1,87 @@+{-# 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)

@@ -0,0 +1,185 @@+{-# 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

@@ -1,159 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE UndecidableInstances #-}---- | Helpers for working with Pandoc documents-module Rib.Pandoc-  ( module Text.Pandoc.Readers-  -- * Parsing-  , parse-  , parsePure-  -- * Converting to HTML-  , render-  , renderInlines-  , render'-  , renderInlines'-  -- * Metadata-  , getMeta-  , setMeta-  , parseMeta-  -- * Extracting information-  , getH1-  , getFirstImg-  )-where--import Control.Monad-import Data.ByteString.Lazy (ByteString)-import qualified Data.Map as Map-import Data.Text (Text)-import qualified Data.Text as T--import Lucid (Html, toHtmlRaw)-import Text.Pandoc-import Text.Pandoc.Filter.IncludeCode (includeCode)-import Text.Pandoc.Readers-import Text.Pandoc.Readers.Markdown (yamlToMeta)-import Text.Pandoc.Shared (stringify)-import Text.Pandoc.Walk (query, walkM)---class IsMetaValue a where-  parseMetaValue :: MetaValue -> a--instance IsMetaValue [Inline] where-  parseMetaValue = \case-    MetaInlines inlines -> inlines-    _ -> error "Not a MetaInline"--instance IsMetaValue (Html ()) where-  parseMetaValue = renderInlines . parseMetaValue @[Inline]--instance IsMetaValue Text where-  parseMetaValue = T.pack . stringify . parseMetaValue @[Inline]--instance {-# Overlappable #-} IsMetaValue a => IsMetaValue [a] where-  parseMetaValue = \case-    MetaList vals -> parseMetaValue <$> vals-    _ -> error "Not a MetaList"---- NOTE: This requires UndecidableInstances, but is there a better way?-instance {-# Overlappable #-} Read a => IsMetaValue a where-  parseMetaValue = read . T.unpack . parseMetaValue @Text---- | Get the metadata value for the given key in a Pandoc document.------ It is recommended to call this function with type application specifying the--- type of `a`.------ `MetaValue` is parsed in accordance with the `IsMetaValue` class constraint.--- Available instances:------ - `Html`: parse value as a Pandoc document and convert to Lucid Html--- - `Text`: parse a raw value (Inline with one Str value)--- - @[a]@: parse a list of values--- - @Read a => a@: parse a raw value and then read it.-getMeta :: IsMetaValue a => String -> Pandoc -> Maybe a-getMeta k (Pandoc meta _) = parseMetaValue <$> lookupMeta k meta---- | Add, or set, a metadata data key to the given Haskell value-setMeta :: Show a => String -> a -> Pandoc -> Pandoc-setMeta k v (Pandoc (Meta meta) bs) = Pandoc (Meta meta') bs-  where-    meta' = Map.insert k v' meta-    v' = MetaInlines [Str $ show v]---- | Pure version of `parse`-parsePure :: (ReaderOptions -> Text -> PandocPure Pandoc) -> Text -> Pandoc-parsePure r =-  either (error . show) id . runPure . r settings-  where-    settings = def { readerExtensions = exts }---- | Parse the source text as a Pandoc document------ Supports the [includeCode](https://github.com/owickstrom/pandoc-include-code) extension.-parse-  :: (ReaderOptions -> Text -> PandocIO Pandoc)-  -- ^ Document format. Example: `Text.Pandoc.Readers.readMarkdown`-  -> Text-  -- ^ Source text to parse-  -> IO Pandoc-parse r =-  either (error . show) (walkM includeSources) <=< runIO . r settings-  where-    settings = def { readerExtensions = exts }-    includeSources = includeCode $ Just $ Format "html5"---- | Parse the metadata source as a Pandoc Meta value-parseMeta :: ByteString -> IO Meta-parseMeta = either (error . show) pure <=< runIO . yamlToMeta settings-  where-    settings = def { readerExtensions = exts }---- | Like `render` but returns the raw HTML string, or the rendering error.-render' :: Pandoc -> Either PandocError Text-render' = runPure . writeHtml5String settings-  where-    settings = def { writerExtensions = exts }---- | Render a Pandoc document as Lucid HTML-render :: Pandoc -> Html ()-render = either (error . show) toHtmlRaw . render'---- | Like `renderInlines` but returns the raw HTML string, or the rendering error.-renderInlines' :: [Inline] -> Either PandocError Text-renderInlines' = render' . Pandoc mempty . pure . Plain---- | Render a list of Pandoc `Text.Pandoc.Inline` values as Lucid HTML------ Useful when working with `Text.Pandoc.Meta` values from the document metadata.-renderInlines :: [Inline] -> Html ()-renderInlines = either (error . show) toHtmlRaw . renderInlines'---- | Get the top-level heading as Lucid HTML-getH1 :: Pandoc -> Maybe (Html ())-getH1 (Pandoc _ bs) = fmap renderInlines $ flip query bs $ \case-  Header 1 _ xs -> Just xs-  _ -> Nothing---- | Get the first image in the document if one exists-getFirstImg-  :: Pandoc-  -> Maybe Text-  -- ^ Relative URL path to the image-getFirstImg (Pandoc _ bs) = flip query bs $ \case-  Image _ _ (url, _) -> Just $ T.pack url-  _ -> Nothing--exts :: Extensions-exts = mconcat-  [ extensionsFromList-    [ Ext_yaml_metadata_block-    , Ext_fenced_code_attributes-    , Ext_auto_identifiers-    , Ext_smart-    ]-  , githubMarkdownExtensions-  ]

@@ -1,54 +1,35 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}  -- | Serve generated static files with HTTP module Rib.Server-  (-    serve-  , getHTMLFileUrl+  ( serve,   ) where -import Prelude hiding (init, last)--import Data.Text (Text)-import qualified Data.Text as T--import Development.Shake.FilePath ((-<.>)) import Network.Wai.Application.Static (defaultFileServerSettings, ssListing, ssLookupFile, staticApp) import qualified Network.Wai.Handler.Warp as Warp 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-  }+staticSiteServerSettings root =+  settings+    { ssLookupFile = ssLookupFile settings,+      ssListing = Nothing -- Disable directory listings+    }   where     settings = defaultFileServerSettings root --- | 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.-getHTMLFileUrl-  :: FilePath-  -- ^ Relative path to a page (extension is ignored)-  -> Text-getHTMLFileUrl path = T.pack $ "/" ++  (path -<.> ".html")- -- | 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-  :: Int-  -- ^ Port number to bind to-  -> FilePath-  -- ^ Directory to serve.-  -> IO ()+serve ::+  -- | Port number to bind to+  Int ->+  -- | Directory to serve.+  FilePath ->+  IO () serve port path = do   putStrLn $ "[Rib] Serving at http://localhost:" <> show port   Warp.run port $ staticApp $ staticSiteServerSettings path

@@ -1,144 +1,117 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}  -- | Combinators for working with Shake. -- -- See the source of `Rib.Simple.buildAction` for example usage. module Rib.Shake-  (-  -- * Basic helpers-    buildHtmlMulti-  , buildHtml-  -- * Read helpers-  , readPandoc-  , readPandocMulti-  -- * Misc-  , buildStaticFiles-  , Dirs(..)+  ( -- * Basic helpers+    buildHtmlMulti,+    buildHtml,++    -- * Read helpers+    readDocMulti,++    -- * Misc+    buildStaticFiles,+    Dirs (..),   ) where -import Control.Monad-import Control.Monad.IO.Class-import Data.Aeson (FromJSON, ToJSON)-import qualified Data.Aeson as Aeson-import Data.Binary-import Data.Bool-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BSL-import Data.Text (Text)-import qualified Data.Text.Encoding as T-import Data.Typeable-+import Data.Aeson import Development.Shake-import Development.Shake.FilePath-import Development.Shake.Forward (cacheAction) import Lucid (Html) import qualified Lucid-import System.Directory (createDirectoryIfMissing)-import Text.Pandoc (Pandoc (Pandoc), PandocIO, ReaderOptions)--import qualified Rib.Pandoc+import Named+import Path+import Path.IO+import Rib.Document+import Rib.Markup (Markup) -newtype Dirs = Dirs (FilePath, FilePath)+data Dirs = Dirs (Path Rel Dir, Path Rel Dir)+  deriving (Typeable) -getDirs :: Action (FilePath, FilePath)+getDirs :: Action (Path Rel Dir, Path Rel Dir) getDirs = getShakeExtra >>= \case   Just (Dirs d) -> return d   Nothing -> fail "Input output directories are not initialized" -ribInputDir :: Action FilePath+ribInputDir :: Action (Path Rel Dir) ribInputDir = fst <$> getDirs -ribOutputDir :: Action FilePath+ribOutputDir :: Action (Path Rel Dir) ribOutputDir = do   output <- snd <$> getDirs-  liftIO $ createDirectoryIfMissing True output+  liftIO $ createDirIfMissing True output   return output  -- | Shake action to copy static files as is-buildStaticFiles :: [FilePattern] -> Action [FilePath]+buildStaticFiles :: [Path Rel File] -> Action () buildStaticFiles staticFilePatterns = do   input <- ribInputDir   output <- ribOutputDir-  files <- getDirectoryFiles input staticFilePatterns+  files <- getDirectoryFiles' input staticFilePatterns   void $ forP files $ \f ->-    copyFileChanged (input </> f) (output </> f)-  pure files+    copyFileChanged' (input </> f) (output </> f)+  where+    copyFileChanged' old new =+      copyFileChanged (toFilePath old) (toFilePath new)  -- | Convert the given pattern of source files into their HTML.-buildHtmlMulti-  :: (FilePattern, ReaderOptions -> Text -> PandocIO Pandoc)-  -- ^ Source file patterns & their associated Pandoc readers-  -> ((FilePath, Pandoc) -> Html ())-  -- ^ How to render the given Pandoc document to HTML-  -> Action [(FilePath, Pandoc)]-  -- ^ List of relative path to generated HTML and the associated Pandoc document-buildHtmlMulti spec r = do-  xs <- readPandocMulti spec-  void $ forP xs $ \x ->-    buildHtml (fst x -<.> "html") (r x)+buildHtmlMulti ::+  forall repr meta.+  (Markup repr, FromJSON meta) =>+  -- | Source file patterns+  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 --- | Like `readPandoc` but operates on multiple files-readPandocMulti-  :: ( FilePattern-     , ReaderOptions -> Text -> PandocIO Pandoc-     )-     -- ^ Tuple of pattern of files to work on and document format.-  -> Action [(FilePath, Pandoc)]-readPandocMulti (pat, r) = do-  input <- ribInputDir-  fs <- getDirectoryFiles input [pat]-  forP fs $ \f ->-    jsonCacheAction f $ (f, ) <$> readPandoc r f---- | Read and parse a Pandoc source document------ If an associated metadata file exists (same filename, with @.yaml@ as--- extension), use it to specify the metadata of the document.-readPandoc-  :: (ReaderOptions -> Text -> PandocIO Pandoc)-  -- ^ Document format. Example: `Text.Pandoc.Readers.readMarkdown`-  -> FilePath-  -> Action Pandoc-readPandoc r f = do+-- | Like `readDoc'` but operates on multiple files+readDocMulti ::+  forall repr meta.+  (Markup repr, FromJSON meta) =>+  -- | Source file patterns+  Path Rel File ->+  Action [Document repr meta]+readDocMulti pat = do   input <- ribInputDir-  let inp = input </> f-  need [inp]-  content <- T.decodeUtf8 <$> liftIO (BS.readFile inp)-  doc <- liftIO $ Rib.Pandoc.parse r content-  -- FIXME: When _creating_ the yaml file for first time, Shake doesn't know to-  -- rebuild this.-  boolFileExists (inp -<.> "yaml") (pure doc) $-    fmap (overrideMeta doc) . readMeta-  where-    overrideMeta (Pandoc _ bs) meta = Pandoc meta bs-    readMeta mf = do-      need [mf]-      liftIO $ Rib.Pandoc.parseMeta =<< BSL.readFile mf-    -- | Like `bool` but works on file existence value-    ---    -- The second function takes the filepath as value.-    boolFileExists fp missingF existsF =-      doesFileExist fp >>= bool missingF (existsF fp)+  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  -- | Build a single HTML file with the given value-buildHtml :: FilePath -> Html () -> Action ()+buildHtml :: Path Rel File -> Html () -> Action () buildHtml f html = do   output <- ribOutputDir-  let out = output </> f-  writeHtml out html--writeHtml :: MonadIO m => FilePath -> Html () -> m ()-writeHtml f = liftIO . BSL.writeFile f . Lucid.renderBS+  writeHtml (output </> f) html+  where+    writeHtml :: MonadIO m => Path b File -> Html () -> m ()+    writeHtml p htmlVal =+      writeFileLText (toFilePath p) $! Lucid.renderText htmlVal --- | Like `Development.Shake.cacheAction` but uses JSON instance instead of Typeable / Binary on `b`.-jsonCacheAction :: (FromJSON b, Typeable k, Binary k, Show k, ToJSON a) => k -> Action a -> Action b-jsonCacheAction k =-    fmap (either error id . Aeson.eitherDecode)-  . cacheAction k-  . fmap Aeson.encode+-- | Like `getDirectoryFiles` but work with `Path`+getDirectoryFiles' :: Path b Dir -> [Path Rel File] -> Action [Path Rel File]+getDirectoryFiles' dir pat =+  traverse (liftIO . parseRelFile) =<< getDirectoryFiles (toFilePath dir) (toFilePath <$> pat)

@@ -1,50 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}---- | Sensible defaults for writing the most simple static site-module Rib.Simple where--import Control.Monad-import Data.Aeson (FromJSON, ToJSON)-import Data.Maybe (fromMaybe)-import GHC.Generics (Generic)--import Development.Shake (Action)-import Lucid (Html)-import Text.Pandoc (Pandoc, readLaTeX, readMarkdown, readOrg, readRST)--import Rib.Pandoc (getMeta)-import Rib.Shake---- | Type of page to be generated-data Page-  = Page_Index [(FilePath, Pandoc)]-  -- ^ Index page linking to a list of posts-  | Page_Post (FilePath, Pandoc)-  -- ^ Individual post page-  deriving (Generic, Show, FromJSON, ToJSON)---- | Shake build action for the most simple static site------ - Copies @static/@ as is.--- - Builds @*.md@, @*.rst@ and @*.org@ as HTML--- - Builds an @index.html@ of all pages unless `draft` metadata is set to `True`.-buildAction :: (Page -> Html ()) -> Action ()-buildAction renderPage = do-  void $ buildStaticFiles ["static/**"]-  posts <- concat <$> forM pats-    (flip buildHtmlMulti $ renderPage . Page_Post)-  let publicPosts = filter (not . isDraft . snd) posts-  buildHtml "index.html" $-    renderPage $ Page_Index publicPosts-  where-    isDraft = fromMaybe False . getMeta @Bool "draft"-    pats =-      [ ("*.md", readMarkdown)-      , ("*.rst", readRST)-      , ("*.org", readOrg)-      , ("*.tex", readLaTeX)-      ]