@@ -1,6 +1,6 @@
11module Text.Hakyll.Page
2− ( Page (..),
3− PageValue,
2+ ( Page,
3+ fromContext,
44 addContext,
55 getBody,
66 readPage,
@@ -12,7 +12,6 @@ import qualified Data.List as L
1212import qualified Data.ByteString.Lazy.Char8 as B
1313import Data.Maybe
1414import Control.Monad
15−import Control.Arrow
1615
1716import System.FilePath
1817import System.IO
@@ -23,30 +22,30 @@ import Text.Pandoc
2322
2423-- | A Page is basically key-value mapping. Certain keys have special
2524-- meanings, like for example url, body and title.
26−data Page = Page (M.Map String PageValue)
25+data Page = Page (M.Map B.ByteString B.ByteString)
2726
28−getContext :: Page -> M.Map String PageValue
29−getContext (Page page) = page
30−
31−-- | We use a ByteString for obvious reasons.
32−type PageValue = B.ByteString
27+fromContext :: (M.Map B.ByteString B.ByteString) -> Page
28+fromContext = Page
3329
3430-- | Add a key-value mapping to the Page.
3531addContext :: String -> String -> Page -> Page
36−addContext key value (Page page) = Page $ M.insert key (B.pack value) page
32+addContext key value (Page page) = Page $ M.insert (B.pack key) (B.pack value) page
33+
34+packPair :: (String, String) -> (B.ByteString, B.ByteString)
35+packPair (a, b) = (B.pack a, B.pack b)
3736
3837-- | Get the URL for a certain page. This should always be defined. If
3938-- not, it will return trash.html.
4039getPageURL :: Page -> String
41−getPageURL page =
42− let result = M.lookup "url" $ getContext page
40+getPageURL (Page page) =
41+ let result = M.lookup (B.pack "url") page
4342 in case result of (Just url) -> B.unpack url
4443 Nothing -> error "URL is not defined."
4544
4645-- | Get the body for a certain page. When not defined, the body will be
4746-- empty.
48−getBody :: Page -> PageValue
49−getBody = fromMaybe B.empty . M.lookup "body" . getContext
47+getBody :: Page -> B.ByteString
48+getBody (Page page) = fromMaybe B.empty $ M.lookup (B.pack "body") page
5049
5150writerOptions :: WriterOptions
5251writerOptions = defaultWriterOptions
@@ -73,17 +72,19 @@ isDelimiter = L.isPrefixOf "---"
7372
7473-- | Used for caching of files.
7574cachePage :: Page -> IO ()
76−cachePage page = do
75+cachePage page@(Page mapping) = do
7776 let destination = toCache $ getURL page
7877 makeDirectories destination
7978 handle <- openFile destination WriteMode
8079 hPutStrLn handle "---"
81− mapM_ (writePair handle) $ M.toList $ getContext page
80+ mapM_ (writePair handle) $ M.toList $ M.delete (B.pack "body") mapping
8281 hPutStrLn handle "---"
8382 B.hPut handle $ getBody page
8483 hClose handle
85− where writePair _ ("body", _) = return ()
86− writePair h (k, v) = hPutStr h (k ++ ": ") >> B.hPut h v >> hPutStrLn h ""
84+ where writePair h (k, v) = B.hPut h k >>
85+ B.hPut h (B.pack ": ") >>
86+ B.hPut h v >>
87+ hPutStrLn h ""
8788
8889-- | Read a page from a file. Metadata is supported, and if the filename
8990-- has a .markdown extension, it will be rendered using pandoc. Note that
@@ -106,7 +107,7 @@ readPage pagePath = do
106107 -- Render file
107108 let rendered = B.pack $ (renderFunction $ takeExtension path) body
108109 seq rendered $ hClose handle
109− let page = addContext "url" url $ Page $ M.fromList $ ("body", rendered) : map (second B.pack) context
110+ let page = addContext "url" url $ Page $ M.fromList $ (B.pack "body", rendered) : map packPair context
110111
111112 -- Cache if needed
112113 if getFromCache then return () else cachePage page
@@ -117,11 +118,9 @@ readPage pagePath = do
117118-- | Create a key-value mapping page from an association list.
118119pageFromList :: [(String, String)] -> Page
119120pageFromList = Page . M.fromList . map packPair
120− where packPair (k, v) = let pv = B.pack v
121− in seq pv (k, pv)
122121
123122-- Make pages renderable
124123instance Renderable Page where
125124 getDependencies = (:[]) . flip addExtension ".html" . dropExtension . getPageURL
126125 getURL = getPageURL
127− toContext = return . M.mapKeys B.pack . getContext
126+ toContext (Page mapping) = return mapping