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
+    }