packages feed

rib 0.6.0.0 → 0.7.0.0

raw patch · 12 files changed

+401/−284 lines, 12 filesdep +dhalldep +safe-exceptionsdep ~claydep ~megaparsecdep ~mmark

Dependencies added: dhall, safe-exceptions

Dependency ranges changed: clay, megaparsec, mmark, path-io, shake

Files

CHANGELOG.md view
@@ -1,5 +1,30 @@ # Change Log for rib +## 0.7.0.0++- Dependency upgrades+  - mmark: 0.0.7.2+  - megaparsec: 0.8+  - clay: 0.14+  - shake: 0.8.15+- New features:+  - Added Dhall parser, `Rib.Parser.Dhall`+  - Add `Rib.Extra` containing useful but non-essential features+- MMark, extensions removed:+  - `ghcSyntaxHighlighter`: we already have `skylighting` (which supports more parsers than Haskell)+  - `obfuscateEmail`: requires JS, which is not documented.+- API changes:+  - Introduced `Route` functionality for simpler management of static routes.+    - Removed `buildHtmlMulti`, `buildHtml`, `readSource` functions and `Source` type.+  - Introduced `Rib.Shake.forEvery` to run a Shake action over a pattern of files when they change.+  - Exposed `Rib.Shake.writeFileCached`+  - `MMark.parse` and `Pandoc.parse` now automatically append path to `ribInputDir` and do not return Either.+  - Added `MMark.parseWith` (and `parsePureWith`), to specify a custom list of mmark extensions+- Bug fixes+  - #95: Fix Shake error `resource busy (file is locked)`+  - #97: Fix Shake error `AsyncCancelled` when server thread crashes+  - #96 & #108: Drop problematic use of Shake `cacheActionWith`+ ## 0.6.0.0  - Advance nixpkgs; require Shake >=0.18.4
README.md view
@@ -7,7 +7,7 @@ [![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**.+Rib is a Haskell **static site generator** that aims to reuse existing libraries instead of reinventing the wheel.  How does it compare to Hakyll? @@ -40,97 +40,142 @@ Here is how your code may look like if you were to generate your static site using Rib: -``` haskell--- | A generated page corresponds to either an index of sources, or an--- individual source.+```haskell+-- | Route corresponding to each generated static page. ----- 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 [Source M.MMark]-  | Page_Single (Source M.MMark)+-- The `a` parameter specifies the data (typically Markdown document) used to+-- generated the final page text.+data Route a where+  Route_Index :: Route ()+  Route_Article :: ArticleRoute a -> Route a --- | 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)+-- | You may even have sub routes.+data ArticleRoute a where+  ArticleRoute_Index :: ArticleRoute [(Route MMark, MMark)]+  ArticleRoute_Article :: Path Rel File -> ArticleRoute MMark +-- | The `IsRoute` instance allows us to determine the target .html path for+-- each route. This affects what `routeUrl` will return.+instance IsRoute Route where+  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"+  ]+ -- | 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.+-- 1. Directory `content`, from which static files will be read.+-- 2. Directory `dest`, under which target files will be generated.+-- 3. Shake action to run. ----- In the shake build action you would expect to use the utility functions+-- 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|a|] [reldir|b|] generateSite+main = 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+  -- 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+      writeHtmlRoute r doc+      pure (r, doc)+  writeHtmlRoute (Route_Article ArticleRoute_Index) articles+  writeHtmlRoute Route_Index ()++-- | Define your site HTML here+renderPage :: Config -> Route a -> a -> Html ()+renderPage config route val = with html_ [lang_ "en"] $ do+  head_ $ do+    meta_ [httpEquiv_ "Content-Type", content_ "text/html; charset=utf-8"]+    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   where-    -- Shake Action for generating the static site-    generateSite :: Action ()-    generateSite = do-      -- Copy over the static files-      Rib.buildStaticFiles [[relfile|static/**|]]-      -- 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-      head_ $ do-        meta_ [httpEquiv_ "Content-Type", content_ "text/html; charset=utf-8"]-        title_ $ case page of-          Page_Index _ -> "My website!"-          Page_Single src -> toHtml $ title $ getMeta src-        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 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 $ 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-      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)+    routeTitle :: Html ()+    routeTitle = case route of+      Route_Index -> toHtml $ siteTitle config+      Route_Article (ArticleRoute_Article _) -> toHtml $ title $ getMeta val+      Route_Article ArticleRoute_Index -> "Articles"+    renderMarkdown =+      MMark.render . either (error . T.unpack) id . MMark.parsePure "<none>"++-- | Define your site CSS here+pageStyle :: Css+pageStyle = "div#thesite" ? do+  C.margin (em 4) (pc 20) (em 1) (pc 20)+  ".header" ? do+    C.marginBottom $ em 2+  "li.pages" ? do+    C.listStyleType C.none+    C.marginTop $ em 1+    "b" ? C.fontSize (em 1.2)+    "p" ? sym C.margin (px 0)++-- | Metadata in our markdown sources+data SrcMeta+  = SrcMeta+      { title :: Text,+        -- | Description is optional, hence `Maybe`+        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/Main.hs) at rib-sample)+(View full [`Main.hs`](https://github.com/srid/rib-sample/blob/master/src/Main.hs) at rib-sample)  ## Getting Started
rib.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: rib-version: 0.6.0.0+version: 0.7.0.0 license: BSD-3-Clause copyright: 2019 Sridhar Ratnakumar maintainer: srid@srid.ca@@ -10,7 +10,7 @@ synopsis:     Static site generator using Shake description:-    Haskell library for writing your own static site generator+    Haskell static site generator that aims to reuse existing libraries instead of reinventing the wheel category: Web build-type: Simple extra-source-files:@@ -25,10 +25,12 @@     exposed-modules:         Rib         Rib.App-        Rib.Source+        Rib.Parser.Dhall         Rib.Parser.MMark         Rib.Parser.Pandoc+        Rib.Route         Rib.Shake+        Rib.Extra.CSS     other-modules:         Rib.Server     hs-source-dirs: src@@ -43,16 +45,17 @@         async,         base-noprelude >=4.7 && <5,         binary >=0.8.6 && <0.9,-        clay >=0.13.1 && <0.14,+        clay >=0.14 && <0.15,         cmdargs >=0.10.20 && <0.11,         containers >=0.6.0 && <0.7,+        dhall,         directory >= 1.0 && <2.0,         exceptions,         foldl,         fsnotify >=0.3.0 && <0.4,         lucid >=2.9.11 && <2.10,-        megaparsec,-        mmark,+        megaparsec >= 8.0,+        mmark >= 0.0.7.2,         mmark-ext,         modern-uri,         mtl >=2.2.2 && <2.3,@@ -60,9 +63,10 @@         pandoc-include-code >=1.4.0 && <1.5,         pandoc-types >=1.17.5 && <1.18,         path >= 0.7.0,-        path-io,+        path-io >= 1.6.0,         relude >= 0.6 && < 0.7,-        shake >= 0.18.4,+        safe-exceptions,+        shake >= 0.18.5,         text >=1.2.3 && <1.3,         wai >=3.2.2 && <3.3,         wai-app-static >=3.1.6 && <3.2,
src/Rib.hs view
@@ -2,18 +2,14 @@ module Rib   ( module Rib.App,     module Rib.Shake,-    Source,-    SourceReader,-    sourcePath,-    sourceVal,-    sourceUrl,+    module Rib.Route,     MMark,     Pandoc,   ) where  import Rib.App-import Rib.Source import Rib.Parser.MMark (MMark) import Rib.Parser.Pandoc (Pandoc)+import Rib.Route import Rib.Shake
src/Rib/App.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-}  -- | CLI interface for Rib.@@ -14,8 +15,9 @@ where  import Control.Concurrent (threadDelay)-import Control.Concurrent.Async (concurrently_)-import Control.Exception (catch)+import Control.Concurrent.Async (race_)+import Control.Concurrent.Chan+import Control.Exception.Safe (catch) import Development.Shake import Development.Shake.Forward (shakeForward) import Path@@ -23,7 +25,8 @@ import qualified Rib.Server as Server import Rib.Shake (RibSettings (..)) import System.Console.CmdArgs-import System.FSNotify (watchTree, withManager)+import System.FSNotify (watchTreeChan, withManager)+import System.IO (BufferMode (LineBuffering), hSetBuffering)  -- | Application modes --@@ -48,9 +51,6 @@ -- | Run Rib using arguments passed in the command line. 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.   Path Rel Dir ->   -- | The path where static files will be generated.  Rib's server uses this   -- directory when serving files.@@ -78,33 +78,45 @@  -- | Like `run` but with an explicitly passed `App` mode 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.-    -- 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 <> " for changes"-    void $ watchTree mgr (toFilePath src) (const True) $ \_ -> do-      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 -> do-    runShake fullGen+runWith src dst buildAction app = 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 ->+      -- FIXME: Shouldn't `catch` Shake exceptions when invoked without fsnotify.+      runShake fullGen+    WatchAndGenerate ->+      runShakeAndObserve+    Serve p dw -> do+      race_ (Server.serve p $ toFilePath dst) $ do+        if dw+          then threadDelay maxBound+          else runShakeAndObserve   where-    runShake fullGen =+    currentRelDir = [reldir|.|]+    runShakeAndObserve = 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+      -- 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 :: SomeException) -> putStrLn $ "[Rib] Shake error: " <> show e+        `catch` \(e :: ShakeException) ->+          putStrLn $+            "[Rib] Unhandled exception when building " <> shakeExceptionTarget e <> ": " <> show e     ribShakeOptions fullGen =       shakeOptions         { shakeVerbosity = Verbose,@@ -112,3 +124,12 @@           shakeLintInside = [""],           shakeExtra = addShakeExtra (RibSettings src dst) (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+          f
+ src/Rib/Extra/CSS.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Some commonly useful CSS styles+module Rib.Extra.CSS where++import Clay+import Relude++-- | Stock CSS for the <kbd> element+--+-- Based on the MDN demo at,+-- https://developer.mozilla.org/en-US/docs/Web/HTML/Element/kbd+mozillaKbdStyle :: Css+mozillaKbdStyle = do+  backgroundColor $ rgb 238 238 238+  color $ rgb 51 51 51+  sym borderRadius (px 3)+  border solid (px 1) $ rgb 180 180 180+  padding (px 2) (px 4) (px 2) (px 4)+  boxShadow $+    (bsColor (rgba 0 0 0 0.2) $ shadowWithBlur (px 0) (px 1) (px 1))+      :| [(bsColor (rgba 255 255 255 0.7) $ bsInset $ shadowWithSpread (px 0) (px 2) (px 0) (px 0))]+  fontSize $ em 0.85+  fontWeight $ weight 700+  lineHeight $ px 1+  whiteSpace nowrap
+ src/Rib/Parser/Dhall.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++-- | Parser for Dhall files.+module Rib.Parser.Dhall+  ( -- * Parsing+    parse,+  )+where++import Development.Shake+import Dhall (FromDhall, auto, input)+import Path+import Relude+import Rib.Shake (ribInputDir)+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+  [Path Rel File] ->+  -- | The Dhall file to parse. Relative to `ribInputDir`.+  Path Rel File ->+  Action a+parse (map toFilePath -> deps) f = do+  inputDir <- ribInputDir+  need deps+  s <- toText <$> readFile' (toFilePath $ inputDir </> f)+  liftIO $ withCurrentDirectory (toFilePath inputDir) $+    input auto s
src/Rib/Parser/MMark.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}@@ -13,6 +14,9 @@   ( -- * Parsing     parse,     parsePure,+    parseWith,+    parsePureWith,+    defaultExts,      -- * Rendering     render,@@ -28,10 +32,11 @@  import Control.Foldl (Fold (..)) import Development.Shake (readFile')+import Development.Shake import Lucid (Html) import Path import Relude-import Rib.Source (SourceReader)+import Rib.Shake (ribInputDir) import Text.MMark (MMark, projectYaml) import qualified Text.MMark as MMark import qualified Text.MMark.Extension as Ext@@ -43,23 +48,39 @@ render :: MMark -> Html () render = MMark.render --- | Pure version of `parse`-parsePure ::+-- | Like `parsePure` but takes a custom list of MMark extensions+parsePureWith ::+  [MMark.Extension] ->   -- | 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+parsePureWith exts 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+-- | 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 = parsePureWith defaultExts +-- | Parse Markdown using mmark+parse :: Path Rel File -> Action MMark+parse = parseWith defaultExts++-- | Like `parse` but takes a custom list of MMark extensions+parseWith :: [MMark.Extension] -> Path Rel File -> Action MMark+parseWith exts f =+  either (fail . toString) pure =<< do+    inputDir <- ribInputDir+    s <- toText <$> readFile' (toFilePath $ inputDir </> f)+    pure $ parsePureWith exts (toFilePath f) s+ -- | Get the first image in the document if one exists getFirstImg :: MMark -> Maybe URI getFirstImg = flip MMark.runScanner $ Fold f Nothing id@@ -74,16 +95,16 @@       Ext.Paragraph xs -> toList xs       _ -> [] -exts :: [MMark.Extension]-exts =+defaultExts :: [MMark.Extension]+defaultExts =   [ Ext.fontAwesome,     Ext.footnotes,     Ext.kbd,     Ext.linkTarget,     Ext.mathJax (Just '$'),-    Ext.obfuscateEmail "protected-email",     Ext.punctuationPrettifier,-    Ext.ghcSyntaxHighlighter,+    -- For list of parsers supported, see:+    -- https://github.com/jgm/skylighting/tree/master/skylighting-core/xml     Ext.skylighting   ]
src/Rib/Parser/Pandoc.hs view
@@ -27,13 +27,13 @@   ) where -import Control.Monad.Except+import Control.Monad.Except (MonadError, liftEither, runExcept) import Data.Aeson-import Development.Shake (readFile')+import Development.Shake (Action, readFile') import Lucid (Html, toHtmlRaw) import Path import Relude-import Rib.Source (SourceReader)+import Rib.Shake (ribInputDir) import Text.Pandoc import Text.Pandoc.Filter.IncludeCode (includeCode) import qualified Text.Pandoc.Readers@@ -43,21 +43,24 @@ parsePure ::   (ReaderOptions -> Text -> PandocPure Pandoc) ->   Text ->-  Either Text Pandoc+  Pandoc parsePure textReader s =-  first show $ runExcept $ do+  either (error . show) id $ runExcept $ do     runPure' $ textReader readerSettings s --- | `SourceReader` for parsing a lightweight markup language using Pandoc+-- | Parse 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'+  Path Rel File ->+  Action Pandoc+parse textReader f =+  either fail pure =<< do+    inputDir <- ribInputDir+    content <- toText <$> readFile' (toFilePath $ inputDir </> f)+    fmap (first show) $ runExceptT $ do+      v' <- runIO' $ textReader readerSettings content+      liftIO $ walkM includeSources v'   where     includeSources = includeCode $ Just $ Format "html5"
+ src/Rib/Route.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Type-safe routes+module Rib.Route+  ( IsRoute (..),+    routeUrl,+    routeUrlRel,+    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 Path+import Relude+import Rib.Shake (writeFileCached)++-- | A route is a GADT representing individual routes.+--+-- The GADT type parameter represents the data used to render that particular route.+class IsRoute (r :: Type -> Type) where+  -- | Return the filepath (relative `Rib.Shake.ribInputDir`) where the+  -- generated content for this route should be written.+  routeFile :: MonadThrow m => r a -> m (Path Rel File)++data UrlType = Relative | Absolute++path2Url :: Path Rel File -> UrlType -> Text+path2Url fp = toText . toFilePath . \case+  Relative ->+    fp+  Absolute ->+    [absdir|/|] </> fp++-- | The absolute URL to this route (relative to site root)+routeUrl :: IsRoute r => r a -> Text+routeUrl = routeUrl' Absolute++-- | The relative URL to this route+routeUrlRel :: IsRoute r => r a -> Text+routeUrlRel = routeUrl' Relative++-- | Get the URL to a route+routeUrl' :: IsRoute r => UrlType -> r a -> Text+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++-- | Write the content `s` to the file corresponding to the given route.+writeRoute :: (IsRoute r, ToString s) => r a -> s -> Action ()+writeRoute r content = do+  fp <- liftIO $ routeFile r+  writeFileCached fp $ toString $ content
src/Rib/Shake.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}@@ -9,15 +10,10 @@ module Rib.Shake   ( -- * Basic helpers     buildStaticFiles,-    buildHtmlMulti,-    buildHtml,-    buildHtml_,--    -- * Reading only-    readSource,+    forEvery,      -- * Writing only-    writeHtml,+    writeFileCached,      -- * Misc     RibSettings (..),@@ -28,13 +24,9 @@ where  import Development.Shake-import Development.Shake.Forward-import Lucid (Html)-import qualified Lucid import Path import Path.IO import Relude-import Rib.Source  -- | RibSettings is initialized with the values passed to `Rib.App.run` data RibSettings@@ -77,85 +69,25 @@     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 ::-  -- | How to parse the source file-  SourceReader repr ->+-- | Run the given action when any file matching the patterns changes+forEvery ::   -- | 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+  (Path Rel File -> Action a) ->+  Action [a]+forEvery pats f = 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 ->-  -- | 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 `buildHtml` but discards its result.-buildHtml_ ::-  SourceReader repr ->-  Path Rel File ->-  Path Rel File ->-  (Source repr -> Html ()) ->-  Action ()-buildHtml_ parser outfile k = void . buildHtml parser outfile k---- | 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+  forP fs f --- | Like writeFile' but uses `cacheAction`.+-- | Write the given file unless it has not changed. -- -- Also, always writes under ribOutputDir writeFileCached :: Path Rel File -> String -> Action ()-writeFileCached k s = do+writeFileCached !k !s = do   f <- fmap (toFilePath . (</> k)) ribOutputDir-  let cacheClosure = (f, s)-      cacheKey = ("writeFileCached" :: Text, f)-  cacheActionWith cacheKey cacheClosure $ do+  currentS <- liftIO $ forgivingAbsence $ readFile f+  unless (Just s == currentS) $ do     writeFile' f $! s     -- Use a character (like +) that contrasts with what Shake uses (#) for     -- logging modified files being read.
− src/Rib/Source.hs 
@@ -1,56 +0,0 @@-{-# 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)