From 05b94c31aede33ca6860357547bed17c993b337e Mon Sep 17 00:00:00 2001 From: Matej Kollar <208115@mail.muni.cz> Date: Mon, 30 Jun 2014 08:04:40 +0200 Subject: Use Reader. To avoid to pass opts explicitly around (as we do not use it very much at the moment anyway) --- src/Text/Pandoc/Writers/MediaWiki.hs | 191 +++++++++++++++++------------------ 1 file changed, 95 insertions(+), 96 deletions(-) (limited to 'src/Text/Pandoc/Writers/MediaWiki.hs') diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 3b987ba2b..6a0c2d0e8 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -39,6 +39,7 @@ import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.XML ( escapeStringForXML ) import Data.List ( intersect, intercalate, intersperse ) import Network.URI ( isURI ) +import Control.Monad.Reader import Control.Monad.State data WriterState = WriterState { @@ -47,20 +48,23 @@ data WriterState = WriterState { , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list } +type MediaWikiWriter = ReaderT WriterOptions (State WriterState) + -- | Convert Pandoc to MediaWiki. writeMediaWiki :: WriterOptions -> Pandoc -> String writeMediaWiki opts document = - evalState (pandocToMediaWiki opts document) + evalState (runReaderT (pandocToMediaWiki document) opts) WriterState { stNotes = False, stListLevel = [], stUseTags = False } -- | Return MediaWiki representation of document. -pandocToMediaWiki :: WriterOptions -> Pandoc -> State WriterState String -pandocToMediaWiki opts (Pandoc meta blocks) = do +pandocToMediaWiki :: Pandoc -> MediaWikiWriter String +pandocToMediaWiki (Pandoc meta blocks) = do + opts <- ask metadata <- metaToJSON opts - (fmap trimr . blockListToMediaWiki opts) - (inlineListToMediaWiki opts) + (fmap trimr . blockListToMediaWiki) + inlineListToMediaWiki meta - body <- blockListToMediaWiki opts blocks + body <- blockListToMediaWiki blocks notesExist <- get >>= return . stNotes let notes = if notesExist then "\n" @@ -78,51 +82,50 @@ escapeString :: String -> String escapeString = escapeStringForXML -- | Convert Pandoc block element to MediaWiki. -blockToMediaWiki :: WriterOptions -- ^ Options - -> Block -- ^ Block element - -> State WriterState String +blockToMediaWiki :: Block -- ^ Block element + -> MediaWikiWriter String -blockToMediaWiki _ Null = return "" +blockToMediaWiki Null = return "" -blockToMediaWiki opts (Div attrs bs) = do - contents <- blockListToMediaWiki opts bs +blockToMediaWiki (Div attrs bs) = do + contents <- blockListToMediaWiki bs return $ render Nothing (tagWithAttrs "div" attrs) ++ "\n\n" ++ contents ++ "\n\n" ++ "" -blockToMediaWiki opts (Plain inlines) = - inlineListToMediaWiki opts inlines +blockToMediaWiki (Plain inlines) = + inlineListToMediaWiki inlines -- title beginning with fig: indicates that the image is a figure -blockToMediaWiki opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToMediaWiki (Para [Image txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return "" - else ("|caption " ++) `fmap` inlineListToMediaWiki opts txt + else ("|caption " ++) `fmap` inlineListToMediaWiki txt let opt = if null txt then "" else "|alt=" ++ if null tit then capt else tit ++ capt return $ "[[Image:" ++ src ++ "|frame|none" ++ opt ++ "]]\n" -blockToMediaWiki opts (Para inlines) = do +blockToMediaWiki (Para inlines) = do useTags <- get >>= return . stUseTags listLevel <- get >>= return . stListLevel - contents <- inlineListToMediaWiki opts inlines + contents <- inlineListToMediaWiki inlines return $ if useTags then "

" ++ contents ++ "

" else contents ++ if null listLevel then "\n" else "" -blockToMediaWiki _ (RawBlock f str) +blockToMediaWiki (RawBlock f str) | f == Format "mediawiki" = return str | f == Format "html" = return str | otherwise = return "" -blockToMediaWiki _ HorizontalRule = return "\n-----\n" +blockToMediaWiki HorizontalRule = return "\n-----\n" -blockToMediaWiki opts (Header level _ inlines) = do - contents <- inlineListToMediaWiki opts inlines +blockToMediaWiki (Header level _ inlines) = do + contents <- inlineListToMediaWiki inlines let eqs = replicate level '=' return $ eqs ++ " " ++ contents ++ " " ++ eqs ++ "\n" -blockToMediaWiki _ (CodeBlock (_,classes,_) str) = do +blockToMediaWiki (CodeBlock (_,classes,_) str) = do let at = classes `intersect` ["actionscript", "ada", "apache", "applescript", "asm", "asp", "autoit", "bash", "blitzbasic", "bnf", "c", "c_mac", "caddcl", "cadlisp", "cfdg", "cfm", "cpp", "cpp-qt", "csharp", "css", "d", "delphi", "diff", "div", "dos", "eiffel", "fortran", @@ -137,68 +140,68 @@ blockToMediaWiki _ (CodeBlock (_,classes,_) str) = do else ("", "") return $ beg ++ escapeString str ++ end -blockToMediaWiki opts (BlockQuote blocks) = do - contents <- blockListToMediaWiki opts blocks +blockToMediaWiki (BlockQuote blocks) = do + contents <- blockListToMediaWiki blocks return $ "
" ++ contents ++ "
" -blockToMediaWiki opts (Table capt aligns widths headers rows') = do +blockToMediaWiki (Table capt aligns widths headers rows') = do caption <- if null capt then return "" else do - c <- inlineListToMediaWiki opts capt + c <- inlineListToMediaWiki capt return $ "|+ " ++ trimr c ++ "\n" let headless = all null headers let allrows = if headless then rows' else headers:rows' tableBody <- (concat . intersperse "|-\n") `fmap` - mapM (tableRowToMediaWiki opts headless aligns widths) + mapM (tableRowToMediaWiki headless aligns widths) (zip [1..] allrows) return $ "{|\n" ++ caption ++ tableBody ++ "|}\n" -blockToMediaWiki opts x@(BulletList items) = do +blockToMediaWiki x@(BulletList items) = do oldUseTags <- get >>= return . stUseTags listLevel <- get >>= return . stListLevel let useTags = oldUseTags || not (isSimpleList x) if useTags then do modify $ \s -> s { stUseTags = True } - contents <- mapM (listItemToMediaWiki opts) items + contents <- mapM listItemToMediaWiki items modify $ \s -> s { stUseTags = oldUseTags } return $ "\n" else do modify $ \s -> s { stListLevel = stListLevel s ++ "*" } - contents <- mapM (listItemToMediaWiki opts) items + contents <- mapM listItemToMediaWiki items modify $ \s -> s { stListLevel = init (stListLevel s) } return $ vcat contents ++ if null listLevel then "\n" else "" -blockToMediaWiki opts x@(OrderedList attribs items) = do +blockToMediaWiki x@(OrderedList attribs items) = do oldUseTags <- get >>= return . stUseTags listLevel <- get >>= return . stListLevel let useTags = oldUseTags || not (isSimpleList x) if useTags then do modify $ \s -> s { stUseTags = True } - contents <- mapM (listItemToMediaWiki opts) items + contents <- mapM listItemToMediaWiki items modify $ \s -> s { stUseTags = oldUseTags } return $ "\n" ++ vcat contents ++ "\n" else do modify $ \s -> s { stListLevel = stListLevel s ++ "#" } - contents <- mapM (listItemToMediaWiki opts) items + contents <- mapM listItemToMediaWiki items modify $ \s -> s { stListLevel = init (stListLevel s) } return $ vcat contents ++ if null listLevel then "\n" else "" -blockToMediaWiki opts x@(DefinitionList items) = do +blockToMediaWiki x@(DefinitionList items) = do oldUseTags <- get >>= return . stUseTags listLevel <- get >>= return . stListLevel let useTags = oldUseTags || not (isSimpleList x) if useTags then do modify $ \s -> s { stUseTags = True } - contents <- mapM (definitionListItemToMediaWiki opts) items + contents <- mapM definitionListItemToMediaWiki items modify $ \s -> s { stUseTags = oldUseTags } return $ "
\n" ++ vcat contents ++ "
\n" else do modify $ \s -> s { stListLevel = stListLevel s ++ ";" } - contents <- mapM (definitionListItemToMediaWiki opts) items + contents <- mapM definitionListItemToMediaWiki items modify $ \s -> s { stListLevel = init (stListLevel s) } return $ vcat contents ++ if null listLevel then "\n" else "" @@ -216,9 +219,9 @@ listAttribsToString (startnum, numstyle, _) = else "") -- | Convert bullet or ordered list item (list of blocks) to MediaWiki. -listItemToMediaWiki :: WriterOptions -> [Block] -> State WriterState String -listItemToMediaWiki opts items = do - contents <- blockListToMediaWiki opts items +listItemToMediaWiki :: [Block] -> MediaWikiWriter String +listItemToMediaWiki items = do + contents <- blockListToMediaWiki items useTags <- get >>= return . stUseTags if useTags then return $ "
  • " ++ contents ++ "
    • " @@ -227,12 +230,11 @@ listItemToMediaWiki opts items = do return $ marker ++ " " ++ contents -- | Convert definition list item (label, list of blocks) to MediaWiki. -definitionListItemToMediaWiki :: WriterOptions - -> ([Inline],[[Block]]) - -> State WriterState String -definitionListItemToMediaWiki opts (label, items) = do - labelText <- inlineListToMediaWiki opts label - contents <- mapM (blockListToMediaWiki opts) items +definitionListItemToMediaWiki :: ([Inline],[[Block]]) + -> MediaWikiWriter String +definitionListItemToMediaWiki (label, items) = do + labelText <- inlineListToMediaWiki label + contents <- mapM blockListToMediaWiki items useTags <- get >>= return . stUseTags if useTags then return $ "
    " ++ labelText ++ "
    \n" ++ @@ -283,25 +285,23 @@ vcat = intercalate "\n" -- Auxiliary functions for tables: -tableRowToMediaWiki :: WriterOptions - -> Bool +tableRowToMediaWiki :: Bool -> [Alignment] -> [Double] -> (Int, [[Block]]) - -> State WriterState String -tableRowToMediaWiki opts headless alignments widths (rownum, cells) = do + -> MediaWikiWriter String +tableRowToMediaWiki headless alignments widths (rownum, cells) = do cells' <- mapM (\cellData -> - tableCellToMediaWiki opts headless rownum cellData) + tableCellToMediaWiki headless rownum cellData) $ zip3 alignments widths cells return $ unlines cells' -tableCellToMediaWiki :: WriterOptions - -> Bool +tableCellToMediaWiki :: Bool -> Int -> (Alignment, Double, [Block]) - -> State WriterState String -tableCellToMediaWiki opts headless rownum (alignment, width, bs) = do - contents <- blockListToMediaWiki opts bs + -> MediaWikiWriter String +tableCellToMediaWiki headless rownum (alignment, width, bs) = do + contents <- blockListToMediaWiki bs let marker = if rownum == 1 && not headless then "!" else "|" let percent w = show (truncate (100*w) :: Integer) ++ "%" let attrs = ["align=" ++ show (alignmentToString alignment) | @@ -321,75 +321,74 @@ alignmentToString alignment = case alignment of AlignDefault -> "left" -- | Convert list of Pandoc block elements to MediaWiki. -blockListToMediaWiki :: WriterOptions -- ^ Options - -> [Block] -- ^ List of block elements - -> State WriterState String -blockListToMediaWiki opts blocks = - mapM (blockToMediaWiki opts) blocks >>= return . vcat +blockListToMediaWiki :: [Block] -- ^ List of block elements + -> MediaWikiWriter String +blockListToMediaWiki blocks = + mapM blockToMediaWiki blocks >>= return . vcat -- | Convert list of Pandoc inline elements to MediaWiki. -inlineListToMediaWiki :: WriterOptions -> [Inline] -> State WriterState String -inlineListToMediaWiki opts lst = - mapM (inlineToMediaWiki opts) lst >>= return . concat +inlineListToMediaWiki :: [Inline] -> MediaWikiWriter String +inlineListToMediaWiki lst = + mapM inlineToMediaWiki lst >>= return . concat -- | Convert Pandoc inline element to MediaWiki. -inlineToMediaWiki :: WriterOptions -> Inline -> State WriterState String +inlineToMediaWiki :: Inline -> MediaWikiWriter String -inlineToMediaWiki opts (Span attrs ils) = do - contents <- inlineListToMediaWiki opts ils +inlineToMediaWiki (Span attrs ils) = do + contents <- inlineListToMediaWiki ils return $ render Nothing (tagWithAttrs "span" attrs) ++ contents ++ "" -inlineToMediaWiki opts (Emph lst) = do - contents <- inlineListToMediaWiki opts lst +inlineToMediaWiki (Emph lst) = do + contents <- inlineListToMediaWiki lst return $ "''" ++ contents ++ "''" -inlineToMediaWiki opts (Strong lst) = do - contents <- inlineListToMediaWiki opts lst +inlineToMediaWiki (Strong lst) = do + contents <- inlineListToMediaWiki lst return $ "'''" ++ contents ++ "'''" -inlineToMediaWiki opts (Strikeout lst) = do - contents <- inlineListToMediaWiki opts lst +inlineToMediaWiki (Strikeout lst) = do + contents <- inlineListToMediaWiki lst return $ "" ++ contents ++ "" -inlineToMediaWiki opts (Superscript lst) = do - contents <- inlineListToMediaWiki opts lst +inlineToMediaWiki (Superscript lst) = do + contents <- inlineListToMediaWiki lst return $ "" ++ contents ++ "" -inlineToMediaWiki opts (Subscript lst) = do - contents <- inlineListToMediaWiki opts lst +inlineToMediaWiki (Subscript lst) = do + contents <- inlineListToMediaWiki lst return $ "" ++ contents ++ "" -inlineToMediaWiki opts (SmallCaps lst) = inlineListToMediaWiki opts lst +inlineToMediaWiki (SmallCaps lst) = inlineListToMediaWiki lst -inlineToMediaWiki opts (Quoted SingleQuote lst) = do - contents <- inlineListToMediaWiki opts lst +inlineToMediaWiki (Quoted SingleQuote lst) = do + contents <- inlineListToMediaWiki lst return $ "\8216" ++ contents ++ "\8217" -inlineToMediaWiki opts (Quoted DoubleQuote lst) = do - contents <- inlineListToMediaWiki opts lst +inlineToMediaWiki (Quoted DoubleQuote lst) = do + contents <- inlineListToMediaWiki lst return $ "\8220" ++ contents ++ "\8221" -inlineToMediaWiki opts (Cite _ lst) = inlineListToMediaWiki opts lst +inlineToMediaWiki (Cite _ lst) = inlineListToMediaWiki lst -inlineToMediaWiki _ (Code _ str) = +inlineToMediaWiki (Code _ str) = return $ "" ++ (escapeString str) ++ "" -inlineToMediaWiki _ (Str str) = return $ escapeString str +inlineToMediaWiki (Str str) = return $ escapeString str -inlineToMediaWiki _ (Math _ str) = return $ "" ++ str ++ "" - -- note: str should NOT be escaped +inlineToMediaWiki (Math _ str) = return $ "" ++ str ++ "" + -- note: str should NOT be escaped -inlineToMediaWiki _ (RawInline f str) +inlineToMediaWiki (RawInline f str) | f == Format "mediawiki" = return str | f == Format "html" = return str | otherwise = return "" -inlineToMediaWiki _ (LineBreak) = return "
    " +inlineToMediaWiki (LineBreak) = return "
    " -inlineToMediaWiki _ Space = return " " +inlineToMediaWiki Space = return " " -inlineToMediaWiki opts (Link txt (src, _)) = do - label <- inlineListToMediaWiki opts txt +inlineToMediaWiki (Link txt (src, _)) = do + label <- inlineListToMediaWiki txt case txt of [Str s] | escapeURI s == src -> return src _ -> if isURI src @@ -398,8 +397,8 @@ inlineToMediaWiki opts (Link txt (src, _)) = do where src' = case src of '/':xs -> xs -- with leading / it's a _ -> src -- link to a help page -inlineToMediaWiki opts (Image alt (source, tit)) = do - alt' <- inlineListToMediaWiki opts alt +inlineToMediaWiki (Image alt (source, tit)) = do + alt' <- inlineListToMediaWiki alt let txt = if (null tit) then if null alt then "" @@ -407,8 +406,8 @@ inlineToMediaWiki opts (Image alt (source, tit)) = do else "|" ++ tit return $ "[[Image:" ++ source ++ txt ++ "]]" -inlineToMediaWiki opts (Note contents) = do - contents' <- blockListToMediaWiki opts contents +inlineToMediaWiki (Note contents) = do + contents' <- blockListToMediaWiki contents modify (\s -> s { stNotes = True }) return $ "" ++ contents' ++ "" -- note - may not work for notes with multiple blocks -- cgit v1.2.3 From 0bc900e36a2c9385ff0163c77993d58fd753d512 Mon Sep 17 00:00:00 2001 From: Matej Kollar <208115@mail.muni.cz> Date: Mon, 30 Jun 2014 08:38:16 +0200 Subject: HLint suggestions. --- src/Text/Pandoc/Writers/MediaWiki.hs | 69 ++++++++++++++++++------------------ 1 file changed, 34 insertions(+), 35 deletions(-) (limited to 'src/Text/Pandoc/Writers/MediaWiki.hs') diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 6a0c2d0e8..edd9771a4 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -37,14 +37,14 @@ import Text.Pandoc.Writers.Shared import Text.Pandoc.Pretty (render) import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.XML ( escapeStringForXML ) -import Data.List ( intersect, intercalate, intersperse ) +import Data.List ( intersect, intercalate ) import Network.URI ( isURI ) import Control.Monad.Reader import Control.Monad.State data WriterState = WriterState { stNotes :: Bool -- True if there are notes - , stListLevel :: [Char] -- String at beginning of list items, e.g. "**" + , stListLevel :: String -- String at beginning of list items, e.g. "**" , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list } @@ -65,17 +65,16 @@ pandocToMediaWiki (Pandoc meta blocks) = do inlineListToMediaWiki meta body <- blockListToMediaWiki blocks - notesExist <- get >>= return . stNotes + notesExist <- gets stNotes let notes = if notesExist then "\n" else "" let main = body ++ notes let context = defField "body" main - $ defField "toc" (writerTableOfContents opts) - $ metadata - if writerStandalone opts - then return $ renderTemplate' (writerTemplate opts) context - else return main + $ defField "toc" (writerTableOfContents opts) metadata + return $ if writerStandalone opts + then renderTemplate' (writerTemplate opts) context + else main -- | Escape special characters for MediaWiki. escapeString :: String -> String @@ -106,8 +105,8 @@ blockToMediaWiki (Para [Image txt (src,'f':'i':'g':':':tit)]) = do return $ "[[Image:" ++ src ++ "|frame|none" ++ opt ++ "]]\n" blockToMediaWiki (Para inlines) = do - useTags <- get >>= return . stUseTags - listLevel <- get >>= return . stListLevel + useTags <- gets stUseTags + listLevel <- gets stListLevel contents <- inlineListToMediaWiki inlines return $ if useTags then "

    " ++ contents ++ "

    " @@ -152,14 +151,14 @@ blockToMediaWiki (Table capt aligns widths headers rows') = do return $ "|+ " ++ trimr c ++ "\n" let headless = all null headers let allrows = if headless then rows' else headers:rows' - tableBody <- (concat . intersperse "|-\n") `fmap` + tableBody <- intercalate "|-\n" `fmap` mapM (tableRowToMediaWiki headless aligns widths) (zip [1..] allrows) return $ "{|\n" ++ caption ++ tableBody ++ "|}\n" blockToMediaWiki x@(BulletList items) = do - oldUseTags <- get >>= return . stUseTags - listLevel <- get >>= return . stListLevel + oldUseTags <- gets stUseTags + listLevel <- gets stListLevel let useTags = oldUseTags || not (isSimpleList x) if useTags then do @@ -174,8 +173,8 @@ blockToMediaWiki x@(BulletList items) = do return $ vcat contents ++ if null listLevel then "\n" else "" blockToMediaWiki x@(OrderedList attribs items) = do - oldUseTags <- get >>= return . stUseTags - listLevel <- get >>= return . stListLevel + oldUseTags <- gets stUseTags + listLevel <- gets stListLevel let useTags = oldUseTags || not (isSimpleList x) if useTags then do @@ -190,8 +189,8 @@ blockToMediaWiki x@(OrderedList attribs items) = do return $ vcat contents ++ if null listLevel then "\n" else "" blockToMediaWiki x@(DefinitionList items) = do - oldUseTags <- get >>= return . stUseTags - listLevel <- get >>= return . stListLevel + oldUseTags <- gets stUseTags + listLevel <- gets stListLevel let useTags = oldUseTags || not (isSimpleList x) if useTags then do @@ -222,11 +221,11 @@ listAttribsToString (startnum, numstyle, _) = listItemToMediaWiki :: [Block] -> MediaWikiWriter String listItemToMediaWiki items = do contents <- blockListToMediaWiki items - useTags <- get >>= return . stUseTags + useTags <- gets stUseTags if useTags then return $ "
  • " ++ contents ++ "
    • " else do - marker <- get >>= return . stListLevel + marker <- gets stListLevel return $ marker ++ " " ++ contents -- | Convert definition list item (label, list of blocks) to MediaWiki. @@ -235,14 +234,14 @@ definitionListItemToMediaWiki :: ([Inline],[[Block]]) definitionListItemToMediaWiki (label, items) = do labelText <- inlineListToMediaWiki label contents <- mapM blockListToMediaWiki items - useTags <- get >>= return . stUseTags + useTags <- gets stUseTags if useTags then return $ "
    " ++ labelText ++ "
    \n" ++ - (intercalate "\n" $ map (\d -> "
    " ++ d ++ "
    ") contents) + intercalate "\n" (map (\d -> "
    " ++ d ++ "
    ") contents) else do - marker <- get >>= return . stListLevel + marker <- gets stListLevel return $ marker ++ " " ++ labelText ++ "\n" ++ - (intercalate "\n" $ map (\d -> init marker ++ ": " ++ d) contents) + intercalate "\n" (map (\d -> init marker ++ ": " ++ d) contents) -- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. isSimpleList :: Block -> Bool @@ -291,8 +290,7 @@ tableRowToMediaWiki :: Bool -> (Int, [[Block]]) -> MediaWikiWriter String tableRowToMediaWiki headless alignments widths (rownum, cells) = do - cells' <- mapM (\cellData -> - tableCellToMediaWiki headless rownum cellData) + cells' <- mapM (tableCellToMediaWiki headless rownum) $ zip3 alignments widths cells return $ unlines cells' @@ -313,7 +311,7 @@ tableCellToMediaWiki headless rownum (alignment, width, bs) = do else unwords attrs ++ "|" return $ marker ++ attr ++ trimr contents -alignmentToString :: Alignment -> [Char] +alignmentToString :: Alignment -> String alignmentToString alignment = case alignment of AlignLeft -> "left" AlignRight -> "right" @@ -324,12 +322,12 @@ alignmentToString alignment = case alignment of blockListToMediaWiki :: [Block] -- ^ List of block elements -> MediaWikiWriter String blockListToMediaWiki blocks = - mapM blockToMediaWiki blocks >>= return . vcat + fmap vcat $ mapM blockToMediaWiki blocks -- | Convert list of Pandoc inline elements to MediaWiki. inlineListToMediaWiki :: [Inline] -> MediaWikiWriter String inlineListToMediaWiki lst = - mapM inlineToMediaWiki lst >>= return . concat + fmap concat $ mapM inlineToMediaWiki lst -- | Convert Pandoc inline element to MediaWiki. inlineToMediaWiki :: Inline -> MediaWikiWriter String @@ -371,7 +369,7 @@ inlineToMediaWiki (Quoted DoubleQuote lst) = do inlineToMediaWiki (Cite _ lst) = inlineListToMediaWiki lst inlineToMediaWiki (Code _ str) = - return $ "" ++ (escapeString str) ++ "" + return $ "" ++ escapeString str ++ "" inlineToMediaWiki (Str str) = return $ escapeString str @@ -391,19 +389,20 @@ inlineToMediaWiki (Link txt (src, _)) = do label <- inlineListToMediaWiki txt case txt of [Str s] | escapeURI s == src -> return src - _ -> if isURI src - then return $ "[" ++ src ++ " " ++ label ++ "]" - else return $ "[[" ++ src' ++ "|" ++ label ++ "]]" + _ -> return $ if isURI src + then "[" ++ src ++ " " ++ label ++ "]" + else "[[" ++ src' ++ "|" ++ label ++ "]]" where src' = case src of '/':xs -> xs -- with leading / it's a _ -> src -- link to a help page + inlineToMediaWiki (Image alt (source, tit)) = do alt' <- inlineListToMediaWiki alt - let txt = if (null tit) + let txt = if null tit then if null alt then "" - else "|" ++ alt' - else "|" ++ tit + else '|' : alt' + else '|' : tit return $ "[[Image:" ++ source ++ txt ++ "]]" inlineToMediaWiki (Note contents) = do -- cgit v1.2.3 From d2c81346e72e8f7a2e8fe3340e8767530087b2fd Mon Sep 17 00:00:00 2001 From: Matej Kollar <208115@mail.muni.cz> Date: Fri, 4 Jul 2014 22:09:36 +0200 Subject: Move more things to Reader. --- src/Text/Pandoc/Writers/MediaWiki.hs | 65 ++++++++++++++++-------------------- 1 file changed, 29 insertions(+), 36 deletions(-) (limited to 'src/Text/Pandoc/Writers/MediaWiki.hs') diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index edd9771a4..77ae27681 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -44,22 +44,27 @@ import Control.Monad.State data WriterState = WriterState { stNotes :: Bool -- True if there are notes - , stListLevel :: String -- String at beginning of list items, e.g. "**" - , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list } -type MediaWikiWriter = ReaderT WriterOptions (State WriterState) +data WriterReader = WriterReader { + options :: WriterOptions -- Writer options + , stListLevel :: String -- String at beginning of list items, e.g. "**" + , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list + } + +type MediaWikiWriter = ReaderT WriterReader (State WriterState) -- | Convert Pandoc to MediaWiki. writeMediaWiki :: WriterOptions -> Pandoc -> String writeMediaWiki opts document = - evalState (runReaderT (pandocToMediaWiki document) opts) - WriterState { stNotes = False, stListLevel = [], stUseTags = False } + let initialState = WriterState { stNotes = False } + env = WriterReader { options = opts, stListLevel = [], stUseTags = False } + in evalState (runReaderT (pandocToMediaWiki document) env) initialState -- | Return MediaWiki representation of document. pandocToMediaWiki :: Pandoc -> MediaWikiWriter String pandocToMediaWiki (Pandoc meta blocks) = do - opts <- ask + opts <- asks options metadata <- metaToJSON opts (fmap trimr . blockListToMediaWiki) inlineListToMediaWiki @@ -105,8 +110,8 @@ blockToMediaWiki (Para [Image txt (src,'f':'i':'g':':':tit)]) = do return $ "[[Image:" ++ src ++ "|frame|none" ++ opt ++ "]]\n" blockToMediaWiki (Para inlines) = do - useTags <- gets stUseTags - listLevel <- gets stListLevel + useTags <- asks stUseTags + listLevel <- asks stListLevel contents <- inlineListToMediaWiki inlines return $ if useTags then "

    " ++ contents ++ "

    " @@ -157,51 +162,39 @@ blockToMediaWiki (Table capt aligns widths headers rows') = do return $ "{|\n" ++ caption ++ tableBody ++ "|}\n" blockToMediaWiki x@(BulletList items) = do - oldUseTags <- gets stUseTags - listLevel <- gets stListLevel + oldUseTags <- asks stUseTags + listLevel <- asks stListLevel let useTags = oldUseTags || not (isSimpleList x) if useTags then do - modify $ \s -> s { stUseTags = True } - contents <- mapM listItemToMediaWiki items - modify $ \s -> s { stUseTags = oldUseTags } + contents <- local (\ s -> s { stUseTags = True }) $ mapM listItemToMediaWiki items return $ "
      \n" ++ vcat contents ++ "
    \n" else do - modify $ \s -> s { stListLevel = stListLevel s ++ "*" } - contents <- mapM listItemToMediaWiki items - modify $ \s -> s { stListLevel = init (stListLevel s) } + contents <- local (\s -> s { stListLevel = stListLevel s ++ "*" }) $ mapM listItemToMediaWiki items return $ vcat contents ++ if null listLevel then "\n" else "" blockToMediaWiki x@(OrderedList attribs items) = do - oldUseTags <- gets stUseTags - listLevel <- gets stListLevel + oldUseTags <- asks stUseTags + listLevel <- asks stListLevel let useTags = oldUseTags || not (isSimpleList x) if useTags then do - modify $ \s -> s { stUseTags = True } - contents <- mapM listItemToMediaWiki items - modify $ \s -> s { stUseTags = oldUseTags } + contents <- local (\s -> s { stUseTags = True }) $ mapM listItemToMediaWiki items return $ "\n" ++ vcat contents ++ "\n" else do - modify $ \s -> s { stListLevel = stListLevel s ++ "#" } - contents <- mapM listItemToMediaWiki items - modify $ \s -> s { stListLevel = init (stListLevel s) } + contents <- local (\s -> s { stListLevel = stListLevel s ++ "#" }) $ mapM listItemToMediaWiki items return $ vcat contents ++ if null listLevel then "\n" else "" blockToMediaWiki x@(DefinitionList items) = do - oldUseTags <- gets stUseTags - listLevel <- gets stListLevel + oldUseTags <- asks stUseTags + listLevel <- asks stListLevel let useTags = oldUseTags || not (isSimpleList x) if useTags then do - modify $ \s -> s { stUseTags = True } - contents <- mapM definitionListItemToMediaWiki items - modify $ \s -> s { stUseTags = oldUseTags } + contents <- local (\s -> s { stUseTags = True }) $ mapM definitionListItemToMediaWiki items return $ "
    \n" ++ vcat contents ++ "
    \n" else do - modify $ \s -> s { stListLevel = stListLevel s ++ ";" } - contents <- mapM definitionListItemToMediaWiki items - modify $ \s -> s { stListLevel = init (stListLevel s) } + contents <- local (\s -> s { stListLevel = stListLevel s ++ ";" }) $ mapM definitionListItemToMediaWiki items return $ vcat contents ++ if null listLevel then "\n" else "" -- Auxiliary functions for lists: @@ -221,11 +214,11 @@ listAttribsToString (startnum, numstyle, _) = listItemToMediaWiki :: [Block] -> MediaWikiWriter String listItemToMediaWiki items = do contents <- blockListToMediaWiki items - useTags <- gets stUseTags + useTags <- asks stUseTags if useTags then return $ "
  • " ++ contents ++ "
    • " else do - marker <- gets stListLevel + marker <- asks stListLevel return $ marker ++ " " ++ contents -- | Convert definition list item (label, list of blocks) to MediaWiki. @@ -234,12 +227,12 @@ definitionListItemToMediaWiki :: ([Inline],[[Block]]) definitionListItemToMediaWiki (label, items) = do labelText <- inlineListToMediaWiki label contents <- mapM blockListToMediaWiki items - useTags <- gets stUseTags + useTags <- asks stUseTags if useTags then return $ "
    " ++ labelText ++ "
    \n" ++ intercalate "\n" (map (\d -> "
    " ++ d ++ "
    ") contents) else do - marker <- gets stListLevel + marker <- asks stListLevel return $ marker ++ " " ++ labelText ++ "\n" ++ intercalate "\n" (map (\d -> init marker ++ ": " ++ d) contents) -- cgit v1.2.3 From 0bda602fcbae13b2eb9ee23d2abd0bcec9e548b4 Mon Sep 17 00:00:00 2001 From: Matej Kollar <208115@mail.muni.cz> Date: Fri, 4 Jul 2014 23:48:58 +0200 Subject: Little restructuralization. --- src/Text/Pandoc/Writers/MediaWiki.hs | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) (limited to 'src/Text/Pandoc/Writers/MediaWiki.hs') diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 77ae27681..baf3ce240 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -162,38 +162,35 @@ blockToMediaWiki (Table capt aligns widths headers rows') = do return $ "{|\n" ++ caption ++ tableBody ++ "|}\n" blockToMediaWiki x@(BulletList items) = do - oldUseTags <- asks stUseTags - listLevel <- asks stListLevel - let useTags = oldUseTags || not (isSimpleList x) + useTags <- fmap (|| not (isSimpleList x)) $ asks stUseTags if useTags then do contents <- local (\ s -> s { stUseTags = True }) $ mapM listItemToMediaWiki items return $ "
      \n" ++ vcat contents ++ "
    \n" else do + listLevel <- asks stListLevel contents <- local (\s -> s { stListLevel = stListLevel s ++ "*" }) $ mapM listItemToMediaWiki items return $ vcat contents ++ if null listLevel then "\n" else "" blockToMediaWiki x@(OrderedList attribs items) = do - oldUseTags <- asks stUseTags - listLevel <- asks stListLevel - let useTags = oldUseTags || not (isSimpleList x) + useTags <- fmap (|| not (isSimpleList x)) $ asks stUseTags if useTags then do contents <- local (\s -> s { stUseTags = True }) $ mapM listItemToMediaWiki items return $ "\n" ++ vcat contents ++ "\n" else do + listLevel <- asks stListLevel contents <- local (\s -> s { stListLevel = stListLevel s ++ "#" }) $ mapM listItemToMediaWiki items return $ vcat contents ++ if null listLevel then "\n" else "" blockToMediaWiki x@(DefinitionList items) = do - oldUseTags <- asks stUseTags - listLevel <- asks stListLevel - let useTags = oldUseTags || not (isSimpleList x) + useTags <- fmap (|| not (isSimpleList x)) $ asks stUseTags if useTags then do contents <- local (\s -> s { stUseTags = True }) $ mapM definitionListItemToMediaWiki items return $ "
    \n" ++ vcat contents ++ "
    \n" else do + listLevel <- asks stListLevel contents <- local (\s -> s { stListLevel = stListLevel s ++ ";" }) $ mapM definitionListItemToMediaWiki items return $ vcat contents ++ if null listLevel then "\n" else "" -- cgit v1.2.3