{-# 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 :: Action RibSettings
ribSettings = Action (Maybe RibSettings)
forall a. Typeable a => Action (Maybe a)
getShakeExtra Action (Maybe RibSettings)
-> (Maybe RibSettings -> Action RibSettings) -> Action RibSettings
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just v :: RibSettings
v -> RibSettings -> Action RibSettings
forall (f :: * -> *) a. Applicative f => a -> f a
pure RibSettings
v
Nothing -> String -> Action RibSettings
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "RibSettings not initialized"
ribInputDir :: Action (Path Rel Dir)
ribInputDir :: Action (Path Rel Dir)
ribInputDir = RibSettings -> Path Rel Dir
_ribSettings_inputDir (RibSettings -> Path Rel Dir)
-> Action RibSettings -> Action (Path Rel Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action RibSettings
ribSettings
ribOutputDir :: Action (Path Rel Dir)
ribOutputDir :: Action (Path Rel Dir)
ribOutputDir = do
Path Rel Dir
output <- RibSettings -> Path Rel Dir
_ribSettings_outputDir (RibSettings -> Path Rel Dir)
-> Action RibSettings -> Action (Path Rel Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action RibSettings
ribSettings
IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Bool -> Path Rel Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
createDirIfMissing Bool
True Path Rel Dir
output
Path Rel Dir -> Action (Path Rel Dir)
forall (m :: * -> *) a. Monad m => a -> m a
return Path Rel Dir
output
buildStaticFiles :: [Path Rel File] -> Action ()
buildStaticFiles :: [Path Rel File] -> Action ()
buildStaticFiles staticFilePatterns :: [Path Rel File]
staticFilePatterns = do
Path Rel Dir
input <- Action (Path Rel Dir)
ribInputDir
Path Rel Dir
output <- Action (Path Rel Dir)
ribOutputDir
[Path Rel File]
files <- Path Rel Dir -> [Path Rel File] -> Action [Path Rel File]
forall b.
Typeable b =>
Path b Dir -> [Path Rel File] -> Action [Path Rel File]
getDirectoryFiles' Path Rel Dir
input [Path Rel File]
staticFilePatterns
Action [()] -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action [()] -> Action ()) -> Action [()] -> Action ()
forall a b. (a -> b) -> a -> b
$ [Path Rel File] -> (Path Rel File -> Action ()) -> Action [()]
forall a b. [a] -> (a -> Action b) -> Action [b]
forP [Path Rel File]
files ((Path Rel File -> Action ()) -> Action [()])
-> (Path Rel File -> Action ()) -> Action [()]
forall a b. (a -> b) -> a -> b
$ \f :: Path Rel File
f ->
Path Rel File -> Path Rel File -> Action ()
forall b t b t. Path b t -> Path b t -> Action ()
copyFileChanged' (Path Rel Dir
input Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
f) (Path Rel Dir
output Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
f)
where
copyFileChanged' :: Path b t -> Path b t -> Action ()
copyFileChanged' (Path b t -> String
forall b t. Path b t -> String
toFilePath -> String
old) (Path b t -> String
forall b t. Path b t -> String
toFilePath -> String
new) =
Partial => String -> String -> Action ()
String -> String -> Action ()
copyFileChanged String
old String
new
forEvery ::
[Path Rel File] ->
(Path Rel File -> Action a) ->
Action [a]
forEvery :: [Path Rel File] -> (Path Rel File -> Action a) -> Action [a]
forEvery pats :: [Path Rel File]
pats f :: Path Rel File -> Action a
f = do
Path Rel Dir
input <- Action (Path Rel Dir)
ribInputDir
[Path Rel File]
fs <- Path Rel Dir -> [Path Rel File] -> Action [Path Rel File]
forall b.
Typeable b =>
Path b Dir -> [Path Rel File] -> Action [Path Rel File]
getDirectoryFiles' Path Rel Dir
input [Path Rel File]
pats
[Path Rel File] -> (Path Rel File -> Action a) -> Action [a]
forall a b. [a] -> (a -> Action b) -> Action [b]
forP [Path Rel File]
fs Path Rel File -> Action a
f
writeFileCached :: Path Rel File -> String -> Action ()
writeFileCached :: Path Rel File -> String -> Action ()
writeFileCached !Path Rel File
k !String
s = do
String
f <- (Path Rel Dir -> String) -> Action (Path Rel Dir) -> Action String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Path Rel File -> String
forall b t. Path b t -> String
toFilePath (Path Rel File -> String)
-> (Path Rel Dir -> Path Rel File) -> Path Rel Dir -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
k)) Action (Path Rel Dir)
ribOutputDir
Maybe String
currentS <- IO (Maybe String) -> Action (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> Action (Maybe String))
-> IO (Maybe String) -> Action (Maybe String)
forall a b. (a -> b) -> a -> b
$ IO String -> IO (Maybe String)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (IO String -> IO (Maybe String)) -> IO String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO String
forall (m :: * -> *). MonadIO m => String -> m String
readFile String
f
Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Maybe String
forall a. a -> Maybe a
Just String
s Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
currentS) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
String -> String -> Action ()
forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFile' String
f (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$! String
s
String -> Action ()
putInfo (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ "+ " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
f
getDirectoryFiles' :: Typeable b => Path b Dir -> [Path Rel File] -> Action [Path Rel File]
getDirectoryFiles' :: Path b Dir -> [Path Rel File] -> Action [Path Rel File]
getDirectoryFiles' (Path b Dir -> String
forall b t. Path b t -> String
toFilePath -> String
dir) ((Path Rel File -> String) -> [Path Rel File] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Rel File -> String
forall b t. Path b t -> String
toFilePath -> [String]
pat) =
(String -> Action (Path Rel File))
-> [String] -> Action [Path Rel File]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (IO (Path Rel File) -> Action (Path Rel File)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Rel File) -> Action (Path Rel File))
-> (String -> IO (Path Rel File))
-> String
-> Action (Path Rel File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile) ([String] -> Action [Path Rel File])
-> Action [String] -> Action [Path Rel File]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [String] -> Action [String]
getDirectoryFiles String
dir [String]
pat