From 31476dd6b8d30c62153ec8f6dabce4509b57516c Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 18 Jan 2010 21:33:38 +0100 Subject: Added basic support for metadata sections. --- src/Text/Hakyll/Page.hs | 78 +++++++++++++++++++++++++++++------------------- src/Text/Hakyll/Regex.hs | 14 +++++++-- 2 files changed, 59 insertions(+), 33 deletions(-) (limited to 'src') 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 -- cgit v1.2.3