{-# LANGUAGE CPP #-} {- Copyright (C) 2009 John MacFarlane 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 , readCategories ) 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) import Data.ByteString.UTF8 (toString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import System.IO (withFile, Handle, IOMode(..)) import qualified Control.Exception as E import System.IO.Error (isEOFError) 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 <- manyTill pMetadataLine pMetaEnd skipMany pBlankline rest <- getInput return (ls, rest) pMetaEnd :: GenParser Char st Char pMetaEnd = try $ do string "..." <|> string "---" pBlankline pBlankline :: GenParser Char st Char pBlankline = try $ many (oneOf " \t") >> newline pMetadataLine :: GenParser Char st (String, String) pMetadataLine = try $ do first <- letter rest <- many (letter <|> digit <|> oneOf "-_") let ident = first:rest 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 = filter (\(k, _) -> not (k `elem` ["title", "format", "toc", "categories"])) (pageMeta 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 "") ++ (unlines (map (\(k, v) -> k ++ ": " ++ v) metadata)) in (if null metadata' then "" else "---\n" ++ metadata' ++ "...\n\n") ++ pageText page' -- | Read categories from metadata strictly. readCategories :: FilePath -> IO [String] readCategories f = withFile f ReadMode $ \h -> E.catch (do fl <- B.hGetLine h if dashline fl then do -- get rest of metadata rest <- hGetLinesTill h dotOrDashline let (md,_) = parseMetadata $ unlines $ "---":rest return $ splitCategories $ fromMaybe "" $ lookup "categories" md else return []) (\e -> if isEOFError e then return [] else E.throwIO e) dashline :: B.ByteString -> Bool dashline x = case BC.unpack x of ('-':'-':'-':xs) | all (==' ') xs -> True _ -> False dotOrDashline :: B.ByteString -> Bool dotOrDashline x = case BC.unpack x of ('-':'-':'-':xs) | all (==' ') xs -> True ('.':'.':'.':xs) | all (==' ') xs -> True _ -> False hGetLinesTill :: Handle -> (B.ByteString -> Bool) -> IO [String] hGetLinesTill h end = do next <- B.hGetLine h if end next then return [toString next] else do rest <- hGetLinesTill h end return (toString next:rest)