{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Rib.Shake
(
buildHtmlMulti
, buildHtml
, readPandoc
, readPandocMulti
, buildStaticFiles
)
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 Development.Shake
import Development.Shake.FilePath
import Development.Shake.Forward (cacheAction)
import Lucid (Html)
import qualified Lucid
import Text.Pandoc (Pandoc (Pandoc), PandocIO, ReaderOptions)
import Rib.App (ribInputDir, ribOutputDir)
import qualified Rib.Pandoc
buildStaticFiles :: [FilePattern] -> Action [FilePath]
buildStaticFiles staticFilePatterns = do
files <- getDirectoryFiles ribInputDir staticFilePatterns
void $ forP files $ \f ->
copyFileChanged (ribInputDir </> f) (ribOutputDir </> f)
pure files
buildHtmlMulti
:: (FilePattern, ReaderOptions -> Text -> PandocIO Pandoc)
-> ((FilePath, Pandoc) -> Html ())
-> Action [(FilePath, Pandoc)]
buildHtmlMulti spec r = do
xs <- readPandocMulti spec
void $ forP xs $ \x ->
buildHtml (fst x -<.> "html") (r x)
pure xs
readPandocMulti
:: ( FilePattern
, ReaderOptions -> Text -> PandocIO Pandoc
)
-> Action [(FilePath, Pandoc)]
readPandocMulti (pat, r) = do
fs <- getDirectoryFiles ribInputDir [pat]
forP fs $ \f ->
jsonCacheAction f $ (f, ) <$> readPandoc r f
readPandoc
:: (ReaderOptions -> Text -> PandocIO Pandoc)
-> FilePath
-> Action Pandoc
readPandoc r f = do
let inp = ribInputDir </> f
need [inp]
content <- T.decodeUtf8 <$> liftIO (BS.readFile inp)
doc <- liftIO $ Rib.Pandoc.parse r content
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
boolFileExists fp missingF existsF =
doesFileExist fp >>= bool missingF (existsF fp)
buildHtml :: FilePath -> Html () -> Action ()
buildHtml f html = do
let out = ribOutputDir </> f
writeHtml out html
writeHtml :: MonadIO m => FilePath -> Html () -> m ()
writeHtml f = liftIO . BSL.writeFile f . Lucid.renderBS
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