{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE LambdaCase          #-}

-- | Defines core combinators for processing files incrementally.
module Achille.Task
    ( Task
    , match
    , match_
    , matchFile
    , matchDir
    , with
    , watch
    , runTask
    ) where


import Data.Functor            ((<&>))
import Control.Monad           (forM, filterM)
import Control.Monad.IO.Class  (MonadIO, liftIO)
import Data.Binary             (Binary)
import System.FilePath         (FilePath, (</>), takeDirectory, takeFileName)
import System.FilePath.Glob    (Pattern)
import System.Directory
import System.IO               (openBinaryFile, hClose, IOMode(ReadMode))
import Data.Time.Clock         (UTCTime(..))
import Data.Time.Calendar      (Day(..))

import qualified System.FilePath.Glob as Glob
import qualified Data.ByteString.Lazy as ByteString

import Achille.Config (Config)
import Achille.Internal

import qualified Achille.Config as Config
import Achille.Internal.IO (AchilleIO)
import qualified Achille.Internal.IO as AchilleIO

-- what our tasks are caching
type MatchVoid  = [(FilePath, Cache)]
type Match b    = [(FilePath, (b, Cache))]
type MatchDir   = [(FilePath, Cache)]
type With a b   = (a, (b, Cache))
type Watch a    = (a, Cache)


shouldForce :: Context a -> FilePath -> Bool
shouldForce :: Context a -> FilePath -> Bool
shouldForce ctx :: Context a
ctx x :: FilePath
x = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (Pattern -> FilePath -> Bool
Glob.match (Pattern -> FilePath -> Bool) -> [Pattern] -> [FilePath -> Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context a -> [Pattern]
forall a. Context a -> [Pattern]
forceFiles Context a
ctx [FilePath -> Bool] -> [FilePath] -> [Bool]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
x)

-- TODO: investigate whether we need glob at all?
--       It doesn't look like it's very fast,
--       and it doesn't allow you to do conditionals with {}
--       such as *.{jpg, png}

-- | Run a recipe on every filepath matching a given pattern.
--   The results are cached and the recipe only recomputes
--   when the underlying file has changed since last run.
match :: (AchilleIO m, Binary a)
      => Pattern -> Recipe m FilePath a -> Recipe m c [a]
match :: Pattern -> Recipe m FilePath a -> Recipe m c [a]
match pattern :: Pattern
pattern (Recipe r :: Context FilePath -> m (a, Cache)
r :: Recipe m FilePath b) = (Context c -> m ([a], Cache)) -> Recipe m c [a]
forall (m :: * -> *) a b.
(Context a -> m (b, Cache)) -> Recipe m a b
Recipe \ctx :: Context c
ctx -> do
    let (cached :: Maybe (Match a)
cached, c' :: Context c
c'@Context{..}) = Context c -> (Maybe (Match a), Context c)
forall a b. Binary a => Context b -> (Maybe a, Context b)
fromContext Context c
ctx
    [FilePath]
paths <- FilePath -> Pattern -> m [FilePath]
forall (m :: * -> *).
AchilleIO m =>
FilePath -> Pattern -> m [FilePath]
AchilleIO.glob (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir) Pattern
pattern
             m [FilePath] -> ([FilePath] -> m [FilePath]) -> m [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> m Bool) -> [FilePath] -> m [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> m Bool
forall (m :: * -> *). AchilleIO m => FilePath -> m Bool
AchilleIO.doesFileExist (FilePath -> m Bool)
-> (FilePath -> FilePath) -> FilePath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir) FilePath -> FilePath -> FilePath
</>))
    case Maybe (Match a)
cached :: Maybe (Match b) of
        Nothing -> do
            Match a
result <- [FilePath] -> (FilePath -> m (FilePath, (a, Cache))) -> m (Match a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
paths \p :: FilePath
p ->
                (FilePath
p,) ((a, Cache) -> (FilePath, (a, Cache)))
-> m (a, Cache) -> m (FilePath, (a, Cache))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context FilePath -> m (a, Cache)
r Context c
c' { inputValue :: FilePath
inputValue = FilePath
p
                              , cache :: Cache
cache = Cache
emptyCache
                              }
            ([a], Cache) -> m ([a], Cache)
forall (m :: * -> *) a. Monad m => a -> m a
return (((FilePath, (a, Cache)) -> a) -> Match a -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((a, Cache) -> a
forall a b. (a, b) -> a
fst ((a, Cache) -> a)
-> ((FilePath, (a, Cache)) -> (a, Cache))
-> (FilePath, (a, Cache))
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, (a, Cache)) -> (a, Cache)
forall a b. (a, b) -> b
snd) Match a
result, Match a -> Cache
forall a. Binary a => a -> Cache
toCache (Match a
result :: Match b))
        Just cached :: Match a
