f5a6c49 · hakyll · git.iko.soy

git.iko.soy/hakyll

Hakyll now passes HLint.

commitf5a6c4974d561e05b2882d38b54b45188ee31185 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateTue 19 Jan 2010, 14:08 (17 years ago) parente9dd4c7

11 files changed+48−48

compare with master

unifiedsplit

src/Network/Hakyll/SimpleServer.hs+12−13 src/Text/Hakyll.hs+3−3 src/Text/Hakyll/CompressCSS.hs+1−1 src/Text/Hakyll/File.hs+5−7 src/Text/Hakyll/Page.hs+4−3 src/Text/Hakyll/Regex.hs+8−6 src/Text/Hakyll/Render.hs+1−1 src/Text/Hakyll/Render/Internal.hs+3−3 src/Text/Hakyll/Renderables.hs+3−3 src/Text/Hakyll/Tags.hs+7−7 src/Text/Hakyll/Util.hs+1−1

src/Network/Hakyll/SimpleServer.hs+12−13

@@ -49,10 +49,11 @@ readRequest :: Handle -> Server Request

4949readRequest handle = do

5050 requestLine <- liftIO $ hGetLine handle

5151 let [method, uri, version] = map trim $ splitRegex " " requestLine

52− return $ Request { requestMethod = method

53− , requestURI = uri

54− , requestVersion = version

55− }

52+ request = Request { requestMethod = method

53+ , requestURI = uri

54+ , requestVersion = version

55+ }

56+ return request

5657

5758-- | Simple representation of the HTTP response we send back.

5859data Response = Response { responseVersion :: String

@@ -64,7 +65,7 @@ data Response = Response { responseVersion :: String

6465

6566instance Show Response where

6667 show response = responseVersion response ++ " "

67− ++ (show $ responseStatusCode response) ++ " "

68+ ++ show (responseStatusCode response) ++ " "

6869 ++ responsePhrase response

6970

7071-- | A default response.

@@ -105,20 +106,19 @@ createGetResponse request = do

105106 log' = writeChan (logChannel config)

106107 isDirectory <- liftIO $ doesDirectoryExist $ documentRoot config ++ uri

107108 let fileName =

108− (documentRoot config) ++ if isDirectory then uri ++ "/index.html"

109− else uri

109+ documentRoot config ++ if isDirectory then uri ++ "/index.html"

110+ else uri

110111

111112 create200 = do

112113 h <- openBinaryFile fileName ReadMode

113114 contentLength <- hFileSize h

114115 body <- hGetContents h

115− let headers =

116− [ ("Content-Length", show $ contentLength)

117− ] ++ getMIMEHeader fileName

116+ let mimeHeader = getMIMEHeader fileName

117+ headers = ("Content-Length", show contentLength) : mimeHeader

118118 return $ defaultResponse

119119 { responseStatusCode = 200

120120 , responsePhrase = "OK"

121− , responseHeaders = (responseHeaders defaultResponse)

121+ , responseHeaders = responseHeaders defaultResponse

122122 `M.union` M.fromList headers

123123 , responseBody = body

124124 }

@@ -131,8 +131,7 @@ createGetResponse request = do

131131 -- Send back the page if found.

132132 exists <- liftIO $ doesFileExist fileName

133133 if exists

134− then do response <- liftIO $ catch create200 create500

135− return response

134+ then liftIO $ catch create200 create500

136135 else do liftIO $ log' $ "Not Found: " ++ fileName

137136 return $ createErrorResponse 404 "Not Found"

138137

src/Text/Hakyll.hs+3−3

@@ -4,6 +4,7 @@ module Text.Hakyll

44 ) where

66import Control.Monad.Reader (runReaderT)

7+import Control.Monad (when)

78import qualified Data.Map as M

89import System.Environment (getArgs, getProgName)

910import System.Directory (doesDirectoryExist, removeDirectoryRecursive)

@@ -43,8 +44,7 @@ clean = do remove' "_cache"

4344 where

4445 remove' dir = do putStrLn $ "Removing " ++ dir ++ "..."

4546 exists <- doesDirectoryExist dir

46− if exists then removeDirectoryRecursive dir

47− else return ()

47+ when exists $ removeDirectoryRecursive dir

4848

4949-- | Show usage information.

5050help :: IO ()

@@ -61,4 +61,4 @@ help = do

6161 ++ name ++ " server [port] Run a local test server.\n"

6262

6363server :: Integer -> IO ()

64−server p = do simpleServer (fromIntegral $ p) "_site"

64+server p = simpleServer (fromIntegral p) "_site"

src/Text/Hakyll/CompressCSS.hs+1−1

@@ -27,7 +27,7 @@ stripComments :: String -> String

2727stripComments [] = []

2828stripComments str

2929 | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str

30− | otherwise = (head str) : (stripComments $ tail str)

30+ | otherwise = head str : stripComments (tail str)

3131 where

3232 eatComments str' | null str' = []

3333 | isPrefixOf "*/" str' = drop 2 str'

src/Text/Hakyll/File.hs+5−7

@@ -26,19 +26,19 @@ import Text.Hakyll.Hakyll (Hakyll)

2626removeLeadingSeparator :: FilePath -> FilePath

2727removeLeadingSeparator [] = []

2828removeLeadingSeparator path

29− | (head path') `elem` pathSeparators = (tail path')

30− | otherwise = path'

29+ | head path' `elem` pathSeparators = tail path'

30+ | otherwise = path'

3131 where

3232 path' = if "$root" `isPrefixOf` path then drop 5 path

3333 else path

3434

3535-- | Convert a relative filepath to a filepath in the destination (@_site@).

3636toDestination :: FilePath -> FilePath

37−toDestination path = "_site" </> (removeLeadingSeparator path)

37+toDestination path = "_site" </> removeLeadingSeparator path

3838

3939-- | Convert a relative filepath to a filepath in the cache (@_cache@).

4040toCache :: FilePath -> FilePath

41−toCache path = "_cache" </> (removeLeadingSeparator path)

41+toCache path = "_cache" </> removeLeadingSeparator path

4242

4343-- | Get the url for a given page.

4444toURL :: FilePath -> FilePath

@@ -106,9 +106,7 @@ havingExtension extension = filter ((==) extension . takeExtension)

106106

107107-- | Perform a Hakyll action on every file in a given directory.

108108directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()

109−directory action dir = do

110− contents <- getRecursiveContents dir

111− mapM_ action contents

109+directory action dir = getRecursiveContents dir >>= mapM_ action

112110

113111-- | Check if a cache file is still valid.

114112isCacheValid :: FilePath -- ^ The cached file.

src/Text/Hakyll/Page.hs+4−3

@@ -11,6 +11,7 @@ import qualified Data.List as L

1111import Data.Maybe (fromMaybe)

1212import Control.Parallel.Strategies (rdeepseq, ($|))

1313import Control.Monad.Reader (liftIO)

14+import Control.Monad (unless)

1415import System.FilePath (takeExtension)

1516import System.IO

1617

@@ -120,11 +121,11 @@ readSection renderFunction isFirst ls

120121 | otherwise = body (tail ls)

121122 where

122123 isDelimiter' = isDelimiter (head ls)

123− isNamedDelimiter = (head ls) `matchesRegex` "----* *[a-zA-Z][a-zA-Z]*"

124+ isNamedDelimiter = head ls `matchesRegex` "----* *[a-zA-Z][a-zA-Z]*"

124125 body ls' = [("body", renderFunction $ unlines ls')]

