rib 0.7.0.0 → 0.8.0.0

raw patch · 14 files changed

+487/−226 lines, 14 filesdep +filepathdep +optparse-applicativedep +timedep ~claydep ~dhalldep ~mmark-extPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath, optparse-applicative, time

Dependency ranges changed: clay, dhall, mmark-ext, pandoc-include-code, pandoc-types

API changes (from Hackage documentation)

Files

• CHANGELOG.md +24/−0
• README.md +73/−102
• rib.cabal +12/−6
• src/Rib/App.hs +111/−64
• src/Rib/Extra/CSS.hs +13/−0
• src/Rib/Extra/OpenGraph.hs +97/−0
• src/Rib/Parser/Dhall.hs +4/−3
• src/Rib/Parser/MMark.hs +20/−5
• src/Rib/Parser/Pandoc.hs +18/−10
• src/Rib/Route.hs +23/−11
• src/Rib/Server.hs +13/−13
• src/Rib/Settings.hs +31/−0
• src/Rib/Shake.hs +4/−12
• src/Rib/Watch.hs +44/−0

@@ -1,5 +1,29 @@ # Change Log for rib +## 0.8.0.0++- Dependency upgrades+  - GHC 8.8+  - pandoc-include-code: 0.5.0.0+  - pandoc-types: 1.20+  - dhall: 1.30+  - clay: 0.13.3 (This is a downgrade, as 0.14 is not released yet)+- New features:+  - API exposes the CLI parser (`optparse-applicative`) for user-level composition+  - Add `Rib.Parser.Pandoc.getToC` returning rendered Table of contents for a Pandoc document+  - Add `Rib.Parser.MMark.getFirstParagraphText`+  - Add `Rib.Extra.OpenGraph` for Open Graph protocol+  - Add to `Rib.Extra.CSS`, `googleFonts` and `stylesheet`+- Bug fixes and misc changes:+  - `routeUrl`: Fix incorrect substitution of "foo-index.html" with "foo-"+  - Lucid rendering functions (like `MMark.render`) are now polymorphic in their monad.+  - #122: Fix Pandoc parser never returning metadata+  - #127: Rib's HTTP server now binds to `127.0.0.1`.+  - Allow directory listings in HTTP server+  - #130: Prevent unnecessary re-running of Shake action by debouncing fsnotify events+  - #136: Move `.shake` database directory under `ribInputDir`+  - default.nix: Takes `overrides` and `additional-packages` as extra arguments+ ## 0.7.0.0  - Dependency upgrades

