summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--hakyll.cabal4
-rw-r--r--src/Hakyll/Check.hs22
-rw-r--r--src/Hakyll/Core/Compiler.hs11
-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/UnixFilter.hs17
-rw-r--r--src/Hakyll/Core/Util/File.hs15
-rw-r--r--src/Hakyll/Init.hs2
-rw-r--r--tests/TestSuite/Util.hs2
-rw-r--r--web/examples.markdown2
11 files changed, 86 insertions, 43 deletions
diff --git a/hakyll.cabal b/hakyll.cabal
index f82daa8..de83ee4 100644
--- a/hakyll.cabal
+++ b/hakyll.cabal
@@ -139,7 +139,7 @@ Library
binary >= 0.5 && < 0.8,
blaze-html >= 0.5 && < 0.7,
blaze-markup >= 0.5.1 && < 0.6,
- bytestring >= 0.10 && < 0.11,
+ bytestring >= 0.9 && < 0.11,
citeproc-hs >= 0.3.2 && < 0.4,
containers >= 0.3 && < 0.6,
cryptohash >= 0.7 && < 0.9,
@@ -215,7 +215,7 @@ Test-suite hakyll-tests
binary >= 0.5 && < 0.8,
blaze-html >= 0.5 && < 0.7,
blaze-markup >= 0.5.1 && < 0.6,
- bytestring >= 0.10 && < 0.11,
+ bytestring >= 0.9 && < 0.11,
citeproc-hs >= 0.3.2 && < 0.4,
containers >= 0.3 && < 0.6,
cryptohash >= 0.7 && < 0.9,
diff --git a/src/Hakyll/Check.hs b/src/Hakyll/Check.hs
index 5c05aa5..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
@@ -137,9 +137,14 @@ checkFile filePath = do
--------------------------------------------------------------------------------
checkUrl :: FilePath -> String -> Checker ()
checkUrl filePath url
- | isExternal url = checkExternalUrl url
- | "mailto:" `isPrefixOf` url = ok url
- | otherwise = checkInternalUrl filePath url
+ | isExternal url = checkExternalUrl url
+ | hasProtocol url = skip "Unknown protocol, skipping"
+ | otherwise = checkInternalUrl filePath url
+ where
+ validProtoChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "+-."
+ hasProtocol str = case break (== ':') str of
+ (proto, ':' : _) -> all (`elem` validProtoChars) proto
+ _ -> False
--------------------------------------------------------------------------------
@@ -148,6 +153,13 @@ ok _ = tell $ mempty {checkerOk = 1}
--------------------------------------------------------------------------------
+skip :: String -> Checker ()
+skip reason = do
+ logger <- checkerLogger <$> ask
+ Logger.debug logger $ reason
+ tell $ mempty {checkerOk = 1}
+
+--------------------------------------------------------------------------------
faulty :: String -> Checker ()
faulty url = do
logger <- checkerLogger <$> ask
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index b711719..c0a217f 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -10,7 +10,7 @@ module Hakyll.Core.Compiler
, getResourceBody
, getResourceString
, getResourceLBS
- , getResourceWith
+ , getResourceFilePath
, Internal.Snapshot
, saveSnapshot
@@ -99,6 +99,15 @@ getResourceLBS = getResourceWith resourceLBS
--------------------------------------------------------------------------------
+-- | Get the file path of the resource we are compiling
+getResourceFilePath :: Compiler FilePath
+getResourceFilePath = do
+ provider <- compilerProvider <$> compilerAsk
+ id' <- compilerUnderlying <$> compilerAsk
+ return $ resourceFilePath provider id'
+
+
+--------------------------------------------------------------------------------
-- | Overloadable function for 'getResourceString' and 'getResourceLBS'
getResourceWith :: (Provider -> Identifier -> IO a) -> Compiler (Item a)
getResourceWith reader = do
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/UnixFilter.hs b/src/Hakyll/Core/UnixFilter.hs
index 6824bd8..1544bf2 100644
--- a/src/Hakyll/Core/UnixFilter.hs
+++ b/src/Hakyll/Core/UnixFilter.hs
@@ -9,7 +9,7 @@ module Hakyll.Core.UnixFilter
--------------------------------------------------------------------------------
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
-import Control.DeepSeq (NFData, deepseq)
+import Control.DeepSeq (deepseq)
import Control.Monad (forM_)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as LB
@@ -57,7 +57,8 @@ unixFilter = unixFilterWith writer reader
hPutStr handle input
reader handle = do
hSetEncoding handle localeEncoding
- hGetContents handle
+ out <- hGetContents handle
+ deepseq out (return out)
--------------------------------------------------------------------------------
@@ -70,12 +71,14 @@ unixFilterLBS :: String -- ^ Program name
-> [String] -- ^ Program args
-> ByteString -- ^ Program input
-> Compiler ByteString -- ^ Program output
-unixFilterLBS = unixFilterWith LB.hPutStr LB.hGetContents
+unixFilterLBS = unixFilterWith LB.hPutStr $ \handle -> do
+ out <- LB.hGetContents handle
+ LB.length out `seq` return out
--------------------------------------------------------------------------------
-- | Overloaded compiler
-unixFilterWith :: (Monoid o, NFData o)
+unixFilterWith :: Monoid o
=> (Handle -> i -> IO ()) -- ^ Writer
-> (Handle -> IO o) -- ^ Reader
-> String -- ^ Program name
@@ -96,7 +99,7 @@ unixFilterWith writer reader programName args input = do
--------------------------------------------------------------------------------
-- | Internally used function
-unixFilterIO :: (Monoid o, NFData o)
+unixFilterIO :: Monoid o
=> (Handle -> i -> IO ())
-> (Handle -> IO o)
-> String
@@ -122,14 +125,14 @@ unixFilterIO writer reader programName args input = do
-- Read from stdout
_ <- forkIO $ do
out <- reader outh
- deepseq out (hClose outh)
+ hClose outh
writeIORef outRef out
putMVar lock ()
-- Read from stderr
_ <- forkIO $ do
err <- hGetContents errh
- deepseq err (hClose errh)
+ hClose errh
writeIORef errRef err
putMVar lock ()
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
diff --git a/web/examples.markdown b/web/examples.markdown
index 98b4d6d..df6fc7c 100644
--- a/web/examples.markdown
+++ b/web/examples.markdown
@@ -29,6 +29,8 @@ this list. This list has no particular ordering.
[source](https://github.com/dannysu/hakyll-blog)
- <http://meta.plasm.us/>,
[source](https://github.com/travisbrown/metaplasm)
+- <http://www.web2day-nantes.org/>,
+ [source](https://github.com/CompanyCampus/web2day2013)
## Hakyll 3.X
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-08 18:56:03 +0000