{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Rib.Shake
(
buildStaticFiles,
forEvery,
writeFileCached,
ribInputDir,
ribOutputDir,
getDirectoryFiles',
)
where
import Development.Shake
import Path
import Path.IO
import Relude
import Rib.Settings
ribSettings :: Action RibSettings
ribSettings = getShakeExtra >>= \case
Just v -> pure v
Nothing -> fail "RibSettings not initialized"
ribInputDir :: Action (Path Rel Dir)
ribInputDir = _ribSettings_inputDir <$> ribSettings
ribOutputDir :: Action (Path Rel Dir)
ribOutputDir = do
output <- _ribSettings_outputDir <$> ribSettings
liftIO $ createDirIfMissing True output
return output
buildStaticFiles :: [Path Rel File] -> Action ()
buildStaticFiles staticFilePatterns = do
input <- ribInputDir
output <- ribOutputDir
files <- getDirectoryFiles' input staticFilePatterns
void $ forP files $ \f ->
copyFileChanged' (input </> f) (output </> f)
where
copyFileChanged' (toFilePath -> old) (toFilePath -> new) =
copyFileChanged old new
forEvery ::
[Path Rel File] ->
(Path Rel File -> Action a) ->
Action [a]
forEvery pats f = do
input <- ribInputDir
fs <- getDirectoryFiles' input pats
forP fs f
writeFileCached :: Path Rel File -> String -> Action ()
writeFileCached !k !s = do
f <- fmap (toFilePath . (</> k)) ribOutputDir
currentS <- liftIO $ forgivingAbsence $ readFile f
unless (Just s == currentS) $ do
writeFile' f $! s
putInfo $ "+ " <> f
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