summaryrefslogtreecommitdiff
path: root/src/Text/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Hakyll')
-rw-r--r--src/Text/Hakyll/CompressCSS.hs12
-rw-r--r--src/Text/Hakyll/Context.hs17
-rw-r--r--src/Text/Hakyll/File.hs23
-rw-r--r--src/Text/Hakyll/Page.hs51
-rw-r--r--src/Text/Hakyll/Render.hs49
-rw-r--r--src/Text/Hakyll/Tags.hs52
-rw-r--r--src/Text/Hakyll/Util.hs8
7 files changed, 119 insertions, 93 deletions
diff --git a/src/Text/Hakyll/CompressCSS.hs b/src/Text/Hakyll/CompressCSS.hs
index 4b35558..f9a062c 100644
--- a/src/Text/Hakyll/CompressCSS.hs
+++ b/src/Text/Hakyll/CompressCSS.hs
@@ -24,8 +24,10 @@ compressWhitespace = substituteRegex "[ \t\n][ \t\n]*" " "
-- | Function that strips CSS comments away.
stripComments :: String -> String
stripComments [] = []
-stripComments str | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str
- | otherwise = (head str) : (stripComments $ tail str)
- where eatComments str' | null str' = []
- | isPrefixOf "*/" str' = drop 2 str'
- | otherwise = eatComments $ tail str'
+stripComments str
+ | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str
+ | otherwise = (head str) : (stripComments $ tail str)
+ where
+ eatComments str' | null str' = []
+ | isPrefixOf "*/" str' = drop 2 str'
+ | otherwise = eatComments $ tail str'
diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs
index 074c88f..d2c6047 100644
--- a/src/Text/Hakyll/Context.hs
+++ b/src/Text/Hakyll/Context.hs
@@ -38,11 +38,12 @@ renderDate :: String -- ^ Key in which the rendered date should be placed.
-> String -- ^ Default value when the date cannot be parsed.
-> ContextManipulation
renderDate key format defaultValue context = M.insert key value context
- where value = fromMaybe defaultValue pretty
- pretty = do filePath <- M.lookup "path" context
- let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
- (takeFileName filePath)
- time <- parseTime defaultTimeLocale
- "%Y-%m-%d"
- dateString :: Maybe UTCTime
- return $ formatTime defaultTimeLocale format time
+ where
+ value = fromMaybe defaultValue pretty
+ pretty = do filePath <- M.lookup "path" context
+ let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
+ (takeFileName filePath)
+ time <- parseTime defaultTimeLocale
+ "%Y-%m-%d"
+ dateString :: Maybe UTCTime
+ return $ formatTime defaultTimeLocale format time
diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs
index d8ee8db..0ed91d5 100644
--- a/src/Text/Hakyll/File.hs
+++ b/src/Text/Hakyll/File.hs
@@ -25,8 +25,9 @@ removeLeadingSeparator [] = []
removeLeadingSeparator path
| (head path') `elem` pathSeparators = (tail path')
| otherwise = path'
- where path' = if "$root" `isPrefixOf` path then drop 5 path
- else 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
@@ -46,21 +47,24 @@ toURL path = if takeExtension path `elem` [".markdown", ".md", ".tex"]
toRoot :: FilePath -> FilePath
toRoot = emptyException . joinPath . map parent . splitPath
. takeDirectory . removeLeadingSeparator
- where parent = const ".."
- emptyException [] = "."
- emptyException x = x
+ where
+ parent = const ".."
+ emptyException [] = "."
+ emptyException x = x
-- | Swaps spaces for '-'.
removeSpaces :: FilePath -> FilePath
removeSpaces = map swap
- where swap ' ' = '-'
- swap x = x
+ where
+ swap ' ' = '-'
+ swap x = x
-- | Given a path to a file, try to make the path writable by making
-- all directories on the path.
makeDirectories :: FilePath -> IO ()
makeDirectories path = createDirectoryIfMissing True dir
- where dir = takeDirectory path
+ where
+ dir = takeDirectory path
-- | Get all contents of a directory. Note that files starting with a dot (.)
-- will be ignored.
@@ -75,7 +79,8 @@ getRecursiveContents topdir = do
then getRecursiveContents path
else return [path]
return (concat paths)
- where isProper = not . (== '.') . head
+ where
+ isProper = not . (== '.') . head
-- | A filter that takes all file names with a given extension. Prefix the
-- extension with a dot:
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index c5ddc3a..682f1b9 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -42,7 +42,8 @@ getPageURL (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page
-- | Get the original page path.
getPagePath :: Page -> String
-getPagePath (Page page) = fromMaybe (error "No page path") $ M.lookup "path" page
+getPagePath (Page page) =
+ fromMaybe (error "No page path") $ M.lookup "path" page
-- | Get the body for a certain page. When not defined, the body will be
-- empty.
@@ -56,21 +57,24 @@ writerOptions = defaultWriterOptions
-- | Get a render function for a given extension.
renderFunction :: String -> (String -> String)
renderFunction ".html" = id
-renderFunction ext = writeHtmlString writerOptions .
- readFunction ext defaultParserState
- where readFunction ".markdown" = readMarkdown
- readFunction ".md" = readMarkdown
- readFunction ".tex" = readLaTeX
- readFunction _ = readMarkdown
+renderFunction ext = writeHtmlString writerOptions
+ . readFunction ext defaultParserState
+ where
+ readFunction ".markdown" = readMarkdown
+ readFunction ".md" = readMarkdown
+ readFunction ".tex" = readLaTeX
+ readFunction _ = readMarkdown
-- | Read metadata header from a file handle.
readMetaData :: Handle -> IO [(String, String)]
readMetaData handle = do
line <- hGetLine handle
- if isDelimiter line then return []
- else do others <- readMetaData handle
- return $ (trimPair . break (== ':')) line : others
- where trimPair (key, value) = (trim key, trim $ tail value)
+ if isDelimiter line
+ then return []
+ else do others <- readMetaData handle
+ return $ (trimPair . break (== ':')) line : others
+ where
+ trimPair (key, value) = (trim key, trim $ tail value)
-- | Check if the given string is a metadata delimiter.
isDelimiter :: String -> Bool
@@ -87,10 +91,11 @@ cachePage page@(Page mapping) = do
hPutStrLn handle "---"
hPutStr handle $ getBody page
hClose handle
- where writePair h (k, v) = hPutStr h k >>
- hPutStr h ": " >>
- hPutStr h v >>
- hPutStrLn h ""
+ where
+ writePair h (k, v) = do hPutStr h k
+ hPutStr h ": "
+ hPutStr h v
+ hPutStrLn h ""
-- | Read a page from a file. Metadata is supported, and if the filename
-- has a .markdown extension, it will be rendered using pandoc. Note that
@@ -104,11 +109,12 @@ readPage pagePath = do
-- Read file.
handle <- openFile path ReadMode
line <- hGetLine handle
- (context, body) <- if isDelimiter line
- then do md <- readMetaData handle
- c <- hGetContents handle
- return (md, c)
- else hGetContents handle >>= \b -> return ([], line ++ b)
+ (context, body) <-
+ if isDelimiter line
+ then do md <- readMetaData handle
+ c <- hGetContents handle
+ return (md, c)
+ else hGetContents handle >>= \b -> return ([], line ++ b)
-- Render file
let rendered = (renderFunction $ takeExtension path) body
@@ -123,8 +129,9 @@ readPage pagePath = do
-- Cache if needed
if getFromCache then return () else cachePage page
return page
- where url = toURL pagePath
- cacheFile = toCache url
+ where
+ url = toURL pagePath
+ cacheFile = toCache url
-- Make pages renderable.
instance Renderable Page where
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index 41f76b8..caf0221 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -43,11 +43,12 @@ substitute escaper string context
| "$$" `isPrefixOf` string = escaper ++ substitute' (tail tail')
| "$" `isPrefixOf` string = substituteKey
| otherwise = (head string) : (substitute' tail')
- where tail' = tail string
- (key, rest) = break (not . isAlpha) tail'
- replacement = fromMaybe ('$' : key) $ M.lookup key context
- substituteKey = replacement ++ substitute' rest
- substitute' str = substitute escaper str context
+ where
+ tail' = tail string
+ (key, rest) = break (not . isAlpha) tail'
+ replacement = fromMaybe ('$' : key) $ M.lookup key context
+ substituteKey = replacement ++ substitute' rest
+ substitute' str = substitute escaper str context
-- | "substitute" for use during a chain.
regularSubstitute :: String -> Context -> String
@@ -97,11 +98,12 @@ renderAndConcatWith :: Renderable a
-> IO String
renderAndConcatWith manipulation templatePath renderables =
foldM concatRender' [] renderables
- where concatRender' :: Renderable a => String -> a -> IO String
- concatRender' chunk renderable = do
- rendered <- renderWith manipulation templatePath renderable
- let body = getBody rendered
- return $ chunk ++ body
+ where
+ concatRender' :: Renderable a => String -> a -> IO String
+ concatRender' chunk renderable = do
+ rendered <- renderWith manipulation templatePath renderable
+ let body = getBody rendered
+ return $ chunk ++ body
-- | Chain a render action for a page with a number of templates. This will
-- also write the result to the site destination. This is the preferred way
@@ -125,23 +127,26 @@ writePage page = do
let destination = toDestination url
makeDirectories destination
writeFile destination body
- where url = getURL page
-          -- Substitute $root here, just before writing.
-          body = finalSubstitute (getBody page)
-                             (M.singleton "root" $ toRoot url)
+ where
+ url = getURL page
+    -- Substitute $root here, just before writing.
+    body = finalSubstitute (getBody page)
+                           (M.singleton "root" $ toRoot url)
-- | Mark a certain file as static, so it will just be copied when the site is
-- generated.
static :: FilePath -> IO ()
-static source = depends destination [source]
- (makeDirectories destination >> copyFile source destination)
- where destination = toDestination source
+static source = depends destination [source] action
+ where
+ destination = toDestination source
+ action = do makeDirectories destination
+ copyFile source destination
-- | Render a css file, compressing it.
css :: FilePath -> IO ()
css source = depends destination [source] css'
- where destination = toDestination source
- css' = do h <- openFile source ReadMode
- contents <- hGetContents h
- makeDirectories destination
- writeFile destination (compressCSS contents)
+ where
+ destination = toDestination source
+ css' = do contents <- readFile source
+ makeDirectories destination
+ writeFile destination (compressCSS contents)
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index 801b9b1..625584e 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -21,10 +21,11 @@ import Control.Arrow (second)
-- commas.
readTagMap :: [FilePath] -> IO (M.Map String [FilePath])
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
+ 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
-- | Render a tag cloud.
renderTagCloud :: M.Map String [FilePath] -- ^ A tag map as produced by 'readTagMap'.
@@ -34,28 +35,31 @@ renderTagCloud :: M.Map String [FilePath] -- ^ A tag map as produced by 'readTag
-> String -- ^ Result of the render.
renderTagCloud tagMap urlFunction minSize maxSize =
intercalate " " $ map renderTag tagCount
- where renderTag :: (String, Float) -> String
- renderTag (tag, count) = "<a style=\"font-size: "
- ++ sizeTag count ++ "\" href=\""
- ++ urlFunction tag ++ "\">"
- ++ tag ++ "</a>"
-
- sizeTag :: Float -> String
- sizeTag count = show size' ++ "%"
- where size' :: Int
- size' = floor (minSize + (relative count) * (maxSize - minSize))
-
- minCount = minimum $ map snd $ tagCount
- maxCount = maximum $ map snd $ tagCount
- relative count = (count - minCount) / (maxCount - minCount)
-
- tagCount :: [(String, Float)]
- tagCount = map (second $ fromIntegral . length) $ M.toList tagMap
+ where
+ renderTag :: (String, Float) -> String
+ renderTag (tag, count) = "<a style=\"font-size: "
+ ++ sizeTag count ++ "\" href=\""
+ ++ urlFunction tag ++ "\">"
+ ++ tag ++ "</a>"
+
+ sizeTag :: Float -> String
+ sizeTag count = show size' ++ "%"
+ where
+ size' :: Int
+ size' = floor (minSize + (relative count) * (maxSize - minSize))
+
+ minCount = minimum $ map snd $ tagCount
+ maxCount = maximum $ map snd $ tagCount
+ relative count = (count - minCount) / (maxCount - minCount)
+
+ tagCount :: [(String, Float)]
+ tagCount = map (second $ fromIntegral . length) $ M.toList tagMap
-- Render all tags to links.
renderTagLinks :: (String -> String) -- ^ Function that produces an url for a tag.
-> ContextManipulation
renderTagLinks urlFunction = renderValue "tags" "tags" renderTagLinks'
- where renderTagLinks' = intercalate ", "
- . map (\t -> link t $ urlFunction t)
- . map trim . splitRegex ","
+ where
+ renderTagLinks' = intercalate ", "
+ . map (\t -> link t $ urlFunction t)
+ . map trim . splitRegex ","
diff --git a/src/Text/Hakyll/Util.hs b/src/Text/Hakyll/Util.hs
index 018c404..858b3fb 100644
--- a/src/Text/Hakyll/Util.hs
+++ b/src/Text/Hakyll/Util.hs
@@ -9,7 +9,8 @@ import Data.Char (isSpace)
-- | Trim a string (drop spaces and tabs at both sides).
trim :: String -> String
trim = reverse . trim' . reverse . trim'
- where trim' = dropWhile isSpace
+ where
+ trim' = dropWhile isSpace
-- | Strip html tags.
stripHTML :: String -> String
@@ -18,8 +19,9 @@ stripHTML str = let (beforeTag, rest) = break (== '<') str
(_, afterTag) = break (== '>') rest
in beforeTag ++ (stripHTML $ tail' afterTag)
-- We need a failsafe tail function.
- where tail' [] = []
- tail' xs = tail xs
+ where
+ tail' [] = []
+ tail' xs = tail xs
-- | Make a HTML link.
--
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 04:41:24 +0000