diff options
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Hakyll/Context.hs | 25 | ||||
-rw-r--r-- | src/Text/Hakyll/Page.hs | 1 | ||||
-rw-r--r-- | src/Text/Hakyll/Render/Internal.hs | 2 | ||||
-rw-r--r-- | src/Text/Hakyll/Tags.hs | 35 | ||||
-rw-r--r-- | src/Text/Hakyll/Util.hs | 6 |
5 files changed, 54 insertions, 15 deletions
diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs index d4d3436..11cc123 100644 --- a/src/Text/Hakyll/Context.hs +++ b/src/Text/Hakyll/Context.hs @@ -3,6 +3,7 @@ module Text.Hakyll.Context ( Context , ContextManipulation , renderValue + , changeValue , renderDate , changeExtension ) where @@ -23,7 +24,9 @@ type Context = Map String String -- | Type for context manipulating functions. type ContextManipulation = Context -> Context --- | Do something with a value of a context. +-- | Do something with a value in a "Context", but keep the old value as well. +-- This is probably the most common function to construct a +-- "ContextManipulation". renderValue :: String -- ^ Key of which the value should be copied. -> String -- ^ Key the value should be copied to. -> (String -> String) -- ^ Function to apply on the value. @@ -32,8 +35,23 @@ renderValue src dst f context = case M.lookup src context of Nothing -> context (Just value) -> M.insert dst (f value) context +-- | Change a value in a "Context". +-- +-- > import Data.Char (toUpper) +-- > changeValue "title" (map toUpper) +-- +-- Will put the title in UPPERCASE. +changeValue :: String -- ^ Key of which the value should be changed. + -> (String -> String) -- ^ Function to apply on the value. + -> ContextManipulation +changeValue key = renderValue key key + -- | When the context has a key called @path@ in a @yyyy-mm-dd-title.extension@ -- format (default for pages), this function can render the date. +-- +-- > renderDate "date" "%B %e, %Y" "Date unknown" +-- +-- Will render something like @January 32, 2010@. renderDate :: String -- ^ Key in which the rendered date should be placed. -> String -- ^ Format to use on the date. -> String -- ^ Default value when the date cannot be parsed. @@ -57,7 +75,8 @@ renderDate key format defaultValue context = M.insert key value context -- > (createPagePath "test.markdown") -- -- Will render to @test.php@ instead of @test.html@. -changeExtension :: String -> ContextManipulation -changeExtension extension = renderValue "url" "url" changeExtension' +changeExtension :: String -- ^ Extension to change to. + -> ContextManipulation +changeExtension extension = changeValue "url" changeExtension' where changeExtension' = flip addExtension extension . dropExtension diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs index 9c319ba..3b76bfd 100644 --- a/src/Text/Hakyll/Page.hs +++ b/src/Text/Hakyll/Page.hs @@ -14,7 +14,6 @@ import Data.Maybe (fromMaybe) import Control.Monad (liftM) import Control.Monad.Reader (liftIO) import System.FilePath (takeExtension) -import System.IO import Text.Pandoc import Data.Binary diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs index 27459ad..ecde1d7 100644 --- a/src/Text/Hakyll/Render/Internal.hs +++ b/src/Text/Hakyll/Render/Internal.hs @@ -60,7 +60,7 @@ pureRenderWith manipulation template context = in body `deepseq` M.insert "body" body context -- | A pure renderAndConcat function. -pureRenderAndConcatWith :: ContextManipulation +pureRenderAndConcatWith :: ContextManipulation -- ^ Manipulation to apply. -> [String] -- ^ Templates to use. -> [Context] -- ^ Different renderables. -> String diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs index 4059597..a2031f8 100644 --- a/src/Text/Hakyll/Tags.hs +++ b/src/Text/Hakyll/Tags.hs @@ -1,5 +1,19 @@ -- | Module containing some specialized functions to deal with tags. -- This Module follows certain conventions. Stick with them. +-- +-- More concrete: all functions in this module assume that the tags are +-- located in the @tags@ field, and separated by commas. An example file +-- @foo.markdown@ could look like: +-- +-- > --- +-- > author: Philip K. Dick +-- > title: Do androids dream of electric sheep? +-- > tags: future, science fiction, humanoid +-- > --- +-- > The novel is set in a post-apocalyptic near future, where the Earth and +-- > its populations have been damaged greatly by Nuclear... +-- +-- All the following functions would work with such a format. module Text.Hakyll.Tags ( readTagMap , renderTagCloud @@ -12,15 +26,13 @@ import Control.Monad (foldM) import Control.Arrow (second) import Text.Hakyll.Hakyll (Hakyll) -import Text.Hakyll.Context (ContextManipulation, renderValue) +import Text.Hakyll.Context (ContextManipulation, changeValue) import Text.Hakyll.Render.Internal (finalSubstitute) import Text.Hakyll.Regex import Text.Hakyll.Util import Text.Hakyll.Page --- | Read a tag map. This creates a map from tags to page paths. This function --- assumes the tags are located in the @tags@ metadata field, separated by --- commas. +-- | Read a tag map. This creates a map from tags to page paths. readTagMap :: [FilePath] -> Hakyll (M.Map String [FilePath]) readTagMap paths = foldM addPaths M.empty paths where @@ -59,10 +71,19 @@ renderTagCloud tagMap urlFunction minSize maxSize = 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. +-- | Render all tags to links. +-- +-- On your side, it is nice if you can display the tags on a page, but +-- naturally, most people would expect these are clickable. +-- +-- So, this function takes a function to produce an url for a given tag, and +-- applies it on all tags. +-- +-- Note that it is your own responsibility to ensure a page which such an url +-- exists. +renderTagLinks :: (String -> String) -- ^ Function to produce an url for a tag. -> ContextManipulation -renderTagLinks urlFunction = renderValue "tags" "tags" renderTagLinks' +renderTagLinks urlFunction = changeValue "tags" renderTagLinks' where renderTagLinks' = intercalate ", " . map ((\t -> link t $ urlFunction t) . trim) diff --git a/src/Text/Hakyll/Util.hs b/src/Text/Hakyll/Util.hs index 8c33512..5105a31 100644 --- a/src/Text/Hakyll/Util.hs +++ b/src/Text/Hakyll/Util.hs @@ -6,20 +6,20 @@ module Text.Hakyll.Util import Data.Char (isSpace) --- | Trim a string (drop spaces and tabs at both sides). +-- | Trim a string (drop spaces, tabs and newlines at both sides). trim :: String -> String trim = reverse . trim' . reverse . trim' where trim' = dropWhile isSpace --- | Strip html tags. +-- | Strip html tags from the given string. stripHTML :: String -> String stripHTML [] = [] stripHTML str = let (beforeTag, rest) = break (== '<') str (_, afterTag) = break (== '>') rest in beforeTag ++ stripHTML (tail' afterTag) - -- We need a failsafe tail function. where + -- We need a failsafe tail function. tail' [] = [] tail' xs = tail xs |