{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Rib.Shake
(
buildStaticFiles,
forEvery,
writeFileCached,
getCliConfig,
ribInputDir,
ribOutputDir,
)
where
import Control.Monad.Catch
import Development.Shake
import Relude
import Rib.Cli (CliConfig)
import qualified Rib.Cli as Cli
import System.Directory
import System.FilePath
import System.IO.Error (isDoesNotExistError)
getCliConfig :: Action CliConfig
getCliConfig = getShakeExtra >>= \case
Just v -> pure v
Nothing -> fail "CliConfig not initialized"
ribInputDir :: Action FilePath
ribInputDir = Cli.inputDir <$> getCliConfig
ribOutputDir :: Action FilePath
ribOutputDir = do
output <- Cli.outputDir <$> getCliConfig
liftIO $ createDirectoryIfMissing True output
return output
buildStaticFiles :: [FilePath] -> Action ()
buildStaticFiles staticFilePatterns = do
input <- ribInputDir
output <- ribOutputDir
files <- getDirectoryFiles input staticFilePatterns
void $ forP files $ \f ->
copyFileChanged (input </> f) (output </> f)
forEvery ::
[FilePath] ->
(FilePath -> Action a) ->
Action [a]
forEvery pats f = do
input <- ribInputDir
fs <- getDirectoryFiles input pats
forP fs f
writeFileCached :: FilePath -> String -> Action ()
writeFileCached !k !s = do
f <- fmap (</> k) ribOutputDir
currentS <- liftIO $ forgivingAbsence $ readFile f
unless (Just s == currentS) $ do
writeFile' f $! s
putInfo $ "+ " <> f
forgivingAbsence :: (MonadIO m, MonadCatch m) => m a -> m (Maybe a)
forgivingAbsence f =
catchIf
isDoesNotExistError
(Just <$> f)
(const $ return Nothing)