{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

-- | Combinators for working with Shake.
module Rib.Shake
  ( -- * Basic helpers
    buildStaticFiles,
    forEvery,

    -- * Writing only
    writeFileCached,

    -- * Misc
    ribInputDir,
    ribOutputDir,
    getDirectoryFiles',
  )
where

import Development.Shake
import Path
import Path.IO
import Relude
import Rib.Settings

-- | Get rib settings from a shake Action monad.
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"

-- | Input directory containing source files
--
-- This is same as the first argument to `Rib.App.run`
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

-- | Output directory where files are generated
--
-- This is same as the second argument to `Rib.App.run`
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

-- | Shake action to copy static files as is.
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

-- | Run the given action when any file matching the patterns changes
forEvery ::
  -- | Source file patterns (relative to `ribInputDir`)
  [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

-- | Write the given file but only when it has been modified.
--
-- Also, always writes under ribOutputDir
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
    -- Use a character (like +) that contrasts with what Shake uses (#) for
    -- logging modified files being read.
    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

-- | Like `getDirectoryFiles` but works with `Path`
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