Hakyll now passes HLint.
This commit is contained in:
parent
e9dd4c75a2
commit
f5a6c4974d
11 changed files with 48 additions and 48 deletions
|
@ -49,10 +49,11 @@ readRequest :: Handle -> Server Request
|
|||
readRequest handle = do
|
||||
requestLine <- liftIO $ hGetLine handle
|
||||
let [method, uri, version] = map trim $ splitRegex " " requestLine
|
||||
return $ Request { requestMethod = method
|
||||
request = Request { requestMethod = method
|
||||
, requestURI = uri
|
||||
, requestVersion = version
|
||||
}
|
||||
return request
|
||||
|
||||
-- | Simple representation of the HTTP response we send back.
|
||||
data Response = Response { responseVersion :: String
|
||||
|
@ -64,7 +65,7 @@ data Response = Response { responseVersion :: String
|
|||
|
||||
instance Show Response where
|
||||
show response = responseVersion response ++ " "
|
||||
++ (show $ responseStatusCode response) ++ " "
|
||||
++ show (responseStatusCode response) ++ " "
|
||||
++ responsePhrase response
|
||||
|
||||
-- | A default response.
|
||||
|
@ -105,20 +106,19 @@ createGetResponse request = do
|
|||
log' = writeChan (logChannel config)
|
||||
isDirectory <- liftIO $ doesDirectoryExist $ documentRoot config ++ uri
|
||||
let fileName =
|
||||
(documentRoot config) ++ if isDirectory then uri ++ "/index.html"
|
||||
documentRoot config ++ if isDirectory then uri ++ "/index.html"
|
||||
else uri
|
||||
|
||||
create200 = do
|
||||
h <- openBinaryFile fileName ReadMode
|
||||
contentLength <- hFileSize h
|
||||
body <- hGetContents h
|
||||
let headers =
|
||||
[ ("Content-Length", show $ contentLength)
|
||||
] ++ getMIMEHeader fileName
|
||||
let mimeHeader = getMIMEHeader fileName
|
||||
headers = ("Content-Length", show contentLength) : mimeHeader
|
||||
return $ defaultResponse
|
||||
{ responseStatusCode = 200
|
||||
, responsePhrase = "OK"
|
||||
, responseHeaders = (responseHeaders defaultResponse)
|
||||
, responseHeaders = responseHeaders defaultResponse
|
||||
`M.union` M.fromList headers
|
||||
, responseBody = body
|
||||
}
|
||||
|
@ -131,8 +131,7 @@ createGetResponse request = do
|
|||
-- Send back the page if found.
|
||||
exists <- liftIO $ doesFileExist fileName
|
||||
if exists
|
||||
then do response <- liftIO $ catch create200 create500
|
||||
return response
|
||||
then liftIO $ catch create200 create500
|
||||
else do liftIO $ log' $ "Not Found: " ++ fileName
|
||||
return $ createErrorResponse 404 "Not Found"
|
||||
|
||||
|
|
|
@ -4,6 +4,7 @@ module Text.Hakyll
|
|||
) where
|
||||
|
||||
import Control.Monad.Reader (runReaderT)
|
||||
import Control.Monad (when)
|
||||
import qualified Data.Map as M
|
||||
import System.Environment (getArgs, getProgName)
|
||||
import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
|
||||
|
@ -43,8 +44,7 @@ clean = do remove' "_cache"
|
|||
where
|
||||
remove' dir = do putStrLn $ "Removing " ++ dir ++ "..."
|
||||
exists <- doesDirectoryExist dir
|
||||
if exists then removeDirectoryRecursive dir
|
||||
else return ()
|
||||
when exists $ removeDirectoryRecursive dir
|
||||
|
||||
-- | Show usage information.
|
||||
help :: IO ()
|
||||
|
@ -61,4 +61,4 @@ help = do
|
|||
++ name ++ " server [port] Run a local test server.\n"
|
||||
|
||||
server :: Integer -> IO ()
|
||||
server p = do simpleServer (fromIntegral $ p) "_site"
|
||||
server p = simpleServer (fromIntegral p) "_site"
|
||||
|
|
|
@ -27,7 +27,7 @@ stripComments :: String -> String
|
|||
stripComments [] = []
|
||||
stripComments str
|
||||
| isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str
|
||||
| otherwise = (head str) : (stripComments $ tail str)
|
||||
| otherwise = head str : stripComments (tail str)
|
||||
where
|
||||
eatComments str' | null str' = []
|
||||
| isPrefixOf "*/" str' = drop 2 str'
|
||||
|
|
|
@ -26,7 +26,7 @@ import Text.Hakyll.Hakyll (Hakyll)
|
|||
removeLeadingSeparator :: FilePath -> FilePath
|
||||
removeLeadingSeparator [] = []
|
||||
removeLeadingSeparator path
|
||||
| (head path') `elem` pathSeparators = (tail path')
|
||||
| head path' `elem` pathSeparators = tail path'
|
||||
| otherwise = path'
|
||||
where
|
||||
path' = if "$root" `isPrefixOf` path then drop 5 path
|
||||
|
@ -34,11 +34,11 @@ removeLeadingSeparator path
|
|||
|
||||
-- | Convert a relative filepath to a filepath in the destination (@_site@).
|
||||
toDestination :: FilePath -> FilePath
|
||||
toDestination path = "_site" </> (removeLeadingSeparator path)
|
||||
toDestination path = "_site" </> removeLeadingSeparator path
|
||||
|
||||
-- | Convert a relative filepath to a filepath in the cache (@_cache@).
|
||||
toCache :: FilePath -> FilePath
|
||||
toCache path = "_cache" </> (removeLeadingSeparator path)
|
||||
toCache path = "_cache" </> removeLeadingSeparator path
|
||||
|
||||
-- | Get the url for a given page.
|
||||
toURL :: FilePath -> FilePath
|
||||
|
@ -106,9 +106,7 @@ havingExtension extension = filter ((==) extension . takeExtension)
|
|||
|
||||
-- | Perform a Hakyll action on every file in a given directory.
|
||||
directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
|
||||
directory action dir = do
|
||||
contents <- getRecursiveContents dir
|
||||
mapM_ action contents
|
||||
directory action dir = getRecursiveContents dir >>= mapM_ action
|
||||
|
||||
-- | Check if a cache file is still valid.
|
||||
isCacheValid :: FilePath -- ^ The cached file.
|
||||
|
|
|
@ -11,6 +11,7 @@ import qualified Data.List as L
|
|||
import Data.Maybe (fromMaybe)
|
||||
import Control.Parallel.Strategies (rdeepseq, ($|))
|
||||
import Control.Monad.Reader (liftIO)
|
||||
import Control.Monad (unless)
|
||||
import System.FilePath (takeExtension)
|
||||
import System.IO
|
||||
|
||||
|
@ -120,11 +121,11 @@ readSection renderFunction isFirst ls
|
|||
| otherwise = body (tail ls)
|
||||
where
|
||||
isDelimiter' = isDelimiter (head ls)
|
||||
isNamedDelimiter = (head ls) `matchesRegex` "----* *[a-zA-Z][a-zA-Z]*"
|
||||
isNamedDelimiter = head ls `matchesRegex` "----* *[a-zA-Z][a-zA-Z]*"
|
||||
body ls' = [("body", renderFunction $ unlines ls')]
|
||||
|
||||
readSimpleMetaData = map readPair
|
||||
readPair = (trimPair . break (== ':'))
|
||||
readPair = trimPair . break (== ':')
|
||||
trimPair (key, value) = (trim key, trim $ tail value)
|
||||
|
||||
readSectionMetaData [] = []
|
||||
|
@ -157,7 +158,7 @@ readPage pagePath = do
|
|||
seq (($|) id rdeepseq context) $ liftIO $ hClose handle
|
||||
|
||||
-- Cache if needed
|
||||
if getFromCache then return () else cachePage page
|
||||
unless getFromCache $ cachePage page
|
||||
return page
|
||||
where
|
||||
url = toURL pagePath
|
||||
|
|
|
@ -12,7 +12,7 @@ import Text.Regex.TDFA
|
|||
-- | Match a regular expression against a string, returning more information
|
||||
-- about the match.
|
||||
matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String])
|
||||
matchRegexAll p str = matchM p str
|
||||
matchRegexAll = matchM
|
||||
|
||||
-- | Replaces every occurance of the given regexp with the replacement string.
|
||||
subRegex :: Regex -- ^ Search pattern
|
||||
|
@ -30,10 +30,10 @@ subRegex regexp inp replacement =
|
|||
Nothing -> repl
|
||||
Just (lead, _, trail, bgroups) ->
|
||||
let newval =
|
||||
if (head bgroups) == "\\"
|
||||
if head bgroups == "\\"
|
||||
then "\\"
|
||||
else let index :: Int
|
||||
index = (read (head bgroups)) - 1
|
||||
index = read (head bgroups) - 1
|
||||
in if index == -1
|
||||
then match'
|
||||
else groups !! index
|
||||
|
@ -41,7 +41,7 @@ subRegex regexp inp replacement =
|
|||
in case matchRegexAll regexp inp of
|
||||
Nothing -> inp
|
||||
Just (lead, match', trail, groups) ->
|
||||
lead ++ lookup' match' replacement groups ++ (subRegex regexp trail replacement)
|
||||
lead ++ lookup' match' replacement groups ++ subRegex regexp trail replacement
|
||||
|
||||
-- | Splits a string based on a regular expression. The regular expression
|
||||
-- should identify one delimiter.
|
||||
|
@ -70,5 +70,7 @@ substituteRegex pattern replacement string =
|
|||
subRegex (makeRegex pattern) string replacement
|
||||
|
||||
-- | Simple regex matching.
|
||||
matchesRegex :: String -> String -> Bool
|
||||
matchesRegex string pattern = string =~ pattern
|
||||
matchesRegex :: String -- ^ Input string.
|
||||
-> String -- ^ Pattern to match.
|
||||
-> Bool
|
||||
matchesRegex = (=~)
|
||||
|
|
|
@ -99,7 +99,7 @@ renderChainWith :: Renderable a
|
|||
renderChainWith manipulation templatePaths renderable =
|
||||
depends (getURL renderable) dependencies render'
|
||||
where
|
||||
dependencies = (getDependencies renderable) ++ templatePaths
|
||||
dependencies = getDependencies renderable ++ templatePaths
|
||||
render' = do templates <- liftIO $ mapM readFile templatePaths
|
||||
context <- toContext renderable
|
||||
let result = pureRenderChainWith manipulation templates context
|
||||
|
|
|
@ -30,10 +30,10 @@ substitute _ [] _ = []
|
|||
substitute escaper string context
|
||||
| "$$" `isPrefixOf` string = escaper ++ substitute' (tail tail')
|
||||
| "$" `isPrefixOf` string = substituteKey
|
||||
| otherwise = (head string) : (substitute' tail')
|
||||
| otherwise = head string : substitute' tail'
|
||||
where
|
||||
tail' = tail string
|
||||
(key, rest) = break (not . isAlpha) tail'
|
||||
(key, rest) = span isAlpha tail'
|
||||
replacement = fromMaybe ('$' : key) $ M.lookup key context
|
||||
substituteKey = replacement ++ substitute' rest
|
||||
substitute' str = substitute escaper str context
|
||||
|
@ -86,7 +86,7 @@ writePage :: Page -> Hakyll ()
|
|||
writePage page = do
|
||||
additionalContext' <- askHakyll additionalContext
|
||||
let destination = toDestination url
|
||||
context = additionalContext' `M.union` (M.singleton "root" $ toRoot url)
|
||||
context = additionalContext' `M.union` M.singleton "root" (toRoot url)
|
||||
makeDirectories destination
|
||||
-- Substitute $root here, just before writing.
|
||||
liftIO $ writeFile destination $ finalSubstitute (getBody page) context
|
||||
|
|
|
@ -40,8 +40,8 @@ instance Renderable CustomPage where
|
|||
getURL = customPageURL
|
||||
toContext page = do
|
||||
values <- mapM (either return id . snd) (customPageContext page)
|
||||
return $ M.fromList $ [ ("url", customPageURL page)
|
||||
] ++ zip (map fst $ customPageContext page) values
|
||||
let pairs = zip (map fst $ customPageContext page) values
|
||||
return $ M.fromList $ ("url", customPageURL page) : pairs
|
||||
|
||||
-- | PagePath is a class that wraps a FilePath. This is used to render Pages
|
||||
-- without reading them first through use of caching.
|
||||
|
@ -96,4 +96,4 @@ instance (Renderable a, Renderable b)
|
|||
return $ c1 `M.union` c2
|
||||
toContext (CombinedRenderableWithURL url a b) = do
|
||||
c <- toContext (CombinedRenderable a b)
|
||||
return $ (M.singleton "url" url) `M.union` c
|
||||
return $ M.singleton "url" url `M.union` c
|
||||
|
|
|
@ -26,8 +26,8 @@ readTagMap paths = foldM addPaths M.empty paths
|
|||
where
|
||||
addPaths current path = do
|
||||
page <- readPage path
|
||||
let tags = map trim $ splitRegex "," $ getValue ("tags") page
|
||||
return $ foldr (\t -> M.insertWith (++) t [path]) current tags
|
||||
let tags = map trim $ splitRegex "," $ getValue "tags" page
|
||||
return $ foldr (flip (M.insertWith (++)) [path]) current tags
|
||||
|
||||
-- | Render a tag cloud.
|
||||
renderTagCloud :: M.Map String [FilePath] -- ^ Map as produced by "readTagMap".
|
||||
|
@ -50,10 +50,10 @@ renderTagCloud tagMap urlFunction minSize maxSize =
|
|||
sizeTag count = show size' ++ "%"
|
||||
where
|
||||
size' :: Int
|
||||
size' = floor (minSize + (relative count) * (maxSize - minSize))
|
||||
size' = floor $ minSize + relative count * (maxSize - minSize)
|
||||
|
||||
minCount = minimum $ map snd $ tagCount
|
||||
maxCount = maximum $ map snd $ tagCount
|
||||
minCount = minimum $ map snd tagCount
|
||||
maxCount = maximum $ map snd tagCount
|
||||
relative count = (count - minCount) / (maxCount - minCount)
|
||||
|
||||
tagCount :: [(String, Float)]
|
||||
|
@ -65,5 +65,5 @@ renderTagLinks :: (String -> String) -- ^ Function that produces an url for a ta
|
|||
renderTagLinks urlFunction = renderValue "tags" "tags" renderTagLinks'
|
||||
where
|
||||
renderTagLinks' = intercalate ", "
|
||||
. map (\t -> link t $ urlFunction t)
|
||||
. map trim . splitRegex ","
|
||||
. map ((\t -> link t $ urlFunction t) . trim)
|
||||
. splitRegex ","
|
||||
|
|
|
@ -17,7 +17,7 @@ stripHTML :: String -> String
|
|||
stripHTML [] = []
|
||||
stripHTML str = let (beforeTag, rest) = break (== '<') str
|
||||
(_, afterTag) = break (== '>') rest
|
||||
in beforeTag ++ (stripHTML $ tail' afterTag)
|
||||
in beforeTag ++ stripHTML (tail' afterTag)
|
||||
-- We need a failsafe tail function.
|
||||
where
|
||||
tail' [] = []
|
||||
|
|
Loading…
Reference in a new issue