diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/Texinfo.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/Texinfo.hs | 191 |
1 files changed, 111 insertions, 80 deletions
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index f2b9aa15f..bf434642e 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2008-2015 John MacFarlane and Peter Wang +Copyright (C) 2008-2018 John MacFarlane + 2012 Peter Wang 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 +20,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Texinfo - Copyright : Copyright (C) 2008-2015 John MacFarlane and Peter Wang + Copyright : Copyright (C) 2008-2018 John MacFarlane + 2012 Peter Wang License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> @@ -29,21 +31,26 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' format into Texinfo. -} module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where +import Control.Monad.Except (throwError) +import Control.Monad.State.Strict +import Data.Char (chr, ord) +import Data.List (maximumBy, transpose) +import Data.Ord (comparing) +import qualified Data.Set as Set +import Data.Text (Text) +import Network.URI (unEscapeString) +import System.FilePath +import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition +import Text.Pandoc.Error +import Text.Pandoc.ImageSize +import Text.Pandoc.Logging import Text.Pandoc.Options +import Text.Pandoc.Pretty import Text.Pandoc.Shared -import Text.Pandoc.Writers.Shared import Text.Pandoc.Templates (renderTemplate') -import Text.Printf ( printf ) -import Data.List ( transpose, maximumBy ) -import Data.Ord ( comparing ) -import Data.Char ( chr, ord ) -import Control.Monad.State -import Text.Pandoc.Pretty -import Text.Pandoc.ImageSize -import Network.URI ( isURI, unEscapeString ) -import System.FilePath -import qualified Data.Set as Set +import Text.Pandoc.Writers.Shared +import Text.Printf (printf) data WriterState = WriterState { stStrikeout :: Bool -- document contains strikeout @@ -59,10 +66,12 @@ data WriterState = - generated .texi files don't work when run through texi2dvi -} +type TI m = StateT WriterState m + -- | Convert Pandoc to Texinfo. -writeTexinfo :: WriterOptions -> Pandoc -> String +writeTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeTexinfo options document = - evalState (pandocToTexinfo options $ wrapTop document) $ + evalStateT (pandocToTexinfo options $ wrapTop document) WriterState { stStrikeout = False, stSuperscript = False, stEscapeComma = False, stSubscript = False, stIdentifiers = Set.empty, stOptions = options} @@ -72,16 +81,18 @@ wrapTop :: Pandoc -> Pandoc wrapTop (Pandoc meta blocks) = Pandoc meta (Header 0 nullAttr (docTitle meta) : blocks) -pandocToTexinfo :: WriterOptions -> Pandoc -> State WriterState String +pandocToTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> TI m Text pandocToTexinfo options (Pandoc meta blocks) = do let titlePage = not $ all null $ docTitle meta : docDate meta : docAuthors meta let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options else Nothing + let render' :: Doc -> Text + render' = render colwidth metadata <- metaToJSON options - (fmap (render colwidth) . blockListToTexinfo) - (fmap (render colwidth) . inlineListToTexinfo) + (fmap render' . blockListToTexinfo) + (fmap render' . inlineListToTexinfo) meta main <- blockListToTexinfo blocks st <- get @@ -91,11 +102,11 @@ pandocToTexinfo options (Pandoc meta blocks) = do $ defField "titlepage" titlePage $ defField "subscript" (stSubscript st) $ defField "superscript" (stSuperscript st) - $ defField "strikeout" (stStrikeout st) - $ metadata + $ + defField "strikeout" (stStrikeout st) metadata case writerTemplate options of Nothing -> return body - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context -- | Escape things as needed for Texinfo. stringToTexinfo :: String -> String @@ -110,7 +121,7 @@ stringToTexinfo = escapeStringUsing texinfoEscapes , ('\x2019', "'") ] -escapeCommas :: State WriterState Doc -> State WriterState Doc +escapeCommas :: PandocMonad m => TI m Doc -> TI m Doc escapeCommas parser = do oldEscapeComma <- gets stEscapeComma modify $ \st -> st{ stEscapeComma = True } @@ -123,8 +134,9 @@ inCmd :: String -> Doc -> Doc inCmd cmd contents = char '@' <> text cmd <> braces contents -- | Convert Pandoc block element to Texinfo. -blockToTexinfo :: Block -- ^ Block to convert - -> State WriterState Doc +blockToTexinfo :: PandocMonad m + => Block -- ^ Block to convert + -> TI m Doc blockToTexinfo Null = return empty @@ -154,17 +166,19 @@ blockToTexinfo (BlockQuote lst) = do contents $$ text "@end quotation" -blockToTexinfo (CodeBlock _ str) = do +blockToTexinfo (CodeBlock _ str) = return $ blankline $$ - text "@verbatim" $$ - flush (text str) $$ - text "@end verbatim" <> blankline + text "@verbatim" $$ + flush (text str) $$ + text "@end verbatim" <> blankline -blockToTexinfo (RawBlock f str) +blockToTexinfo b@(RawBlock f str) | f == "texinfo" = return $ text str | f == "latex" || f == "tex" = return $ text "@tex" $$ text str $$ text "@end tex" - | otherwise = return empty + | otherwise = do + report $ BlockNotRendered b + return empty blockToTexinfo (BulletList lst) = do items <- mapM listItemToTexinfo lst @@ -204,7 +218,7 @@ blockToTexinfo HorizontalRule = text "@bigskip@hrule@bigskip" $$ text "@end iftex" $$ text "@ifnottex" $$ - text (take 72 $ repeat '-') $$ + text (replicate 72 '-') $$ text "@end ifnottex" blockToTexinfo (Header 0 _ lst) = do @@ -214,23 +228,27 @@ blockToTexinfo (Header 0 _ lst) = do return $ text "@node Top" $$ text "@top " <> txt <> blankline -blockToTexinfo (Header level _ lst) = do - node <- inlineListForNode lst - txt <- inlineListToTexinfo lst - idsUsed <- gets stIdentifiers - let id' = uniqueIdent lst idsUsed - modify $ \st -> st{ stIdentifiers = Set.insert id' idsUsed } - return $ if (level > 0) && (level <= 4) - then blankline <> text "@node " <> node $$ - text (seccmd level) <> txt $$ - text "@anchor" <> braces (text $ '#':id') - else txt - where - seccmd 1 = "@chapter " - seccmd 2 = "@section " - seccmd 3 = "@subsection " - seccmd 4 = "@subsubsection " - seccmd _ = error "illegal seccmd level" +blockToTexinfo (Header level _ lst) + | level < 1 || level > 4 = blockToTexinfo (Para lst) + | otherwise = do + node <- inlineListForNode lst + txt <- inlineListToTexinfo lst + idsUsed <- gets stIdentifiers + let id' = uniqueIdent lst idsUsed + modify $ \st -> st{ stIdentifiers = Set.insert id' idsUsed } + sec <- seccmd level + return $ if (level > 0) && (level <= 4) + then blankline <> text "@node " <> node $$ + text sec <> txt $$ + text "@anchor" <> braces (text $ '#':id') + else txt + where + seccmd :: PandocMonad m => Int -> TI m String + seccmd 1 = return "@chapter " + seccmd 2 = return "@section " + seccmd 3 = return "@subsection " + seccmd 4 = return "@subsubsection " + seccmd _ = throwError $ PandocSomeError "illegal seccmd level" blockToTexinfo (Table caption aligns widths heads rows) = do headers <- if all null heads @@ -256,28 +274,32 @@ blockToTexinfo (Table caption aligns widths heads rows) = do inCmd "caption" captionText $$ text "@end float" -tableHeadToTexinfo :: [Alignment] +tableHeadToTexinfo :: PandocMonad m + => [Alignment] -> [[Block]] - -> State WriterState Doc + -> TI m Doc tableHeadToTexinfo = tableAnyRowToTexinfo "@headitem " -tableRowToTexinfo :: [Alignment] +tableRowToTexinfo :: PandocMonad m + => [Alignment] -> [[Block]] - -> State WriterState Doc + -> TI m Doc tableRowToTexinfo = tableAnyRowToTexinfo "@item " -tableAnyRowToTexinfo :: String +tableAnyRowToTexinfo :: PandocMonad m + => String -> [Alignment] -> [[Block]] - -> State WriterState Doc + -> TI m Doc tableAnyRowToTexinfo itemtype aligns cols = zipWithM alignedBlock aligns cols >>= return . (text itemtype $$) . foldl (\row item -> row $$ (if isEmpty row then empty else text " @tab ") <> item) empty -alignedBlock :: Alignment +alignedBlock :: PandocMonad m + => Alignment -> [Block] - -> State WriterState Doc + -> TI m Doc -- XXX @flushleft and @flushright text won't get word wrapped. Since word -- wrapping is more important than alignment, we ignore the alignment. alignedBlock _ = blockListToTexinfo @@ -292,8 +314,9 @@ alignedBlock _ col = blockListToTexinfo col -} -- | Convert Pandoc block elements to Texinfo. -blockListToTexinfo :: [Block] - -> State WriterState Doc +blockListToTexinfo :: PandocMonad m + => [Block] + -> TI m Doc blockListToTexinfo [] = return empty blockListToTexinfo (x:xs) = do x' <- blockToTexinfo x @@ -316,8 +339,8 @@ blockListToTexinfo (x:xs) = do Para _ -> do xs' <- blockListToTexinfo xs case xs of - ((CodeBlock _ _):_) -> return $ x' $$ xs' - _ -> return $ x' $+$ xs' + (CodeBlock _ _:_) -> return $ x' $$ xs' + _ -> return $ x' $+$ xs' _ -> do xs' <- blockListToTexinfo xs return $ x' $$ xs' @@ -335,15 +358,17 @@ collectNodes level (x:xs) = _ -> collectNodes level xs -makeMenuLine :: Block - -> State WriterState Doc +makeMenuLine :: PandocMonad m + => Block + -> TI m Doc makeMenuLine (Header _ _ lst) = do txt <- inlineListForNode lst return $ text "* " <> txt <> text "::" -makeMenuLine _ = error "makeMenuLine called with non-Header block" +makeMenuLine _ = throwError $ PandocSomeError "makeMenuLine called with non-Header block" -listItemToTexinfo :: [Block] - -> State WriterState Doc +listItemToTexinfo :: PandocMonad m + => [Block] + -> TI m Doc listItemToTexinfo lst = do contents <- blockListToTexinfo lst let spacer = case reverse lst of @@ -351,8 +376,9 @@ listItemToTexinfo lst = do _ -> empty return $ text "@item" $$ contents <> spacer -defListItemToTexinfo :: ([Inline], [[Block]]) - -> State WriterState Doc +defListItemToTexinfo :: PandocMonad m + => ([Inline], [[Block]]) + -> TI m Doc defListItemToTexinfo (term, defs) = do term' <- inlineListToTexinfo term let defToTexinfo bs = do d <- blockListToTexinfo bs @@ -363,13 +389,15 @@ defListItemToTexinfo (term, defs) = do return $ text "@item " <> term' $+$ vcat defs' -- | Convert list of inline elements to Texinfo. -inlineListToTexinfo :: [Inline] -- ^ Inlines to convert - -> State WriterState Doc +inlineListToTexinfo :: PandocMonad m + => [Inline] -- ^ Inlines to convert + -> TI m Doc inlineListToTexinfo lst = mapM inlineToTexinfo lst >>= return . hcat -- | Convert list of inline elements to Texinfo acceptable for a node name. -inlineListForNode :: [Inline] -- ^ Inlines to convert - -> State WriterState Doc +inlineListForNode :: PandocMonad m + => [Inline] -- ^ Inlines to convert + -> TI m Doc inlineListForNode = return . text . stringToTexinfo . filter (not . disallowedInNode) . stringify @@ -378,8 +406,9 @@ disallowedInNode :: Char -> Bool disallowedInNode c = c `elem` (".,:()" :: String) -- | Convert inline element to Texinfo -inlineToTexinfo :: Inline -- ^ Inline to convert - -> State WriterState Doc +inlineToTexinfo :: PandocMonad m + => Inline -- ^ Inline to convert + -> TI m Doc inlineToTexinfo (Span _ lst) = inlineListToTexinfo lst @@ -408,7 +437,7 @@ inlineToTexinfo (Subscript lst) = do inlineToTexinfo (SmallCaps lst) = inlineListToTexinfo lst >>= return . inCmd "sc" -inlineToTexinfo (Code _ str) = do +inlineToTexinfo (Code _ str) = return $ text $ "@code{" ++ stringToTexinfo str ++ "}" inlineToTexinfo (Quoted SingleQuote lst) = do @@ -423,12 +452,14 @@ inlineToTexinfo (Cite _ lst) = inlineListToTexinfo lst inlineToTexinfo (Str str) = return $ text (stringToTexinfo str) inlineToTexinfo (Math _ str) = return $ inCmd "math" $ text str -inlineToTexinfo (RawInline f str) +inlineToTexinfo il@(RawInline f str) | f == "latex" || f == "tex" = return $ text "@tex" $$ text str $$ text "@end tex" | f == "texinfo" = return $ text str - | otherwise = return empty -inlineToTexinfo (LineBreak) = return $ text "@*" <> cr + | otherwise = do + report $ InlineNotRendered il + return empty +inlineToTexinfo LineBreak = return $ text "@*" <> cr inlineToTexinfo SoftBreak = do wrapText <- gets (writerWrapText . stOptions) case wrapText of @@ -441,10 +472,10 @@ inlineToTexinfo (Link _ txt (src@('#':_), _)) = do contents <- escapeCommas $ inlineListToTexinfo txt return $ text "@ref" <> braces (text (stringToTexinfo src) <> text "," <> contents) -inlineToTexinfo (Link _ txt (src, _)) = do +inlineToTexinfo (Link _ txt (src, _)) = case txt of [Str x] | escapeURI x == src -> -- autolink - do return $ text $ "@url{" ++ x ++ "}" + return $ text $ "@url{" ++ x ++ "}" _ -> do contents <- escapeCommas $ inlineListToTexinfo txt let src1 = stringToTexinfo src return $ text ("@uref{" ++ src1 ++ ",") <> contents <> @@ -453,7 +484,7 @@ inlineToTexinfo (Link _ txt (src, _)) = do inlineToTexinfo (Image attr alternate (source, _)) = do content <- escapeCommas $ inlineListToTexinfo alternate opts <- gets stOptions - let showDim dim = case (dimension dim attr) of + let showDim dim = case dimension dim attr of (Just (Pixel a)) -> showInInch opts (Pixel a) ++ "in" (Just (Percent _)) -> "" (Just d) -> show d |