diff options
| -rw-r--r-- | src/Hakyll/Check.hs | 4 | ||||
| -rw-r--r-- | src/Hakyll/Core/Configuration.hs | 38 | ||||
| -rw-r--r-- | src/Hakyll/Core/Provider.hs | 8 | ||||
| -rw-r--r-- | src/Hakyll/Core/Provider/Internal.hs | 8 | ||||
| -rw-r--r-- | src/Hakyll/Core/Util/File.hs | 15 | ||||
| -rw-r--r-- | src/Hakyll/Init.hs | 2 | ||||
| -rw-r--r-- | tests/TestSuite/Util.hs | 2 |
7 files changed, 47 insertions, 30 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 diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs index 6cef730..ef8768c 100644 --- a/tests/TestSuite/Util.hs +++ b/tests/TestSuite/Util.hs @@ -46,7 +46,7 @@ newTestStore = Store.new True $ storeDirectory testConfiguration -------------------------------------------------------------------------------- newTestProvider :: Store -> IO Provider -newTestProvider store = newProvider store (const False) $ +newTestProvider store = newProvider store (const $ return False) $ providerDirectory testConfiguration |