From f5a6c4974d561e05b2882d38b54b45188ee31185 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Tue, 19 Jan 2010 14:08:19 +0100 Subject: Hakyll now passes HLint. --- src/Network/Hakyll/SimpleServer.hs | 25 ++++++++++++------------- src/Text/Hakyll.hs | 6 +++--- src/Text/Hakyll/CompressCSS.hs | 2 +- src/Text/Hakyll/File.hs | 12 +++++------- src/Text/Hakyll/Page.hs | 7 ++++--- src/Text/Hakyll/Regex.hs | 14 ++++++++------ src/Text/Hakyll/Render.hs | 2 +- src/Text/Hakyll/Render/Internal.hs | 6 +++--- src/Text/Hakyll/Renderables.hs | 6 +++--- src/Text/Hakyll/Tags.hs | 14 +++++++------- src/Text/Hakyll/Util.hs | 2 +- 11 files changed, 48 insertions(+), 48 deletions(-) (limited to 'src') diff --git a/src/Network/Hakyll/SimpleServer.hs b/src/Network/Hakyll/SimpleServer.hs index 3fd63d5..6258e35 100644 --- a/src/Network/Hakyll/SimpleServer.hs +++ b/src/Network/Hakyll/SimpleServer.hs @@ -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 - , requestURI = uri - , requestVersion = version - } + 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" - else uri + 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" diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs index 6718de6..295f32e 100644 --- a/src/Text/Hakyll.hs +++ b/src/Text/Hakyll.hs @@ -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" diff --git a/src/Text/Hakyll/CompressCSS.hs b/src/Text/Hakyll/CompressCSS.hs index c6693b7..d575348 100644 --- a/src/Text/Hakyll/CompressCSS.hs +++ b/src/Text/Hakyll/CompressCSS.hs @@ -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' diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs index 2a77707..1becb46 100644 --- a/src/Text/Hakyll/File.hs +++ b/src/Text/Hakyll/File.hs @@ -26,19 +26,19 @@ import Text.Hakyll.Hakyll (Hakyll) removeLeadingSeparator :: FilePath -> FilePath removeLeadingSeparator [] = [] removeLeadingSeparator path - | (head path') `elem` pathSeparators = (tail path') - | otherwise = path' + | head path' `elem` pathSeparators = tail path' + | otherwise = path' where path' = if "$root" `isPrefixOf` path then drop 5 path else 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. diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs index 70724e2..9c01801 100644 --- a/src/Text/Hakyll/Page.hs +++ b/src/Text/Hakyll/Page.hs @@ -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 diff --git a/src/Text/Hakyll/Regex.hs b/src/Text/Hakyll/Regex.hs index 9b7177e..8706f99 100644 --- a/src/Text/Hakyll/Regex.hs +++ b/src/Text/Hakyll/Regex.hs @@ -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 = (=~) diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs index 144c357..a0f067f 100644 --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -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 diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs index d4c1697..89a2709 100644 --- a/src/Text/Hakyll/Render/Internal.hs +++ b/src/Text/Hakyll/Render/Internal.hs @@ -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 diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs index 5832a09..9e62a91 100644 --- a/src/Text/Hakyll/Renderables.hs +++ b/src/Text/Hakyll/Renderables.hs @@ -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 diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs index e15a41f..4059597 100644 --- a/src/Text/Hakyll/Tags.hs +++ b/src/Text/Hakyll/Tags.hs @@ -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 "," diff --git a/src/Text/Hakyll/Util.hs b/src/Text/Hakyll/Util.hs index 858b3fb..8c33512 100644 --- a/src/Text/Hakyll/Util.hs +++ b/src/Text/Hakyll/Util.hs @@ -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' [] = [] -- cgit v1.2.3