@@ -1,5 +1,6 @@
1module Text.Hakyll.Page
1module Text.Hakyll.Page
3 addContext,
4 addContext,
@@ -11,6 +12,7 @@ module Text.Hakyll.Page
12import qualified Data.Map as M
13import qualified Data.Map as M
13import qualified Data.List as L
14import qualified Data.List as L
15+import qualified Data.ByteString.Lazy.Char8 as B
14import Data.Maybe
16import Data.Maybe
16import System.FilePath
18import System.FilePath
@@ -20,40 +22,50 @@ import Text.Pandoc
21-- | A Page is basically key-value mapping. Certain keys have special
23-- | A Page is basically key-value mapping. Certain keys have special
22-- meanings, like for example url, body and title.
24-- meanings, like for example url, body and title.
23−type Page = M.Map String String
25+type Page = M.Map String PageValue
27+-- | We use a ByteString for obvious reasons.
28+type PageValue = B.ByteString
25-- | Add a key-value mapping to the Page.
31-- | Add a key-value mapping to the Page.
26addContext :: String -> String -> Page -> Page
32addContext :: String -> String -> Page -> Page
27−addContext = M.insert
33+addContext key value = M.insert key (B.pack value)
29-- | Get the URL for a certain page. This should always be defined. If
35-- | Get the URL for a certain page. This should always be defined. If
30-- not, it will return trash.html.
36-- not, it will return trash.html.
31getURL :: Page -> String
37getURL :: Page -> String
32−getURL context = fromMaybe "trash.html" $ M.lookup "url" context
38+getURL context = let result = M.lookup "url" context
39+ in case result of (Just url) -> B.unpack url
40+ Nothing -> error "URL is not defined."
34-- | Get the body for a certain page. When not defined, the body will be
42-- | Get the body for a certain page. When not defined, the body will be
36−getBody :: Page -> String
44+getBody :: Page -> PageValue
37−getBody context = fromMaybe "" $ M.lookup "body" context
45+getBody context = fromMaybe B.empty $ M.lookup "body" context
39−readConfig :: [String] -> Page
40−readConfig = M.fromList . map (trim . break (== ':'))
41− where trim (key, value) = (key, dropWhile (`elem` ": ") value)
43−extractContext :: String -> Page
44−extractContext str = M.insert "body" (unlines body) (readConfig header)
45− where allLines = lines str
46− isDelimiter = L.isPrefixOf "---"
47− (header, body) | isDelimiter (head allLines) = let (h, b) = L.break (isDelimiter) (tail allLines)
49− | otherwise = ([], allLines)
51writerOptions :: WriterOptions
47writerOptions :: WriterOptions
52writerOptions = defaultWriterOptions
48writerOptions = defaultWriterOptions
54−markdownToHTML :: String -> String
50+renderFunction :: String -> (String -> String)
51+renderFunction ".html" = id
55−markdownToHTML = writeHtmlString writerOptions .
52+renderFunction ext = writeHtmlString writerOptions .
56− readMarkdown defaultParserState
53+ renderFunction' ext defaultParserState
54+ where renderFunction' ".markdown" = readMarkdown
55+ renderFunction' ".md" = readMarkdown
56+ renderFunction' ".tex" = readLaTeX
57+ renderFunction' _ = readMarkdown
59+readMetaData :: Handle -> IO [(String, String)]
60+readMetaData handle = do
61+ line <- hGetLine handle
62+ if isDelimiter line then return []
63+ else do others <- readMetaData handle
64+ return $ (trim . break (== ':')) line : others
65+ where trim (key, value) = (key, dropWhile (`elem` ": ") value)
67+isDelimiter :: String -> Bool
68+isDelimiter = L.isPrefixOf "---"
58-- | Read a page from a file. Metadata is supported, and if the filename
70-- | Read a page from a file. Metadata is supported, and if the filename
59-- has a .markdown extension, it will be rendered using pandoc. Note that
71-- has a .markdown extension, it will be rendered using pandoc. Note that
@@ -61,24 +73,30 @@ markdownToHTML = writeHtmlString writerOptions .
61readPage :: FilePath -> IO Page
73readPage :: FilePath -> IO Page
62readPage path = do
74readPage path = do
63 handle <- openFile path ReadMode
75 handle <- openFile path ReadMode
76+ line <- hGetLine handle
77+ (context, body) <- if isDelimiter line
78+ then do md <- readMetaData handle
64− content <- hGetContents handle
79+ c <- hGetContents handle
65− seq content $ hClose handle
80+ return (md, c)
66− let context = extractContext content
81+ else hGetContents handle >>= \b -> return ([], line ++ b)
67− body = (if takeExtension path == ".markdown" then markdownToHTML else id)
82+
68− (getBody context)
83+ let rendered = B.pack $ (renderFunction $ takeExtension path) body
69 url = addExtension (dropExtension path) ".html"
84 url = addExtension (dropExtension path) ".html"
85+ seq rendered $ hClose handle
70− return $ addContext "url" url $ addContext "body" body $ context
86+ return $ M.insert "body" rendered $ addContext "url" url $ pageFromList context
72-- | Create a key-value mapping page from an association list.
88-- | Create a key-value mapping page from an association list.
73pageFromList :: [(String, String)] -> Page
89pageFromList :: [(String, String)] -> Page
74−pageFromList = M.fromList
90+pageFromList = M.fromList . map packPair
91+ where packPair (k, v) = let pv = B.pack v
76-- | Concat the bodies of pages, and return the result.
94-- | Concat the bodies of pages, and return the result.
77−concatPages :: [Page] -> String
95+concatPages :: [Page] -> PageValue
78concatPages = concatPagesWith "body"
96concatPages = concatPagesWith "body"
80-- | Concat certain values of pages, and return the result.
98-- | Concat certain values of pages, and return the result.
81concatPagesWith :: String -- ^ Key of which to concat the values.
99concatPagesWith :: String -- ^ Key of which to concat the values.
82 -> [Page] -- ^ Pages to get the values from.
100 -> [Page] -- ^ Pages to get the values from.
83− -> String -- ^ The concatenation.
101+ -> PageValue -- ^ The concatenation.
84−concatPagesWith key = concat . map (fromMaybe "" . M.lookup key)
102+concatPagesWith key = B.concat . map (fromMaybe B.empty . M.lookup key)