cached -> do
            Match a
result <- [FilePath] -> (FilePath -> m (FilePath, (a, Cache))) -> m (Match a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
paths \p :: FilePath
p ->
                case FilePath -> Match a -> Maybe (a, Cache)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
p Match a
cached of
                    Just (v :: a
v, cache :: Cache
cache) -> (FilePath
p,) ((a, Cache) -> (FilePath, (a, Cache)))
-> m (a, Cache) -> m (FilePath, (a, Cache))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
                        UTCTime
tfile  <- FilePath -> m UTCTime
forall (m :: * -> *). AchilleIO m => FilePath -> m UTCTime
AchilleIO.getModificationTime (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath
p)
                        if UTCTime
timestamp UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
tfile Bool -> Bool -> Bool
|| Context c -> FilePath -> Bool
forall a. Context a -> FilePath -> Bool
shouldForce Context c
ctx (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath
p) then
                            Context FilePath -> m (a, Cache)
r Context c
c' {inputValue :: FilePath
inputValue = FilePath
p, cache :: Cache
cache = Cache
cache}
                        else (a, Cache) -> m (a, Cache)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
v, Cache
cache)
                    Nothing -> (FilePath
p,) ((a, Cache) -> (FilePath, (a, Cache)))
-> m (a, Cache) -> m (FilePath, (a, Cache))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context FilePath -> m (a, Cache)
r Context c
c' {inputValue :: FilePath
inputValue = FilePath
p, cache :: Cache
cache = Cache
emptyCache}
            ([a], Cache) -> m ([a], Cache)
forall (m :: * -> *) a. Monad m => a -> m a
return (((FilePath, (a, Cache)) -> a) -> Match a -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((a, Cache) -> a
forall a b. (a, b) -> a
fst ((a, Cache) -> a)
-> ((FilePath, (a, Cache)) -> (a, Cache))
-> (FilePath, (a, Cache))
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, (a, Cache)) -> (a, Cache)
forall a b. (a, b) -> b
snd) Match a
result, Match a -> Cache
forall a. Binary a => a -> Cache
toCache (Match a
result :: Match b))


-- | Run a recipe on every filepath matching a given pattern,
--   and discard the result.
--   Filepaths are cached and the recipe only recomputes when
--   the underlying file has changed since last run.
match_ :: AchilleIO m => Pattern -> Recipe m FilePath a -> Task m ()
match_ :: Pattern -> Recipe m FilePath a -> Task m ()
match_ pattern :: Pattern
pattern (Recipe r :: Context FilePath -> m (a, Cache)
r) = (Context () -> m ((), Cache)) -> Task m ()
forall (m :: * -> *) a b.
(Context a -> m (b, Cache)) -> Recipe m a b
Recipe \ctx :: Context ()
ctx -> do
    let (result :: Maybe MatchVoid
result, c' :: Context ()
c'@Context{..}) = Context () -> (Maybe MatchVoid, Context ())
forall a b. Binary a => Context b -> (Maybe a, Context b)
fromContext Context ()
ctx 
    [FilePath]
paths <- FilePath -> Pattern -> m [FilePath]
forall (m :: * -> *).
AchilleIO m =>
FilePath -> Pattern -> m [FilePath]
AchilleIO.glob (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir) Pattern
pattern
             m [FilePath] -> ([FilePath] -> m [FilePath]) -> m [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> m Bool) -> [FilePath] -> m [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> m Bool
forall (m :: * -> *). AchilleIO m => FilePath -> m Bool
AchilleIO.doesFileExist (FilePath -> m Bool)
-> (FilePath -> FilePath) -> FilePath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir) FilePath -> FilePath -> FilePath
</>))
    case Maybe MatchVoid
result :: Maybe MatchVoid of
        Nothing -> do
            MatchVoid
