Add TmpFile utilities

8 files changed, 125 insertions, 58 deletions

diff --git a/src/Hakyll/Commands.hs b/src/Hakyll/Commands.hs
index b7e85bc..61e40b8 100644
--- a/src/Hakyll/Commands.hs
+++ b/src/Hakyll/Commands.hs
@@ -13,9 +13,6 @@ module Hakyll.Commands
 
 
 --------------------------------------------------------------------------------
-import           Control.Monad              (when)
-import           System.Directory           (doesDirectoryExist,
-                                             removeDirectoryRecursive)
 import           System.Exit                (exitWith)
 import           System.Process             (system)
 
@@ -26,6 +23,7 @@ import           Hakyll.Core.Configuration
 import           Hakyll.Core.Logger         (Verbosity)
 import           Hakyll.Core.Rules
 import           Hakyll.Core.Runtime
+import           Hakyll.Core.Util.File
 
 
 --------------------------------------------------------------------------------
@@ -59,11 +57,11 @@ clean :: Configuration -> IO ()
 clean conf = do
     remove $ destinationDirectory conf
     remove $ storeDirectory conf
+    remove $ tmpDirectory conf
   where
     remove dir = do
         putStrLn $ "Removing " ++ dir ++ "..."
-        exists <- doesDirectoryExist dir
-        when exists $ removeDirectoryRecursive dir
+        removeDirectory dir
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 6e07602..be49e9f 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -34,6 +34,7 @@ import qualified Data.Set                       as S
 
 
 --------------------------------------------------------------------------------
+import           Hakyll.Core.Configuration
 import           Hakyll.Core.Dependencies
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Identifier.Pattern
@@ -47,7 +48,9 @@ import           Hakyll.Core.Store
 --------------------------------------------------------------------------------
 -- | Environment in which a compiler runs
 data CompilerRead = CompilerRead
