diff options
Diffstat (limited to 'src/Text/Pandoc')
32 files changed, 613 insertions, 506 deletions
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 4eb527b6e..c88cee9c4 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -55,6 +55,7 @@ data Extension = Ext_footnotes -- ^ Pandoc/PHP/MMD style footnotes | Ext_inline_notes -- ^ Pandoc-style inline notes | Ext_pandoc_title_block -- ^ Pandoc title block + | Ext_yaml_title_block -- ^ YAML metadata block | Ext_mmd_title_block -- ^ Multimarkdown metadata block | Ext_table_captions -- ^ Pandoc-style table captions | Ext_implicit_figures -- ^ A paragraph with just an image is a figure @@ -106,6 +107,7 @@ pandocExtensions = Set.fromList [ Ext_footnotes , Ext_inline_notes , Ext_pandoc_title_block + , Ext_yaml_title_block , Ext_table_captions , Ext_implicit_figures , Ext_simple_tables diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 71b16b7ca..fce6f2248 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -148,7 +148,7 @@ where import Text.Pandoc.Definition import Text.Pandoc.Options -import Text.Pandoc.Builder (Blocks, Inlines, rawBlock) +import Text.Pandoc.Builder (Blocks, Inlines, rawBlock, HasMeta(..)) import Text.Pandoc.XML (fromEntities) import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn) import Text.Parsec @@ -799,9 +799,7 @@ data ParserState = ParserState stateSubstitutions :: SubstTable, -- ^ List of substitution references stateNotes :: NoteTable, -- ^ List of notes (raw bodies) stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies) - stateTitle :: [Inline], -- ^ Title of document - stateAuthors :: [[Inline]], -- ^ Authors of document - stateDate :: [Inline], -- ^ Date of document + stateMeta :: Meta, -- ^ Document metadata stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used stateHeaders :: M.Map Inlines String, -- ^ List of headers and ids (used for implicit ref links) stateIdentifiers :: [String], -- ^ List of header identifiers used @@ -816,6 +814,12 @@ data ParserState = ParserState instance Default ParserState where def = defaultParserState +instance HasMeta ParserState where + setMeta field val st = + st{ stateMeta = setMeta field val $ stateMeta st } + deleteMeta field st = + st{ stateMeta = deleteMeta field $ stateMeta st } + defaultParserState :: ParserState defaultParserState = ParserState { stateOptions = def, @@ -828,9 +832,7 @@ defaultParserState = stateSubstitutions = M.empty, stateNotes = [], stateNotes' = [], - stateTitle = [], - stateAuthors = [], - stateDate = [], + stateMeta = nullMeta, stateHeaderTable = [], stateHeaders = M.empty, stateIdentifiers = [], diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 32ce46fba..f6657a4d1 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -39,7 +39,7 @@ module Text.Pandoc.Readers.HTML ( readHtml import Text.HTML.TagSoup import Text.HTML.TagSoup.Match import Text.Pandoc.Definition -import Text.Pandoc.Builder (text, toList) +import qualified Text.Pandoc.Builder as B import Text.Pandoc.Shared import Text.Pandoc.Options import Text.Pandoc.Parsing @@ -47,6 +47,7 @@ import Data.Maybe ( fromMaybe, isJust ) import Data.List ( intercalate ) import Data.Char ( isDigit ) import Control.Monad ( liftM, guard, when, mzero ) +import Control.Applicative ( (<$>), (<$) ) isSpace :: Char -> Bool isSpace ' ' = True @@ -58,32 +59,26 @@ isSpace _ = False readHtml :: ReaderOptions -- ^ Reader options -> String -- ^ String to parse (assumes @'\n'@ line endings) -> Pandoc -readHtml opts inp = Pandoc meta blocks - where blocks = case runParser parseBody def{ stateOptions = opts } - "source" rest of - Left err' -> error $ "\nError at " ++ show err' - Right result -> result - tags = canonicalizeTags $ +readHtml opts inp = + case runParser parseDoc def{ stateOptions = opts } "source" tags of + Left err' -> error $ "\nError at " ++ show err' + Right result -> result + where tags = canonicalizeTags $ parseTagsOptions parseOptions{ optTagPosition = True } inp - hasHeader = any (~== TagOpen "head" []) tags - (meta, rest) = if hasHeader - then parseHeader tags - else (Meta [] [] [], tags) + parseDoc = do + blocks <- (fixPlains False . concat) <$> manyTill block eof + meta <- stateMeta <$> getState + return $ Pandoc meta blocks type TagParser = Parser [Tag String] ParserState --- TODO - fix this - not every header has a title tag -parseHeader :: [Tag String] -> (Meta, [Tag String]) -parseHeader tags = (Meta{docTitle = tit'', docAuthors = [], docDate = []}, rest) - where (tit,_) = break (~== TagClose "title") $ drop 1 $ - dropWhile (\t -> not $ t ~== TagOpen "title" []) tags - tit' = concatMap fromTagText $ filter isTagText tit - tit'' = normalizeSpaces $ toList $ text tit' - rest = drop 1 $ dropWhile (\t -> not $ t ~== TagClose "head" || - t ~== TagOpen "body" []) tags +pBody :: TagParser [Block] +pBody = pInTags "body" block -parseBody :: TagParser [Block] -parseBody = liftM (fixPlains False . concat) $ manyTill block eof +pHead :: TagParser [Block] +pHead = pInTags "head" $ pTitle <|> ([] <$ pAnyTag) + where pTitle = pInTags "title" inline >>= setTitle . normalizeSpaces + setTitle t = [] <$ (updateState $ B.setMeta "title" (B.fromList t)) block :: TagParser [Block] block = choice @@ -94,6 +89,8 @@ block = choice , pList , pHrule , pSimpleTable + , pHead + , pBody , pPlain , pRawHtmlBlock ] @@ -366,7 +363,7 @@ pImage = do let url = fromAttrib "src" tag let title = fromAttrib "title" tag let alt = fromAttrib "alt" tag - return [Image (toList $ text alt) (escapeURI url, title)] + return [Image (B.toList $ B.text alt) (escapeURI url, title)] pCode :: TagParser [Inline] pCode = try $ do diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs index 081ec7b5e..0e74406ef 100644 --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -21,7 +21,7 @@ import Text.Pandoc.Readers.Haddock.Parse readHaddock :: ReaderOptions -- ^ Reader options -> String -- ^ String to parse -> Pandoc -readHaddock _ s = Pandoc (Meta [] [] []) blocks +readHaddock _ s = Pandoc nullMeta blocks where blocks = case parseParas (tokenise s (0,0)) of Left [] -> error "parse failure" diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index f3f76ce5c..0d4afb2a7 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -65,13 +65,11 @@ parseLaTeX = do bs <- blocks eof st <- getState - let title' = stateTitle st - let authors' = stateAuthors st - let date' = stateDate st + let meta = stateMeta st refs <- getOption readerReferences mbsty <- getOption readerCitationStyle - return $ processBiblio mbsty refs - $ Pandoc (Meta title' authors' date') $ toList bs + let (Pandoc _ bs') = processBiblio mbsty refs $ doc bs + return $ Pandoc meta bs' type LP = Parser [Char] ParserState @@ -249,13 +247,13 @@ ignoreBlocks name = (name, doraw <|> (mempty <$ optargs)) blockCommands :: M.Map String (LP Blocks) blockCommands = M.fromList $ [ ("par", mempty <$ skipopts) - , ("title", mempty <$ (skipopts *> tok >>= addTitle)) - , ("subtitle", mempty <$ (skipopts *> tok >>= addSubtitle)) + , ("title", mempty <$ (skipopts *> tok >>= addMeta "title")) + , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle")) , ("author", mempty <$ (skipopts *> authors)) -- -- in letter class, temp. store address & sig as title, author - , ("address", mempty <$ (skipopts *> tok >>= addTitle)) + , ("address", mempty <$ (skipopts *> tok >>= addMeta "address")) , ("signature", mempty <$ (skipopts *> authors)) - , ("date", mempty <$ (skipopts *> tok >>= addDate)) + , ("date", mempty <$ (skipopts *> tok >>= addMeta "date")) -- sectioning , ("chapter", updateState (\s -> s{ stateHasChapters = True }) *> section nullAttr 0) @@ -301,12 +299,8 @@ blockCommands = M.fromList $ , "hspace", "vspace" ] -addTitle :: Inlines -> LP () -addTitle tit = updateState (\s -> s{ stateTitle = toList tit }) - -addSubtitle :: Inlines -> LP () -addSubtitle tit = updateState (\s -> s{ stateTitle = stateTitle s ++ - toList (str ":" <> linebreak <> tit) }) +addMeta :: ToMetaValue a => String -> a -> LP () +addMeta field val = updateState $ setMeta field val authors :: LP () authors = try $ do @@ -317,10 +311,7 @@ authors = try $ do -- skip e.g. \vspace{10pt} auths <- sepBy oneAuthor (controlSeq "and") char '}' - updateState (\s -> s { stateAuthors = map (normalizeSpaces . toList) auths }) - -addDate :: Inlines -> LP () -addDate dat = updateState (\s -> s{ stateDate = toList dat }) + addMeta "authors" (map trimInlines auths) section :: Attr -> Int -> LP Blocks section attr lvl = do @@ -872,20 +863,24 @@ letter_contents = do bs <- blocks st <- getState -- add signature (author) and address (title) - let addr = case stateTitle st of - [] -> mempty - x -> para $ trimInlines $ fromList x - updateState $ \s -> s{ stateAuthors = [], stateTitle = [] } + let addr = case lookupMeta "address" (stateMeta st) of + Just (MetaBlocks [Plain xs]) -> + para $ trimInlines $ fromList xs + _ -> mempty return $ addr <> bs -- sig added by \closing closing :: LP Blocks closing = do contents <- tok st <- getState - let sigs = case stateAuthors st of - [] -> mempty - xs -> para $ trimInlines $ fromList - $ intercalate [LineBreak] xs + let extractInlines (MetaBlocks [Plain ys]) = ys + extractInlines (MetaBlocks [Para ys ]) = ys + extractInlines _ = [] + let sigs = case lookupMeta "author" (stateMeta st) of + Just (MetaList xs) -> + para $ trimInlines $ fromList $ + intercalate [LineBreak] $ map extractInlines xs + _ -> mempty return $ para (trimInlines contents) <> sigs item :: LP Blocks diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 35c236041..8c836614f 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -37,7 +37,13 @@ import Data.Ord ( comparing ) import Data.Char ( isAlphaNum, toLower ) import Data.Maybe import Text.Pandoc.Definition +import qualified Data.Text as T +import Data.Text (Text) +import qualified Data.Yaml as Yaml +import qualified Data.HashMap.Strict as H import qualified Text.Pandoc.Builder as B +import qualified Text.Pandoc.UTF8 as UTF8 +import qualified Data.Vector as V import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>)) import Text.Pandoc.Options import Text.Pandoc.Shared @@ -196,12 +202,13 @@ dateLine = try $ do skipSpaces trimInlinesF . mconcat <$> manyTill inline newline -titleBlock :: MarkdownParser (F Inlines, F [Inlines], F Inlines) +titleBlock :: MarkdownParser (F (Pandoc -> Pandoc)) titleBlock = pandocTitleBlock + <|> yamlTitleBlock <|> mmdTitleBlock - <|> return (mempty, return [], mempty) + <|> return (return id) -pandocTitleBlock :: MarkdownParser (F Inlines, F [Inlines], F Inlines) +pandocTitleBlock :: MarkdownParser (F (Pandoc -> Pandoc)) pandocTitleBlock = try $ do guardEnabled Ext_pandoc_title_block lookAhead (char '%') @@ -209,25 +216,78 @@ pandocTitleBlock = try $ do author <- option (return []) authorsLine date <- option mempty dateLine optional blanklines - return (title, author, date) - -mmdTitleBlock :: MarkdownParser (F Inlines, F [Inlines], F Inlines) + return $ do + title' <- title + author' <- author + date' <- date + return $ B.setMeta "title" title' + . B.setMeta "author" author' + . B.setMeta "date" date' + +yamlTitleBlock :: MarkdownParser (F (Pandoc -> Pandoc)) +yamlTitleBlock = try $ do + guardEnabled Ext_yaml_title_block + string "---" + blankline + rawYaml <- unlines <$> manyTill anyLine stopLine + optional blanklines + opts <- stateOptions <$> getState + return $ return $ + case Yaml.decode $ UTF8.fromString rawYaml of + Just (Yaml.Object hashmap) -> + H.foldrWithKey (\k v f -> + if ignorable k + then f + else B.setMeta (T.unpack k) (yamlToMeta opts v) . f) + id hashmap + _ -> fail "Could not parse yaml object" + +-- ignore fields starting with _ +ignorable :: Text -> Bool +ignorable t = (T.pack "_") `T.isPrefixOf` t + +toMetaValue :: ReaderOptions -> Text -> MetaValue +toMetaValue opts x = + case readMarkdown opts (T.unpack x) of + Pandoc _ [Plain xs] -> MetaInlines xs + Pandoc _ [Para xs] + | endsWithNewline x -> MetaBlocks [Para xs] + | otherwise -> MetaInlines xs + Pandoc _ bs -> MetaBlocks bs + where endsWithNewline t = (T.pack "\n") `T.isSuffixOf` t + +yamlToMeta :: ReaderOptions -> Yaml.Value -> MetaValue +yamlToMeta opts (Yaml.String t) = toMetaValue opts t +yamlToMeta _ (Yaml.Number n) = MetaString $ show n +yamlToMeta _ (Yaml.Bool b) = MetaString $ map toLower $ show b +yamlToMeta opts (Yaml.Array xs) = B.toMetaValue $ map (yamlToMeta opts) + $ V.toList xs +yamlToMeta opts (Yaml.Object o) = MetaMap $ H.foldrWithKey (\k v m -> + if ignorable k + then m + else M.insert (T.unpack k) + (yamlToMeta opts v) m) + M.empty o +yamlToMeta _ _ = MetaString "" + +stopLine :: MarkdownParser () +stopLine = try $ (string "---" <|> string "...") >> blankline >> return () + +mmdTitleBlock :: MarkdownParser (F (Pandoc -> Pandoc)) mmdTitleBlock = try $ do guardEnabled Ext_mmd_title_block kvPairs <- many1 kvPair blanklines - let title = maybe mempty return $ lookup "title" kvPairs - let author = maybe mempty (\x -> return [x]) $ lookup "author" kvPairs - let date = maybe mempty return $ lookup "date" kvPairs - return (title, author, date) + return $ return $ \(Pandoc m bs) -> + Pandoc (foldl (\m' (k,v) -> addMetaField k v m') m kvPairs) bs -kvPair :: MarkdownParser (String, Inlines) +kvPair :: MarkdownParser (String, MetaValue) kvPair = try $ do key <- many1Till (alphaNum <|> oneOf "_- ") (char ':') val <- manyTill anyChar (try $ newline >> lookAhead (blankline <|> nonspaceChar)) let key' = concat $ words $ map toLower key - let val' = trimInlines $ B.text val + let val' = MetaBlocks $ B.toList $ B.plain $ B.text $ trim val return (key',val') parseMarkdown :: MarkdownParser Pandoc @@ -236,16 +296,15 @@ parseMarkdown = do updateState $ \state -> state { stateOptions = let oldOpts = stateOptions state in oldOpts{ readerParseRaw = True } } - (title, authors, date) <- option (mempty,return [],mempty) titleBlock + titleTrans <- option (return id) titleBlock blocks <- parseBlocks st <- getState mbsty <- getOption readerCitationStyle refs <- getOption readerReferences return $ processBiblio mbsty refs - $ B.setTitle (runF title st) - $ B.setAuthors (runF authors st) - $ B.setDate (runF date st) - $ B.doc $ runF blocks st + $ runF titleTrans st + $ B.doc + $ runF blocks st addWarning :: Maybe SourcePos -> String -> MarkdownParser () addWarning mbpos msg = diff --git a/src/Text/Pandoc/Readers/Native.hs b/src/Text/Pandoc/Readers/Native.hs index a0e5a0635..c5d4cb98a 100644 --- a/src/Text/Pandoc/Readers/Native.hs +++ b/src/Text/Pandoc/Readers/Native.hs @@ -33,12 +33,6 @@ module Text.Pandoc.Readers.Native ( readNative ) where import Text.Pandoc.Definition import Text.Pandoc.Shared (safeRead) -nullMeta :: Meta -nullMeta = Meta{ docTitle = [] - , docAuthors = [] - , docDate = [] - } - -- | Read native formatted text and return a Pandoc document. -- The input may be a full pandoc document, a block list, a block, -- an inline list, or an inline. Thus, for example, @@ -47,7 +41,7 @@ nullMeta = Meta{ docTitle = [] -- -- will be treated as if it were -- --- > Pandoc (Meta [] [] []) [Plain [Str "hi"]] +-- > Pandoc nullMeta [Plain [Str "hi"]] -- readNative :: String -- ^ String to parse (assuming @'\n'@ line endings) -> Pandoc diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 4e0c0a277..0829996a7 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -31,6 +31,7 @@ module Text.Pandoc.Readers.RST ( readRST ) where import Text.Pandoc.Definition +import Text.Pandoc.Builder (setMeta, fromList) import Text.Pandoc.Shared import Text.Pandoc.Parsing import Text.Pandoc.Options @@ -39,7 +40,6 @@ import Data.List ( findIndex, intersperse, intercalate, transpose, sort, deleteFirstsBy, isSuffixOf ) import qualified Data.Map as M import Text.Printf ( printf ) -import Data.Maybe ( catMaybes ) import Control.Applicative ((<$>), (<$), (<*), (*>)) import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>)) import qualified Text.Pandoc.Builder as B @@ -87,16 +87,30 @@ promoteHeaders _ [] = [] -- | If list of blocks starts with a header (or a header and subheader) -- of level that are not found elsewhere, return it as a title and --- promote all the other headers. -titleTransform :: [Block] -- ^ list of blocks - -> ([Block], [Inline]) -- ^ modified list of blocks, title -titleTransform ((Header 1 _ head1):(Header 2 _ head2):rest) | - not (any (isHeader 1) rest || any (isHeader 2) rest) = -- both title & subtitle - (promoteHeaders 2 rest, head1 ++ [Str ":", Space] ++ head2) -titleTransform ((Header 1 _ head1):rest) | - not (any (isHeader 1) rest) = -- title, no subtitle - (promoteHeaders 1 rest, head1) -titleTransform blocks = (blocks, []) +-- promote all the other headers. Also process a definition list right +-- after the title block as metadata. +titleTransform :: ([Block], Meta) -- ^ list of blocks, metadata + -> ([Block], Meta) -- ^ modified list of blocks, metadata +titleTransform (bs, meta) = + let (bs', meta') = + case bs of + ((Header 1 _ head1):(Header 2 _ head2):rest) + | not (any (isHeader 1) rest || any (isHeader 2) rest) -> -- tit/sub + (promoteHeaders 2 rest, setMeta "title" (fromList head1) $ + setMeta "subtitle" (fromList head2) meta) + ((Header 1 _ head1):rest) + | not (any (isHeader 1) rest) -> -- title only + (promoteHeaders 1 rest, + setMeta "title" (fromList head1) meta) + _ -> (bs, meta) + in case bs' of + (DefinitionList ds : rest) -> + (rest, metaFromDefList ds meta') + _ -> (bs', meta') + +metaFromDefList :: [([Inline], [[Block]])] -> Meta -> Meta +metaFromDefList ds meta = foldr f meta ds + where f (k,v) = setMeta (map toLower $ stringify k) (mconcat $ map fromList v) parseRST :: RSTParser Pandoc parseRST = do @@ -114,14 +128,12 @@ parseRST = do -- now parse it for real... blocks <- B.toList <$> parseBlocks standalone <- getOption readerStandalone - let (blocks', title) = if standalone - then titleTransform blocks - else (blocks, []) state <- getState - let authors = stateAuthors state - let date = stateDate state - let title' = if null title then stateTitle state else title - return $ Pandoc (Meta title' authors date) blocks' + let meta = stateMeta state + let (blocks', meta') = if standalone + then titleTransform (blocks, meta) + else (blocks, meta) + return $ Pandoc meta' blocks' -- -- parsing blocks @@ -163,38 +175,19 @@ rawFieldListItem indent = try $ do return (name, raw) fieldListItem :: String - -> RSTParser (Maybe (Inlines, [Blocks])) + -> RSTParser (Inlines, [Blocks]) fieldListItem indent = try $ do (name, raw) <- rawFieldListItem indent let term = B.str name contents <- parseFromString parseBlocks raw optional blanklines - case (name, B.toList contents) of - ("Author", x) -> do - updateState $ \st -> - st{ stateAuthors = stateAuthors st ++ [extractContents x] } - return Nothing - ("Authors", [BulletList auths]) -> do - updateState $ \st -> st{ stateAuthors = map extractContents auths } - return Nothing - ("Date", x) -> do - updateState $ \st -> st{ stateDate = extractContents x } - return Nothing - ("Title", x) -> do - updateState $ \st -> st{ stateTitle = extractContents x } - return Nothing - _ -> return $ Just (term, [contents]) - -extractContents :: [Block] -> [Inline] -extractContents [Plain auth] = auth -extractContents [Para auth] = auth -extractContents _ = [] + return (term, [contents]) fieldList :: RSTParser Blocks fieldList = try $ do indent <- lookAhead $ many spaceChar items <- many1 $ fieldListItem indent - case catMaybes items of + case items of [] -> return mempty items' -> return $ B.definitionList items' diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 22ec52362..a1687a691 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -93,7 +93,7 @@ parseTextile = do updateState $ \s -> s { stateNotes = reverse reversedNotes } -- now parse it for real... blocks <- parseBlocks - return $ Pandoc (Meta [] [] []) blocks -- FIXME + return $ Pandoc nullMeta blocks -- FIXME noteMarker :: Parser [Char] ParserState [Char] noteMarker = skipMany spaceChar >> string "fn" >> manyTill digit (char '.') diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index c571c4143..9c62db86e 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveDataTypeable, CPP #-} {- -Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2006-2013 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 @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Shared - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2013 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> @@ -61,6 +61,10 @@ module Text.Pandoc.Shared ( isHeaderBlock, headerShift, isTightList, + addMetaField, + makeMeta, + metaToJSON, + setField, -- * TagSoup HTML handling renderTags', -- * File handling @@ -78,7 +82,7 @@ module Text.Pandoc.Shared ( import Text.Pandoc.Definition import Text.Pandoc.Generic -import Text.Pandoc.Builder (Blocks) +import Text.Pandoc.Builder (Blocks, ToMetaValue(..)) import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.UTF8 as UTF8 import System.Environment (getProgName) @@ -86,6 +90,7 @@ import System.Exit (exitWith, ExitCode(..)) import Data.Char ( toLower, isLower, isUpper, isAlpha, isLetter, isDigit, isSpace ) import Data.List ( find, isPrefixOf, intercalate ) +import qualified Data.Map as M import Network.URI ( escapeURIString, isAbsoluteURI, parseURI, unEscapeString ) import System.Directory import Text.Pandoc.MIME (getMimeType) @@ -104,6 +109,11 @@ import qualified Data.ByteString.Char8 as B8 import Network.HTTP (findHeader, rspBody, RequestMethod(..), HeaderName(..), mkRequest) import Network.Browser (browse, setAllowRedirects, setOutHandler, request) +import qualified Data.Traversable as Traversable +import qualified Data.HashMap.Strict as H +import qualified Data.Text as T +import Data.Aeson (ToJSON (..), Value(Object), Result(..), fromJSON) + #ifdef EMBED_DATA_FILES import Text.Pandoc.Data (dataFiles) import System.FilePath ( joinPath, splitDirectories ) @@ -491,6 +501,67 @@ isTightList = and . map firstIsPlain where firstIsPlain (Plain _ : _) = True firstIsPlain _ = False +-- | Set a field of a 'Meta' object. If the field already has a value, +-- convert it into a list with the new value appended to the old value(s). +addMetaField :: ToMetaValue a + => String + -> a + -> Meta + -> Meta +addMetaField key val (Meta meta) = + Meta $ M.insertWith combine key (toMetaValue val) meta + where combine newval (MetaList xs) = MetaList (xs ++ [newval]) + combine newval x = MetaList [x, newval] + +-- | Create 'Meta' from old-style title, authors, date. This is +-- provided to ease the transition from the old API. +makeMeta :: [Inline] -> [[Inline]] -> [Inline] -> Meta +makeMeta title authors date = + addMetaField "title" (B.fromList title) + $ addMetaField "author" (map B.fromList authors) + $ addMetaField "date" (B.fromList date) + $ nullMeta + +-- | Create JSON value for template from a 'Meta' and an association list +-- of variables, specified at the command line or in the writer. +-- Variables overwrite metadata fields with the same names. +metaToJSON :: (Monad m, Functor m) + => ([Block] -> m String) -- ^ Writer for output format + => ([Inline] -> m String) -- ^ Writer for output format + -> Meta -- ^ Metadata + -> m Value +metaToJSON blockWriter inlineWriter (Meta metamap) = toJSON + `fmap` Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap + +metaValueToJSON :: (Monad m, Functor m) + => ([Block] -> m String) + -> ([Inline] -> m String) + -> MetaValue + -> m Value +metaValueToJSON blockWriter inlineWriter (MetaMap metamap) = toJSON + `fmap` Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap +metaValueToJSON blockWriter inlineWriter (MetaList xs) = + toJSON `fmap` Traversable.mapM (metaValueToJSON blockWriter inlineWriter) xs +metaValueToJSON _ _ (MetaString s) = return $ toJSON s +metaValueToJSON blockWriter _ (MetaBlocks bs) = toJSON `fmap` blockWriter bs +metaValueToJSON _ inlineWriter (MetaInlines bs) = toJSON `fmap` inlineWriter bs + +setField :: ToJSON a + => String + -> a + -> Value + -> Value +-- | Set a field of a JSON object. If the field already has a value, +-- convert it into a list with the new value appended to the old value(s). +-- This is a utility function to be used in preparing template contexts. +setField field val (Object hashmap) = + Object $ H.insertWith combine (T.pack field) (toJSON val) hashmap + where combine newval oldval = + case fromJSON oldval of + Success xs -> toJSON $ xs ++ [newval] + _ -> toJSON [oldval, newval] +setField _ _ x = x + -- -- TagSoup HTML handling -- diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index 12a7e732a..e1a127bbd 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -86,6 +86,7 @@ example above. -} module Text.Pandoc.Templates ( renderTemplate + , renderTemplate' , TemplateTarget(..) , varListToJSON , compileTemplate @@ -165,13 +166,17 @@ varListToJSON assoc = toJSON $ M.fromList assoc' toVal xs = toJSON xs renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b -renderTemplate template context = - toTarget $ renderTemplate' template (toJSON context) - where renderTemplate' (Template f) val = f val +renderTemplate (Template f) context = toTarget $ f $ toJSON context compileTemplate :: Text -> Either String Template compileTemplate template = A.parseOnly pTemplate template +-- | Like 'renderTemplate', but compiles the template first, +-- raising an error if compilation fails. +renderTemplate' :: (ToJSON a, TemplateTarget b) => String -> a -> b +renderTemplate' template = + renderTemplate (either error id $ compileTemplate $ T.pack template) + var :: Variable -> Template var = Template . resolveVar diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index 16ce452ef..60879d54f 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -38,13 +38,16 @@ AsciiDoc: <http://www.methods.co.nz/asciidoc/> -} module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc) where import Text.Pandoc.Definition -import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Shared import Text.Pandoc.Options import Text.Pandoc.Parsing hiding (blankline, space) import Data.List ( isPrefixOf, intersperse, intercalate ) import Text.Pandoc.Pretty import Control.Monad.State +import qualified Data.Map as M +import Data.Aeson (Value(String), fromJSON, toJSON, Result(..)) +import qualified Data.Text as T data WriterState = WriterState { defListMarker :: String , orderedListLevel :: Int @@ -62,29 +65,33 @@ writeAsciiDoc opts document = -- | Return asciidoc representation of document. pandocToAsciiDoc :: WriterOptions -> Pandoc -> State WriterState String -pandocToAsciiDoc opts (Pandoc (Meta title authors date) blocks) = do - title' <- inlineListToAsciiDoc opts title - let title'' = title' $$ text (replicate (offset title') '=') - authors' <- mapM (inlineListToAsciiDoc opts) authors - -- asciidoc only allows a singel author - date' <- inlineListToAsciiDoc opts date - let titleblock = not $ null title && null authors && null date - body <- blockListToAsciiDoc opts blocks +pandocToAsciiDoc opts (Pandoc meta blocks) = do + let titleblock = not $ null (docTitle meta) && null (docAuthors meta) && + null (docDate meta) let colwidth = if writerWrapText opts then Just $ writerColumns opts else Nothing + metadata <- metaToJSON + (fmap (render colwidth) . blockListToAsciiDoc opts) + (fmap (render colwidth) . inlineListToAsciiDoc opts) + meta + let addTitleLine (String t) = String $ + t <> "\n" <> T.replicate (T.length t) "=" + addTitleLine x = x + let metadata' = case fromJSON metadata of + Success m -> toJSON $ M.adjust addTitleLine + ("title" :: T.Text) m + _ -> metadata + body <- blockListToAsciiDoc opts blocks let main = render colwidth body - let context = writerVariables opts ++ - [ ("body", main) - , ("title", render colwidth title'') - , ("date", render colwidth date') - ] ++ - [ ("toc", "yes") | writerTableOfContents opts && - writerStandalone opts ] ++ - [ ("titleblock", "yes") | titleblock ] ++ - [ ("author", render colwidth a) | a <- authors' ] + let context = setField "body" main + $ setField "toc" + (writerTableOfContents opts && writerStandalone opts) + $ setField "titleblock" titleblock + $ foldl (\acc (x,y) -> setField x y acc) + metadata' (writerVariables opts) if writerStandalone opts - then return $ renderTemplate context $ writerTemplate opts + then return $ renderTemplate' (writerTemplate opts) context else return main -- | Escape special characters for AsciiDoc. diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 0566abbbd..b19737a5e 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -37,7 +37,7 @@ import Text.Printf ( printf ) import Data.List ( intercalate, isPrefixOf ) import Control.Monad.State import Text.Pandoc.Pretty -import Text.Pandoc.Templates ( renderTemplate ) +import Text.Pandoc.Templates ( renderTemplate' ) import Network.URI ( isURI, unEscapeString ) data WriterState = @@ -59,36 +59,32 @@ writeConTeXt options document = in evalState (pandocToConTeXt options document) defaultWriterState pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String -pandocToConTeXt options (Pandoc (Meta title authors date) blocks) = do +pandocToConTeXt options (Pandoc meta blocks) = do let colwidth = if writerWrapText options then Just $ writerColumns options else Nothing - titletext <- if null title - then return "" - else liftM (render colwidth) $ inlineListToConTeXt title - authorstext <- mapM (liftM (render colwidth) . inlineListToConTeXt) authors - datetext <- if null date - then return "" - else liftM (render colwidth) $ inlineListToConTeXt date + metadata <- metaToJSON + (fmap (render colwidth) . blockListToConTeXt) + (fmap (render colwidth) . inlineListToConTeXt) + meta body <- mapM (elementToConTeXt options) $ hierarchicalize blocks let main = (render colwidth . vcat) body - let context = writerVariables options ++ - [ ("toc", if writerTableOfContents options then "yes" else "") - , ("placelist", intercalate "," $ + let context = setField "toc" (writerTableOfContents options) + $ setField "placelist" (intercalate ("," :: String) $ take (writerTOCDepth options + if writerChapters options then 0 else 1) ["chapter","section","subsection","subsubsection", "subsubsubsection","subsubsubsubsection"]) - , ("body", main) - , ("title", titletext) - , ("date", datetext) ] ++ - [ ("number-sections", "yes") | writerNumberSections options ] ++ - [ ("mainlang", maybe "" (reverse . takeWhile (/=',') . reverse) - (lookup "lang" $ writerVariables options)) ] ++ - [ ("author", a) | a <- authorstext ] + $ setField "body" main + $ setField "number-sections" (writerNumberSections options) + $ setField "mainlang" (maybe "" + (reverse . takeWhile (/=',') . reverse) + (lookup "lang" $ writerVariables options)) + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables options) return $ if writerStandalone options - then renderTemplate context $ writerTemplate options + then renderTemplate' (writerTemplate options) context else main -- escape things as needed for ConTeXt diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index fc16a057e..e6d912e78 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -121,10 +121,10 @@ writeCustom luaFile opts doc = do return $ toString rendered docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO ByteString -docToCustom lua opts (Pandoc (Meta title authors date) blocks) = do - title' <- inlineListToCustom lua title - authors' <- mapM (inlineListToCustom lua) authors - date' <- inlineListToCustom lua date +docToCustom lua opts (Pandoc meta blocks) = do + title' <- inlineListToCustom lua $ docTitle meta + authors' <- mapM (inlineListToCustom lua) $ docAuthors meta + date' <- inlineListToCustom lua $ docDate meta body <- blockListToCustom lua blocks callfunc lua "Doc" body title' authors' date' (writerVariables opts) diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 35e7f3342..404171fe0 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -32,21 +32,26 @@ import Text.Pandoc.Definition import Text.Pandoc.XML import Text.Pandoc.Shared import Text.Pandoc.Options -import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Readers.TeXMath import Data.List ( isPrefixOf, intercalate, isSuffixOf ) import Data.Char ( toLower ) import Text.Pandoc.Highlighting ( languages, languagesByExtension ) import Text.Pandoc.Pretty +import qualified Text.Pandoc.Builder as B import Text.TeXMath import qualified Text.XML.Light as Xml import Data.Generics (everywhere, mkT) -- | Convert list of authors to a docbook <author> section -authorToDocbook :: WriterOptions -> [Inline] -> Doc +authorToDocbook :: WriterOptions -> [Inline] -> B.Inlines authorToDocbook opts name' = let name = render Nothing $ inlinesToDocbook opts name' - in if ',' `elem` name + colwidth = if writerWrapText opts + then Just $ writerColumns opts + else Nothing + in B.rawInline "docbook" $ render colwidth $ + if ',' `elem` name then -- last name first let (lastname, rest) = break (==',') name firstname = triml rest in @@ -64,11 +69,8 @@ authorToDocbook opts name' = -- | Convert Pandoc document to string in Docbook format. writeDocbook :: WriterOptions -> Pandoc -> String -writeDocbook opts (Pandoc (Meta tit auths dat) blocks) = - let title = inlinesToDocbook opts tit - authors = map (authorToDocbook opts) auths - date = inlinesToDocbook opts dat - elements = hierarchicalize blocks +writeDocbook opts (Pandoc meta blocks) = + let elements = hierarchicalize blocks colwidth = if writerWrapText opts then Just $ writerColumns opts else Nothing @@ -78,17 +80,21 @@ writeDocbook opts (Pandoc (Meta tit auths dat) blocks) = then opts{ writerChapters = True } else opts startLvl = if writerChapters opts' then 0 else 1 + auths' = map (authorToDocbook opts) $ docAuthors meta + meta' = B.setMeta "author" auths' meta + Just metadata = metaToJSON + (Just . render colwidth . blocksToDocbook opts) + (Just . render colwidth . inlinesToDocbook opts) + meta' main = render' $ vcat (map (elementToDocbook opts' startLvl) elements) - context = writerVariables opts ++ - [ ("body", main) - , ("title", render' title) - , ("date", render' date) ] ++ - [ ("author", render' a) | a <- authors ] ++ - [ ("mathml", "yes") | case writerHTMLMathMethod opts of - MathML _ -> True - _ -> False ] + context = setField "body" main + $ setField "mathml" (case writerHTMLMathMethod opts of + MathML _ -> True + _ -> False) + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables opts) in if writerStandalone opts - then renderTemplate context $ writerTemplate opts + then renderTemplate' (writerTemplate opts) context else main -- | Convert an Element to Docbook. diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 50e39a2a7..85b9705ac 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -103,7 +103,7 @@ toLazy = BL.fromChunks . (:[]) writeDocx :: WriterOptions -- ^ Writer options -> Pandoc -- ^ Document to convert -> IO BL.ByteString -writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do +writeDocx opts doc@(Pandoc meta _) = do let datadir = writerUserDataDir opts let doc' = bottomUp (concatMap fixDisplayMath) doc refArchive <- liftM (toArchive . toLazy) $ @@ -226,11 +226,11 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do ,("xmlns:dcterms","http://purl.org/dc/terms/") ,("xmlns:dcmitype","http://purl.org/dc/dcmitype/") ,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")] - $ mknode "dc:title" [] (stringify tit) + $ mknode "dc:title" [] (stringify $ docTitle meta) : mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] - (maybe "" id $ normalizeDate $ stringify date) + (maybe "" id $ normalizeDate $ stringify $ docDate meta) : mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] () -- put current time here - : map (mknode "dc:creator" [] . stringify) auths + : map (mknode "dc:creator" [] . stringify) (docAuthors meta) let docPropsEntry = toEntry docPropsPath epochtime $ UTF8.fromStringLazy $ showTopElement' docProps let relsPath = "_rels/.rels" rels <- case findEntryByPath relsPath refArchive of @@ -361,7 +361,12 @@ getNumId = length `fmap` gets stLists -- | Convert Pandoc document to two OpenXML elements (the main document and footnotes). writeOpenXML :: WriterOptions -> Pandoc -> WS (Element, Element) -writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do +writeOpenXML opts (Pandoc meta blocks) = do + let tit = docTitle meta ++ case lookupMeta "subtitle" meta of + Just (MetaBlocks [Plain xs]) -> LineBreak : xs + _ -> [] + let auths = docAuthors meta + let dat = docDate meta title <- withParaProp (pStyle "Title") $ blocksToOpenXML opts [Para tit | not (null tit)] authors <- withParaProp (pStyle "Authors") $ blocksToOpenXML opts [Para (intercalate [LineBreak] auths) | not (null auths)] @@ -372,7 +377,7 @@ writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do let blocks' = bottomUp convertSpace $ blocks doc' <- blocksToOpenXML opts blocks' notes' <- reverse `fmap` gets stFootnotes - let meta = title ++ authors ++ date + let meta' = title ++ authors ++ date let stdAttributes = [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main") ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math") @@ -383,7 +388,7 @@ writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do ,("xmlns:a","http://schemas.openxmlformats.org/drawingml/2006/main") ,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture") ,("xmlns:wp","http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")] - let doc = mknode "w:document" stdAttributes $ mknode "w:body" [] (meta ++ doc') + let doc = mknode "w:document" stdAttributes $ mknode "w:body" [] (meta' ++ doc') let notes = mknode "w:footnotes" stdAttributes notes' return (doc, notes) diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 9af78a338..f171a2560 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -45,6 +45,7 @@ import Data.Time import System.Locale import Text.Pandoc.Shared hiding ( Element ) import qualified Text.Pandoc.Shared as Shared +import Text.Pandoc.Builder (fromList, setMeta) import Text.Pandoc.Options import Text.Pandoc.Definition import Text.Pandoc.Generic @@ -180,8 +181,10 @@ writeEPUB opts doc@(Pandoc meta _) = do $ writeHtml opts'{ writerNumberOffset = maybe [] id mbnum } $ case bs of - (Header _ _ xs : _) -> Pandoc (Meta xs [] []) bs - _ -> Pandoc (Meta [] [] []) bs + (Header _ _ xs : _) -> + Pandoc (setMeta "title" (fromList xs) nullMeta) bs + _ -> + Pandoc nullMeta bs let chapterEntries = zipWith chapToEntry [1..] chapters @@ -248,9 +251,9 @@ writeEPUB opts doc@(Pandoc meta _) = do Just _ -> [ unode "itemref" ! [("idref", "cover"),("linear","no")] $ () ] ++ ((unode "itemref" ! [("idref", "title_page") - ,("linear", case meta of - Meta [] [] [] -> "no" - _ -> "yes")] $ ()) : + ,("linear", if null (docTitle meta) + then "no" + else "yes")] $ ()) : (unode "itemref" ! [("idref", "nav") ,("linear", if writerTableOfContents opts then "yes" @@ -440,7 +443,7 @@ transformInline _ _ _ x = return x writeHtmlInline :: WriterOptions -> Inline -> String writeHtmlInline opts z = trimr $ writeHtmlString opts{ writerStandalone = False } - $ Pandoc (Meta [] [] []) [Plain [z]] + $ Pandoc nullMeta [Plain [z]] (!) :: Node t => (t -> Element) -> [(String, String)] -> t -> Element (!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n) diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 1cc17d7fd..169fdcbce 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -34,18 +34,16 @@ import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Pandoc.Options import Text.Pandoc.Templates -import Text.Pandoc.Generic import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Slides import Text.Pandoc.Highlighting ( highlight, styleToCss, formatHtmlInline, formatHtmlBlock ) -import Text.Pandoc.XML (stripTags, fromEntities) +import Text.Pandoc.XML (fromEntities) import Network.HTTP ( urlEncode ) import Numeric ( showHex ) import Data.Char ( ord, toLower ) import Data.List ( isPrefixOf, intersperse ) import Data.String ( fromString ) -import qualified Data.Text as T import Data.Maybe ( catMaybes ) import Control.Monad.State import Text.Blaze.Html hiding(contents) @@ -62,6 +60,7 @@ import Text.TeXMath import Text.XML.Light.Output import System.FilePath (takeExtension) import Data.Monoid +import Data.Aeson (Value) data WriterState = WriterState { stNotes :: [Html] -- ^ List of notes @@ -93,39 +92,30 @@ nl opts = if writerWrapText opts -- | Convert Pandoc document to Html string. writeHtmlString :: WriterOptions -> Pandoc -> String writeHtmlString opts d = - let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d) - defaultWriterState + let (body, context) = evalState (pandocToHtml opts d) defaultWriterState in if writerStandalone opts - then inTemplate opts tit auths authsMeta date toc body' newvars - else renderHtml body' + then inTemplate opts context body + else renderHtml body -- | Convert Pandoc document to Html structure. writeHtml :: WriterOptions -> Pandoc -> Html writeHtml opts d = - let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d) - defaultWriterState + let (body, context) = evalState (pandocToHtml opts d) defaultWriterState in if writerStandalone opts - then inTemplate opts tit auths authsMeta date toc body' newvars - else body' + then inTemplate opts context body + else body -- result is (title, authors, date, toc, body, new variables) pandocToHtml :: WriterOptions -> Pandoc - -> State WriterState (Html, [Html], [Html], Html, Maybe Html, Html, [(String,String)]) -pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do - let standalone = writerStandalone opts - tit <- if standalone - then inlineListToHtml opts title' - else return mempty - auths <- if standalone - then mapM (inlineListToHtml opts) authors' - else return [] - authsMeta <- if standalone - then mapM (inlineListToHtml opts . prepForMeta) authors' - else return [] - date <- if standalone - then inlineListToHtml opts date' - else return mempty + -> State WriterState (Html, Value) +pandocToHtml opts (Pandoc meta blocks) = do + metadata <- metaToJSON + (fmap renderHtml . blockListToHtml opts) + (fmap renderHtml . inlineListToHtml opts) + meta + let authsMeta = map stringify $ docAuthors meta + let dateMeta = stringify $ docDate meta let slideLevel = maybe (getSlideLevel blocks) id $ writerSlideLevel opts let sects = hierarchicalize $ if writerSlideVariant opts == NoSlides @@ -165,58 +155,37 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do | otherwise -> mempty Nothing -> mempty else mempty - let newvars = [("highlighting-css", - styleToCss $ writerHighlightStyle opts) | - stHighlighting st] ++ - [("math", renderHtml math) | stMath st] ++ - [("quotes", "yes") | stQuotes st] - return (tit, auths, authsMeta, date, toc, thebody, newvars) - --- | Prepare author for meta tag, converting notes into --- bracketed text and removing links. -prepForMeta :: [Inline] -> [Inline] -prepForMeta = bottomUp (concatMap fixInline) - where fixInline (Note [Para xs]) = [Str " ["] ++ xs ++ [Str "]"] - fixInline (Note [Plain xs]) = [Str " ["] ++ xs ++ [Str "]"] - fixInline (Link lab _) = lab - fixInline (Image lab _) = lab - fixInline x = [x] + let context = (if stHighlighting st + then setField "highlighting-css" + (styleToCss $ writerHighlightStyle opts) + else id) $ + (if stMath st + then setField "math" (renderHtml math) + else id) $ + setField "quotes" (stQuotes st) $ + maybe id (setField "toc" . renderHtml) toc $ + setField "author-meta" authsMeta $ + maybe id (setField "date-meta") (normalizeDate dateMeta) $ + setField "pagetitle" (stringify $ docTitle meta) $ + setField "idprefix" (writerIdentifierPrefix opts) $ + -- these should maybe be set in pandoc.hs + setField "slidy-url" + ("http://www.w3.org/Talks/Tools/Slidy2" :: String) $ + setField "slideous-url" ("slideous" :: String) $ + setField "revealjs-url" ("reveal.js" :: String) $ + setField "s5-url" ("s5/default" :: String) $ + setField "html5" (writerHtml5 opts) $ + foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables opts) + return (thebody, context) inTemplate :: TemplateTarget a => WriterOptions + -> Value -> Html - -> [Html] - -> [Html] - -> Html - -> Maybe Html - -> Html - -> [(String,String)] -> a -inTemplate opts tit auths authsMeta date toc body' newvars = - let title' = renderHtml tit - date' = renderHtml date - dateMeta = maybe [] (\x -> [("date-meta",x)]) $ normalizeDate date' - variables = writerVariables opts ++ newvars - context = variables ++ dateMeta ++ - [ ("body", dropWhile (=='\n') $ renderHtml body') - , ("pagetitle", stripTags title') - , ("title", title') - , ("date", date') - , ("idprefix", writerIdentifierPrefix opts) - , ("slidy-url", "http://www.w3.org/Talks/Tools/Slidy2") - , ("slideous-url", "slideous") - , ("revealjs-url", "reveal.js") - , ("s5-url", "s5/default") ] ++ - [ ("html5","true") | writerHtml5 opts ] ++ - (case toc of - Just t -> [ ("toc", renderHtml t)] - Nothing -> []) ++ - [ ("author", renderHtml a) | a <- auths ] ++ - [ ("author-meta", stripTags $ renderHtml a) | a <- authsMeta ] - template = case compileTemplate (T.pack $ writerTemplate opts) of - Left e -> error e - Right t -> t - in renderTemplate template (varListToJSON context) +inTemplate opts context body = renderTemplate' (writerTemplate opts) + $ setField "body" (renderHtml body) context -- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix prefixedId :: WriterOptions -> String -> Attribute diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 04bb3f9e2..89cf9812a 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} {- Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu> @@ -81,7 +81,7 @@ writeLaTeX options document = stInternalLinks = [], stUsesEuro = False } pandocToLaTeX :: WriterOptions -> Pandoc -> State WriterState String -pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do +pandocToLaTeX options (Pandoc meta blocks) = do -- see if there are internal links let isInternalLink (Link _ ('#':xs,_)) = [xs] isInternalLink _ = [] @@ -103,9 +103,10 @@ pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do let colwidth = if writerWrapText options then Just $ writerColumns options else Nothing - titletext <- liftM (render colwidth) $ inlineListToLaTeX title - authorsText <- mapM (liftM (render colwidth) . inlineListToLaTeX) authors - dateText <- liftM (render colwidth) $ inlineListToLaTeX date + metadata <- metaToJSON + (fmap (render colwidth) . blockListToLaTeX) + (fmap (render colwidth) . inlineListToLaTeX) + meta let (blocks', lastHeader) = if writerCiteMethod options == Citeproc then (blocks, []) else case last blocks of @@ -115,55 +116,52 @@ pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do then toSlides blocks' else return blocks' body <- mapM (elementToLaTeX options) $ hierarchicalize blocks'' - biblioTitle <- liftM (render colwidth) $ inlineListToLaTeX lastHeader + (biblioTitle :: String) <- liftM (render colwidth) $ inlineListToLaTeX lastHeader let main = render colwidth $ vsep body st <- get let biblioFiles = intercalate "," $ map dropExtension $ writerBiblioFiles options - citecontext = case writerCiteMethod options of - Natbib -> [ ("biblio-files", biblioFiles) - , ("biblio-title", biblioTitle) - , ("natbib", "yes") - ] - Biblatex -> [ ("biblio-files", biblioFiles) - , ("biblio-title", biblioTitle) - , ("biblatex", "yes") - ] - _ -> [] - context = writerVariables options ++ - [ ("toc", if writerTableOfContents options then "yes" else "") - , ("toc-depth", show (writerTOCDepth options - - if writerChapters options - then 1 - else 0)) - , ("body", main) - , ("title", titletext) - , ("title-meta", stringify title) - , ("author-meta", intercalate "; " $ map stringify authors) - , ("date", dateText) - , ("documentclass", if writerBeamer options - then "beamer" - else if writerChapters options - then "book" - else "article") ] ++ - [ ("author", a) | a <- authorsText ] ++ - [ ("verbatim-in-note", "yes") | stVerbInNote st ] ++ - [ ("tables", "yes") | stTable st ] ++ - [ ("strikeout", "yes") | stStrikeout st ] ++ - [ ("url", "yes") | stUrl st ] ++ - [ ("numbersections", "yes") | writerNumberSections options ] ++ - [ ("lhs", "yes") | stLHS st ] ++ - [ ("graphics", "yes") | stGraphics st ] ++ - [ ("book-class", "yes") | stBook st] ++ - [ ("euro", "yes") | stUsesEuro st] ++ - [ ("listings", "yes") | writerListings options || stLHS st ] ++ - [ ("beamer", "yes") | writerBeamer options ] ++ - [ ("mainlang", maybe "" (reverse . takeWhile (/=',') . reverse) - (lookup "lang" $ writerVariables options)) ] ++ - [ ("highlighting-macros", styleToLaTeX - $ writerHighlightStyle options ) | stHighlighting st ] ++ - citecontext + let context = setField "toc" (writerTableOfContents options) $ + setField "toc-depth" (show (writerTOCDepth options - + if writerChapters options + then 1 + else 0)) $ + setField "body" main $ + setField "title-meta" (stringify $ docTitle meta) $ + setField "author-meta" (intercalate "; " $ map stringify $ docAuthors meta) $ + setField "documentclass" (if writerBeamer options + then ("beamer" :: String) + else if writerChapters options + then "book" + else "article") $ + setField "verbatim-in-note" (stVerbInNote st) $ + setField "tables" (stTable st) $ + setField "strikeout" (stStrikeout st) $ + setField "url" (stUrl st) $ + setField "numbersections" (writerNumberSections options) $ + setField "lhs" (stLHS st) $ + setField "graphics" (stGraphics st) $ + setField "book-class" (stBook st) $ + setField "euro" (stUsesEuro st) $ + setField "listings" (writerListings options || stLHS st) $ + setField "beamer" (writerBeamer options) $ + setField "mainlang" (maybe "" (reverse . takeWhile (/=',') . reverse) + (lookup "lang" $ writerVariables options)) $ + (if stHighlighting st + then setField "highlighting-macros" (styleToLaTeX + $ writerHighlightStyle options ) + else id) $ + (case writerCiteMethod options of + Natbib -> setField "biblio-files" biblioFiles . + setField "biblio-title" biblioTitle . + setField "natbib" True + Biblatex -> setField "biblio-files" biblioFiles . + setField "biblio-title" biblioTitle . + setField "biblatex" True + _ -> id) $ + foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables options) return $ if writerStandalone options - then renderTemplate context template + then renderTemplate' template context else main -- | Convert Elements to LaTeX diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 17be983ce..b417565ce 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -37,8 +37,8 @@ import Text.Pandoc.Readers.TeXMath import Text.Printf ( printf ) import Data.List ( isPrefixOf, intersperse, intercalate ) import Text.Pandoc.Pretty +import Text.Pandoc.Builder (deleteMeta) import Control.Monad.State -import qualified Data.Text as T type Notes = [[Block]] data WriterState = WriterState { stNotes :: Notes @@ -50,39 +50,37 @@ writeMan opts document = evalState (pandocToMan opts document) (WriterState [] F -- | Return groff man representation of document. pandocToMan :: WriterOptions -> Pandoc -> State WriterState String -pandocToMan opts (Pandoc (Meta title authors date) blocks) = do - titleText <- inlineListToMan opts title - authors' <- mapM (inlineListToMan opts) authors - date' <- inlineListToMan opts date +pandocToMan opts (Pandoc meta blocks) = do let colwidth = if writerWrapText opts then Just $ writerColumns opts else Nothing let render' = render colwidth + titleText <- inlineListToMan opts $ docTitle meta let (cmdName, rest) = break (== ' ') $ render' titleText let (title', section) = case reverse cmdName of (')':d:'(':xs) | d `elem` ['0'..'9'] -> - (text (reverse xs), char d) - xs -> (text (reverse xs), doubleQuotes empty) + (reverse xs, [d]) + xs -> (reverse xs, "\"\"") let description = hsep $ map (doubleQuotes . text . trim) $ splitBy (== '|') rest + metadata <- metaToJSON + (fmap (render colwidth) . blockListToMan opts) + (fmap (render colwidth) . inlineListToMan opts) + $ deleteMeta "title" meta body <- blockListToMan opts blocks notes <- liftM stNotes get notes' <- notesToMan opts (reverse notes) let main = render' $ body $$ notes' $$ text "" hasTables <- liftM stHasTables get - let context = writerVariables opts ++ - [ ("body", main) - , ("title", render' title') - , ("section", render' section) - , ("date", render' date') - , ("description", render' description) ] ++ - [ ("has-tables", "yes") | hasTables ] ++ - [ ("author", render' a) | a <- authors' ] - template = case compileTemplate (T.pack $ writerTemplate opts) of - Left e -> error e - Right t -> t + let context = setField "body" main + $ setField "title" title' + $ setField "section" section + $ setField "description" (render' description) + $ setField "has-tables" hasTables + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables opts) if writerStandalone opts - then return $ renderTemplate template (varListToJSON context) + then return $ renderTemplate' (writerTemplate opts) context else return main -- | Return man representation of notes. diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 76e804cf3..cd3c1db81 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, TupleSections #-} +{-# LANGUAGE OverloadedStrings, TupleSections, ScopedTypeVariables #-} {- Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu> @@ -33,7 +33,7 @@ Markdown: <http://daringfireball.net/projects/markdown/> module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where import Text.Pandoc.Definition import Text.Pandoc.Generic -import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Shared import Text.Pandoc.Options import Text.Pandoc.Parsing hiding (blankline, char, space) @@ -111,10 +111,10 @@ plainTitleBlock tit auths dat = -- | Return markdown representation of document. pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String -pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do - title' <- inlineListToMarkdown opts title - authors' <- mapM (inlineListToMarkdown opts) authors - date' <- inlineListToMarkdown opts date +pandocToMarkdown opts (Pandoc meta blocks) = do + title' <- inlineListToMarkdown opts $ docTitle meta + authors' <- mapM (inlineListToMarkdown opts) $ docAuthors meta + date' <- inlineListToMarkdown opts $ docDate meta isPlain <- gets stPlain let titleblock = case True of _ | isPlain -> @@ -128,28 +128,33 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do let toc = if writerTableOfContents opts then tableOfContents opts headerBlocks else empty + let colwidth = if writerWrapText opts + then Just $ writerColumns opts + else Nothing + metadata <- metaToJSON + (fmap (render colwidth) . blockListToMarkdown opts) + (fmap (render colwidth) . inlineListToMarkdown opts) + meta body <- blockListToMarkdown opts blocks st <- get notes' <- notesToMarkdown opts (reverse $ stNotes st) st' <- get -- note that the notes may contain refs refs' <- refsToMarkdown opts (reverse $ stRefs st') - let colwidth = if writerWrapText opts - then Just $ writerColumns opts - else Nothing - let main = render colwidth $ body <> + let render' :: Doc -> String + render' = render colwidth + let main = render' $ body <> (if isEmpty notes' then empty else blankline <> notes') <> (if isEmpty refs' then empty else blankline <> refs') - let context = writerVariables opts ++ - [ ("toc", render colwidth toc) - , ("body", main) - , ("title", render Nothing title') - , ("date", render Nothing date') - ] ++ - [ ("author", render Nothing a) | a <- authors' ] ++ - [ ("titleblock", render colwidth titleblock) - | not (null title && null authors && null date) ] + let context = setField "toc" (render' toc) + $ setField "body" main + $ (if not (null (docTitle meta) && null (docAuthors meta) + && null (docDate meta)) + then setField "titleblock" (render' titleblock) + else id) + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables opts) if writerStandalone opts - then return $ renderTemplate context $ writerTemplate opts + then return $ renderTemplate' (writerTemplate opts) context else return main -- | Return markdown representation of reference key table. @@ -370,7 +375,7 @@ blockToMarkdown opts t@(Table caption aligns widths headers rows) = do rawHeaders rawRows | otherwise -> fmap (id,) $ return $ text $ writeHtmlString def - $ Pandoc (Meta [] [] []) [t] + $ Pandoc nullMeta [t] return $ nst $ tbl $$ blankline $$ caption'' $$ blankline blockToMarkdown opts (BulletList items) = do contents <- mapM (bulletListItemToMarkdown opts) items diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 4cec2d648..c0f141780 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -33,7 +33,7 @@ module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared -import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.XML ( escapeStringForXML ) import Data.List ( intersect, intercalate ) import Network.URI ( isURI ) @@ -53,18 +53,23 @@ writeMediaWiki opts document = -- | Return MediaWiki representation of document. pandocToMediaWiki :: WriterOptions -> Pandoc -> State WriterState String -pandocToMediaWiki opts (Pandoc _ blocks) = do +pandocToMediaWiki opts (Pandoc meta blocks) = do + metadata <- metaToJSON + (fmap trimr . blockListToMediaWiki opts) + (inlineListToMediaWiki opts) + meta body <- blockListToMediaWiki opts blocks notesExist <- get >>= return . stNotes let notes = if notesExist then "\n<references />" else "" let main = body ++ notes - let context = writerVariables opts ++ - [ ("body", main) ] ++ - [ ("toc", "yes") | writerTableOfContents opts ] + let context = setField "body" main + $ setField "toc" (writerTableOfContents opts) + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables opts) if writerStandalone opts - then return $ renderTemplate context $ writerTemplate opts + then return $ renderTemplate' (writerTemplate opts) context else return main -- | Escape special characters for MediaWiki. diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index 7fb304e86..afe73102c 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -72,7 +72,7 @@ writeNative opts (Pandoc meta blocks) = then Just $ writerColumns opts else Nothing withHead = if writerStandalone opts - then \bs -> text ("Pandoc " ++ "(" ++ show meta ++ ")") $$ - bs $$ cr + then \bs -> text ("Pandoc (" ++ show meta ++ ") ") $$ + bs $$ cr else id in render colwidth $ withHead $ prettyList $ map prettyBlock blocks diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 030a975f4..db27286e8 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -53,8 +53,9 @@ import System.FilePath ( takeExtension ) writeODT :: WriterOptions -- ^ Writer options -> Pandoc -- ^ Document to convert -> IO B.ByteString -writeODT opts doc@(Pandoc (Meta title _ _) _) = do +writeODT opts doc@(Pandoc meta _) = do let datadir = writerUserDataDir opts + let title = docTitle meta refArchive <- liftM toArchive $ case writerReferenceODT opts of Just f -> B.readFile f diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs index f7eb9289a..b71c7cf6e 100644 --- a/src/Text/Pandoc/Writers/OPML.hs +++ b/src/Text/Pandoc/Writers/OPML.hs @@ -32,37 +32,38 @@ import Text.Pandoc.Definition import Text.Pandoc.XML import Text.Pandoc.Shared import Text.Pandoc.Options -import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Writers.HTML (writeHtmlString) import Text.Pandoc.Writers.Markdown (writeMarkdown) -import Data.List ( intercalate ) import Text.Pandoc.Pretty import Data.Time import System.Locale (defaultTimeLocale) +import qualified Text.Pandoc.Builder as B -- | Convert Pandoc document to string in OPML format. writeOPML :: WriterOptions -> Pandoc -> String -writeOPML opts (Pandoc (Meta tit auths dat) blocks) = - let title = writeHtmlInlines tit - author = writeHtmlInlines $ intercalate [Space,Str ";",Space] auths - date = convertDate dat - elements = hierarchicalize blocks +writeOPML opts (Pandoc meta blocks) = + let elements = hierarchicalize blocks colwidth = if writerWrapText opts then Just $ writerColumns opts else Nothing + meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta + Just metadata = metaToJSON + (Just . writeMarkdown def . Pandoc nullMeta) + (Just . trimr . writeMarkdown def . Pandoc nullMeta . + (\ils -> [Plain ils])) + meta' main = render colwidth $ vcat (map (elementToOPML opts) elements) - context = writerVariables opts ++ - [ ("body", main) - , ("title", title) - , ("date", date) - , ("author", author) ] + context = setField "body" main + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables opts) in if writerStandalone opts - then renderTemplate context $ writerTemplate opts + then renderTemplate' (writerTemplate opts) context else main writeHtmlInlines :: [Inline] -> String writeHtmlInlines ils = trim $ writeHtmlString def - $ Pandoc (Meta [] [] []) [Plain ils] + $ Pandoc nullMeta [Plain ils] -- date format: RFC 822: Thu, 14 Jul 2005 23:41:05 GMT showDateTimeRFC822 :: UTCTime -> String @@ -82,7 +83,7 @@ elementToOPML opts (Sec _ _num _ title elements) = fromBlk _ = error "fromBlk called on non-block" (blocks, rest) = span isBlk elements attrs = [("text", writeHtmlInlines title)] ++ - [("_note", writeMarkdown def (Pandoc (Meta [] [] []) + [("_note", writeMarkdown def (Pandoc nullMeta (map fromBlk blocks))) | not (null blocks)] in inTags True "outline" attrs $ diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index b59e096c9..0c09cde99 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -33,7 +33,7 @@ module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.XML -import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Pretty import Text.Printf ( printf ) @@ -42,6 +42,7 @@ import Control.Arrow ( (***), (>>>) ) import Control.Monad.State hiding ( when ) import Data.Char (chr, isDigit) import qualified Data.Map as Map +import Text.Pandoc.Shared (metaToJSON, setField) -- | Auxiliary function to convert Plain block to Para. plainToPara :: Block -> Block @@ -172,34 +173,32 @@ handleSpaces s -- | Convert Pandoc document to string in OpenDocument format. writeOpenDocument :: WriterOptions -> Pandoc -> String -writeOpenDocument opts (Pandoc (Meta title authors date) blocks) = - let ((doc, title', authors', date'),s) = flip runState - defaultWriterState $ do - title'' <- inlinesToOpenDocument opts title - authors'' <- mapM (inlinesToOpenDocument opts) authors - date'' <- inlinesToOpenDocument opts date - doc'' <- blocksToOpenDocument opts blocks - return (doc'', title'', authors'', date'') - colwidth = if writerWrapText opts +writeOpenDocument opts (Pandoc meta blocks) = + let colwidth = if writerWrapText opts then Just $ writerColumns opts else Nothing render' = render colwidth - body' = render' doc + ((body, metadata),s) = flip runState + defaultWriterState $ do + m <- metaToJSON + (fmap (render colwidth) . blocksToOpenDocument opts) + (fmap (render colwidth) . inlinesToOpenDocument opts) + meta + b <- render' `fmap` blocksToOpenDocument opts blocks + return (b, m) styles = stTableStyles s ++ stParaStyles s ++ stTextStyles s listStyle (n,l) = inTags True "text:list-style" [("style:name", "L" ++ show n)] (vcat l) listStyles = map listStyle (stListStyles s) automaticStyles = inTagsIndented "office:automatic-styles" $ vcat $ reverse $ styles ++ listStyles - context = writerVariables opts ++ - [ ("body", body') - , ("automatic-styles", render' automaticStyles) - , ("title", render' title') - , ("date", render' date') ] ++ - [ ("author", render' a) | a <- authors' ] + context = setField "body" body + $ setField "automatic-styles" (render' automaticStyles) + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables opts) in if writerStandalone opts - then renderTemplate context $ writerTemplate opts - else body' + then renderTemplate' (writerTemplate opts) context + else body withParagraphStyle :: WriterOptions -> String -> [Block] -> State WriterState Doc withParagraphStyle o s (b:bs) diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 4e7b21e35..49af8124a 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -35,7 +35,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Pretty -import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Templates (renderTemplate') import Data.List ( intersect, intersperse, transpose ) import Control.Monad.State import Control.Applicative ( (<$>) ) @@ -58,27 +58,26 @@ writeOrg opts document = -- | Return Org representation of document. pandocToOrg :: Pandoc -> State WriterState String -pandocToOrg (Pandoc (Meta tit auth dat) blocks) = do +pandocToOrg (Pandoc meta blocks) = do opts <- liftM stOptions get - title <- titleToOrg tit - authors <- mapM inlineListToOrg auth - date <- inlineListToOrg dat + let colwidth = if writerWrapText opts + then Just $ writerColumns opts + else Nothing + metadata <- metaToJSON + (fmap (render colwidth) . blockListToOrg) + (fmap (render colwidth) . inlineListToOrg) + meta body <- blockListToOrg blocks notes <- liftM (reverse . stNotes) get >>= notesToOrg -- note that the notes may contain refs, so we do them first hasMath <- liftM stHasMath get - let colwidth = if writerWrapText opts - then Just $ writerColumns opts - else Nothing let main = render colwidth $ foldl ($+$) empty $ [body, notes] - let context = writerVariables opts ++ - [ ("body", main) - , ("title", render Nothing title) - , ("date", render Nothing date) ] ++ - [ ("math", "yes") | hasMath ] ++ - [ ("author", render Nothing a) | a <- authors ] + let context = setField "body" main + $ setField "math" hasMath + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables opts) if writerStandalone opts - then return $ renderTemplate context $ writerTemplate opts + then return $ renderTemplate' (writerTemplate opts) context else return main -- | Return Org representation of notes. @@ -103,12 +102,6 @@ escapeString = escapeStringUsing $ , ('\x2026',"...") ] ++ backslashEscapes "^_" -titleToOrg :: [Inline] -> State WriterState Doc -titleToOrg [] = return empty -titleToOrg lst = do - contents <- inlineListToOrg lst - return $ "#+TITLE: " <> contents - -- | Convert Pandoc block element to Org. blockToOrg :: Block -- ^ Block element -> State WriterState Doc diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 72afb1f21..fc9b69983 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -30,11 +30,12 @@ Conversion of 'Pandoc' documents to reStructuredText. reStructuredText: <http://docutils.sourceforge.net/rst.html> -} -module Text.Pandoc.Writers.RST ( writeRST) where +module Text.Pandoc.Writers.RST ( writeRST ) where import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared -import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Templates (renderTemplate') +import Text.Pandoc.Builder (deleteMeta) import Data.List ( isPrefixOf, intersperse, transpose ) import Network.URI (isAbsoluteURI) import Text.Pandoc.Pretty @@ -62,31 +63,35 @@ writeRST opts document = -- | Return RST representation of document. pandocToRST :: Pandoc -> State WriterState String -pandocToRST (Pandoc (Meta tit auth dat) blocks) = do +pandocToRST (Pandoc meta blocks) = do opts <- liftM stOptions get - title <- titleToRST tit - authors <- mapM inlineListToRST auth - date <- inlineListToRST dat + let colwidth = if writerWrapText opts + then Just $ writerColumns opts + else Nothing + let subtit = case lookupMeta "subtitle" meta of + Just (MetaBlocks [Plain xs]) -> xs + _ -> [] + title <- titleToRST (docTitle meta) subtit + metadata <- metaToJSON (fmap (render colwidth) . blockListToRST) + (fmap (trimr . render colwidth) . inlineListToRST) + $ deleteMeta "title" $ deleteMeta "subtitle" meta body <- blockListToRST blocks notes <- liftM (reverse . stNotes) get >>= notesToRST -- note that the notes may contain refs, so we do them first refs <- liftM (reverse . stLinks) get >>= refsToRST pics <- liftM (reverse . stImages) get >>= pictRefsToRST hasMath <- liftM stHasMath get - let colwidth = if writerWrapText opts - then Just $ writerColumns opts - else Nothing let main = render colwidth $ foldl ($+$) empty $ [body, notes, refs, pics] - let context = writerVariables opts ++ - [ ("body", main) - , ("title", render Nothing title) - , ("date", render colwidth date) - , ("toc", if writerTableOfContents opts then "yes" else "") - , ("toc-depth", show (writerTOCDepth opts)) ] ++ - [ ("math", "yes") | hasMath ] ++ - [ ("author", render colwidth a) | a <- authors ] + let context = setField "body" main + $ setField "toc" (writerTableOfContents opts) + $ setField "toc-depth" (writerTOCDepth opts) + $ setField "math" hasMath + $ setField "title" (render Nothing title :: String) + $ setField "math" hasMath + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables opts) if writerStandalone opts - then return $ renderTemplate context $ writerTemplate opts + then return $ renderTemplate' (writerTemplate opts) context else return main -- | Return RST representation of reference key table. @@ -136,13 +141,20 @@ pictToRST (label, (src, _, mbtarget)) = do escapeString :: String -> String escapeString = escapeStringUsing (backslashEscapes "`\\|*_") -titleToRST :: [Inline] -> State WriterState Doc -titleToRST [] = return empty -titleToRST lst = do - contents <- inlineListToRST lst - let titleLength = length $ (render Nothing contents :: String) - let border = text (replicate titleLength '=') - return $ border $$ contents $$ border +titleToRST :: [Inline] -> [Inline] -> State WriterState Doc +titleToRST [] _ = return empty +titleToRST tit subtit = do + title <- inlineListToRST tit + subtitle <- inlineListToRST subtit + return $ bordered title '=' $$ bordered subtitle '-' + +bordered :: Doc -> Char -> Doc +bordered contents c = + if len > 0 + then border $$ contents $$ border + else empty + where len = offset contents + border = text (replicate len c) -- | Convert Pandoc block element to RST. blockToRST :: Block -- ^ Block element diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 0d4a22cd5..cc59be4be 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -32,7 +32,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Readers.TeXMath -import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Generic (bottomUpM) import Data.List ( isSuffixOf, intercalate ) import Data.Char ( ord, chr, isDigit, toLower ) @@ -73,24 +73,22 @@ writeRTFWithEmbeddedImages options doc = -- | Convert Pandoc to a string in rich text format. writeRTF :: WriterOptions -> Pandoc -> String -writeRTF options (Pandoc (Meta title authors date) blocks) = - let titletext = inlineListToRTF title - authorstext = map inlineListToRTF authors - datetext = inlineListToRTF date - spacer = not $ all null $ titletext : datetext : authorstext +writeRTF options (Pandoc meta blocks) = + let spacer = not $ all null $ docTitle meta : docDate meta : docAuthors meta + Just metadata = metaToJSON + (Just . concatMap (blockToRTF 0 AlignDefault)) + (Just . inlineListToRTF) + meta body = concatMap (blockToRTF 0 AlignDefault) blocks isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options isTOCHeader _ = False - context = writerVariables options ++ - [ ("body", body) - , ("title", titletext) - , ("date", datetext) ] ++ - [ ("author", a) | a <- authorstext ] ++ - [ ("spacer", "yes") | spacer ] ++ - [ ("toc", tableOfContents $ filter isTOCHeader blocks) | - writerTableOfContents options ] + context = setField "body" body + $ setField "spacer" spacer + $ setField "toc" (tableOfContents $ filter isTOCHeader blocks) + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables options) in if writerStandalone options - then renderTemplate context $ writerTemplate options + then renderTemplate' (writerTemplate options) context else body -- | Construct table of contents from list of header blocks. diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 502a91967..c2131ad98 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -31,7 +31,7 @@ module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared -import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Templates (renderTemplate') import Text.Printf ( printf ) import Data.List ( transpose, maximumBy ) import Data.Ord ( comparing ) @@ -63,33 +63,33 @@ writeTexinfo options document = -- | Add a "Top" node around the document, needed by Texinfo. wrapTop :: Pandoc -> Pandoc -wrapTop (Pandoc (Meta title authors date) blocks) = - Pandoc (Meta title authors date) (Header 0 nullAttr title : blocks) +wrapTop (Pandoc meta blocks) = + Pandoc meta (Header 0 nullAttr (docTitle meta) : blocks) pandocToTexinfo :: WriterOptions -> Pandoc -> State WriterState String -pandocToTexinfo options (Pandoc (Meta title authors date) blocks) = do - titleText <- inlineListToTexinfo title - authorsText <- mapM inlineListToTexinfo authors - dateText <- inlineListToTexinfo date - let titlePage = not $ all null $ title : date : authors - main <- blockListToTexinfo blocks - st <- get +pandocToTexinfo options (Pandoc meta blocks) = do + let titlePage = not $ all null + $ docTitle meta : docDate meta : docAuthors meta let colwidth = if writerWrapText options then Just $ writerColumns options else Nothing + metadata <- metaToJSON + (fmap (render colwidth) . blockListToTexinfo) + (fmap (render colwidth) . inlineListToTexinfo) + meta + main <- blockListToTexinfo blocks + st <- get let body = render colwidth main - let context = writerVariables options ++ - [ ("body", body) - , ("title", render colwidth titleText) - , ("date", render colwidth dateText) ] ++ - [ ("toc", "yes") | writerTableOfContents options ] ++ - [ ("titlepage", "yes") | titlePage ] ++ - [ ("subscript", "yes") | stSubscript st ] ++ - [ ("superscript", "yes") | stSuperscript st ] ++ - [ ("strikeout", "yes") | stStrikeout st ] ++ - [ ("author", render colwidth a) | a <- authorsText ] + let context = setField "body" body + $ setField "toc" (writerTableOfContents options) + $ setField "titlepage" titlePage + $ setField "subscript" (stSubscript st) + $ setField "superscript" (stSuperscript st) + $ setField "strikeout" (stStrikeout st) + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables options) if writerStandalone options - then return $ renderTemplate context $ writerTemplate options + then return $ renderTemplate' (writerTemplate options) context else return body -- | Escape things as needed for Texinfo. diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 6a3f2fea5..58d1a3a95 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -33,7 +33,7 @@ module Text.Pandoc.Writers.Textile ( writeTextile ) where import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared -import Text.Pandoc.Templates (renderTemplate) +import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.XML ( escapeStringForXML ) import Data.List ( intercalate ) import Control.Monad.State @@ -53,13 +53,17 @@ writeTextile opts document = -- | Return Textile representation of document. pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String -pandocToTextile opts (Pandoc _ blocks) = do +pandocToTextile opts (Pandoc meta blocks) = do + metadata <- metaToJSON + (blockListToTextile opts) (inlineListToTextile opts) meta body <- blockListToTextile opts blocks notes <- liftM (unlines . reverse . stNotes) get let main = body ++ if null notes then "" else ("\n\n" ++ notes) - let context = writerVariables opts ++ [ ("body", main) ] + let context = setField "body" main + $ foldl (\acc (x,y) -> setField x y acc) + metadata (writerVariables opts) if writerStandalone opts - then return $ renderTemplate context $ writerTemplate opts + then return $ renderTemplate' (writerTemplate opts) context else return main withUseTags :: State WriterState a -> State WriterState a diff --git a/src/Text/Pandoc/XML.hs b/src/Text/Pandoc/XML.hs index 3f684f728..89ae81a10 100644 --- a/src/Text/Pandoc/XML.hs +++ b/src/Text/Pandoc/XML.hs @@ -27,8 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Functions for escaping and formatting XML. -} -module Text.Pandoc.XML ( stripTags, - escapeCharForXML, +module Text.Pandoc.XML ( escapeCharForXML, escapeStringForXML, inTags, selfClosingTag, @@ -41,16 +40,6 @@ import Text.Pandoc.Pretty import Data.Char (ord, isAscii, isSpace) import Text.HTML.TagSoup.Entity (lookupEntity) --- | Remove everything between <...> -stripTags :: String -> String -stripTags ('<':xs) = - let (_,rest) = break (=='>') xs - in if null rest - then "" - else stripTags (tail rest) -- leave off > -stripTags (x:xs) = x : stripTags xs -stripTags [] = [] - -- | Escape one character as needed for XML. escapeCharForXML :: Char -> String escapeCharForXML x = case x of |