Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

147 lines (133 sloc) 5.572 kB
{-
Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{- Functions for translating between Page structures and raw
- text strings. The strings may begin with a metadata block,
- which looks like this (it is valid YAML):
-
- > ---
- > title: Custom Title
- > format: markdown+lhs
- > toc: yes
- > categories: foo bar baz
- > ...
-
- This would tell gitit to use "Custom Title" as the displayed
- page title (instead of the page name), to interpret the page
- text as markdown with literate haskell, to include a table of
- contents, and to include the page in the categories foo, bar,
- and baz.
-
- The metadata block may be omitted entirely, and any particular line
- may be omitted. The categories in the @categories@ field should be
- separated by spaces. Commas will be treated as spaces.
-
- Metadata value fields may be continued on the next line, as long as
- it is nonblank and starts with a space character.
-
- Unrecognized metadata fields are simply ignored.
-}
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)
-- | Read a string (the contents of a page file) and produce a Page
-- object, using defaults except when overridden by metadata.
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'
-- | Write a string (the contents of a page file) corresponding to
-- a Page object, using explicit metadata only when needed.
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 _ = []
Jump to Line
Something went wrong with that request. Please try again.