@@ -4,16 +4,16 @@  [![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)+[![built with nix](https://img.shields.io/badge/builtwith-nix-purple.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 **static site generator** that aims to reuse existing libraries instead of reinventing the wheel. -How does it compare to Hakyll?+How does it compare to the popular static site generator Hakyll?  - 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))+- Write HTML ([Lucid](https://chrisdone.com/posts/lucid2/)) & CSS ([Clay](http://fvisser.nl/clay/)) in Haskell.+- Built-in support for [Pandoc](https://pandoc.org/) and [MMark](https://github.com/mmark-md/mmark). - Remain as simple as possible to use (see example below) - Nix-based environment for reproducibility - `ghcid` and fsnotify for "hot reload"@@ -24,16 +24,15 @@  **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](#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 @@ -44,15 +43,10 @@ -- | Route corresponding to each generated static page. -- -- The `a` parameter specifies the data (typically Markdown document) used to--- generated the final page text.+-- generate the final page text. data Route a where-  Route_Index :: Route ()-  Route_Article :: ArticleRoute a -> Route a---- | You may even have sub routes.-data ArticleRoute a where-  ArticleRoute_Index :: ArticleRoute [(Route MMark, MMark)]-  ArticleRoute_Article :: Path Rel File -> ArticleRoute MMark+  Route_Index :: Route [(Route Pandoc, Pandoc)]+  Route_Article :: Path Rel File -> Route Pandoc  -- | The `IsRoute` instance allows us to determine the target .html path for -- each route. This affects what `routeUrl` will return.@@ -60,19 +54,9 @@   routeFile = \case     Route_Index ->       pure [relfile|index.html|]-    Route_Article r ->-      fmap ([reldir|article|] </>) $ case r of-        ArticleRoute_Article srcPath ->-          replaceExtension ".html" srcPath-        ArticleRoute_Index ->-          pure [relfile|index.html|]---- | The "Config" type generated from the Dhall type.------ Use `Rib.Parser.Dhall` to parse it (see below).-makeHaskellTypes-  [ SingleConstructor "Config" "Config" "./src-dhall/Config.dhall"-  ]+    Route_Article srcPath ->+      fmap ([reldir|article|] </>) $+        replaceExtension ".html" srcPath  -- | Main entry point to our generator. --@@ -85,69 +69,58 @@ -- In the shake 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|content|] [reldir|dest|] generateSite+main = withUtf8 $ do+  Rib.run [reldir|content|] [reldir|dest|] generateSite  -- | Shake action for generating the static site generateSite :: Action () generateSite = do   -- Copy over the static files   Rib.buildStaticFiles [[relfile|static/**|]]-  -- Read the site config-  config :: Config <--    Dhall.parse-      [[relfile|src-dhall/Config.dhall|]]-      [relfile|config.dhall|]   let writeHtmlRoute :: Route a -> a -> Action ()-      writeHtmlRoute r = writeRoute r . Lucid.renderText . renderPage config r+      writeHtmlRoute r = Rib.writeRoute r . Lucid.renderText . renderPage r   -- Build individual sources, generating .html for each.   articles <-     Rib.forEvery [[relfile|*.md|]] $ \srcPath -> do-      let r = Route_Article $ ArticleRoute_Article srcPath-      doc <- MMark.parse srcPath+      let r = Route_Article srcPath+      doc <- Pandoc.parse Pandoc.readMarkdown srcPath       writeHtmlRoute r doc       pure (r, doc)-  writeHtmlRoute (Route_Article ArticleRoute_Index) articles-  writeHtmlRoute Route_Index ()+  writeHtmlRoute Route_Index articles  -- | Define your site HTML here-renderPage :: Config -> Route a -> a -> Html ()-renderPage config route val = with html_ [lang_ "en"] $ do+renderPage :: Route a -> a -> Html ()+renderPage route val = html_ [lang_ "en"] $ do   head_ $ do     meta_ [httpEquiv_ "Content-Type", content_ "text/html; charset=utf-8"]-    title_ $ routeTitle+    title_ routeTitle     style_ [type_ "text/css"] $ C.render pageStyle   body_ $ do-    with div_ [id_ "thesite"] $ do-      with div_ [class_ "header"] $-        with a_ [href_ "/"] "Back to Home"-      h1_ routeTitle-      case route of-        Route_Index ->-          p_ $ do-            "This site is work in progress. Meanwhile visit the "-            with a_ [href_ $ routeUrl $ Route_Article ArticleRoute_Index] "articles"-            " page."-        Route_Article ArticleRoute_Index ->-          div_ $ forM_ val $ \(r, src) ->-            with li_ [class_ "pages"] $ do-              let meta = getMeta src-              b_ $ with a_ [href_ (Rib.routeUrl r)] $ toHtml $ title meta-              maybe mempty renderMarkdown $ description meta-        Route_Article (ArticleRoute_Article _) ->-          with article_ [class_ "post"] $ do-            MMark.render val+    div_ [class_ "header"] $+      a_ [href_ "/"] "Back to Home"+    h1_ routeTitle+    case route of+      Route_Index ->+        div_ $ forM_ val $ \(r, src) ->+          li_ [class_ "pages"] $ do+            let meta = getMeta src+            b_ $ a_ [href_ (Rib.routeUrl r)] $ toHtml $ title meta+            renderMarkdown `mapM_` description meta+      Route_Article _ ->+        article_ $+          Pandoc.render val   where     routeTitle :: Html ()     routeTitle = case route of-      Route_Index -> toHtml $ siteTitle config-      Route_Article (ArticleRoute_Article _) -> toHtml $ title $ getMeta val-      Route_Article ArticleRoute_Index -> "Articles"+      Route_Index -> "Rib sample site"+      Route_Article _ -> toHtml $ title $ getMeta val+    renderMarkdown :: Text -> Html ()     renderMarkdown =-      MMark.render . either (error . T.unpack) id . MMark.parsePure "<none>"+      Pandoc.render . Pandoc.parsePure Pandoc.readMarkdown  -- | Define your site CSS here pageStyle :: Css-pageStyle = "div#thesite" ? do+pageStyle = C.body ? do   C.margin (em 4) (pc 20) (em 1) (pc 20)   ".header" ? do     C.marginBottom $ em 2@@ -165,14 +138,6 @@         description :: Maybe Text       }   deriving (Show, Eq, Generic, FromJSON)---- | Get metadata from Markdown's YAML block-getMeta :: MMark -> SrcMeta-getMeta src = case MMark.projectYaml src of-  Nothing -> error "No YAML metadata"-  Just val -> case fromJSON val of-    Aeson.Error e -> error $ "JSON error: " <> e-    Aeson.Success v -> v ```  (View full [`Main.hs`](https://github.com/srid/rib-sample/blob/master/src/Main.hs) at rib-sample)@@ -194,37 +159,37 @@ ... $ cd mysite $ ls -F-a/  default.nix  Main.hs  README.md  rib-sample.cabal+content/  default.nix  Main.hs  README.md  rib-sample.cabal ```  The three key items here are:  1. `Main.hs`: Haskell source containing the DSL of the HTML/CSS of your site.-1. `a/`: The source content (eg: Markdown sources and static files)-1. `b/`: The target directory, excluded from the git repository, will contain+1. `content/`: The source content (eg: Markdown sources and static files)+1. `dest/`: The target directory, excluded from the git repository, will contain    _generated_ content (i.e., the HTML files, and copied over static content)    -The template repository comes with a few sample posts under `a/`, and a basic+The template repository comes with a few sample posts under `content/`, and a basic HTML layout and CSS style defined in `Main.hs`.   ### Run the site  Now let's run them all.  -Clone the sample repository locally, install [Nix](https://nixos.org/nix/) and-run your site as follows:+Clone the sample repository locally, install [Nix](https://nixos.org/nix/) (as+described in its README) and run your site as follows:  ```shell-nix-shell --run 'ghcid -T main'+nix-shell --run 'ghcid -T ":main serve"' ``` -(Note even though the author recommends it Nix is strictly not required; you may-simply run `ghcid -T main` instead of the above command if you do not wish to+(Note that even though the author recommends it Nix is strictly not required; you may+simply run `ghcid -T ":main serve"` instead of the above command if you do not wish to use Nix.) -Running this command gives you a local HTTP server at http://localhost:8080/+Running this command gives you a local HTTP server at http://127.0.0.1:8080 (serving the generated files) that automatically reloads when either the content-(`a/`) or the HTML/CSS/build-actions (`Main.hs`) changes. Hot reload, in other+(`content/`) or the HTML/CSS/build-actions (`Main.hs`) changes. Hot reload, in other words.  ### How Rib works@@ -238,28 +203,27 @@ 1. [`ghcid`](https://github.com/ndmitchell/ghcid) will compile your `Main.hs`    and run its `main` function. -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. `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-   `a/` directory for changes, starting HTTP server for the `b/` directory. By-   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.+   `content/` directory for changes, starting HTTP server for the `dest/` directory.+   The "serve" subcommand will run the Shake build action passed as argument on +   every file change and spin up a HTTP server.    -Run that command, and visit http://localhost:8080 to view your site.+Run that command, and visit http://127.0.0.1:8080 to view your site.  ### Editing workflow -Now try making some changes to the content, say `a/first-post.md`. You should+Now try making some changes to the content, say `content/first-post.md`. You should see it reflected when you refresh the page. Or change the HTML or CSS of your site in `Main.hs`; this will trigger `ghcid` to rebuild the Haskell source and restart the server.  ### What's next? -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` to make this easier. +Great, by now you should have your static site generator ready and running!   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)@@ -269,5 +233,12 @@  * [rib-sample](https://github.com/srid/rib-sample): Use this to get started with   your own site.+  +* [zulip-archive](https://github.com/srid/zulip-archive): Zulip chat archive viewer ([running here](https://funprog.srid.ca/)). -* Author's own website. Live at https://www.srid.ca/ +* [open-editions.org](https://github.com/open-editions/open-editions.org) ([running here](https://open-editions.org/)).++* Rib powers the Zettelkasten system [neuron](https://github.com/srid/neuron#neuron)+  * Example: [www.srid.ca](https://www.srid.ca/)+  * Example: [neuron.srid.ca](https://neuron.srid.ca/)+  * Example: [haskell.srid.ca](https://haskell.srid.ca/)

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: rib-version: 0.7.0.0+version: 0.8.0.0 license: BSD-3-Clause copyright: 2019 Sridhar Ratnakumar maintainer: srid@srid.ca@@ -25,12 +25,15 @@     exposed-modules:         Rib         Rib.App+        Rib.Watch         Rib.Parser.Dhall         Rib.Parser.MMark         Rib.Parser.Pandoc         Rib.Route         Rib.Shake+        Rib.Settings         Rib.Extra.CSS+        Rib.Extra.OpenGraph     other-modules:         Rib.Server     hs-source-dirs: src@@ -45,29 +48,32 @@         async,         base-noprelude >=4.7 && <5,         binary >=0.8.6 && <0.9,-        clay >=0.14 && <0.15,+        clay >=0.13.3,         cmdargs >=0.10.20 && <0.11,         containers >=0.6.0 && <0.7,-        dhall,+        dhall >= 1.30 && <1.31,         directory >= 1.0 && <2.0,         exceptions,         foldl,         fsnotify >=0.3.0 && <0.4,+        filepath,         lucid >=2.9.11 && <2.10,         megaparsec >= 8.0,         mmark >= 0.0.7.2,-        mmark-ext,+        mmark-ext >= 0.2.1.0,         modern-uri,         mtl >=2.2.2 && <2.3,+        optparse-applicative >= 0.15,         pandoc >=2.7 && <3,-        pandoc-include-code >=1.4.0 && <1.5,-        pandoc-types >=1.17.5 && <1.18,+        pandoc-include-code >=1.5 && <1.6,+        pandoc-types >=1.20,         path >= 0.7.0,         path-io >= 1.6.0,         relude >= 0.6 && < 0.7,         safe-exceptions,         shake >= 0.18.5,         text >=1.2.3 && <1.3,+        time >= 1.9,         wai >=3.2.2 && <3.3,         wai-app-static >=3.1.6 && <3.2,         warp

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}@@ -8,7 +8,8 @@ -- -- Mostly you would only need `Rib.App.run`, passing it your Shake build action. module Rib.App-  ( App (..),+  ( Command (..),+    commandParser,     run,     runWith,   )@@ -16,29 +17,31 @@  import Control.Concurrent (threadDelay) import Control.Concurrent.Async (race_)-import Control.Concurrent.Chan import Control.Exception.Safe (catch)-import Development.Shake+import Development.Shake hiding (command) import Development.Shake.Forward (shakeForward)+import Options.Applicative import Path+import Path.IO import Relude import qualified Rib.Server as Server-import Rib.Shake (RibSettings (..))-import System.Console.CmdArgs-import System.FSNotify (watchTreeChan, withManager)+import Rib.Settings (RibSettings (..))+import Rib.Watch (onTreeChange)+import System.FSNotify (Event (..), eventIsDirectory, eventPath) import System.IO (BufferMode (LineBuffering), hSetBuffering) --- | Application modes------ The mode in which to run the Rib CLI-data App-  = -- | Generate static files once.+-- | Rib CLI commands+data Command+  = -- Run an one-off generation with silent logging+    -- TODO: Eventually replace this with proper logging mechanism.+    OneOff+  | -- | Generate the site 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+    Watch   | -- | Run a HTTP server serving content from the output directory     Serve       { -- | Port to bind the server@@ -46,8 +49,27 @@         -- | Unless set run `WatchAndGenerate` automatically         dontWatch :: Bool       }-  deriving (Data, Typeable, Show, Eq)+  deriving (Show, Eq, Generic) +-- | Commandline parser `Parser` for the Rib CLI+commandParser :: Parser Command+commandParser =+  hsubparser $+    mconcat+      [ command "generate" $ info generateCommand $ progDesc "Run one-off generation of static files",+        command "watch" $ info watchCommand $ progDesc "Watch the source directory, and generate when it changes",+        command "serve" $ info serveCommand $ progDesc "Like watch, but also starts a HTTP server"+      ]+  where+    generateCommand =+      Generate <$> switch (long "full" <> help "Do a full generation (toggles shakeRebuild)")+    watchCommand =+      pure Watch+    serveCommand =+      Serve+        <$> option auto (long "port" <> short 'p' <> help "HTTP server port" <> showDefault <> value 8080 <> metavar "PORT")+        <*> switch (long "no-watch" <> help "Serve only; don't watch and regenerate")+ -- | Run Rib using arguments passed in the command line. run ::   -- | Directory from which source content will be read.@@ -58,78 +80,103 @@   -- | Shake build rules for building the static site   Action () ->   IO ()-run src dst buildAction = runWith src dst buildAction =<< cmdArgs ribCli+run src dst buildAction = runWith src dst buildAction =<< execParser opts   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-            { full = False &= help "Force a full generation of all files"-            }-            &= help "Generate the site"-        ]+    opts =+      info+        (commandParser <**> helper)+        ( fullDesc+            <> progDesc "Rib static site generator CLI"+        ) --- | Like `run` but with an explicitly passed `App` mode-runWith :: Path Rel Dir -> Path Rel Dir -> Action () -> App -> IO ()-runWith src dst buildAction app = do+-- | Like `run` but with an explicitly passed `Command`+runWith :: Path Rel Dir -> Path Rel Dir -> Action () -> Command -> IO ()+runWith src dst buildAction ribCmd = do   when (src == currentRelDir) $     -- Because otherwise our use of `watchTree` can interfere with Shake's file     -- scaning.     fail "cannot use '.' as source directory."   -- For saner output-  hSetBuffering stdout LineBuffering-  case app of-    Generate fullGen ->+  flip hSetBuffering LineBuffering `mapM_` [stdout, stderr]+  let ribSettings =+        case ribCmd of+          OneOff ->+            RibSettings src dst Silent False+          Generate fullGen ->+            RibSettings src dst Verbose fullGen+          _ ->+            RibSettings src dst Verbose False+  case ribCmd of+    OneOff ->+      runShake ribSettings buildAction+    Generate _ ->       -- FIXME: Shouldn't `catch` Shake exceptions when invoked without fsnotify.-      runShake fullGen-    WatchAndGenerate ->-      runShakeAndObserve+      runShakeBuild ribSettings+    Watch ->+      runShakeAndObserve ribSettings     Serve p dw -> do       race_ (Server.serve p $ toFilePath dst) $ do         if dw           then threadDelay maxBound-          else runShakeAndObserve+          else runShakeAndObserve ribSettings   where     currentRelDir = [reldir|.|]-    runShakeAndObserve = do+    -- Keep shake database directory under the src directory instead of the+    -- (default) current working directory, which may not always be a project+    -- root (as in the case of neuron).+    shakeDatabaseDir :: Path Rel Dir = src </> [reldir|.shake|]+    runShakeAndObserve ribSettings = do       -- Begin with a *full* generation as the HTML layout may have been changed.       -- 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+      runShakeBuild $ ribSettings {_ribSettings_fullGen = True}       -- And then every time a file changes under the current directory-      onTreeChange src $-        runShake False-    runShake fullGen = do-      putStrLn $ "[Rib] Generating " <> toFilePath src <> " (full=" <> show 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 :: ShakeException) ->-          putStrLn $-            "[Rib] Unhandled exception when building " <> shakeExceptionTarget e <> ": " <> show e-    ribShakeOptions fullGen =+      putStrLn $ "[Rib] Watching " <> toFilePath src <> " for changes"+      onSrcChange $ runShakeBuild ribSettings+    runShakeBuild ribSettings = do+      runShake ribSettings $ do+        putInfo $ "[Rib] Generating " <> toFilePath src <> " (full=" <> show (_ribSettings_fullGen ribSettings) <> ")"+        buildAction+    runShake ribSettings shakeAction = do+      shakeForward (shakeOptionsFrom ribSettings) shakeAction+        `catch` handleShakeException+    handleShakeException (e :: ShakeException) =+      -- Gracefully handle any exceptions when running Shake actions. We want+      -- Rib to keep running instead of crashing abruptly.+      putStrLn $+        "[Rib] Unhandled exception when building " <> shakeExceptionTarget e <> ": " <> show e+    shakeOptionsFrom settings =       shakeOptions-        { shakeVerbosity = Verbose,-          shakeRebuild = bool [] [(RebuildNow, "**")] fullGen,+        { shakeVerbosity = _ribSettings_verbosity settings,+          shakeFiles = toFilePath shakeDatabaseDir,+          shakeRebuild = bool [] [(RebuildNow, "**")] (_ribSettings_fullGen settings),           shakeLintInside = [""],-          shakeExtra = addShakeExtra (RibSettings src dst) (shakeExtra shakeOptions)+          shakeExtra = addShakeExtra settings (shakeExtra shakeOptions)         }-    onTreeChange fp f = do-      putStrLn $ "[Rib] Watching " <> toFilePath src <> " for changes"-      withManager $ \mgr -> do-        events <- newChan-        void $ watchTreeChan mgr (toFilePath fp) (const True) events-        forever $ do-          -- TODO: debounce-          void $ readChan events+    onSrcChange f = do+      workDir <- getCurrentDir+      -- Top-level directories to ignore from notifications+      dirBlacklist <- traverse makeAbsolute [shakeDatabaseDir, src </> [reldir|.git|]]+      let isBlacklisted :: FilePath -> Bool+          isBlacklisted p = or $ flip fmap dirBlacklist $ \b -> toFilePath b `isPrefixOf` p+      onTreeChange src $ \allEvents -> do+        let events = filter (not . isBlacklisted . eventPath) allEvents+        unless (null events) $ do+          -- Log the changed events for diagnosis.+          logEvent workDir `mapM_` events           f+    logEvent workDir e = do+      eventRelPath <-+        if eventIsDirectory e+          then fmap toFilePath . makeRelative workDir =<< parseAbsDir (eventPath e)+          else fmap toFilePath . makeRelative workDir =<< parseAbsFile (eventPath e)+      putStrLn $ eventLogPrefix e <> " " <> eventRelPath+    eventLogPrefix = \case+      -- Single character log prefix to indicate file actions is a convention in Rib.+      Added _ _ _ -> "A"+      Modified _ _ _ -> "M"+      Removed _ _ _ -> "D"+      Unknown _ _ _ -> "?"

@@ -5,6 +5,8 @@ module Rib.Extra.CSS where  import Clay+import qualified Data.Text as T+import Lucid import Relude  -- | Stock CSS for the <kbd> element@@ -25,3 +27,14 @@   fontWeight $ weight 700   lineHeight $ px 1   whiteSpace nowrap++-- | Include the specified Google Fonts+googleFonts :: Monad m => [Text] -> HtmlT m ()+googleFonts fs =+  let fsEncoded = T.intercalate "|" $ T.replace " " "+" <$> fs+      fsUrl = "https://fonts.googleapis.com/css?family=" <> fsEncoded <> "&display=swap"+   in stylesheet fsUrl++-- | Include the specified stylesheet URL+stylesheet :: Monad m => Text -> HtmlT m ()+stylesheet x = link_ [rel_ "stylesheet", href_ x]

@@ -0,0 +1,97 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Meta tags for The Open Graph protocol: https://ogp.me/+module Rib.Extra.OpenGraph+  ( OpenGraph (..),+    OGType (..),+    Article (..),+  )+where++import Data.Time (UTCTime)+import Data.Time.Format.ISO8601 (formatShow, iso8601Format)+import Lucid+import Lucid.Base (makeAttribute)+import Relude+import qualified Text.URI as URI++-- The OpenGraph metadata+--+-- This type can be directly rendered to HTML using `toHTML`.+data OpenGraph+  = OpenGraph+      { _openGraph_title :: Text,+        _openGraph_url :: Maybe URI.URI,+        _openGraph_author :: Maybe Text,+        _openGraph_description :: Maybe Text,+        _openGraph_siteName :: Text,+        _openGraph_type :: Maybe OGType,+        _openGraph_image :: Maybe URI.URI+      }+  deriving (Eq, Show)++instance ToHtml OpenGraph where+  toHtmlRaw = toHtml+  toHtml OpenGraph {..} = do+    meta' "author" `mapM_` _openGraph_author+    meta' "description" `mapM_` _openGraph_description+    requireAbsolute "OGP URL" (\uri -> link_ [rel_ "canonical", href_ uri]) `mapM_` _openGraph_url+    metaOg "title" _openGraph_title+    metaOg "site_name" _openGraph_siteName+    toHtml `mapM_` _openGraph_type+    requireAbsolute "OGP image URL" (metaOg "image") `mapM_` _openGraph_image+    where+      meta' k v = meta_ [name_ k, content_ v]+      requireAbsolute description f uri =+        if isJust (URI.uriScheme uri)+          then f $ URI.render uri+          else error $ description <> " must be absolute. this URI is not: " <> URI.render uri++-- TODO: Remaining ADT values & sub-fields+data OGType+  = OGType_Article Article+  | OGType_Website+  deriving (Eq, Show)++instance ToHtml OGType where+  toHtmlRaw = toHtml+  toHtml = \case+    OGType_Article article -> do+      metaOg "type" "article"+      toHtml article+    OGType_Website -> do+      metaOg "type" "website"++-- TODO: _article_profile :: [Profile]+data Article+  = Article+      { _article_section :: Maybe Text,+        _article_modifiedTime :: Maybe UTCTime,+        _article_publishedTime :: Maybe UTCTime,+        _article_expirationTime :: Maybe UTCTime,+        _article_tag :: [Text]+      }+  deriving (Eq, Show)++instance ToHtml Article where+  toHtmlRaw = toHtml+  toHtml Article {..} = do+    metaOg "article:section" `mapM_` _article_section+    metaOgTime "article:modified_time" `mapM_` _article_modifiedTime+    metaOgTime "article:published_time" `mapM_` _article_publishedTime+    metaOgTime "article:expiration_time" `mapM_` _article_expirationTime+    metaOg "article:tag" `mapM_` _article_tag+    where+      metaOgTime k t =+        metaOg k $ toText $ formatShow iso8601Format t++-- Open graph meta element+metaOg :: Applicative m => Text -> Text -> HtmlT m ()+metaOg k v =+  meta_+    [ makeAttribute "property" $ "og:" <> k,+      content_ v+    ]

@@ -3,7 +3,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} --- | Parser for Dhall files.+-- | Parser for Dhall configuration files.+--+-- Use `Dhall.TH.makeHaskellTypes` to create the Haskell type first. And then+-- call `parse` from your Shake action. module Rib.Parser.Dhall   ( -- * Parsing     parse,@@ -18,8 +21,6 @@ import System.Directory  -- | Parse a Dhall file as Haskell type.------ Use `Dhall.TH.makeHaskellTypes` to create the Haskell type first. parse ::   FromDhall a =>   -- | Dependent .dhall files, which must trigger a rebuild

@@ -23,6 +23,7 @@      -- * Extracting information     getFirstImg,+    getFirstParagraphText,     projectYaml,      -- * Re-exports@@ -31,9 +32,8 @@ where  import Control.Foldl (Fold (..))-import Development.Shake (readFile')-import Development.Shake-import Lucid (Html)+import Development.Shake (Action, readFile')+import Lucid.Base (HtmlT (..)) import Path import Relude import Rib.Shake (ribInputDir)@@ -45,8 +45,11 @@ import Text.URI (URI)  -- | Render a MMark document as HTML-render :: MMark -> Html ()-render = MMark.render+render :: Monad m => MMark -> HtmlT m ()+render = liftHtml . MMark.render+  where+    liftHtml :: Monad m => HtmlT Identity () -> HtmlT m ()+    liftHtml = HtmlT . pure . runIdentity . runHtmlT  -- | Like `parsePure` but takes a custom list of MMark extensions parsePureWith ::@@ -94,6 +97,18 @@       Ext.Naked xs -> toList xs       Ext.Paragraph xs -> toList xs       _ -> []++-- | Get the first paragraph text of a MMark document.+--+-- Useful to determine "preview" of your notes.+getFirstParagraphText :: MMark -> Maybe Text+getFirstParagraphText =+  flip MMark.runScanner $ Fold f Nothing id+  where+    f acc blk = acc <|> (Ext.asPlainText <$> getPara blk)+    getPara = \case+      Ext.Paragraph xs -> Just xs+      _ -> Nothing  defaultExts :: [MMark.Extension] defaultExts =

@@ -19,6 +19,7 @@     -- * Extracting information     extractMeta,     getH1,+    getToC,     getFirstImg,      -- * Re-exports@@ -30,7 +31,7 @@ import Control.Monad.Except (MonadError, liftEither, runExcept) import Data.Aeson import Development.Shake (Action, readFile')-import Lucid (Html, toHtmlRaw)+import Lucid (HtmlT, toHtmlRaw) import Path import Relude import Rib.Shake (ribInputDir)@@ -38,6 +39,7 @@ import Text.Pandoc.Filter.IncludeCode (includeCode) import qualified Text.Pandoc.Readers import Text.Pandoc.Walk (query, walkM)+import Text.Pandoc.Writers.Shared (toTableOfContents)  -- | Pure version of `parse` parsePure ::@@ -65,7 +67,7 @@     includeSources = includeCode $ Just $ Format "html5"  -- | Render a Pandoc document to HTML-render :: Pandoc -> Html ()+render :: Monad m => Pandoc -> HtmlT m () render doc =   either error id $ first show $ runExcept $ do     runPure'@@ -85,20 +87,26 @@ -- | 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 :: Monad m => [Inline] -> HtmlT m () renderPandocInlines =-  toHtmlRaw-    . render-    . Pandoc mempty-    . pure-    . Plain+  renderPandocBlocks . pure . Plain +renderPandocBlocks :: Monad m => [Block] -> HtmlT m ()+renderPandocBlocks =+  toHtmlRaw . render . Pandoc mempty+ -- | Get the top-level heading as Lucid HTML-getH1 :: Pandoc -> Maybe (Html ())+getH1 :: Monad m => Pandoc -> Maybe (HtmlT m ()) getH1 (Pandoc _ bs) = fmap renderPandocInlines $ flip query bs $ \case   Header 1 _ xs -> Just xs   _ -> Nothing +-- | Get the document table of contents+getToC :: Monad m => Pandoc -> HtmlT m ()+getToC (Pandoc _ bs) = renderPandocBlocks [toc]+  where+    toc = toTableOfContents writerSettings bs+ -- | Get the first image in the document if one exists getFirstImg ::   Pandoc ->@@ -132,7 +140,7 @@ -- -- 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+flattenMeta (Meta meta) = fmap toJSON . traverse go <$> guarded (not . null) meta   where     go :: MetaValue -> Either Text Value     go (MetaMap m) = toJSON <$> traverse go m

@@ -1,33 +1,37 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} --- | Type-safe routes+-- | Type-safe routes for static sites. module Rib.Route-  ( IsRoute (..),+  ( -- * Defining routes+    IsRoute (..),++    -- * Rendering routes     routeUrl,     routeUrlRel,++    -- * Writing routes     writeRoute,   ) where  import Control.Monad.Catch import Data.Kind-import Data.Text (Text) import qualified Data.Text as T-import Development.Shake (Action, liftIO)+import Development.Shake (Action) import Path import Relude import Rib.Shake (writeFileCached) --- | A route is a GADT representing individual routes.+-- | A route is a GADT which represents the individual routes in a static site. ----- The GADT type parameter represents the data used to render that particular route.+-- `r` represents the data used to render that particular route. class IsRoute (r :: Type -> Type) where-  -- | Return the filepath (relative `Rib.Shake.ribInputDir`) where the+  -- | Return the filepath (relative to `Rib.Shake.ribInputDir`) where the   -- generated content for this route should be written.   routeFile :: MonadThrow m => r a -> m (Path Rel File) @@ -53,11 +57,19 @@ routeUrl' urlType = stripIndexHtml . flip path2Url urlType . either (error . toText . displayException) id . routeFile   where     stripIndexHtml s =-      if T.isSuffixOf "index.html" s-        then T.dropEnd (T.length $ "index.html") s-        else s+      -- Because path2Url can return relative URL, we must account for there+      -- not being a / at the beginning.+      if  | "/index.html" `T.isSuffixOf` s ->+            T.dropEnd (T.length "index.html") s+          | s == "index.html" ->+            "."+          | otherwise ->+            s  -- | Write the content `s` to the file corresponding to the given route.+--+-- This is similar to `Rib.Shake.writeFileCached`, but takes a route instead of+-- a filepath as its argument. writeRoute :: (IsRoute r, ToString s) => r a -> s -> Action () writeRoute r content = do   fp <- liftIO $ routeFile r

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}  -- | Serve generated static files with HTTP module Rib.Server@@ -6,21 +7,13 @@   ) where -import Network.Wai.Application.Static (defaultFileServerSettings, ssListing, staticApp)+import Network.Wai.Application.Static (defaultFileServerSettings, 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 =-  defaultSettings-    { ssListing = Nothing -- Disable directory listings-    }-  where-    defaultSettings = defaultFileServerSettings root- -- | Run a HTTP server to serve a directory of static files+--+-- Binds the server to host 127.0.0.1. serve ::   -- | Port number to bind to   Int ->@@ -28,5 +21,12 @@   FilePath ->   IO () serve port path = do-  putStrLn $ "[Rib] Serving at http://localhost:" <> show port-  Warp.run port $ staticApp $ staticSiteServerSettings path+  putStrLn $ "[Rib] Serving " <> path <> " at http://" <> host <> ":" <> show port+  Warp.runSettings settings app+  where+    app = staticApp $ defaultFileServerSettings path+    host = "127.0.0.1"+    settings =+      Warp.setHost (fromString host)+        $ Warp.setPort port+        $ Warp.defaultSettings

@@ -0,0 +1,31 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++module Rib.Settings+  ( RibSettings (..),+  )+where++import Development.Shake (Verbosity)+import Path+import Relude++-- | The settings with which Rib is run+--+-- RibSettings is initialized with the values passed to `Rib.App.run`+data RibSettings+  = RibSettings+      { _ribSettings_inputDir :: Path Rel Dir,+        _ribSettings_outputDir :: Path Rel Dir,+        -- | Shake verbosity level+        _ribSettings_verbosity :: Verbosity,+        -- | Whether we must try to generate all files even if they have not+        -- been modified since last generation.+        _ribSettings_fullGen :: Bool+      }+  deriving (Typeable)

@@ -16,7 +16,6 @@     writeFileCached,      -- * Misc-    RibSettings (..),     ribInputDir,     ribOutputDir,     getDirectoryFiles',@@ -27,14 +26,7 @@ import Path import Path.IO import Relude---- | 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)+import Rib.Settings  -- | Get rib settings from a shake Action monad. ribSettings :: Action RibSettings@@ -48,7 +40,7 @@ ribInputDir :: Action (Path Rel Dir) ribInputDir = _ribSettings_inputDir <$> ribSettings --- Output directory containing generated files+-- | Output directory where files are generated -- -- This is same as the second argument to `Rib.App.run` ribOutputDir :: Action (Path Rel Dir)@@ -80,7 +72,7 @@   fs <- getDirectoryFiles' input pats   forP fs f --- | Write the given file unless it has not changed.+-- | Write the given file but only when it has been modified. -- -- Also, always writes under ribOutputDir writeFileCached :: Path Rel File -> String -> Action ()@@ -94,6 +86,6 @@     putInfo $ "+ " <> f  -- | Like `getDirectoryFiles` but works with `Path`-getDirectoryFiles' :: Path b Dir -> [Path Rel File] -> Action [Path Rel File]+getDirectoryFiles' :: Typeable b => Path b Dir -> [Path Rel File] -> Action [Path Rel File] getDirectoryFiles' (toFilePath -> dir) (fmap toFilePath -> pat) =   traverse (liftIO . parseRelFile) =<< getDirectoryFiles dir pat

@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Filesystem watching using fsnotify+module Rib.Watch+  ( onTreeChange,+  )+where++import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (race)+import Control.Concurrent.Chan+import Path+import Relude+import System.FSNotify (Event (..), watchTreeChan, withManager)++-- | Recursively monitor the contents of the given path and invoke the given IO+-- action for every event triggered.+--+-- If multiple events fire rapidly, the IO action is invoked only once, taking+-- those multiple events as its argument.+onTreeChange :: Path b t -> ([Event] -> IO ()) -> IO ()+onTreeChange fp f = do+  withManager $ \mgr -> do+    eventCh <- newChan+    void $ watchTreeChan mgr (toFilePath fp) (const True) eventCh+    forever $ do+      firstEvent <- readChan eventCh+      events <- debounce 100 [firstEvent] $ readChan eventCh+      f events++debounce :: Int -> [event] -> IO event -> IO [event]+debounce millies events f = do+  -- Race the readEvent against the timelimit.+  race f (threadDelay (1000 * millies)) >>= \case+    Left event ->+      -- If the read event finishes first try again.+      debounce millies (events <> [event]) f+    Right () ->+      -- Otherwise continue+      return events