result <- [FilePath] -> (FilePath -> m (FilePath, Cache)) -> m MatchVoid
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
paths \p :: FilePath
p ->
                ((FilePath
p,) (Cache -> (FilePath, Cache))
-> ((a, Cache) -> Cache) -> (a, Cache) -> (FilePath, Cache)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Cache) -> Cache
forall a b. (a, b) -> b
snd) ((a, Cache) -> (FilePath, Cache))
-> m (a, Cache) -> m (FilePath, Cache)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context FilePath -> m (a, Cache)
r Context ()
c' { inputValue :: FilePath
inputValue = FilePath
p
                                      , cache :: Cache
cache = Cache
emptyCache
                                      }
            ((), Cache) -> m ((), Cache)
forall (m :: * -> *) a. Monad m => a -> m a
return (() , MatchVoid -> Cache
forall a. Binary a => a -> Cache
toCache (MatchVoid
result :: MatchVoid))
        Just cached :: MatchVoid
cached -> do
            MatchVoid
result <- [FilePath] -> (FilePath -> m (FilePath, Cache)) -> m MatchVoid
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
paths \p :: FilePath
p ->
                case FilePath -> MatchVoid -> Maybe Cache
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
p MatchVoid
cached of
                    Just cache :: Cache
cache -> (FilePath
p,) (Cache -> (FilePath, Cache)) -> m Cache -> m (FilePath, Cache)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
                        UTCTime
tfile <- FilePath -> m UTCTime
forall (m :: * -> *). AchilleIO m => FilePath -> m UTCTime
AchilleIO.getModificationTime (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath
p)
                        if UTCTime
timestamp UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
tfile Bool -> Bool -> Bool
|| Context () -> FilePath -> Bool
forall a. Context a -> FilePath -> Bool
shouldForce Context ()
ctx (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath
p) then
                            (a, Cache) -> Cache
forall a b. (a, b) -> b
snd ((a, Cache) -> Cache) -> m (a, Cache) -> m Cache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context FilePath -> m (a, Cache)
r Context ()
c' {inputValue :: FilePath
inputValue = FilePath
p, cache :: Cache
cache = Cache
cache}
                        else Cache -> m Cache
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cache
cache
                    Nothing -> ((FilePath
p,) (Cache -> (FilePath, Cache))
-> ((a, Cache) -> Cache) -> (a, Cache) -> (FilePath, Cache)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Cache) -> Cache
forall a b. (a, b) -> b
snd) ((a, Cache) -> (FilePath, Cache))
-> m (a, Cache) -> m (FilePath, Cache)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context FilePath -> m (a, Cache)
r Context ()
c' {inputValue :: FilePath
inputValue = FilePath
p, cache :: Cache
cache = Cache
emptyCache}
            ((), Cache) -> m ((), Cache)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), MatchVoid -> Cache
forall a. Binary a => a -> Cache
toCache (MatchVoid
result :: MatchVoid))


-- | Run a recipe for a filepath matching a given pattern.
--   The result is cached and the recipe only recomputes
--   when the underlying file has changed since last run.
--   Will fail is no file is found matching the pattern.
matchFile :: (AchilleIO m, Binary a)
          => Pattern -> Recipe m FilePath a -> Recipe m b a
matchFile :: Pattern -> Recipe m FilePath a -> Recipe m b a
matchFile p :: Pattern
p (Recipe r :: Context FilePath -> m (a, Cache)
r :: Recipe m FilePath a) = (Context b -> m (a, Cache)) -> Recipe m b a
forall (m :: * -> *) a b.
(Context a -> m (b, Cache)) -> Recipe m a b
Recipe \ctx :: Context b
ctx@Context{..} ->
    FilePath -> Pattern -> m [FilePath]
forall (m :: * -> *).
AchilleIO m =>
FilePath -> Pattern -> m [FilePath]
AchilleIO.glob (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir) Pattern
p m [FilePath] -> ([FilePath] -> m (a, Cache)) -> m (a, Cache)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [] -> FilePath -> m (a, Cache)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
AchilleIO.fail (FilePath -> m (a, Cache)) -> FilePath -> m (a, Cache)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords
                  [ "No file was found matching pattern"
                  , Pattern -> FilePath
Glob.decompile Pattern
p
                  , "inside directory"
                  , FilePath
currentDir
                  ]
        (p :: FilePath
p:xs :: [FilePath]
xs) ->
            let (result :: Maybe (a, Cache)
result, c' :: Context b
c'@Context{..}) = Context b -> (Maybe (a, Cache), Context b)
forall a b. Binary a => Context b -> (Maybe a, Context b)
fromContext Context b
ctx
            in case Maybe (a, Cache)
result :: Maybe (Watch a) of
                Nothing -> Context FilePath -> m (a, Cache)
r Context b
c' {cache :: Cache
cache = Cache
emptyCache, inputValue :: FilePath
inputValue = FilePath
p}
                                    m (a, Cache) -> ((a, Cache) -> (a, Cache)) -> m (a, Cache)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v :: (a, Cache)
