{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE LambdaCase #-}
module Development.Shake.Persist (newCachePersist, persist) where
import Development.Shake
import Development.Shake.FilePath
import qualified System.Directory as Sys
import System.IO.Unsafe
import Data.Binary
import Data.Monoid
import Language.Haskell.TH
import Data.Char

locateTemporaryDirectory :: IO FilePath
locateTemporaryDirectory = Sys.doesDirectoryExist ".shake" >>= \case
  True -> do
    cwd <- Sys.getCurrentDirectory
    pure $ cwd </> ".shake"
  False -> do
    home <- Sys.getHomeDirectory
    pure $ home </> ".cache/shake-persist"

-- | Sometimes you want cache some computation, dependent on content of
-- some file, between different executions of build system.
--
-- This function provides such functionality: given procedure, that
-- extract some value from file and string, uniquely describing
-- that procedure, function in 'Rules' monad returned, that
-- caches extracted value across multiple invocations of build system.
newCachePersist :: Binary a => String
                -> (FilePath -> Action a)
                -> Rules (FilePath -> Action a)
newCachePersist suffix gen = do
  let tmpdir = unsafePerformIO locateTemporaryDirectory
  tmpdir <//> "*" <.> suffix %> \out -> do
    let file = takeBaseName . drop (length tmpdir) $ out
    need [file]
    gen file >>= liftIO . encodeFile out
  newCache $ \file' -> do
    cwd <- liftIO Sys.getCurrentDirectory
    let file = cwd </> file'
        cacheFile = tmpdir <> file <.> suffix
    need [cacheFile]
    liftIO $ decodeFile cacheFile


-- | Template-haskell function, that can be used to automatically derive
-- suffix argument for 'newCachePersist'. Usually it will be used as follows:
--
-- @
--   $(persist [| generateStuffFromFile |]) :: Rules (FilePath -> Value)
-- @
persist :: ExpQ -> ExpQ
persist fnQ = do
  suffix <- fmap (filter (\x -> not $ isSpace x || x == '.') . show) fnQ
  [| newCachePersist suffix $fnQ |]