diff options
author | fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> | 2007-11-03 22:14:03 +0000 |
---|---|---|
committer | fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> | 2007-11-03 22:14:03 +0000 |
commit | 4a841bfc5464907adea4cdd655485565565b40ae (patch) | |
tree | 36c0a21e3639614c8d25b5fb1909c32d0ab11dcd /src/Text/Pandoc/Writers/RST.hs | |
parent | 3116d30133196e1bb258f7e74e03d4a85f3b21ae (diff) | |
download | pandoc-4a841bfc5464907adea4cdd655485565565b40ae.tar.gz |
Use template haskell to avoid the need for templates:
+ Added library Text.Pandoc.Include, with a template haskell
function $(includeStrFrom fname) to include a file as a string
constant at compile time.
+ This removes the need for the 'templates' directory or Makefile
target. These have been removed.
+ The base source directory has been changed from src to .
+ A new 'data' directory has been added, containing the ASCIIMathML.js
script, writer headers, and S5 files.
+ The src/wrappers directory has been moved to 'wrappers'.
+ The Text.Pandoc.ASCIIMathML library is no longer needed, since
Text.Pandoc.Writers.HTML can use includeStrFrom to include the
ASCIIMathML.js code directly. It has been removed.
git-svn-id: https://pandoc.googlecode.com/svn/trunk@1063 788f1e2b-df1e-0410-8736-df70ead52e1b
Diffstat (limited to 'src/Text/Pandoc/Writers/RST.hs')
-rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 325 |
1 files changed, 0 insertions, 325 deletions
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs deleted file mode 100644 index ddcbf95c0..000000000 --- a/src/Text/Pandoc/Writers/RST.hs +++ /dev/null @@ -1,325 +0,0 @@ -{- -Copyright (C) 2006-7 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 --} - -{- | - Module : Text.Pandoc.Writers.RST - Copyright : Copyright (C) 2006-7 John MacFarlane - License : GNU GPL, version 2 or above - - Maintainer : John MacFarlane <jgm@berkeley.edu> - Stability : alpha - Portability : portable - -Conversion of 'Pandoc' documents to reStructuredText. - -reStructuredText: <http://docutils.sourceforge.net/rst.html> --} -module Text.Pandoc.Writers.RST ( writeRST) where -import Text.Pandoc.Definition -import Text.Pandoc.Shared -import Text.Pandoc.Blocks -import Data.List ( isPrefixOf, isSuffixOf, drop, intersperse ) -import Text.PrettyPrint.HughesPJ hiding ( Str ) -import Control.Monad.State - -type Notes = [[Block]] -type Refs = KeyTable -type WriterState = (Notes, Refs, Refs) -- first Refs is links, second pictures - --- | Convert Pandoc to RST. -writeRST :: WriterOptions -> Pandoc -> String -writeRST opts document = - render $ evalState (pandocToRST opts document) ([],[],[]) - --- | Return RST representation of document. -pandocToRST :: WriterOptions -> Pandoc -> State WriterState Doc -pandocToRST opts (Pandoc meta blocks) = do - let before = writerIncludeBefore opts - let after = writerIncludeAfter opts - before' = if null before then empty else text before - after' = if null after then empty else text after - metaBlock <- metaToRST opts meta - let head = if (writerStandalone opts) - then metaBlock $+$ text (writerHeader opts) - else empty - body <- blockListToRST opts blocks - (notes, _, _) <- get - notes' <- notesToRST opts (reverse notes) - (_, refs, pics) <- get -- note that the notes may contain refs - refs' <- keyTableToRST opts (reverse refs) - pics' <- pictTableToRST opts (reverse pics) - return $ head $+$ before' $+$ body $+$ notes' $+$ text "" $+$ refs' $+$ - pics' $+$ after' - --- | Return RST representation of reference key table. -keyTableToRST :: WriterOptions -> KeyTable -> State WriterState Doc -keyTableToRST opts refs = mapM (keyToRST opts) refs >>= return . vcat - --- | Return RST representation of a reference key. -keyToRST :: WriterOptions - -> ([Inline], (String, String)) - -> State WriterState Doc -keyToRST opts (label, (src, tit)) = do - label' <- inlineListToRST opts label - let label'' = if ':' `elem` (render label') - then char '`' <> label' <> char '`' - else label' - return $ text ".. _" <> label'' <> text ": " <> text src - --- | Return RST representation of notes. -notesToRST :: WriterOptions -> [[Block]] -> State WriterState Doc -notesToRST opts notes = - mapM (\(num, note) -> noteToRST opts num note) (zip [1..] notes) >>= - return . vcat - --- | Return RST representation of a note. -noteToRST :: WriterOptions -> Int -> [Block] -> State WriterState Doc -noteToRST opts num note = do - contents <- blockListToRST opts note - let marker = text ".. [" <> text (show num) <> text "] " - return $ hang marker 3 contents - --- | Return RST representation of picture reference table. -pictTableToRST :: WriterOptions -> KeyTable -> State WriterState Doc -pictTableToRST opts refs = mapM (pictToRST opts) refs >>= return . vcat - --- | Return RST representation of a picture substitution reference. -pictToRST :: WriterOptions - -> ([Inline], (String, String)) - -> State WriterState Doc -pictToRST opts (label, (src, _)) = do - label' <- inlineListToRST opts label - return $ text ".. " <> char '|' <> label' <> char '|' <> text " image:: " <> - text src - --- | Take list of inline elements and return wrapped doc. -wrappedRST :: WriterOptions -> [Inline] -> State WriterState Doc -wrappedRST opts inlines = mapM (wrapIfNeeded opts (inlineListToRST opts)) - (splitBy LineBreak inlines) >>= return . vcat - --- | Escape special characters for RST. -escapeString :: String -> String -escapeString = escapeStringUsing (backslashEscapes "`\\|*_") - --- | Convert bibliographic information into RST header. -metaToRST :: WriterOptions -> Meta -> State WriterState Doc -metaToRST opts (Meta title authors date) = do - title' <- titleToRST opts title - authors' <- authorsToRST authors - date' <- dateToRST date - let toc = if writerTableOfContents opts - then text "" $+$ text ".. contents::" - else empty - return $ title' $+$ authors' $+$ date' $+$ toc - -titleToRST :: WriterOptions -> [Inline] -> State WriterState Doc -titleToRST opts [] = return empty -titleToRST opts lst = do - contents <- inlineListToRST opts lst - let titleLength = length $ render contents - let border = text (replicate titleLength '=') - return $ border $+$ contents $+$ border <> text "\n" - -authorsToRST :: [String] -> State WriterState Doc -authorsToRST [] = return empty -authorsToRST (first:rest) = do - rest' <- authorsToRST rest - return $ (text ":Author: " <> text first) $+$ rest' - -dateToRST :: String -> State WriterState Doc -dateToRST [] = return empty -dateToRST str = return $ text ":Date: " <> text (escapeString str) - --- | Convert Pandoc block element to RST. -blockToRST :: WriterOptions -- ^ Options - -> Block -- ^ Block element - -> State WriterState Doc -blockToRST opts Null = return empty -blockToRST opts (Plain inlines) = wrappedRST opts inlines -blockToRST opts (Para [TeX str]) = - let str' = if "\n" `isSuffixOf` str then str ++ "\n" else str ++ "\n\n" in - return $ hang (text "\n.. raw:: latex\n") 3 $ vcat $ map text (lines str') -blockToRST opts (Para inlines) = do - contents <- wrappedRST opts inlines - return $ contents <> text "\n" -blockToRST opts (RawHtml str) = - let str' = if "\n" `isSuffixOf` str then str ++ "\n" else str ++ "\n\n" in - return $ hang (text "\n.. raw:: html\n") 3 $ vcat $ map text (lines str') -blockToRST opts HorizontalRule = return $ text "--------------\n" -blockToRST opts (Header level inlines) = do - contents <- inlineListToRST opts inlines - let headerLength = length $ render contents - let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1) - let border = text $ replicate headerLength headerChar - return $ contents $+$ border <> text "\n" -blockToRST opts (CodeBlock str) = return $ (text "::\n") $+$ - (nest (writerTabStop opts) $ vcat $ map text (lines str)) <> text "\n" -blockToRST opts (BlockQuote blocks) = do - contents <- blockListToRST opts blocks - return $ (nest (writerTabStop opts) contents) <> text "\n" -blockToRST opts (Table caption aligns widths headers rows) = do - caption' <- inlineListToRST opts caption - let caption'' = if null caption - then empty - else text "" $+$ (text "Table: " <> caption') - headers' <- mapM (blockListToRST opts) headers - let widthsInChars = map (floor . (78 *)) widths - let alignHeader alignment = case alignment of - AlignLeft -> leftAlignBlock - AlignCenter -> centerAlignBlock - AlignRight -> rightAlignBlock - AlignDefault -> leftAlignBlock - let hpipeBlocks blocks = hcatBlocks [beg, middle, end] - where height = maximum (map heightOfBlock blocks) - sep = TextBlock 3 height (replicate height " | ") - beg = TextBlock 2 height (replicate height "| ") - end = TextBlock 2 height (replicate height " |") - middle = hcatBlocks $ intersperse sep blocks - let makeRow = hpipeBlocks . zipWith docToBlock widthsInChars - let head = makeRow headers' - rows' <- mapM (\row -> do cols <- mapM (blockListToRST opts) row - return $ makeRow cols) rows - let tableWidth = sum widthsInChars - let maxRowHeight = maximum $ map heightOfBlock (head:rows') - let border ch = char '+' <> char ch <> - (hcat $ intersperse (char ch <> char '+' <> char ch) $ - map (\l -> text $ replicate l ch) widthsInChars) <> - char ch <> char '+' - let body = vcat $ intersperse (border '-') $ map blockToDoc rows' - return $ border '-' $+$ blockToDoc head $+$ border '=' $+$ body $+$ - border '-' $$ caption'' $$ text "" -blockToRST opts (BulletList items) = do - contents <- mapM (bulletListItemToRST opts) items - -- ensure that sublists have preceding blank line - return $ text "" $+$ vcat contents <> text "\n" -blockToRST opts (OrderedList (start, style, delim) items) = do - let markers = if start == 1 && style == DefaultStyle && delim == DefaultDelim - then take (length items) $ repeat "#." - else take (length items) $ orderedListMarkers - (start, style, delim) - let maxMarkerLength = maximum $ map length markers - let markers' = map (\m -> let s = maxMarkerLength - length m - in m ++ replicate s ' ') markers - contents <- mapM (\(item, num) -> orderedListItemToRST opts item num) $ - zip markers' items - -- ensure that sublists have preceding blank line - return $ text "" $+$ vcat contents <> text "\n" -blockToRST opts (DefinitionList items) = do - contents <- mapM (definitionListItemToRST opts) items - return $ (vcat contents) <> text "\n" - --- | Convert bullet list item (list of blocks) to RST. -bulletListItemToRST :: WriterOptions -> [Block] -> State WriterState Doc -bulletListItemToRST opts items = do - contents <- blockListToRST opts items - return $ hang (text "- ") 3 contents - --- | Convert ordered list item (a list of blocks) to RST. -orderedListItemToRST :: WriterOptions -- ^ options - -> String -- ^ marker for list item - -> [Block] -- ^ list item (list of blocks) - -> State WriterState Doc -orderedListItemToRST opts marker items = do - contents <- blockListToRST opts items - return $ hang (text marker) (length marker + 1) contents - --- | Convert defintion list item (label, list of blocks) to RST. -definitionListItemToRST :: WriterOptions -> ([Inline], [Block]) -> State WriterState Doc -definitionListItemToRST opts (label, items) = do - label <- inlineListToRST opts label - contents <- blockListToRST opts items - return $ label $+$ nest (writerTabStop opts) contents - --- | Convert list of Pandoc block elements to RST. -blockListToRST :: WriterOptions -- ^ Options - -> [Block] -- ^ List of block elements - -> State WriterState Doc -blockListToRST opts blocks = - mapM (blockToRST opts) blocks >>= return . vcat - --- | Convert list of Pandoc inline elements to RST. -inlineListToRST :: WriterOptions -> [Inline] -> State WriterState Doc -inlineListToRST opts lst = mapM (inlineToRST opts) lst >>= return . hcat - --- | Convert Pandoc inline element to RST. -inlineToRST :: WriterOptions -> Inline -> State WriterState Doc -inlineToRST opts (Emph lst) = do - contents <- inlineListToRST opts lst - return $ char '*' <> contents <> char '*' -inlineToRST opts (Strong lst) = do - contents <- inlineListToRST opts lst - return $ text "**" <> contents <> text "**" -inlineToRST opts (Strikeout lst) = do - contents <- inlineListToRST opts lst - return $ text "[STRIKEOUT:" <> contents <> char ']' -inlineToRST opts (Superscript lst) = do - contents <- inlineListToRST opts lst - return $ text "\\ :sup:`" <> contents <> text "`\\ " -inlineToRST opts (Subscript lst) = do - contents <- inlineListToRST opts lst - return $ text "\\ :sub:`" <> contents <> text "`\\ " -inlineToRST opts (Quoted SingleQuote lst) = do - contents <- inlineListToRST opts lst - return $ char '\'' <> contents <> char '\'' -inlineToRST opts (Quoted DoubleQuote lst) = do - contents <- inlineListToRST opts lst - return $ char '"' <> contents <> char '"' -inlineToRST opts EmDash = return $ text "--" -inlineToRST opts EnDash = return $ char '-' -inlineToRST opts Apostrophe = return $ char '\'' -inlineToRST opts Ellipses = return $ text "..." -inlineToRST opts (Code str) = return $ text $ "``" ++ str ++ "``" -inlineToRST opts (Str str) = return $ text $ escapeString str -inlineToRST opts (TeX str) = return $ text str -inlineToRST opts (HtmlInline str) = return empty -inlineToRST opts (LineBreak) = return $ char ' ' -- RST doesn't have linebreaks -inlineToRST opts Space = return $ char ' ' -inlineToRST opts (Link [Code str] (src, tit)) | src == str || - src == "mailto:" ++ str = do - let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src - return $ text srcSuffix -inlineToRST opts (Link txt (src, tit)) = do - let useReferenceLinks = writerReferenceLinks opts - linktext <- inlineListToRST opts $ normalizeSpaces txt - if useReferenceLinks - then do (notes, refs, pics) <- get - let refs' = if (txt, (src, tit)) `elem` refs - then refs - else (txt, (src, tit)):refs - put (notes, refs', pics) - return $ char '`' <> linktext <> text "`_" - else return $ char '`' <> linktext <> text " <" <> text src <> text ">`_" -inlineToRST opts (Image alternate (source, tit)) = do - (notes, refs, pics) <- get - let labelsUsed = map fst pics - let txt = if null alternate || alternate == [Str ""] || - alternate `elem` labelsUsed - then [Str $ "image" ++ show (length refs)] - else alternate - let pics' = if (txt, (source, tit)) `elem` pics - then pics - else (txt, (source, tit)):pics - put (notes, refs, pics') - label <- inlineListToRST opts txt - return $ char '|' <> label <> char '|' -inlineToRST opts (Note contents) = do - -- add to notes in state - modify (\(notes, refs, pics) -> (contents:notes, refs, pics)) - (notes, _, _) <- get - let ref = show $ (length notes) - return $ text " [" <> text ref <> text "]_" |