Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Writers: Use gets to access MonadState where possible (#3480)

Browse source
This commit is contained in:
Alexander Krotov 2017-03-01 23:36:54 +04:00 • committed by John MacFarlane
parent ea619bfcb4
commit 39a8359b57
7 changed files with 53 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/Text/Pandoc/Writers/AsciiDoc.hs
View file

@ -286,7 +286,7 @@ bulletListItemToAsciiDoc opts blocks = do
return $ d <> cr <> chomp x
addBlock d b = do x <- blockToAsciiDoc opts b
return $ d <> cr <> text "+" <> cr <> chomp x
lev <- bulletListLevel `fmap` get
lev <- gets bulletListLevel
modify $ \s -> s{ bulletListLevel = lev + 1 }
contents <- foldM addBlock empty blocks
modify $ \s -> s{ bulletListLevel = lev }
@ -307,7 +307,7 @@ orderedListItemToAsciiDoc opts marker blocks = do
return $ d <> cr <> chomp x
addBlock d b = do x <- blockToAsciiDoc opts b
return $ d <> cr <> text "+" <> cr <> chomp x
lev <- orderedListLevel `fmap` get
lev <- gets orderedListLevel
modify $ \s -> s{ orderedListLevel = lev + 1 }
contents <- foldM addBlock empty blocks
modify $ \s -> s{ orderedListLevel = lev }
@ -320,7 +320,7 @@ definitionListItemToAsciiDoc :: PandocMonad m
-> ADW m Doc
definitionListItemToAsciiDoc opts (label, defs) = do
labelText <- inlineListToAsciiDoc opts label
marker <- defListMarker `fmap` get
marker <- gets defListMarker
if marker == "::"
then modify (\st -> st{ defListMarker = ";;"})
else modify (\st -> st{ defListMarker = "::"})

4
src/Text/Pandoc/Writers/DokuWiki.hs
View file

@ -53,7 +53,7 @@ import Data.List ( intersect, intercalate, isPrefixOf, transpose )
import Data.Default (Default(..))
import Network.URI ( isURI )
import Control.Monad ( zipWithM )
import Control.Monad.State ( modify, State, get, evalState )
import Control.Monad.State ( modify, State, gets, evalState )
import Control.Monad.Reader ( ReaderT, runReaderT, ask, local )
import Text.Pandoc.Class (PandocMonad)
@ -93,7 +93,7 @@ pandocToDokuWiki opts (Pandoc meta blocks) = do
(inlineListToDokuWiki opts)
meta
body <- blockListToDokuWiki opts blocks
notesExist <- stNotes <$> get
notesExist <- gets stNotes
let notes = if notesExist
then "" -- TODO Was "\n<references />" Check whether I can really remove this:
-- if it is definitely to do with footnotes, can remove this whole bit

6
src/Text/Pandoc/Writers/Man.hs
View file

@ -82,10 +82,10 @@ pandocToMan opts (Pandoc meta blocks) = do
(fmap (render colwidth) . inlineListToMan opts)
$ deleteMeta "title" meta
body <- blockListToMan opts blocks
notes <- liftM stNotes get
notes <- gets stNotes
notes' <- notesToMan opts (reverse notes)
let main = render' $ body $$ notes' $$ text ""
hasTables <- liftM stHasTables get
hasTables <- gets stHasTables
let context = defField "body" main
$ setFieldsFromTitle
$ defField "has-tables" hasTables
@ -376,6 +376,6 @@ inlineToMan opts (Image attr alternate (source, tit)) = do
inlineToMan _ (Note contents) = do
-- add to notes in state
modify $ \st -> st{ stNotes = contents : stNotes st }
notes <- liftM stNotes get
notes <- gets stNotes
let ref = show $ (length notes)
return $ char '[' <> text ref <> char ']'

10
src/Text/Pandoc/Writers/Org.hs
View file

@ -61,7 +61,7 @@ writeOrg opts document = return $
-- | Return Org representation of document.
pandocToOrg :: Pandoc -> State WriterState String
pandocToOrg (Pandoc meta blocks) = do
opts <- liftM stOptions get
opts <- gets stOptions
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
@ -70,8 +70,8 @@ pandocToOrg (Pandoc meta blocks) = do
(fmap (render colwidth) . inlineListToOrg)
meta
body <- blockListToOrg blocks
notes <- liftM (reverse . stNotes) get >>= notesToOrg
hasMath <- liftM stHasMath get
notes <- gets (reverse . stNotes) >>= notesToOrg
hasMath <- gets stHasMath
let main = render colwidth $ foldl ($+$) empty $ [body, notes]
let context = defField "body" main
$ defField "math" hasMath
@ -188,7 +188,7 @@ blockToOrg (Header level attr inlines) = do
else cr <> nest (level + 1) (propertiesDrawer attr)
return $ headerStr <> " " <> contents <> drawerStr <> blankline
blockToOrg (CodeBlock (_,classes,_) str) = do
opts <- stOptions <$> get
opts <- gets stOptions
let tabstop = writerTabStop opts
let at = map pandocLangToOrg classes `intersect` orgLangIdentifiers
let (beg, end) = case at of
@ -365,7 +365,7 @@ inlineToOrg (Image _ _ (source, _)) = do
return $ "[[" <> text (orgPath source) <> "]]"
inlineToOrg (Note contents) = do
-- add to notes in state
notes <- get >>= (return . stNotes)
notes <- gets stNotes
modify $ \st -> st { stNotes = contents:notes }
let ref = show $ (length notes) + 1
return $ "[fn:" <> text ref <> "]"

28
src/Text/Pandoc/Writers/RST.hs
View file

@ -70,7 +70,7 @@ writeRST opts document = return $
-- | Return RST representation of document.
pandocToRST :: Pandoc -> State WriterState String
pandocToRST (Pandoc meta blocks) = do
opts <- liftM stOptions get
opts <- gets stOptions
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
@ -85,12 +85,12 @@ pandocToRST (Pandoc meta blocks) = do
body <- blockListToRST' True $ case writerTemplate opts of
Just _ -> normalizeHeadings 1 blocks
Nothing -> blocks
notes <- liftM (reverse . stNotes) get >>= notesToRST
notes <- gets (reverse . stNotes) >>= 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
rawTeX <- liftM stHasRawTeX get
refs <- gets (reverse . stLinks) >>= refsToRST
pics <- gets (reverse . stImages) >>= pictRefsToRST
hasMath <- gets stHasMath
rawTeX <- gets stHasRawTeX
let main = render colwidth $ foldl ($+$) empty $ [body, notes, refs, pics]
let context = defField "body" main
$ defField "toc" (writerTableOfContents opts)
@ -245,7 +245,7 @@ blockToRST (Header level (name,classes,_) inlines) = do
| otherwise = ":class: " <> text (unwords classes)
return $ nowrap $ hang 3 ".. " (rub $$ name' $$ cls) $$ blankline
blockToRST (CodeBlock (_,classes,kvs) str) = do
opts <- stOptions <$> get
opts <- gets stOptions
let tabstop = writerTabStop opts
let startnum = maybe "" (\x -> " " <> text x) $ lookup "startFrom" kvs
let numberlines = if "numberLines" `elem` classes
@ -261,7 +261,7 @@ blockToRST (CodeBlock (_,classes,kvs) str) = do
(lang:_) -> (".. code:: " <> text lang) $$ numberlines)
$+$ nest tabstop (text str) $$ blankline
blockToRST (BlockQuote blocks) = do
tabstop <- get >>= (return . writerTabStop . stOptions)
tabstop <- gets $ writerTabStop . stOptions
contents <- blockListToRST blocks
return $ (nest tabstop contents) <> blankline
blockToRST (Table caption _ widths headers rows) = do
@ -274,7 +274,7 @@ blockToRST (Table caption _ widths headers rows) = do
-- isSimpleCell _ = False
-- let isSimple = all (==0) widths && all (all isSimpleCell) rows
let numChars = maximum . map offset
opts <- get >>= return . stOptions
opts <- gets stOptions
let widthsInChars =
if all (== 0) widths
then map ((+2) . numChars) $ transpose (headers' : rawRows)
@ -342,7 +342,7 @@ definitionListItemToRST :: ([Inline], [[Block]]) -> State WriterState Doc
definitionListItemToRST (label, defs) = do
label' <- inlineListToRST label
contents <- liftM vcat $ mapM blockListToRST defs
tabstop <- get >>= (return . writerTabStop . stOptions)
tabstop <- gets $ writerTabStop . stOptions
return $ label' $$ nest tabstop (nestle contents <> cr)
-- | Format a list of lines as line block.
@ -483,7 +483,7 @@ inlineToRST (RawInline f x)
inlineToRST (LineBreak) = return cr -- there's no line break in RST (see Para)
inlineToRST Space = return space
inlineToRST SoftBreak = do
wrapText <- gets (writerWrapText . stOptions)
wrapText <- gets $ writerWrapText . stOptions
case wrapText of
WrapPreserve -> return cr
WrapAuto -> return space
@ -500,10 +500,10 @@ inlineToRST (Link _ [Image attr alt (imgsrc,imgtit)] (src, _tit)) = do
label <- registerImage attr alt (imgsrc,imgtit) (Just src)
return $ "|" <> label <> "|"
inlineToRST (Link _ txt (src, tit)) = do
useReferenceLinks <- get >>= return . writerReferenceLinks . stOptions
useReferenceLinks <- gets $ writerReferenceLinks . stOptions
linktext <- inlineListToRST $ normalizeSpaces txt
if useReferenceLinks
then do refs <- get >>= return . stLinks
then do refs <- gets stLinks
case lookup txt refs of
Just (src',tit') ->
if src == src' && tit == tit'
@ -526,7 +526,7 @@ inlineToRST (Note contents) = do
registerImage :: Attr -> [Inline] -> Target -> Maybe String -> State WriterState Doc
registerImage attr alt (src,tit) mbtarget = do
pics <- get >>= return . stImages
pics <- gets stImages
txt <- case lookup alt pics of
Just (a,s,t,mbt) | (a,s,t,mbt) == (attr,src,tit,mbtarget)
-> return alt

20
src/Text/Pandoc/Writers/Textile.hs
View file

@ -63,7 +63,7 @@ pandocToTextile opts (Pandoc meta blocks) = do
metadata <- metaToJSON opts (blockListToTextile opts)
(inlineListToTextile opts) meta
body <- blockListToTextile opts blocks
notes <- liftM (unlines . reverse . stNotes) get
notes <- gets $ unlines . reverse . stNotes
let main = body ++ if null notes then "" else ("\n\n" ++ notes)
let context = defField "body" main metadata
case writerTemplate opts of
@ -72,7 +72,7 @@ pandocToTextile opts (Pandoc meta blocks) = do
withUseTags :: State WriterState a -> State WriterState a
withUseTags action = do
oldUseTags <- liftM stUseTags get
oldUseTags <- gets stUseTags
modify $ \s -> s { stUseTags = True }
result <- action
modify $ \s -> s { stUseTags = oldUseTags }
@ -124,8 +124,8 @@ blockToTextile opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
return $ im ++ "\n" ++ capt
blockToTextile opts (Para inlines) = do
useTags <- liftM stUseTags get
listLevel <- liftM stListLevel get
useTags <- gets stUseTags
listLevel <- gets stListLevel
contents <- inlineListToTextile opts inlines
return $ if useTags
then "<p>" ++ contents ++ "</p>"
@ -212,7 +212,7 @@ blockToTextile opts (Table capt aligns widths headers rows') = do
"<tbody>\n" ++ unlines body' ++ "</tbody>\n</table>\n"
blockToTextile opts x@(BulletList items) = do
oldUseTags <- liftM stUseTags get
oldUseTags <- gets stUseTags
let useTags = oldUseTags || not (isSimpleList x)
if useTags
then do
@ -220,13 +220,13 @@ blockToTextile opts x@(BulletList items) = do
return $ "<ul>\n" ++ vcat contents ++ "\n</ul>\n"
else do
modify $ \s -> s { stListLevel = stListLevel s ++ "*" }
level <- get >>= return . length . stListLevel
level <- gets $ length . stListLevel
contents <- mapM (listItemToTextile opts) items
modify $ \s -> s { stListLevel = init (stListLevel s) }
return $ vcat contents ++ (if level > 1 then "" else "\n")
blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do
oldUseTags <- liftM stUseTags get
oldUseTags <- gets stUseTags
let useTags = oldUseTags || not (isSimpleList x)
if useTags
then do
@ -238,7 +238,7 @@ blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do
, stStartNum = if start > 1
then Just start
else Nothing }
level <- get >>= return . length . stListLevel
level <- gets $ length . stListLevel
contents <- mapM (listItemToTextile opts) items
modify $ \s -> s { stListLevel = init (stListLevel s),
stStartNum = Nothing }
@ -265,7 +265,7 @@ listAttribsToString (startnum, numstyle, _) =
listItemToTextile :: WriterOptions -> [Block] -> State WriterState String
listItemToTextile opts items = do
contents <- blockListToTextile opts items
useTags <- get >>= return . stUseTags
useTags <- gets stUseTags
if useTags
then return $ "<li>" ++ contents ++ "</li>"
else do
@ -477,7 +477,7 @@ inlineToTextile opts (Image attr@(_, cls, _) alt (source, tit)) = do
return $ "!" ++ classes ++ styles ++ source ++ txt ++ "!"
inlineToTextile opts (Note contents) = do
curNotes <- liftM stNotes get
curNotes <- gets stNotes
let newnum = length curNotes + 1
contents' <- blockListToTextile opts contents
let thisnote = "fn" ++ show newnum ++ ". " ++ contents' ++ "\n"

32
src/Text/Pandoc/Writers/ZimWiki.hs
View file

@ -43,7 +43,7 @@ import Data.Text ( breakOnAll, pack )
import Data.Default (Default(..))
import Network.URI ( isURI )
import Control.Monad ( zipWithM )
import Control.Monad.State ( modify, State, get, evalState )
import Control.Monad.State ( modify, State, gets, evalState )
import Text.Pandoc.Class ( PandocMonad )
import qualified Data.Map as Map
@ -110,8 +110,8 @@ blockToZimWiki opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
return $ "{{" ++ prefix ++ src ++ imageDims opts attr ++ opt ++ "}}\n"
blockToZimWiki opts (Para inlines) = do
indent <- stIndent <$> get
-- useTags <- stUseTags <$> get
indent <- gets stIndent
-- useTags <- gets stUseTags
contents <- inlineListToZimWiki opts inlines
return $ contents ++ if null indent then "\n" else ""
@ -181,14 +181,14 @@ blockToZimWiki opts (Table capt aligns _ headers rows) = do
unlines (map renderRow rows')
blockToZimWiki opts (BulletList items) = do
indent <- stIndent <$> get
indent <- gets stIndent
modify $ \s -> s { stIndent = stIndent s ++ "\t" }
contents <- (mapM (listItemToZimWiki opts) items)
modify $ \s -> s{ stIndent = indent } -- drop 1 (stIndent s) }
return $ vcat contents ++ if null indent then "\n" else ""
blockToZimWiki opts (OrderedList _ items) = do
indent <- stIndent <$> get
indent <- gets stIndent
modify $ \s -> s { stIndent = stIndent s ++ "\t", stItemNum = 1 }
contents <- (mapM (orderedListItemToZimWiki opts) items)
modify $ \s -> s{ stIndent = indent } -- drop 1 (stIndent s) }
@ -202,14 +202,14 @@ definitionListItemToZimWiki :: WriterOptions -> ([Inline],[[Block]]) -> State Wr
definitionListItemToZimWiki opts (label, items) = do
labelText <- inlineListToZimWiki opts label
contents <- mapM (blockListToZimWiki opts) items
indent <- stIndent <$> get
indent <- gets stIndent
return $ indent ++ "* **" ++ labelText ++ "** " ++ concat contents
-- Auxiliary functions for lists:
indentFromHTML :: WriterOptions -> String -> State WriterState String
indentFromHTML _ str = do
indent <- stIndent <$> get
itemnum <- stItemNum <$> get
indent <- gets stIndent
itemnum <- gets stItemNum
if isInfixOf "<li>" str then return $ indent ++ show itemnum ++ "."
else if isInfixOf "</li>" str then return "\n"
else if isInfixOf "<li value=" str then do
@ -242,15 +242,15 @@ vcat = intercalate "\n"
listItemToZimWiki :: WriterOptions -> [Block] -> State WriterState String
listItemToZimWiki opts items = do
contents <- blockListToZimWiki opts items
indent <- stIndent <$> get
indent <- gets stIndent
return $ indent ++ "* " ++ contents
-- | Convert ordered list item (list of blocks) to ZimWiki.
orderedListItemToZimWiki :: WriterOptions -> [Block] -> State WriterState String
orderedListItemToZimWiki opts items = do
contents <- blockListToZimWiki opts items
indent <- stIndent <$> get
itemnum <- stItemNum <$> get
indent <- gets stIndent
itemnum <- gets stItemNum
--modify $ \s -> s { stItemNum = itemnum + 1 } -- this is not strictly necessary for zim as zim does its own renumbering
return $ indent ++ show itemnum ++ ". " ++ contents
@ -316,8 +316,8 @@ inlineToZimWiki opts (Cite _ lst) = inlineListToZimWiki opts lst
inlineToZimWiki _ (Code _ str) = return $ "''" ++ str ++ "''"
inlineToZimWiki _ (Str str) = do
inTable <- stInTable <$> get
inLink <- stInLink <$> get
inTable <- gets stInTable
inLink <- gets stInLink
if inTable
then return $ substitute "|" "\\|" . escapeString $ str
else
@ -337,7 +337,7 @@ inlineToZimWiki opts (RawInline f str)
| otherwise = return ""
inlineToZimWiki _ LineBreak = do
inTable <- stInTable <$> get
inTable <- gets stInTable
if inTable
then return "\\n"
else return "\n"
@ -351,7 +351,7 @@ inlineToZimWiki opts SoftBreak =
inlineToZimWiki _ Space = return " "
inlineToZimWiki opts (Link _ txt (src, _)) = do
inTable <- stInTable <$> get
inTable <- gets stInTable
modify $ \s -> s { stInLink = True }
label <- inlineListToZimWiki opts $ removeFormatting txt -- zim does not allow formatting in link text, it takes the text verbatim, no need to escape it
modify $ \s -> s { stInLink = False }
@ -369,7 +369,7 @@ inlineToZimWiki opts (Link _ txt (src, _)) = do
_ -> src -- link to a help page
inlineToZimWiki opts (Image attr alt (source, tit)) = do
alt' <- inlineListToZimWiki opts alt
inTable <- stInTable <$> get
inTable <- gets stInTable
let txt = case (tit, alt, inTable) of
("",[], _) -> ""
("", _, False ) -> "|" ++ alt'