module Network.Gitit.Page ( stringToPage
, pageToString
, extractCategories
)
where
import Network.Gitit.Types
import Network.Gitit.Util (trim, splitCategories, parsePageType)
import Text.ParserCombinators.Parsec
import Data.Char (toLower)
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
parseMetadata :: String -> ([(String, String)], String)
parseMetadata raw =
case parse pMetadataBlock "" raw of
Left _ -> ([], raw)
Right (ls, rest) -> (ls, rest)
pMetadataBlock :: GenParser Char st ([(String, String)], String)
pMetadataBlock = try $ do
string "---"
pBlankline
ls <- many pMetadataLine
string "..."
pBlankline
skipMany pBlankline
rest <- getInput
return (ls, rest)
pBlankline :: GenParser Char st Char
pBlankline = try $ many (oneOf " \t") >> newline
pMetadataLine :: GenParser Char st (String, String)
pMetadataLine = try $ do
ident <- many1 letter
skipMany (oneOf " \t")
char ':'
rawval <- many $ noneOf "\n\r"
<|> (try $ newline >> notFollowedBy pBlankline >>
skipMany1 (oneOf " \t") >> return ' ')
newline
return (ident, trim rawval)
stringToPage :: Config -> String -> String -> Page
stringToPage conf pagename raw =
let (ls, rest) = parseMetadata raw
page' = Page { pageName = pagename
, pageFormat = defaultPageType conf
, pageLHS = defaultLHS conf
, pageTOC = tableOfContents conf
, pageTitle = pagename
, pageCategories = []
, pageText = filter (/= '\r') rest
, pageMeta = ls }
in foldr adjustPage page' ls
adjustPage :: (String, String) -> Page -> Page
adjustPage ("title", val) page' = page' { pageTitle = val }
adjustPage ("format", val) page' = page' { pageFormat = pt, pageLHS = lhs }
where (pt, lhs) = parsePageType val
adjustPage ("toc", val) page' = page' {
pageTOC = (map toLower val) `elem` ["yes","true"] }
adjustPage ("categories", val) page' =
page' { pageCategories = splitCategories val ++ pageCategories page' }
adjustPage (_, _) page' = page'
pageToString :: Config -> Page -> String
pageToString conf page' =
let pagename = pageName page'
pagetitle = pageTitle page'
pageformat = pageFormat page'
pagelhs = pageLHS page'
pagetoc = pageTOC page'
pagecats = pageCategories page'
metadata' = (if pagename /= pagetitle
then "!title: " ++ pagetitle ++ "\n"
else "") ++
(if pageformat /= defaultPageType conf ||
pagelhs /= defaultLHS conf
then "!format: " ++
map toLower (show pageformat) ++
if pagelhs then "+lhs\n" else "\n"
else "") ++
(if pagetoc /= tableOfContents conf
then "!toc: " ++
(if pagetoc then "yes" else "no") ++ "\n"
else "") ++
(if not (null pagecats)
then "!categories: " ++ intercalate " " pagecats ++ "\n"
else "")
in metadata' ++ (if null metadata' then "" else "\n") ++ pageText page'
extractCategories :: String -> [String]
extractCategories s | take 3 s == "---" =
let (md,_) = parseMetadata s
in splitCategories $ fromMaybe "" $ lookup "categories" md
extractCategories _ = []