125126

126127 readSimpleMetaData = map readPair

127− readPair = (trimPair . break (== ':'))

128+ readPair = trimPair . break (== ':')

128129 trimPair (key, value) = (trim key, trim $ tail value)

129130

130131 readSectionMetaData [] = []

@@ -157,7 +158,7 @@ readPage pagePath = do

157158 seq (($|) id rdeepseq context) $ liftIO $ hClose handle

158159

159160 -- Cache if needed

160− if getFromCache then return () else cachePage page

161+ unless getFromCache $ cachePage page

161162 return page

162163 where

163164 url = toURL pagePath

src/Text/Hakyll/Regex.hs+8−6

@@ -12,7 +12,7 @@ import Text.Regex.TDFA

1212-- | Match a regular expression against a string, returning more information

1313-- about the match.

1414matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String])

15−matchRegexAll p str = matchM p str

15+matchRegexAll = matchM

1616

1717-- | Replaces every occurance of the given regexp with the replacement string.

1818subRegex :: Regex -- ^ Search pattern

@@ -30,10 +30,10 @@ subRegex regexp inp replacement =

3030 Nothing -> repl

3131 Just (lead, _, trail, bgroups) ->

3232 let newval =

33− if (head bgroups) == "\\"

33+ if head bgroups == "\\"

3434 then "\\"

3535 else let index :: Int

36− index = (read (head bgroups)) - 1

36+ index = read (head bgroups) - 1

3737 in if index == -1

3838 then match'

3939 else groups !! index

@@ -41,7 +41,7 @@ subRegex regexp inp replacement =

4141 in case matchRegexAll regexp inp of

4242 Nothing -> inp

4343 Just (lead, match', trail, groups) ->

44− lead ++ lookup' match' replacement groups ++ (subRegex regexp trail replacement)

44+ lead ++ lookup' match' replacement groups ++ subRegex regexp trail replacement

4545

4646-- | Splits a string based on a regular expression. The regular expression

4747-- should identify one delimiter.

@@ -70,5 +70,7 @@ substituteRegex pattern replacement string =

7070 subRegex (makeRegex pattern) string replacement

7171

7272-- | Simple regex matching.

73−matchesRegex :: String -> String -> Bool

74−matchesRegex string pattern = string =~ pattern

73+matchesRegex :: String -- ^ Input string.

74+ -> String -- ^ Pattern to match.

75+ -> Bool

76+matchesRegex = (=~)

src/Text/Hakyll/Render.hs+1−1

@@ -99,7 +99,7 @@ renderChainWith :: Renderable a

9999renderChainWith manipulation templatePaths renderable =

100100 depends (getURL renderable) dependencies render'

101101 where

102− dependencies = (getDependencies renderable) ++ templatePaths

102+ dependencies = getDependencies renderable ++ templatePaths

103103 render' = do templates <- liftIO $ mapM readFile templatePaths

104104 context <- toContext renderable

105105 let result = pureRenderChainWith manipulation templates context

src/Text/Hakyll/Render/Internal.hs+3−3

@@ -30,10 +30,10 @@ substitute _ [] _ = []

3030substitute escaper string context

3131 | "$$" `isPrefixOf` string = escaper ++ substitute' (tail tail')

