@@ -1,6 +1,6 @@
1module Text.Hakyll.Page
1module Text.Hakyll.Page
2− ( Page (..),
2+ ( Page,
3− PageValue,
3+ fromContext,
4 addContext,
4 addContext,
@@ -12,7 +12,6 @@ import qualified Data.List as L
12import qualified Data.ByteString.Lazy.Char8 as B
12import qualified Data.ByteString.Lazy.Char8 as B
13import Data.Maybe
13import Data.Maybe
14import Control.Monad
14import Control.Monad
17import System.FilePath
16import System.FilePath
18import System.IO
17import System.IO
@@ -23,30 +22,30 @@ import Text.Pandoc
24-- | A Page is basically key-value mapping. Certain keys have special
23-- | A Page is basically key-value mapping. Certain keys have special
25-- meanings, like for example url, body and title.
24-- 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)
28−getContext :: Page -> M.Map String PageValue
27+fromContext :: (M.Map B.ByteString B.ByteString) -> Page
29−getContext (Page page) = page
28+fromContext = Page
31−-- | We use a ByteString for obvious reasons.
32−type PageValue = B.ByteString
34-- | Add a key-value mapping to the Page.
30-- | Add a key-value mapping to the Page.
35addContext :: String -> String -> Page -> Page
31addContext :: 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
34+packPair :: (String, String) -> (B.ByteString, B.ByteString)
35+packPair (a, b) = (B.pack a, B.pack b)
38-- | Get the URL for a certain page. This should always be defined. If
37-- | Get the URL for a certain page. This should always be defined. If
39-- not, it will return trash.html.
38-- not, it will return trash.html.
40getPageURL :: Page -> String
39getPageURL :: Page -> String
41−getPageURL page =
40+getPageURL (Page page) =
42− let result = M.lookup "url" $ getContext page
41+ let result = M.lookup (B.pack "url") page
43 in case result of (Just url) -> B.unpack url
42 in case result of (Just url) -> B.unpack url
44 Nothing -> error "URL is not defined."
43 Nothing -> error "URL is not defined."
46-- | Get the body for a certain page. When not defined, the body will be
45-- | Get the body for a certain page. When not defined, the body will be
48−getBody :: Page -> PageValue
47+getBody :: Page -> B.ByteString
49−getBody = fromMaybe B.empty . M.lookup "body" . getContext
48+getBody (Page page) = fromMaybe B.empty $ M.lookup (B.pack "body") page
51writerOptions :: WriterOptions
50writerOptions :: WriterOptions
52writerOptions = defaultWriterOptions
51writerOptions = defaultWriterOptions
@@ -73,17 +72,19 @@ isDelimiter = L.isPrefixOf "---"
74-- | Used for caching of files.
73-- | Used for caching of files.
75cachePage :: Page -> IO ()
74cachePage :: Page -> IO ()
76−cachePage page = do
75+cachePage page@(Page mapping) = do
77 let destination = toCache $ getURL page
76 let destination = toCache $ getURL page
78 makeDirectories destination
77 makeDirectories destination
79 handle <- openFile destination WriteMode
78 handle <- openFile destination WriteMode
80 hPutStrLn handle "---"
79 hPutStrLn handle "---"
81− mapM_ (writePair handle) $ M.toList $ getContext page
80+ mapM_ (writePair handle) $ M.toList $ M.delete (B.pack "body") mapping
82 hPutStrLn handle "---"
81 hPutStrLn handle "---"
83 B.hPut handle $ getBody page
82 B.hPut handle $ getBody page
84 hClose handle
83 hClose handle
85− where writePair _ ("body", _) = return ()
84+ where writePair h (k, v) = B.hPut h k >>
85+ B.hPut h (B.pack ": ") >>
86− writePair h (k, v) = hPutStr h (k ++ ": ") >> B.hPut h v >> hPutStrLn h ""
87+ hPutStrLn h ""
88-- | Read a page from a file. Metadata is supported, and if the filename
89-- | Read a page from a file. Metadata is supported, and if the filename
89-- has a .markdown extension, it will be rendered using pandoc. Note that
90-- has a .markdown extension, it will be rendered using pandoc. Note that
@@ -106,7 +107,7 @@ readPage pagePath = do
106 -- Render file
107 -- Render file
107 let rendered = B.pack $ (renderFunction $ takeExtension path) body
108 let rendered = B.pack $ (renderFunction $ takeExtension path) body
108 seq rendered $ hClose handle
109 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
111 -- Cache if needed
112 -- Cache if needed
112 if getFromCache then return () else cachePage page
113 if getFromCache then return () else cachePage page
@@ -117,11 +118,9 @@ readPage pagePath = do
117-- | Create a key-value mapping page from an association list.
118-- | Create a key-value mapping page from an association list.
118pageFromList :: [(String, String)] -> Page
119pageFromList :: [(String, String)] -> Page
119pageFromList = Page . M.fromList . map packPair
120pageFromList = Page . M.fromList . map packPair
120− where packPair (k, v) = let pv = B.pack v
123-- Make pages renderable
122-- Make pages renderable
124instance Renderable Page where
123instance Renderable Page where
125 getDependencies = (:[]) . flip addExtension ".html" . dropExtension . getPageURL
124 getDependencies = (:[]) . flip addExtension ".html" . dropExtension . getPageURL
126 getURL = getPageURL
125 getURL = getPageURL
127− toContext = return . M.mapKeys B.pack . getContext
126+ toContext (Page mapping) = return mapping