v -> ((a, Cache) -> a
forall a b. (a, b) -> a
fst (a, Cache)
v, (a, Cache) -> Cache
forall a. Binary a => a -> Cache
toCache ((a, Cache)
v :: Watch a))
                Just (x :: a
x, cache :: Cache
cache) -> do
                    UTCTime
tfile  <- FilePath -> m UTCTime
forall (m :: * -> *). AchilleIO m => FilePath -> m UTCTime
AchilleIO.getModificationTime (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath
p)
                    if UTCTime
timestamp UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
tfile Bool -> Bool -> Bool
|| Context b -> FilePath -> Bool
forall a. Context a -> FilePath -> Bool
shouldForce Context b
ctx (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath
p) then
                        Context FilePath -> m (a, Cache)
r Context b
c' {cache :: Cache
cache = Cache
cache, inputValue :: FilePath
inputValue = FilePath
p}
                            m (a, Cache) -> ((a, Cache) -> (a, Cache)) -> m (a, Cache)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v :: (a, Cache)
v -> ((a, Cache) -> a
forall a b. (a, b) -> a
fst (a, Cache)
v, (a, Cache) -> Cache
forall a. Binary a => a -> Cache
toCache ((a, Cache)
v :: Watch a))
                    else (a, Cache) -> m (a, Cache)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, (a, Cache) -> Cache
forall a. Binary a => a -> Cache
toCache ((a
x, Cache
cache) :: Watch a))


-- | For every file matching the pattern, run a recipe with the
--   file as input and with the file's parent directory as current working directory.
--   The underlying recipe will be run regardless of whether the file was modified.
matchDir :: AchilleIO m
         => Pattern -> Recipe m FilePath a -> Recipe m c [a]
matchDir :: Pattern -> Recipe m FilePath a -> Recipe m c [a]
matchDir pattern :: Pattern
pattern (Recipe r :: Context FilePath -> m (a, Cache)
r) = (Context c -> m ([a], Cache)) -> Recipe m c [a]
forall (m :: * -> *) a b.
(Context a -> m (b, Cache)) -> Recipe m a b
Recipe \ctx :: Context c
ctx -> do
    let (result :: Maybe MatchVoid
result, c' :: Context c
c'@Context{..}) = Context c -> (Maybe MatchVoid, Context c)
forall a b. Binary a => Context b -> (Maybe a, Context b)
fromContext Context c
ctx 
    [FilePath]
paths <- FilePath -> Pattern -> m [FilePath]
forall (m :: * -> *).
AchilleIO m =>
FilePath -> Pattern -> m [FilePath]
AchilleIO.glob (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir) Pattern
pattern
    case Maybe MatchVoid
result :: Maybe MatchDir of
        Nothing -> do
            [(a, Cache)]
result <- [FilePath] -> (FilePath -> m (a, Cache)) -> m [(a, Cache)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
paths \p :: FilePath
p ->
                          Context FilePath -> m (a, Cache)
r Context c
c' { inputValue :: FilePath
inputValue = FilePath -> FilePath
takeFileName FilePath
p
                               , currentDir :: FilePath
currentDir = FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeDirectory FilePath
p
                               , cache :: Cache
cache      = Cache
emptyCache
                               }
            ([a], Cache) -> m ([a], Cache)
forall (m :: * -> *) a. Monad m => a -> m a
return (((a, Cache) -> a) -> [(a, Cache)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Cache) -> a
forall a b. (a, b) -> a
fst [(a, Cache)]
result, MatchVoid -> Cache
forall a. Binary a => a -> Cache
toCache ([FilePath] -> [Cache] -> MatchVoid
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
paths (((a, Cache) -> Cache) -> [(a, Cache)] -> [Cache]
forall a b. (a -> b) -> [a] -> [b]
map (a, Cache) -> Cache
forall a b. (a, b) -> b
snd [(a, Cache)]
result) :: MatchDir))
        Just cached :: MatchVoid
cached -> do
            [(a, Cache)]
result <- [FilePath] -> (FilePath -> m (a, Cache)) -> m [(a, Cache)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
paths \p :: FilePath
p ->
                case FilePath -> MatchVoid -> Maybe Cache
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
p MatchVoid
cached of
                    Just cache :: Cache
cache -> Context FilePath -> m (a, Cache)
r Context c
c' { inputValue :: FilePath
inputValue = FilePath -> FilePath
takeFileName FilePath
p
                                       , currentDir :: FilePath
currentDir = FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeDirectory FilePath
p
                                       , cache :: Cache
cache      = Cache
cache
                                       }
                    Nothing -> Context FilePath -> m (a, Cache)
r Context c
c' {inputValue :: FilePath
inputValue = FilePath
p, cache :: Cache
cache = Cache
emptyCache}
            ([a], Cache) -> m ([a], Cache)
