b5e34c6 · hakyll · git.iko.soy

git.iko.soy/hakyll

Merge github.com:jaspervdj/hakyll into fsnotify

commitb5e34c64a78c687fa8c0fef6c4afb2fd77cc2414 authorSimonas Kazlauskas <git@kazlauskas.me> dateWed 3 Apr 2013, 13:11 (14 years ago) parent259190e c40cf28

11 files changed+86−43

compare with master

unifiedsplit

hakyll.cabal+2−2 src/Hakyll/Check.hs+17−5 src/Hakyll/Core/Compiler.hs+10−1 src/Hakyll/Core/Configuration.hs+26−12 src/Hakyll/Core/Provider.hs+4−4 src/Hakyll/Core/Provider/Internal.hs+4−4 src/Hakyll/Core/UnixFilter.hs+10−7 src/Hakyll/Core/Util/File.hs+9−6 src/Hakyll/Init.hs+1−1 tests/TestSuite/Util.hs+1−1 web/examples.markdown+2

hakyll.cabal+2−2

@@ -139,7 +139,7 @@ Library

139139 binary >= 0.5 && < 0.8,

140140 blaze-html >= 0.5 && < 0.7,

141141 blaze-markup >= 0.5.1 && < 0.6,

142− bytestring >= 0.10 && < 0.11,

142+ bytestring >= 0.9 && < 0.11,

143143 citeproc-hs >= 0.3.2 && < 0.4,

144144 containers >= 0.3 && < 0.6,

145145 cryptohash >= 0.7 && < 0.9,

@@ -215,7 +215,7 @@ Test-suite hakyll-tests

215215 binary >= 0.5 && < 0.8,

216216 blaze-html >= 0.5 && < 0.7,

217217 blaze-markup >= 0.5.1 && < 0.6,

218− bytestring >= 0.10 && < 0.11,

218+ bytestring >= 0.9 && < 0.11,

219219 citeproc-hs >= 0.3.2 && < 0.4,

220220 containers >= 0.3 && < 0.6,

221221 cryptohash >= 0.7 && < 0.9,

src/Hakyll/Check.hs+17−5

@@ -109,8 +109,8 @@ runChecker checker config verbosity check' = do

109109checkDestination :: Checker ()

110110checkDestination = do

111111 config <- checkerConfig <$> ask

112− files <- liftIO $

113− getRecursiveContents (const False) (destinationDirectory config)

112+ files <- liftIO $ getRecursiveContents

113+ (const $ return False) (destinationDirectory config)

114114

115115 let htmls =

