summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Check.hs4
-rw-r--r--src/Hakyll/Core/Configuration.hs38
-rw-r--r--src/Hakyll/Core/Provider.hs8
-rw-r--r--src/Hakyll/Core/Provider/Internal.hs8
-rw-r--r--src/Hakyll/Core/Util/File.hs15
-rw-r--r--src/Hakyll/Init.hs2
6 files changed, 46 insertions, 29 deletions
diff --git a/src/Hakyll/Check.hs b/src/Hakyll/Check.hs
index 6d75e2e..48bb655 100644
--- a/src/Hakyll/Check.hs
+++ b/src/Hakyll/Check.hs
@@ -109,8 +109,8 @@ runChecker checker config verbosity check' = do
checkDestination :: Checker ()
checkDestination = do
config <- checkerConfig <$> ask
- files <- liftIO $
- getRecursiveContents (const False) (destinationDirectory config)
+ files <- liftIO $ getRecursiveContents
+ (const $ return False) (destinationDirectory config)
let htmls =
[ destinationDirectory config </> file
diff --git a/src/Hakyll/Core/Configuration.hs b/src/Hakyll/Core/Configuration.hs
index 480c6c4..70a7a1c 100644
--- a/src/Hakyll/Core/Configuration.hs
+++ b/src/Hakyll/Core/Configuration.hs
@@ -8,11 +8,13 @@ module Hakyll.Core.Configuration
--------------------------------------------------------------------------------
-import Control.Monad (void)
-import Data.Default (Default(..))
-import Data.List (isPrefixOf, isSuffixOf)
-import System.FilePath (normalise, takeFileName)
-import System.Process (system)
+import Control.Monad (void)
+import Data.Default (Default (..))
+import Data.List (isPrefixOf, isSuffixOf)
+import System.Directory (canonicalizePath)
+import System.FilePath (isAbsolute, normalise, takeFileName)
+import System.IO.Error (catchIOError)
+import System.Process (system)
--------------------------------------------------------------------------------
@@ -99,11 +101,23 @@ defaultConfiguration = Configuration
--------------------------------------------------------------------------------
-- | Check if a file should be ignored
-shouldIgnoreFile :: Configuration -> FilePath -> Bool
-shouldIgnoreFile conf path =
- destinationDirectory conf `isPrefixOf` path' ||
- storeDirectory conf `isPrefixOf` path' ||
- tmpDirectory conf `isPrefixOf` path' ||
- ignoreFile conf path'
+shouldIgnoreFile :: Configuration -> FilePath -> IO Bool
+shouldIgnoreFile conf path = orM
+ [ inDir (destinationDirectory conf)
+ , inDir (storeDirectory conf)
+ , inDir (tmpDirectory conf)
+ , return (ignoreFile conf path')
+ ]
where
- path' = normalise path
+ path' = normalise path
+ absolute = isAbsolute path
+
+ inDir dir
+ | absolute = do
+ dir' <- catchIOError (canonicalizePath dir) (const $ return dir)
+ return $ dir' `isPrefixOf` path'
+ | otherwise = return $ dir `isPrefixOf` path'
+
+ orM :: [IO Bool] -> IO Bool
+ orM [] = return False
+ orM (x : xs) = x >>= \b -> if b then return True else orM xs
diff --git a/src/Hakyll/Core/Provider.hs b/src/Hakyll/Core/Provider.hs
index 400f044..384f5b1 100644
--- a/src/Hakyll/Core/Provider.hs
+++ b/src/Hakyll/Core/Provider.hs
@@ -31,10 +31,10 @@ import Hakyll.Core.Store (Store)
--------------------------------------------------------------------------------
-- | Create a resource provider
-newProvider :: Store -- ^ Store to use
- -> (FilePath -> Bool) -- ^ Should we ignore this file?
- -> FilePath -- ^ Search directory
- -> IO Internal.Provider -- ^ Resulting provider
+newProvider :: Store -- ^ Store to use
+ -> (FilePath -> IO Bool) -- ^ Should we ignore this file?
+ -> FilePath -- ^ Search directory
+ -> IO Internal.Provider -- ^ Resulting provider
newProvider store ignore directory = do
-- Delete metadata cache where necessary
p <- Internal.newProvider store ignore directory
diff --git a/src/Hakyll/Core/Provider/Internal.hs b/src/Hakyll/Core/Provider/Internal.hs
index 5c3d07e..583c665 100644
--- a/src/Hakyll/Core/Provider/Internal.hs
+++ b/src/Hakyll/Core/Provider/Internal.hs
@@ -103,10 +103,10 @@ data Provider = Provider
--------------------------------------------------------------------------------
-- | Create a resource provider
-newProvider :: Store -- ^ Store to use
- -> (FilePath -> Bool) -- ^ Should we ignore this file?
- -> FilePath -- ^ Search directory
- -> IO Provider -- ^ Resulting provider
+newProvider :: Store -- ^ Store to use
+ -> (FilePath -> IO Bool) -- ^ Should we ignore this file?
+ -> FilePath -- ^ Search directory
+ -> IO Provider -- ^ Resulting provider
newProvider store ignore directory = do
list <- map fromFilePath <$> getRecursiveContents ignore directory
let universe = S.fromList list
diff --git a/src/Hakyll/Core/Util/File.hs b/src/Hakyll/Core/Util/File.hs
index 20cfbbc..b20576f 100644
--- a/src/Hakyll/Core/Util/File.hs
+++ b/src/Hakyll/Core/Util/File.hs
@@ -9,7 +9,7 @@ module Hakyll.Core.Util.File
--------------------------------------------------------------------------------
import Control.Applicative ((<$>))
-import Control.Monad (forM, when)
+import Control.Monad (filterM, forM, when)
import System.Directory (createDirectoryIfMissing,
doesDirectoryExist, getDirectoryContents,
removeDirectoryRecursive)
@@ -25,18 +25,21 @@ makeDirectories = createDirectoryIfMissing True . takeDirectory
--------------------------------------------------------------------------------
-- | Get all contents of a directory.
-getRecursiveContents :: (FilePath -> Bool) -- ^ Ignore this file/directory
- -> FilePath -- ^ Directory to search
- -> IO [FilePath] -- ^ List of files found
+getRecursiveContents :: (FilePath -> IO Bool) -- ^ Ignore this file/directory
+ -> FilePath -- ^ Directory to search
+ -> IO [FilePath] -- ^ List of files found
getRecursiveContents ignore top = go ""
where
- isProper x = notElem x [".", ".."] && not (ignore x)
+ isProper x
+ | x `elem` [".", ".."] = return False
+ | otherwise = not <$> ignore x
+
go dir = do
dirExists <- doesDirectoryExist (top </> dir)
if not dirExists
then return []
else do
- names <- filter isProper <$> getDirectoryContents (top </> dir)
+ names <- filterM isProper =<< getDirectoryContents (top </> dir)
paths <- forM names $ \name -> do
let rel = dir </> name
isDirectory <- doesDirectoryExist (top </> rel)
diff --git a/src/Hakyll/Init.hs b/src/Hakyll/Init.hs
index 2a92340..d50c6f6 100644
--- a/src/Hakyll/Init.hs
+++ b/src/Hakyll/Init.hs
@@ -23,7 +23,7 @@ main = do
progName <- getProgName
args <- getArgs
srcDir <- getDataFileName "example"
- files <- getRecursiveContents (const False) srcDir
+ files <- getRecursiveContents (const $ return False) srcDir
case args of
[dstDir] -> forM_ files $ \file -> do