forall (m :: * -> *) a. Monad m => a -> m a
return (((a, Cache) -> a) -> [(a, Cache)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Cache) -> a
forall a b. (a, b) -> a
fst [(a, Cache)]
result, MatchVoid -> Cache
forall a. Binary a => a -> Cache
toCache ([FilePath] -> [Cache] -> MatchVoid
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
paths (((a, Cache) -> Cache) -> [(a, Cache)] -> [Cache]
forall a b. (a -> b) -> [a] -> [b]
map (a, Cache) -> Cache
forall a b. (a, b) -> b
snd [(a, Cache)]
result) :: MatchDir))


-- | Cache a value and only trigger a given recipe if said value has changed between runs.
--   cache the result of the recipe.
with :: (Applicative m, Binary a, Eq a, Binary b)
     => a -> Recipe m c b -> Recipe m c b
with :: a -> Recipe m c b -> Recipe m c b
with (a
x :: a) (Recipe r :: Context c -> m (b, Cache)
r :: Recipe m1 c d) = (Context c -> m (b, Cache)) -> Recipe m c b
forall (m :: * -> *) a b.
(Context a -> m (b, Cache)) -> Recipe m a b
Recipe \ctx :: Context c
ctx ->
    let (result :: Maybe (With a b)
result, c' :: Context c
c'@Context{..}) = Context c -> (Maybe (With a b), Context c)
forall a b. Binary a => Context b -> (Maybe a, Context b)
fromContext Context c
ctx 
    in case Maybe (With a b)
result :: Maybe (With a d) of
        Nothing ->
            Context c -> m (b, Cache)
r Context c
c' {cache :: Cache
cache = Cache
emptyCache}
                m (b, Cache) -> ((b, Cache) -> (b, Cache)) -> m (b, Cache)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v :: (b, Cache)
v -> ((b, Cache) -> b
forall a b. (a, b) -> a
fst (b, Cache)
v, With a b -> Cache
forall a. Binary a => a -> Cache
toCache ((a
x, (b, Cache)
v) :: With a d))
        Just (x' :: a
x', (v :: b
v, cache :: Cache
cache)) ->
            if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x' then (b, Cache) -> m (b, Cache)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
v , With a b -> Cache
forall a. Binary a => a -> Cache
toCache ((a
x', (b
v, Cache
cache)) :: With a d))
            else Context c -> m (b, Cache)
r Context c
c' m (b, Cache) -> ((b, Cache) -> (b, Cache)) -> m (b, Cache)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v :: (b, Cache)
v -> ((b, Cache) -> b
forall a b. (a, b) -> a
fst (b, Cache)
v, With a b -> Cache
forall a. Binary a => a -> Cache
toCache ((a
x, (b, Cache)
v) :: With a d))


-- | Cache a value and only trigger a given recipe if said value has changed between runs.
--   Like 'with', but the result of the recipe won't be cached.
--   If the recipe must be retriggered, it will be in depth.
watch :: (Functor m, Binary a, Eq a)
      => a -> Recipe m c b -> Recipe m c b
