diff options
Diffstat (limited to 'src/Text/Hakyll/Page.hs')
-rw-r--r-- | src/Text/Hakyll/Page.hs | 98 |
1 files changed, 98 insertions, 0 deletions
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs new file mode 100644 index 0000000..fc0498e --- /dev/null +++ b/src/Text/Hakyll/Page.hs @@ -0,0 +1,98 @@ +-- | A module for dealing with @Page@s. This module is mostly internally used. +module Text.Hakyll.Page + ( PageSection (..) + , readPage + , readPageAction + ) where + +import Data.List (isPrefixOf) +import Data.Char (isSpace) +import Control.Monad.Reader (liftIO) +import System.FilePath +import Control.Monad.State (State, evalState, get, put) + +import Text.Hakyll.File +import Text.Hakyll.HakyllMonad +import Text.Hakyll.HakyllAction +import Text.Hakyll.Regex (substituteRegex, matchesRegex) +import Text.Hakyll.Util (trim) + +-- | Page info handle: (key, value, needs rendering) +-- +data PageSection = PageSection {unPageSection :: [(String, String, Bool)]} + deriving (Show) + +-- | Split a page into sections. +-- +splitAtDelimiters :: [String] -> State (Maybe String) [[String]] +splitAtDelimiters [] = return [] +splitAtDelimiters ls@(x:xs) = do + delimiter <- get + if not (isDelimiter delimiter x) + then return [ls] + else do let proper = takeWhile (== '-') x + (content, rest) = break (isDelimiter $ Just proper) xs + put $ Just proper + rest' <- splitAtDelimiters rest + return $ (x : content) : rest' + where + isDelimiter old = case old of + Nothing -> isPossibleDelimiter + (Just d) -> (== d) . takeWhile (== '-') + +-- | Check if the given string is a metadata delimiter. +isPossibleDelimiter :: String -> Bool +isPossibleDelimiter = isPrefixOf "---" + +-- | Read one section of a page. +-- +readSection :: Bool -- ^ If this section is the first section in the page. + -> [String] -- ^ Lines in the section. + -> PageSection -- ^ Key-values extracted. +readSection _ [] = PageSection [] +readSection isFirst ls + | not isDelimiter' = body ls + | isNamedDelimiter = PageSection $ readSectionMetaData ls + | isFirst = PageSection $ readSimpleMetaData (drop 1 ls) + | otherwise = body (drop 1 ls) + where + isDelimiter' = isPossibleDelimiter (head ls) + isNamedDelimiter = head ls `matchesRegex` "^----* *[a-zA-Z0-9][a-zA-Z0-9]*" + body ls' = PageSection [("body", unlines ls', True)] + + readSimpleMetaData = map readPair . filter (not . all isSpace) + readPair = trimPair . break (== ':') + trimPair (key, value) = (trim key, trim (drop 1 value), False) + + readSectionMetaData [] = [] + readSectionMetaData (header:value) = + let key = substituteRegex "[^a-zA-Z0-9]" "" header + in [(key, unlines value, True)] + +-- | Read a page from a file. Metadata is supported. +-- +readPage :: FilePath -> Hakyll [PageSection] +readPage path = do + let sectionFunctions = map readSection $ True : repeat False + + -- Read file. + contents <- liftIO $ readFile path + url <- toUrl path + let sections = evalState (splitAtDelimiters $ lines contents) Nothing + sectionsData = zipWith ($) sectionFunctions sections + + return $ PageSection [ ("url", url, False) + , ("path", path, False) + ] : category : sectionsData + where + category = let dirs = splitDirectories $ takeDirectory path + in PageSection [("category", last dirs, False) | not (null dirs)] + +-- | Read a page from a file. Metadata is supported. +-- +readPageAction :: FilePath -> HakyllAction () [PageSection] +readPageAction path = HakyllAction + { actionDependencies = [path] + , actionUrl = Left $ toUrl path + , actionFunction = const $ readPage path + } |