Task.hs

{-# 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 ctx x = or (Glob.match <$> forceFiles ctx <*> pure 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 r :: Recipe m FilePath b) = Recipe \ctx -> do
    let (cached, c'@Context{..}) = fromContext ctx
    paths <- AchilleIO.glob (inputDir </> currentDir) pattern
             >>= filterM (AchilleIO.doesFileExist . ((inputDir </> currentDir) </>))
    case cached :: Maybe (Match b) of
        Nothing -> do
            result <- forM paths \p ->
                (p,) <$> r c' { inputValue = p
                              , cache = emptyCache
                              }
            return (map (fst . snd) result, toCache (result :: Match b))
        Just cached -> do
            result <- forM paths \p ->
                case lookup p cached of
                    Just (v, cache) -> (p,) <$> do
                        tfile  <- AchilleIO.getModificationTime (inputDir </> currentDir </> p)
                        if timestamp < tfile || shouldForce ctx (inputDir </> currentDir </> p) then
                            r c' {inputValue = p, cache = cache}
                        else pure (v, cache)
                    Nothing -> (p,) <$> r c' {inputValue = p, cache = emptyCache}
            return (map (fst . snd) result, toCache (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 r) = Recipe \ctx -> do
    let (result, c'@Context{..}) = fromContext ctx 
    paths <- AchilleIO.glob (inputDir </> currentDir) pattern
             >>= filterM (AchilleIO.doesFileExist . ((inputDir </> currentDir) </>))
    case result :: Maybe MatchVoid of
        Nothing -> do
            result <- forM paths \p ->
                ((p,) . snd) <$> r c' { inputValue = p
                                      , cache = emptyCache
                                      }
            return (() , toCache (result :: MatchVoid))
        Just cached -> do
            result <- forM paths \p ->
                case lookup p cached of
                    Just cache -> (p,) <$> do
                        tfile <- AchilleIO.getModificationTime (inputDir </> currentDir </> p)
                        if timestamp < tfile || shouldForce ctx (inputDir </> currentDir </> p) then
                            snd <$> r c' {inputValue = p, cache = cache}
                        else pure cache
                    Nothing -> ((p,) . snd) <$> r c' {inputValue = p, cache = emptyCache}
            return ((), toCache (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 p (Recipe r :: Recipe m FilePath a) = Recipe \ctx@Context{..} ->
    AchilleIO.glob (inputDir </> currentDir) p >>= \case
        [] -> AchilleIO.fail $ unwords
                  [ "No file was found matching pattern"
                  , Glob.decompile p
                  , "inside directory"
                  , currentDir
                  ]
        (p:xs) ->
            let (result, c'@Context{..}) = fromContext ctx
            in case result :: Maybe (Watch a) of
                Nothing -> r c' {cache = emptyCache, inputValue = p}
                                    <&> \v -> (fst v, toCache (v :: Watch a))
                Just (x, cache) -> do
                    tfile  <- AchilleIO.getModificationTime (inputDir </> currentDir </> p)
                    if timestamp < tfile || shouldForce ctx (inputDir </> currentDir </> p) then
                        r c' {cache = cache, inputValue = p}
                            <&> \v -> (fst v, toCache (v :: Watch a))
                    else pure (x, toCache ((x, 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 r) = Recipe \ctx -> do
    let (result, c'@Context{..}) = fromContext ctx 
    paths <- AchilleIO.glob (inputDir </> currentDir) pattern
    case result :: Maybe MatchDir of
        Nothing -> do
            result <- forM paths \p ->
                          r c' { inputValue = takeFileName p
                               , currentDir = currentDir </> takeDirectory p
                               , cache      = emptyCache
                               }
            return (map fst result, toCache (zip paths (map snd result) :: MatchDir))
        Just cached -> do
            result <- forM paths \p ->
                case lookup p cached of
                    Just cache -> r c' { inputValue = takeFileName p
                                       , currentDir = currentDir </> takeDirectory p
                                       , cache      = cache
                                       }
                    Nothing -> r c' {inputValue = p, cache = emptyCache}
            return (map fst result, toCache (zip paths (map snd 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 (x :: a) (Recipe r :: Recipe m1 c d) = Recipe \ctx ->
    let (result, c'@Context{..}) = fromContext ctx 
    in case result :: Maybe (With a d) of
        Nothing ->
            r c' {cache = emptyCache}
                <&> \v -> (fst v, toCache ((x, v) :: With a d))
        Just (x', (v, cache)) ->
            if x == x' then pure (v , toCache ((x', (v, cache)) :: With a d))
            else r c' <&> \v -> (fst v, toCache ((x, 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 (x :: a) (Recipe r :: Recipe m c b) = Recipe \ctx ->
    let (result, c'@Context{..}) = fromContext ctx
    in case result :: Maybe (Watch a) of
        Nothing ->
            r c' {cache = emptyCache}
                <&> \v -> (fst v, toCache ((x, snd v) :: Watch a))
        Just (x', cache) ->
            r c' {mustRun = if x /= x' then MustRunOne else NoMust, cache = cache}
                <&> \v -> (fst v, toCache ((x, snd 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 force config (Recipe r) = do
    cacheExists <- liftIO $ doesFileExist (Config.cacheFile config)
    timestamp   <- if cacheExists then
                        liftIO $ getModificationTime (Config.cacheFile config)
                   else pure (UTCTime (ModifiedJulianDay 0) 0)
    let ctx = Context (Config.contentDir config)
                      (Config.outputDir config)
                      ""
                      timestamp
                      force
                      NoMust
    (v, cache') <-
        if cacheExists then do
            handle <- liftIO $ openBinaryFile (Config.cacheFile config) ReadMode
            cache  <- liftIO $ ByteString.hGetContents handle
            (value, cache') <- r (ctx cache ())
            liftIO $ hClose handle
            pure (value, cache')
        else do r (ctx emptyCache ())
    liftIO $ ByteString.writeFile (Config.cacheFile config) cache'
    pure v