diff options
Diffstat (limited to 'src/Hakyll/Core')
-rw-r--r-- | src/Hakyll/Core/Compiler/Internal.hs | 5 | ||||
-rw-r--r-- | src/Hakyll/Core/Configuration.hs | 4 | ||||
-rw-r--r-- | src/Hakyll/Core/File.hs | 89 | ||||
-rw-r--r-- | src/Hakyll/Core/Runtime.hs | 7 | ||||
-rw-r--r-- | src/Hakyll/Core/Store.hs | 14 | ||||
-rw-r--r-- | src/Hakyll/Core/Util/File.hs | 13 | ||||
-rw-r--r-- | src/Hakyll/Core/Writable/CopyFile.hs | 43 |
7 files changed, 122 insertions, 53 deletions
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 |