summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJasper Van der Jeugt <jaspervdj@gmail.com>2010-01-18 21:33:38 +0100
committerJasper Van der Jeugt <jaspervdj@gmail.com>2010-01-18 21:33:38 +0100
commit31476dd6b8d30c62153ec8f6dabce4509b57516c (patch)
treeb7513e971a8963deca1a1ea06238954da37efdd1 /src
parent597116a87d795eb26fc92bdd7519556c89c8b11d (diff)
downloadhakyll-31476dd6b8d30c62153ec8f6dabce4509b57516c.tar.gz
Added basic support for metadata sections.
Diffstat (limited to 'src')
-rw-r--r--src/Text/Hakyll/Page.hs78
-rw-r--r--src/Text/Hakyll/Regex.hs14
2 files changed, 59 insertions, 33 deletions
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index 28d3540..41ddba6 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -12,7 +12,7 @@ import Data.Maybe (fromMaybe)
import Control.Parallel.Strategies (rdeepseq, ($|))
import Control.Monad.Reader (liftIO)
import System.FilePath (takeExtension)
-import System.IO (Handle, IOMode(..), openFile, hClose)
+import System.IO (IOMode(..), openFile, hClose)
import qualified System.IO.UTF8 as U
import Text.Pandoc
@@ -22,6 +22,7 @@ import Text.Hakyll.File
import Text.Hakyll.Util (trim)
import Text.Hakyll.Context (Context)
import Text.Hakyll.Renderable
+import Text.Hakyll.Regex (substituteRegex, matchesRegex)
-- | A Page is basically key-value mapping. Certain keys have special
-- meanings, like for example url, body and title.
@@ -56,25 +57,22 @@ writerOptions :: WriterOptions
writerOptions = defaultWriterOptions
-- | Get a render function for a given extension.
-renderFunction :: String -> (String -> String)
-renderFunction ".html" = id
-renderFunction ext = writeHtmlString writerOptions
- . readFunction ext defaultParserState
+getRenderFunction :: String -> (String -> String)
+getRenderFunction ".html" = id
+getRenderFunction ext = writeHtmlString writerOptions
+ . readFunction ext defaultParserState
where
readFunction ".rst" = readRST
readFunction ".tex" = readLaTeX
readFunction _ = readMarkdown
--- | Read metadata header from a file handle.
-readMetaData :: Handle -> Hakyll [(String, String)]
-readMetaData handle = do
- line <- liftIO $ U.hGetLine handle
- if isDelimiter line
- then return []
- else do others <- readMetaData handle
- return $ (trimPair . break (== ':')) line : others
- where
- trimPair (key, value) = (trim key, trim $ tail value)
+-- | Split a page into sections.
+splitAtDelimiters :: [String] -> [[String]]
+splitAtDelimiters [] = []
+splitAtDelimiters ls@(x:xs)
+ | isDelimiter x = let (content, rest) = break isDelimiter xs
+ in (x : content) : splitAtDelimiters rest
+ | otherwise = [ls]
-- | Check if the given string is a metadata delimiter.
isDelimiter :: String -> Bool
@@ -106,6 +104,31 @@ cachePage page@(Page mapping) = do
destination = toCache $ getURL page
+-- | Read one section of a page.
+readSection :: (String -> String) -- ^ Render function.
+ -> Bool -- ^ If this section is the first section in the page.
+ -> [String] -- ^ Lines in the section.
+ -> [(String, String)] -- ^ Key-values extracted.
+readSection _ _ [] = []
+readSection renderFunction True ls
+ | isDelimiter (head ls) = readSimpleMetaData (tail ls)
+ | otherwise = [("body", renderFunction $ unlines ls)]
+ where
+ readSimpleMetaData = map readPair
+ readPair = (trimPair . break (== ':'))
+ trimPair (key, value) = (trim key, trim $ tail value)
+
+readSection renderFunction False ls
+ | isDelimiter (head ls) = readSectionMetaData ls
+ | otherwise = error $ "Page parsing error at: " ++ head ls
+ where
+ readSectionMetaData [] = []
+ readSectionMetaData (header:value) =
+ let key = if header `matchesRegex` "----* *[a-zA-Z][a-zA-Z]*"
+ then substituteRegex "[^a-zA-Z]" "" header
+ else "body"
+ in [(key, renderFunction $ unlines value)]
+
-- | Read a page from a file. Metadata is supported, and if the filename
-- has a @.markdown@ extension, it will be rendered using pandoc.
readPage :: FilePath -> Hakyll Page
@@ -113,27 +136,22 @@ readPage pagePath = do
-- Check cache.
getFromCache <- isCacheValid cacheFile [pagePath]
let path = if getFromCache then cacheFile else pagePath
+ renderFunction = getRenderFunction $ takeExtension path
+ sectionFunctions = map (readSection renderFunction)
+ (True : repeat False)
-- Read file.
handle <- liftIO $ openFile path ReadMode
- line <- liftIO $ U.hGetLine handle
- (metaData, body) <-
- if isDelimiter line
- then do md <- readMetaData handle
- b <- liftIO $ U.hGetContents handle
- return (md, b)
- else do b <- liftIO $ U.hGetContents handle
- return ([], line ++ "\n" ++ b)
-
- -- Render file
- let rendered = (renderFunction $ takeExtension path) body
+ sections <- fmap (splitAtDelimiters . lines )
+ (liftIO $ U.hGetContents handle)
+
+ let context = concat $ zipWith ($) sectionFunctions sections
page = fromContext $ M.fromList $
- [ ("body", rendered)
- , ("url", url)
+ [ ("url", url)
, ("path", pagePath)
- ] ++ metaData
+ ] ++ context
- seq (($|) id rdeepseq rendered) $ liftIO $ hClose handle
+ seq (($|) id rdeepseq context) $ liftIO $ hClose handle
-- Cache if needed
if getFromCache then return () else cachePage page
diff --git a/src/Text/Hakyll/Regex.hs b/src/Text/Hakyll/Regex.hs
index 37bbc7e..9b7177e 100644
--- a/src/Text/Hakyll/Regex.hs
+++ b/src/Text/Hakyll/Regex.hs
@@ -1,8 +1,10 @@
-- | A module that exports a simple regex interface. This code is mostly copied
--- from the regex-compat package at hackage.
+-- from the regex-compat package at hackage. I decided to write this module
+-- because I want to abstract the regex package used.
module Text.Hakyll.Regex
( splitRegex
, substituteRegex
+ , matchesRegex
) where
import Text.Regex.TDFA
@@ -58,9 +60,15 @@ splitRegex :: String -> String -> [String]
splitRegex pattern = filter (not . null)
. splitRegex' (makeRegex pattern)
--- | Substitute a regex. Simplified interface.
+-- | Substitute a regex. Simplified interface. This function performs a global
+-- substitution.
substituteRegex :: String -- ^ Pattern to replace (regex).
-> String -- ^ Replacement string.
-> String -- ^ Input string.
-> String -- ^ Result.
-substituteRegex pattern replacement str = subRegex (makeRegex pattern) str replacement
+substituteRegex pattern replacement string =
+ subRegex (makeRegex pattern) string replacement
+
+-- | Simple regex matching.
+matchesRegex :: String -> String -> Bool
+matchesRegex string pattern = string =~ pattern