summaryrefslogtreecommitdiff
path: root/src/Text/Hakyll/Page.hs
blob: 5b3586d9a02e102648bc64a8752941a4d6b07af2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
module Text.Hakyll.Page 
    ( Page,
      addContext,
      getURL,
      getBody,
      readPage,
      pageFromList,
      concatPages,
      concatPagesWith
    ) where

import qualified Data.Map as M
import qualified Data.List as L
import System.FilePath
import Data.Maybe
import Text.Pandoc

-- | A Page is basically key-value mapping. Certain keys have special
--   meanings, like for example url, body and title.
type Page = M.Map String String

-- | Add a key-value mapping to the Page.
addContext :: String -> String -> Page -> Page
addContext = M.insert

-- | Get the URL for a certain page. This should always be defined. If
--   not, it will return trash.html.
getURL :: Page -> String
getURL context = fromMaybe "trash.html" $ M.lookup "url" context

-- | Get the body for a certain page. When not defined, the body will be
--   empty.
getBody :: Page -> String
getBody context = fromMaybe "" $ M.lookup "body" context

readConfig :: [String] -> Page
readConfig = M.fromList . map (trim . break (== ':'))
    where trim (key, value) = (key, dropWhile (`elem` ": ") value)

extractContext :: String -> Page
extractContext str = M.insert "body" (unlines body) (readConfig header)
    where allLines = lines str
          isDelimiter = L.isPrefixOf "---"
          (header, body) | isDelimiter (head allLines) = let (h, b) = L.break (isDelimiter) (tail allLines)
                                                         in (h, tail b)
                         | otherwise = ([], allLines)

writerOptions :: WriterOptions
writerOptions = defaultWriterOptions

markdownToHTML :: String -> String
markdownToHTML = writeHtmlString writerOptions .
                 readMarkdown defaultParserState

-- | 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
--   pages are not templates, so they should not contain $identifiers.
readPage :: FilePath -> IO Page
readPage path = do
    content <- readFile path
    let context = extractContext content
        body = (if takeExtension path == ".markdown" then markdownToHTML else id)
               (getBody context)
        url = addExtension (dropExtension path) ".html"
    return $ addContext "url" url $ addContext "body" body $ context

-- | Create a key-value mapping page from an association list.
pageFromList :: [(String, String)] -> Page
pageFromList = M.fromList

-- | Concat the bodies of pages, and return the result.
concatPages :: [Page] -> String
concatPages = concatPagesWith "body"

-- | Concat certain values of pages, and return the result.
concatPagesWith :: String -- ^ Key of which to concat the values.
                -> [Page] -- ^ Pages to get the values from.
                -> String -- ^ The concatenation.
concatPagesWith key = concat . map (fromMaybe "" . M.lookup key)