From 0bfebc3e7e1605a830abfcbde8058df811fff8d0 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Fri, 12 Jul 2019 11:07:04 -0400 Subject: [PATCH] Switch to Development.Shake.Forward Much simpler than the default backward-defined system. --- rib.cabal | 1 - src/Rib/Settings.hs | 3 +- src/Rib/Shake.hs | 110 ++++++++++++++++---------------------------- 3 files changed, 41 insertions(+), 73 deletions(-) diff --git a/rib.cabal b/rib.cabal index 6bcdfb0..624e1b2 100644 --- a/rib.cabal +++ b/rib.cabal @@ -51,7 +51,6 @@ library , safe , shake , skylighting - , slick , text , time , wai diff --git a/src/Rib/Settings.hs b/src/Rib/Settings.hs index 469b765..7fec72e 100644 --- a/src/Rib/Settings.hs +++ b/src/Rib/Settings.hs @@ -4,7 +4,6 @@ module Rib.Settings where -import Control.Monad.Reader import Data.Text (Text) import Development.Shake @@ -36,7 +35,7 @@ data Settings = Settings -- We rebuild only the post files, assuming html/css/md file parsing has -- changed in our Haskell source. - , buildRules :: ReaderT (Settings, PostFilePath -> Action Pandoc) Rules () + , buildRules :: Settings -> Action () -- ^ Build rules specifying how to build the site -- -- A simple implementation is included, which you may copy over to customize diff --git a/src/Rib/Shake.hs b/src/Rib/Shake.hs index d61d637..f39b4c1 100644 --- a/src/Rib/Shake.hs +++ b/src/Rib/Shake.hs @@ -1,29 +1,29 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Rib.Shake ( ribShake , simpleBuildRules + , parsePandocCached ) where +import Control.Monad import Control.Monad.IO.Class (liftIO) -import Control.Monad.Reader +import Data.Aeson (decode, encode) import Data.Bool (bool) import qualified Data.ByteString.Char8 as BS8 -import Data.Text (Text) +import Data.Maybe import qualified Data.Text.Encoding as T -import System.Environment (withArgs) -import Development.Shake (Action, Rebuild (..), Rules, Verbosity (Chatty), copyFileChanged, getDirectoryFiles, - need, readFile', shakeArgs, shakeOptions, shakeRebuild, shakeVerbosity, want, (%>), - (|%>), (~>)) -import Development.Shake.FilePath (dropDirectory1, (-<.>), ()) +import Development.Shake +import Development.Shake.FilePath ((-<.>), ()) +import Development.Shake.Forward (cacheAction, shakeForward) import Lucid import Text.Pandoc (Pandoc) -import qualified Slick - import Rib.Server (getHTMLFileUrl) import qualified Rib.Settings as S import Rib.Types @@ -35,18 +35,13 @@ ribShake -> S.Settings -- ^ Site settings -> IO () -ribShake forceGen cfg = withArgs [] $ do - -- The withArgs above is to ensure that our own app arguments is not - -- confusing Shake. +ribShake forceGen cfg = do let opts = shakeOptions { shakeVerbosity = Chatty , shakeRebuild = bool [] ((RebuildNow,) <$> S.rebuildPatterns cfg) forceGen } - shakeArgs opts $ do - let parsePage = S.parsePage cfg - parsePandocCached <- Slick.jsonCache' $ parsePandoc parsePage - - runReaderT (S.buildRules cfg) (cfg, parsePandocCached) + shakeForward opts $ + S.buildRules cfg cfg -- Build rules for the simplest site possible. -- @@ -56,59 +51,34 @@ simpleBuildRules -- ^ Which files are considered to be static files. -> [FilePath] -- ^ Which files are considered to be post files - -> ReaderT (S.Settings, PostFilePath -> Action Pandoc) Rules () -simpleBuildRules staticFilePatterns postFilePatterns = do - destDir <- asks $ S.destDir . fst - contentDir <- asks $ S.contentDir . fst - pageWidget <- asks $ S.pageWidget . fst - parsePandocCached <- asks snd + -> S.Settings + -> Action () +simpleBuildRules staticFilePatterns postFilePatterns cfg@S.Settings {..} = do + -- Copy static assets + files <- getDirectoryFiles contentDir staticFilePatterns + void $ forP files $ \inp -> + copyFileChanged (contentDir inp) (destDir inp) - let - -- | Convert 'build' filepaths into source file filepaths - destToSrc :: FilePath -> FilePath - destToSrc = (contentDir ) . dropDirectory1 + -- Generate posts + postFiles <- getDirectoryFiles contentDir postFilePatterns + posts <- forP postFiles $ \f -> do + let out = destDir f -<.> "html" + inp = contentDir f + doc <- parsePandocCached cfg inp + let post = Post doc $ getHTMLFileUrl f + liftIO $ renderToFile out $ pageWidget $ Page_Post post + pure post - lift $ do - want ["site"] + -- Generate the main table of contents + -- TODO: Support `draft` property + liftIO $ renderToFile (destDir "index.html") $ + pageWidget $ Page_Index posts - -- Require all the things we need to build the whole site - "site" ~> - need ["static", "posts", destDir "index.html"] - - -- Require all static assets - "static" ~> do - files <- getDirectoryFiles contentDir staticFilePatterns - need $ (destDir ) <$> files - - -- Rule for handling static assets, just copy them from source to dest - (destDir ) <$> staticFilePatterns |%> \out -> - copyFileChanged (destToSrc out) out - - -- Find and require every post to be built - "posts" ~> do - files <- getDirectoryFiles contentDir postFilePatterns - need $ (destDir ) . (-<.> "html") <$> files - - -- Build the main table of contents - (destDir "index.html") %> \out -> do - files <- getDirectoryFiles contentDir postFilePatterns - -- TODO: Support `draft` property - posts <- forM files $ \f -> do - doc <- parsePandocCached $ PostFilePath (contentDir f) - pure $ Post doc $ getHTMLFileUrl f - liftIO $ renderToFile out $ pageWidget $ Page_Index posts - - -- Rule for building individual posts - (destDir "*.html") %> \out -> do - let f = dropDirectory1 $ destToSrc out -<.> "md" - doc <- parsePandocCached $ PostFilePath (contentDir f) - let post = Post doc $ getHTMLFileUrl f - liftIO $ renderToFile out $ pageWidget $ Page_Post post - --- Require the given post file and parse it as Pandoc document. -parsePandoc - :: (Text -> Pandoc) - -> PostFilePath - -> Action Pandoc -parsePandoc parse (PostFilePath f) = - parse . T.decodeUtf8 . BS8.pack <$> readFile' f +parsePandocCached :: S.Settings -> FilePath -> Action Pandoc +parsePandocCached cfg f = + jsonCacheAction f $ parsePandoc $ S.parsePage cfg + where + jsonCacheAction k = + fmap (fromMaybe (error "cache error") . decode) . cacheAction k . fmap encode + parsePandoc parse = + parse . T.decodeUtf8 . BS8.pack <$> readFile' f