3232 | "$" `isPrefixOf` string = substituteKey

33− | otherwise = (head string) : (substitute' tail')

33+ | otherwise = head string : substitute' tail'

3434 where

3535 tail' = tail string

36− (key, rest) = break (not . isAlpha) tail'

36+ (key, rest) = span isAlpha tail'

3737 replacement = fromMaybe ('$' : key) $ M.lookup key context

3838 substituteKey = replacement ++ substitute' rest

3939 substitute' str = substitute escaper str context

@@ -86,7 +86,7 @@ writePage :: Page -> Hakyll ()

8686writePage page = do

8787 additionalContext' <- askHakyll additionalContext

8888 let destination = toDestination url

89− context = additionalContext' `M.union` (M.singleton "root" $ toRoot url)

89+ context = additionalContext' `M.union` M.singleton "root" (toRoot url)

9090 makeDirectories destination

9191 -- Substitute $root here, just before writing.

9292 liftIO $ writeFile destination $ finalSubstitute (getBody page) context

src/Text/Hakyll/Renderables.hs+3−3

@@ -40,8 +40,8 @@ instance Renderable CustomPage where

4040 getURL = customPageURL

4141 toContext page = do

4242 values <- mapM (either return id . snd) (customPageContext page)

43− return $ M.fromList $ [ ("url", customPageURL page)

44− ] ++ zip (map fst $ customPageContext page) values

43+ let pairs = zip (map fst $ customPageContext page) values

44+ return $ M.fromList $ ("url", customPageURL page) : pairs

4545

4646-- | PagePath is a class that wraps a FilePath. This is used to render Pages

4747-- without reading them first through use of caching.

@@ -96,4 +96,4 @@ instance (Renderable a, Renderable b)

9696 return $ c1 `M.union` c2

9797 toContext (CombinedRenderableWithURL url a b) = do

9898 c <- toContext (CombinedRenderable a b)

99− return $ (M.singleton "url" url) `M.union` c

99+ return $ M.singleton "url" url `M.union` c

src/Text/Hakyll/Tags.hs+7−7

@@ -26,8 +26,8 @@ readTagMap paths = foldM addPaths M.empty paths

2626 where

2727 addPaths current path = do

2828 page <- readPage path

29− let tags = map trim $ splitRegex "," $ getValue ("tags") page

30− return $ foldr (\t -> M.insertWith (++) t [path]) current tags

29+ let tags = map trim $ splitRegex "," $ getValue "tags" page

30+ return $ foldr (flip (M.insertWith (++)) [path]) current tags

3131

3232-- | Render a tag cloud.

3333renderTagCloud :: M.Map String [FilePath] -- ^ Map as produced by "readTagMap".

@@ -50,10 +50,10 @@ renderTagCloud tagMap urlFunction minSize maxSize =

5050 sizeTag count = show size' ++ "%"

5151 where

5252 size' :: Int

53− size' = floor (minSize + (relative count) * (maxSize - minSize))

53+ size' = floor $ minSize + relative count * (maxSize - minSize)

5454

55− minCount = minimum $ map snd $ tagCount

56− maxCount = maximum $ map snd $ tagCount

55+ minCount = minimum $ map snd tagCount

56+ maxCount = maximum $ map snd tagCount

5757 relative count = (count - minCount) / (maxCount - minCount)

5858

5959 tagCount :: [(String, Float)]

@@ -65,5 +65,5 @@ renderTagLinks :: (String -> String) -- ^ Function that produces an url for a ta

6565renderTagLinks urlFunction = renderValue "tags" "tags" renderTagLinks'

6666 where

6767 renderTagLinks' = intercalate ", "

68− . map (\t -> link t $ urlFunction t)

69− . map trim . splitRegex ","

68+ . map ((\t -> link t $ urlFunction t) . trim)

69+ . splitRegex ","

src/Text/Hakyll/Util.hs+1−1

@@ -17,7 +17,7 @@ stripHTML :: String -> String

1717stripHTML [] = []

1818stripHTML str = let (beforeTag, rest) = break (== '<') str

1919 (_, afterTag) = break (== '>') rest

20− in beforeTag ++ (stripHTML $ tail' afterTag)

20+ in beforeTag ++ stripHTML (tail' afterTag)

2121 -- We need a failsafe tail function.

2222 where

2323 tail' [] = []