summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Network/Hakyll/SimpleServer.hs25
-rw-r--r--src/Text/Hakyll.hs6
-rw-r--r--src/Text/Hakyll/CompressCSS.hs2
-rw-r--r--src/Text/Hakyll/File.hs12
-rw-r--r--src/Text/Hakyll/Page.hs7
-rw-r--r--src/Text/Hakyll/Regex.hs14
-rw-r--r--src/Text/Hakyll/Render.hs2
-rw-r--r--src/Text/Hakyll/Render/Internal.hs6
-rw-r--r--src/Text/Hakyll/Renderables.hs6
-rw-r--r--src/Text/Hakyll/Tags.hs14
-rw-r--r--src/Text/Hakyll/Util.hs2
11 files changed, 48 insertions, 48 deletions
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' [] = []
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 04:17:15 +0000