-    { -- | Underlying identifier
+    { -- | Main configuration
+      compilerConfig     :: Configuration
+    , -- | Underlying identifier
       compilerUnderlying :: Identifier
     , -- | Resource provider
       compilerProvider   :: Provider
diff --git a/src/Hakyll/Core/Configuration.hs b/src/Hakyll/Core/Configuration.hs
index 86898dc..47de700 100644
--- a/src/Hakyll/Core/Configuration.hs
+++ b/src/Hakyll/Core/Configuration.hs
@@ -18,6 +18,8 @@ data Configuration = Configuration
       destinationDirectory :: FilePath
     , -- | Directory where hakyll's internal store is kept
       storeDirectory       :: FilePath
+    , -- | Directory in which some temporary files will be kept
+      tmpDirectory         :: FilePath
     , -- | Directory where hakyll finds the files to compile. This is @.@ by
       -- default.
       providerDirectory    :: FilePath
@@ -61,6 +63,7 @@ defaultConfiguration :: Configuration
 defaultConfiguration = Configuration
     { destinationDirectory = "_site"
     , storeDirectory       = "_cache"
+    , tmpDirectory         = "_cache/tmp"
     , providerDirectory    = "."
     , ignoreFile           = ignoreFile'
     , deployCommand        = "echo 'No deploy command specified'"
@@ -83,6 +86,7 @@ shouldIgnoreFile :: Configuration -> FilePath -> Bool
 shouldIgnoreFile conf path =
     destinationDirectory conf `isPrefixOf` path' ||
     storeDirectory conf `isPrefixOf` path' ||
+    tmpDirectory conf `isPrefixOf` path' ||
     ignoreFile conf path'
   where
     path' = normalise path
diff --git a/src/Hakyll/Core/File.hs b/src/Hakyll/Core/File.hs
new file mode 100644
index 0000000..a7b4a35
--- /dev/null
+++ b/src/Hakyll/Core/File.hs
@@ -0,0 +1,89 @@
+--------------------------------------------------------------------------------
+-- | Exports simple compilers to just copy files
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Hakyll.Core.File
+    ( CopyFile (..)
+    , copyFileCompiler
+    , TmpFile (..)
+    , newTmpFile
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Control.Applicative           ((<$>))
+import           Data.Binary                   (Binary (..))
+import           Data.Typeable                 (Typeable)
+import           System.Directory              (copyFile, doesFileExist,
+                                                renameFile)
+import           System.FilePath               ((</>))
+import           System.Random                 (randomIO)
+
+
+--------------------------------------------------------------------------------
+import           Hakyll.Core.Compiler
+import           Hakyll.Core.Compiler.Internal
+import           Hakyll.Core.Configuration
+import           Hakyll.Core.Identifier
+import           Hakyll.Core.Item
+import qualified Hakyll.Core.Store             as Store
+import           Hakyll.Core.Util.File
+import           Hakyll.Core.Writable
+
+
+--------------------------------------------------------------------------------
+-- | This will copy any file directly by using a system call
+data CopyFile = CopyFile
+    deriving (Show, Eq, Ord, Typeable)
+
+
+--------------------------------------------------------------------------------
+instance Binary CopyFile where
+    put CopyFile = return ()
+    get          = return CopyFile
+
+
+--------------------------------------------------------------------------------
+instance Writable CopyFile where
+    write dst item = copyFile (toFilePath $ itemIdentifier item) dst
+
+
+--------------------------------------------------------------------------------
+copyFileCompiler :: Compiler (Item CopyFile)
+copyFileCompiler = makeItem CopyFile
+
+
+--------------------------------------------------------------------------------
+newtype TmpFile = TmpFile FilePath
+    deriving (Typeable)
+
+
+--------------------------------------------------------------------------------
+instance Binary TmpFile where
+    put _ = return ()
+    get   = error $
+        "Hakyll.Core.File.TmpFile: You tried to load a TmpFile, however, " ++
+        "this is not possible since these are deleted as soon as possible."
+
+
+--------------------------------------------------------------------------------
+instance Writable TmpFile where
+    write dst (Item _ (TmpFile fp)) = renameFile fp dst
+
+
+--------------------------------------------------------------------------------
+-- | Create a tmp file
+newTmpFile :: String            -- ^ Suffix and extension
+           -> Compiler TmpFile  -- ^ Resulting tmp path
+newTmpFile suffix = do
+    path <- mkPath
+    compilerUnsafeIO $ makeDirectories path
+    debugCompiler $ "newTmpFile " ++ path
+    return $ TmpFile path
+  where
+    mkPath = do
+        rand <- compilerUnsafeIO $ randomIO :: Compiler Int
+        tmp  <- tmpDirectory . compilerConfig <$> compilerAsk
+        let path = tmp </> Store.hash [show rand] ++ "-" ++ suffix
+        exists <- compilerUnsafeIO $ doesFileExist path
+        if exists then mkPath else return path
diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs
index e052f37..4755a6a 100644
--- a/src/Hakyll/Core/Runtime.hs
+++ b/src/Hakyll/Core/Runtime.hs
@@ -85,6 +85,10 @@ run config verbosity rules = do
 
         Right (_, s, _) -> do
             Store.set store factsKey $ runtimeFacts s
+
+            Logger.debug logger "Removing tmp directory..."
+            removeDirectory $ tmpDirectory config
+
             Logger.flush logger
             return ruleSet
   where
@@ -180,7 +184,8 @@ chase trail id'
 
         let compiler = todo M.! id'
             read' = CompilerRead
-                { compilerUnderlying = id'
+                { compilerConfig     = config
+                , compilerUnderlying = id'
                 , compilerProvider   = provider
                 , compilerUniverse   = M.keysSet universe
                 , compilerRoutes     = routes
diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs
index 231da2a..63dd64c 100644
--- a/src/Hakyll/Core/Store.hs
+++ b/src/Hakyll/Core/Store.hs
@@ -9,6 +9,7 @@ module Hakyll.Core.Store
     , set
     , get
     , delete
+    , hash
     ) where
 
 
@@ -144,12 +145,13 @@ delete store identifier = do
 
 
 --------------------------------------------------------------------------------
-hash :: [String] -> String
-hash = concatMap (printf "%02x") . B.unpack .
-    MD5.hash . T.encodeUtf8 . T.pack . intercalate "/"
-
-
---------------------------------------------------------------------------------
 -- | Delete a file unless it doesn't exist...
 deleteFile :: FilePath -> IO ()
 deleteFile = handle (\(_ :: IOException) -> return ()) . removeFile
+
+
+--------------------------------------------------------------------------------
+-- | Mostly meant for internal usage
+hash :: [String] -> String
+hash = concatMap (printf "%02x") . B.unpack .
+    MD5.hash . T.encodeUtf8 . T.pack . intercalate "/"
diff --git a/src/Hakyll/Core/Util/File.hs b/src/Hakyll/Core/Util/File.hs
index 6d6b5c2..0e34d7c 100644
--- a/src/Hakyll/Core/Util/File.hs
+++ b/src/Hakyll/Core/Util/File.hs
@@ -3,14 +3,16 @@
 module Hakyll.Core.Util.File
     ( makeDirectories
     , getRecursiveContents
+    , removeDirectory
     ) where
 
 
 --------------------------------------------------------------------------------
 import           Control.Applicative ((<$>))
-import           Control.Monad       (forM)
+import           Control.Monad       (forM, when)
 import           System.Directory    (createDirectoryIfMissing,
-                                      doesDirectoryExist, getDirectoryContents)
+                                      doesDirectoryExist, getDirectoryContents,
+                                      removeDirectoryRecursive)
 import           System.FilePath     (takeDirectory, (</>))
 
 
@@ -42,3 +44,10 @@ getRecursiveContents top = go ""
                         else return [rel]
 
                 return $ concat paths
+
+
+--------------------------------------------------------------------------------
+removeDirectory :: FilePath -> IO ()
+removeDirectory fp = do
+    e <- doesDirectoryExist fp
+    when e $ removeDirectoryRecursive fp
diff --git a/src/Hakyll/Core/Writable/CopyFile.hs b/src/Hakyll/Core/Writable/CopyFile.hs
deleted file mode 100644
index 58397ac..0000000
--- a/src/Hakyll/Core/Writable/CopyFile.hs
+++ /dev/null
@@ -1,43 +0,0 @@
---------------------------------------------------------------------------------
--- | Exports simple compilers to just copy files
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Hakyll.Core.Writable.CopyFile
-    ( CopyFile (..)
-    , copyFileCompiler
-    ) where
-
-
---------------------------------------------------------------------------------
-import           Data.Binary            (Binary (..))
-import           Data.Typeable          (Typeable)
-import           System.Directory       (copyFile)
-
-
---------------------------------------------------------------------------------
-import           Hakyll.Core.Compiler
-import           Hakyll.Core.Identifier
-import           Hakyll.Core.Item
-import           Hakyll.Core.Writable
-
-
---------------------------------------------------------------------------------
--- | This will copy any file directly by using a system call
-data CopyFile = CopyFile
-    deriving (Show, Eq, Ord, Typeable)
-
-
---------------------------------------------------------------------------------
-instance Binary CopyFile where
-    put CopyFile = return ()
-    get          = return CopyFile
-
-
---------------------------------------------------------------------------------
-instance Writable CopyFile where
-    write dst item = copyFile (toFilePath $ itemIdentifier item) dst
-
-
---------------------------------------------------------------------------------
-copyFileCompiler :: Compiler (Item CopyFile)
-copyFileCompiler = makeItem CopyFile