116116 [ destinationDirectory config </> file

@@ -137,9 +137,14 @@ checkFile filePath = do

137137--------------------------------------------------------------------------------

138138checkUrl :: FilePath -> String -> Checker ()

139139checkUrl filePath url

140− | isExternal url = checkExternalUrl url

141− | "mailto:" `isPrefixOf` url = ok url

142− | otherwise = checkInternalUrl filePath url

140+ | isExternal url = checkExternalUrl url

141+ | hasProtocol url = skip "Unknown protocol, skipping"

142+ | otherwise = checkInternalUrl filePath url

143+ where

144+ validProtoChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "+-."

145+ hasProtocol str = case break (== ':') str of

146+ (proto, ':' : _) -> all (`elem` validProtoChars) proto

147+ _ -> False

143148

144149

145150--------------------------------------------------------------------------------

@@ -147,6 +152,13 @@ ok :: String -> Checker ()

147152ok _ = tell $ mempty {checkerOk = 1}

148153

149154

155+--------------------------------------------------------------------------------

156+skip :: String -> Checker ()

157+skip reason = do

158+ logger <- checkerLogger <$> ask

159+ Logger.debug logger $ reason

160+ tell $ mempty {checkerOk = 1}

161+

150162--------------------------------------------------------------------------------

151163faulty :: String -> Checker ()

152164faulty url = do

src/Hakyll/Core/Compiler.hs+10−1

@@ -10,7 +10,7 @@ module Hakyll.Core.Compiler

1010 , getResourceBody

1111 , getResourceString

1212 , getResourceLBS

13− , getResourceWith

13+ , getResourceFilePath

1414

1515 , Internal.Snapshot

1616 , saveSnapshot

@@ -98,6 +98,15 @@ getResourceLBS :: Compiler (Item ByteString)

9898getResourceLBS = getResourceWith resourceLBS

9999

100100

101+--------------------------------------------------------------------------------

102+-- | Get the file path of the resource we are compiling

103+getResourceFilePath :: Compiler FilePath

104+getResourceFilePath = do

105+ provider <- compilerProvider <$> compilerAsk

106+ id' <- compilerUnderlying <$> compilerAsk

107+ return $ resourceFilePath provider id'

108+

109+

101110--------------------------------------------------------------------------------

102111-- | Overloadable function for 'getResourceString' and 'getResourceLBS'

103112getResourceWith :: (Provider -> Identifier -> IO a) -> Compiler (Item a)

src/Hakyll/Core/Configuration.hs+26−12

@@ -8,11 +8,13 @@ module Hakyll.Core.Configuration

1010--------------------------------------------------------------------------------

11−import Control.Monad (void)

12−import Data.Default (Default(..))

13−import Data.List (isPrefixOf, isSuffixOf)

14−import System.FilePath (normalise, takeFileName)

15−import System.Process (system)

11+import Control.Monad (void)

12+import Data.Default (Default (..))

13+import Data.List (isPrefixOf, isSuffixOf)

14+import System.Directory (canonicalizePath)

15+import System.FilePath (isAbsolute, normalise, takeFileName)

16+import System.IO.Error (catchIOError)

17+import System.Process (system)

1618

1719

1820--------------------------------------------------------------------------------

@@ -99,11 +101,23 @@ defaultConfiguration = Configuration

99101

100102--------------------------------------------------------------------------------

101103-- | Check if a file should be ignored

102−shouldIgnoreFile :: Configuration -> FilePath -> Bool

103−shouldIgnoreFile conf path =

104− destinationDirectory conf `isPrefixOf` path' ||

105− storeDirectory conf `isPrefixOf` path' ||

106− tmpDirectory conf `isPrefixOf` path' ||

107− ignoreFile conf path'

104+shouldIgnoreFile :: Configuration -> FilePath -> IO Bool

105+shouldIgnoreFile conf path = orM

106+ [ inDir (destinationDirectory conf)

107+ , inDir (storeDirectory conf)

108+ , inDir (tmpDirectory conf)

109+ , return (ignoreFile conf path')

110+ ]

108111 where

109− path' = normalise path

112+ path' = normalise path

113+ absolute = isAbsolute path

114+

115+ inDir dir

116+ | absolute = do

117+ dir' <- catchIOError (canonicalizePath dir) (const $ return dir)

118+ return $ dir' `isPrefixOf` path'

119+ | otherwise = return $ dir `isPrefixOf` path'

120+

121+ orM :: [IO Bool] -> IO Bool

122+ orM [] = return False

123+ orM (x : xs) = x >>= \b -> if b then return True else orM xs

src/Hakyll/Core/Provider.hs+4−4

@@ -31,10 +31,10 @@ import Hakyll.Core.Store (Store)

3131

3232--------------------------------------------------------------------------------

3333-- | Create a resource provider

34−newProvider :: Store -- ^ Store to use

35− -> (FilePath -> Bool) -- ^ Should we ignore this file?

36− -> FilePath -- ^ Search directory

37− -> IO Internal.Provider -- ^ Resulting provider

34+newProvider :: Store -- ^ Store to use

35+ -> (FilePath -> IO Bool) -- ^ Should we ignore this file?

36+ -> FilePath -- ^ Search directory

37+ -> IO Internal.Provider -- ^ Resulting provider

3838newProvider store ignore directory = do

3939 -- Delete metadata cache where necessary

4040 p <- Internal.newProvider store ignore directory

src/Hakyll/Core/Provider/Internal.hs+4−4

@@ -103,10 +103,10 @@ data Provider = Provider

103103

104104--------------------------------------------------------------------------------

105105-- | Create a resource provider

106−newProvider :: Store -- ^ Store to use

107− -> (FilePath -> Bool) -- ^ Should we ignore this file?

108− -> FilePath -- ^ Search directory

109− -> IO Provider -- ^ Resulting provider

106+newProvider :: Store -- ^ Store to use

107+ -> (FilePath -> IO Bool) -- ^ Should we ignore this file?

108+ -> FilePath -- ^ Search directory

109+ -> IO Provider -- ^ Resulting provider

110110newProvider store ignore directory = do

111111 list <- map fromFilePath <$> getRecursiveContents ignore directory

112112 let universe = S.fromList list

src/Hakyll/Core/UnixFilter.hs+10−7

@@ -9,7 +9,7 @@ module Hakyll.Core.UnixFilter

99--------------------------------------------------------------------------------

1010import Control.Concurrent (forkIO)

1111import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)

12−import Control.DeepSeq (NFData, deepseq)

12+import Control.DeepSeq (deepseq)

1313import Control.Monad (forM_)

1414import Data.ByteString.Lazy (ByteString)

1515import qualified Data.ByteString.Lazy as LB

@@ -57,7 +57,8 @@ unixFilter = unixFilterWith writer reader

5757 hPutStr handle input

5858 reader handle = do

5959 hSetEncoding handle localeEncoding

60− hGetContents handle

60+ out <- hGetContents handle

61+ deepseq out (return out)

6162

6263

6364--------------------------------------------------------------------------------

@@ -70,12 +71,14 @@ unixFilterLBS :: String -- ^ Program name

7071 -> [String] -- ^ Program args

7172 -> ByteString -- ^ Program input

7273 -> Compiler ByteString -- ^ Program output

73−unixFilterLBS = unixFilterWith LB.hPutStr LB.hGetContents

74+unixFilterLBS = unixFilterWith LB.hPutStr $ \handle -> do

75+ out <- LB.hGetContents handle

76+ LB.length out `seq` return out

7477

7578

7679--------------------------------------------------------------------------------

7780-- | Overloaded compiler

78−unixFilterWith :: (Monoid o, NFData o)

81+unixFilterWith :: Monoid o

7982 => (Handle -> i -> IO ()) -- ^ Writer

8083 -> (Handle -> IO o) -- ^ Reader

8184 -> String -- ^ Program name

@@ -96,7 +99,7 @@ unixFilterWith writer reader programName args input = do

9699

97100--------------------------------------------------------------------------------

98101-- | Internally used function

99−unixFilterIO :: (Monoid o, NFData o)

102+unixFilterIO :: Monoid o

100103 => (Handle -> i -> IO ())

101104 -> (Handle -> IO o)

102105 -> String

@@ -122,14 +125,14 @@ unixFilterIO writer reader programName args input = do

122125 -- Read from stdout

123126 _ <- forkIO $ do

124127 out <- reader outh

125− deepseq out (hClose outh)

128+ hClose outh

126129 writeIORef outRef out

127130 putMVar lock ()

128131

129132 -- Read from stderr

130133 _ <- forkIO $ do

131134 err <- hGetContents errh

132− deepseq err (hClose errh)

135+ hClose errh

133136 writeIORef errRef err

134137 putMVar lock ()

135138

src/Hakyll/Core/Util/File.hs+9−6

@@ -9,7 +9,7 @@ module Hakyll.Core.Util.File

1010--------------------------------------------------------------------------------

1111import Control.Applicative ((<$>))

12−import Control.Monad (forM, when)

12+import Control.Monad (filterM, forM, when)

1313import System.Directory (createDirectoryIfMissing,

1414 doesDirectoryExist, getDirectoryContents,

1515 removeDirectoryRecursive)

@@ -25,18 +25,21 @@ makeDirectories = createDirectoryIfMissing True . takeDirectory

2525

2626--------------------------------------------------------------------------------

2727-- | Get all contents of a directory.

28−getRecursiveContents :: (FilePath -> Bool) -- ^ Ignore this file/directory

29− -> FilePath -- ^ Directory to search

30− -> IO [FilePath] -- ^ List of files found

28+getRecursiveContents :: (FilePath -> IO Bool) -- ^ Ignore this file/directory

29+ -> FilePath -- ^ Directory to search

30+ -> IO [FilePath] -- ^ List of files found

3131getRecursiveContents ignore top = go ""

3232 where

33− isProper x = notElem x [".", ".."] && not (ignore x)

33+ isProper x

34+ | x `elem` [".", ".."] = return False

35+ | otherwise = not <$> ignore x

36+

3437 go dir = do

3538 dirExists <- doesDirectoryExist (top </> dir)

3639 if not dirExists

3740 then return []

3841 else do

39− names <- filter isProper <$> getDirectoryContents (top </> dir)

42+ names <- filterM isProper =<< getDirectoryContents (top </> dir)

4043 paths <- forM names $ \name -> do

4144 let rel = dir </> name

4245 isDirectory <- doesDirectoryExist (top </> rel)

src/Hakyll/Init.hs+1−1

@@ -23,7 +23,7 @@ main = do

2323 progName <- getProgName

2424 args <- getArgs

2525 srcDir <- getDataFileName "example"

26− files <- getRecursiveContents (const False) srcDir

26+ files <- getRecursiveContents (const $ return False) srcDir

2727

2828 case args of

2929 [dstDir] -> forM_ files $ \file -> do

tests/TestSuite/Util.hs+1−1

@@ -46,7 +46,7 @@ newTestStore = Store.new True $ storeDirectory testConfiguration

4646

4747--------------------------------------------------------------------------------

4848newTestProvider :: Store -> IO Provider

49−newTestProvider store = newProvider store (const False) $

49+newTestProvider store = newProvider store (const $ return False) $

5050 providerDirectory testConfiguration

5151

5252

web/examples.markdown+2

@@ -29,6 +29,8 @@ this list. This list has no particular ordering.

2929 [source](https://github.com/dannysu/hakyll-blog)

3030- <http://meta.plasm.us/>,

3131 [source](https://github.com/travisbrown/metaplasm)

32+- <http://www.web2day-nantes.org/>,

33+ [source](https://github.com/CompanyCampus/web2day2013)

3234

3335## Hakyll 3.X

3436