watch :: a -> Recipe m c b -> Recipe m c b
watch (a
x :: a) (Recipe r :: Context c -> m (b, Cache)
r :: Recipe m c b) = (Context c -> m (b, Cache)) -> Recipe m c b
forall (m :: * -> *) a b.
(Context a -> m (b, Cache)) -> Recipe m a b
Recipe \ctx :: Context c
ctx ->
    let (result :: Maybe (Watch a)
result, c' :: Context c
c'@Context{..}) = Context c -> (Maybe (Watch a), Context c)
forall a b. Binary a => Context b -> (Maybe a, Context b)
fromContext Context c
ctx
    in case Maybe (Watch a)
result :: Maybe (Watch a) of
        Nothing ->
            Context c -> m (b, Cache)
r Context c
c' {cache :: Cache
cache = Cache
emptyCache}
                m (b, Cache) -> ((b, Cache) -> (b, Cache)) -> m (b, Cache)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v :: (b, Cache)
v -> ((b, Cache) -> b
forall a b. (a, b) -> a
fst (b, Cache)
v, Watch a -> Cache
forall a. Binary a => a -> Cache
toCache ((a
x, (b, Cache) -> Cache
forall a b. (a, b) -> b
snd (b, Cache)
v) :: Watch a))
        Just (x' :: a
x', cache :: Cache
cache) ->
            Context c -> m (b, Cache)
r Context c
c' {mustRun :: MustRun
mustRun = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x' then MustRun
MustRunOne else MustRun
NoMust, cache :: Cache
cache = Cache
cache}
                m (b, Cache) -> ((b, Cache) -> (b, Cache)) -> m (b, Cache)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v :: (b, Cache)
v -> ((b, Cache) -> b
forall a b. (a, b) -> a
fst (b, Cache)
v, Watch a -> Cache
forall a. Binary a => a -> Cache
toCache ((a
x, (b, Cache) -> Cache
forall a b. (a, b) -> b
snd (b, Cache)
v) :: Watch a))


-- | Run a task using the provided config and a list of dirty files.
--   This takes care of loading the existing cache and updating it.
runTask :: MonadIO m
        => [Glob.Pattern]  -- ^ Files for which we force recompilation
        -> Config          -- ^ The config
        -> Task m a        -- ^ The task
        -> m a
runTask :: [Pattern] -> Config -> Task m a -> m a
runTask force :: [Pattern]
force config :: Config
config (Recipe r :: Context () -> m (a, Cache)
r) = do
    Bool
cacheExists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (Config -> FilePath
Config.cacheFile Config
config)
    UTCTime
timestamp   <- if Bool
cacheExists then
                        IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> m UTCTime) -> IO UTCTime -> m UTCTime
forall a b. (a -> b) -> a -> b
$ FilePath -> IO UTCTime
getModificationTime (Config -> FilePath
Config.cacheFile Config
config)
                   else UTCTime -> m UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day
ModifiedJulianDay 0) 0)
    let ctx :: Cache -> a -> Context a
ctx = FilePath
-> FilePath
-> FilePath
-> UTCTime
-> [Pattern]
-> MustRun
-> Cache
-> a
-> Context a
forall a.
FilePath
-> FilePath
-> FilePath
-> UTCTime
-> [Pattern]
-> MustRun
-> Cache
-> a
-> Context a
Context (Config -> FilePath
Config.contentDir Config
config)
                      (Config -> FilePath
Config.outputDir Config
config)
                      ""
                      UTCTime
timestamp
                      [Pattern]
force
                      MustRun
NoMust
    (v :: a
v, cache' :: Cache
cache') <-
        if Bool
cacheExists then do
            Handle
handle <- IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openBinaryFile (Config -> FilePath
Config.cacheFile Config
config) IOMode
ReadMode
            Cache
cache  <- IO Cache -> m Cache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Cache -> m Cache) -> IO Cache -> m Cache
forall a b. (a -> b) -> a -> b
$ Handle -> IO Cache
ByteString.hGetContents Handle
handle
            (value :: a
value, cache' :: Cache
cache') <- Context () -> m (a, Cache)
r (Cache -> () -> Context ()
forall a. Cache -> a -> Context a
ctx Cache
cache ())
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
handle
            (a, Cache) -> m (a, Cache)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
value, Cache
cache')
        else do Context () -> m (a, Cache)
r (Cache -> () -> Context ()
forall a. Cache -> a -> Context a
ctx Cache
emptyCache ())
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Cache -> IO ()
ByteString.writeFile (Config -> FilePath
Config.cacheFile Config
config) Cache
cache'
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v