7c268c4 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Muse writer: move options, stTopLevel and stInsideBlock to WriterEnv

7c268c4Alexander Krotov9 years ago

src/Text/Pandoc/Writers/Muse.hs+33−30

compare with master

unifiedsplit

@@ -44,6 +44,7 @@ even though it is supported only in Emacs Muse.

44-}

45module Text.Pandoc.Writers.Muse (writeMuse) where

46import Prelude

47+import Control.Monad.Reader

47import Control.Monad.State.Strict

48import Control.Monad.State.Strict

48import Data.Char (isSpace, isDigit, isAsciiUpper, isAsciiLower)

49import Data.Char (isSpace, isDigit, isAsciiUpper, isAsciiLower)

49import Data.Text (Text)

50import Data.Text (Text)

@@ -61,15 +62,22 @@ import Text.Pandoc.Writers.Shared

61import qualified Data.Set as Set

62import qualified Data.Set as Set

63type Notes = [[Block]]

64type Notes = [[Block]]

65+

66+type Muse m = ReaderT WriterEnv (StateT WriterState m)

67+

68+data WriterEnv =

69+ WriterEnv { envOptions :: WriterOptions

70+ , envTopLevel :: Bool

71+ , envInsideBlock :: Bool

72+ }

73+

64data WriterState =

74data WriterState =

65 WriterState { stNotes :: Notes

75 WriterState { stNotes :: Notes

66− , stOptions :: WriterOptions

67− , stTopLevel :: Bool

68− , stInsideBlock :: Bool

69 , stIds :: Set.Set String

76 , stIds :: Set.Set String

70 }

77 }

72−type Muse = StateT WriterState

79+evalMuse :: PandocMonad m => Muse m a -> WriterEnv -> WriterState -> m a

80+evalMuse document env st = evalStateT (runReaderT document env) st

74-- | Convert Pandoc to Muse.

82-- | Convert Pandoc to Muse.

75writeMuse :: PandocMonad m

83writeMuse :: PandocMonad m

@@ -77,20 +85,21 @@ writeMuse :: PandocMonad m

77 -> Pandoc

85 -> Pandoc

78 -> m Text

86 -> m Text

79writeMuse opts document =

87writeMuse opts document =

88+ evalMuse (pandocToMuse document) env st

89+ where env = WriterEnv { envOptions = opts

90+ , envTopLevel = True

91+ , envInsideBlock = False

92+ }

80− let st = WriterState { stNotes = []

93+ st = WriterState { stNotes = []

81− , stOptions = opts

82− , stTopLevel = True

83− , stInsideBlock = False

84− , stIds = Set.empty

94+ , stIds = Set.empty

85− }

95+ }

86− in evalStateT (pandocToMuse document) st

88-- | Return Muse representation of document.

97-- | Return Muse representation of document.

89pandocToMuse :: PandocMonad m

98pandocToMuse :: PandocMonad m

90 => Pandoc

99 => Pandoc

91 -> Muse m Text

100 -> Muse m Text

92pandocToMuse (Pandoc meta blocks) = do

101pandocToMuse (Pandoc meta blocks) = do

93− opts <- gets stOptions

102+ opts <- asks envOptions

94 let colwidth = if writerWrapText opts == WrapAuto

103 let colwidth = if writerWrapText opts == WrapAuto

95 then Just $ writerColumns opts

104 then Just $ writerColumns opts

96 else Nothing

105 else Nothing

@@ -121,7 +130,7 @@ catWithBlankLines (b : bs) n = do

121catWithBlankLines _ _ = error "Expected at least one block"

130catWithBlankLines _ _ = error "Expected at least one block"

122

131

123-- | Convert list of Pandoc block elements to Muse

132-- | Convert list of Pandoc block elements to Muse

124−-- | without setting stTopLevel.

133+-- | without setting envTopLevel.

125flatBlockListToMuse :: PandocMonad m

134flatBlockListToMuse :: PandocMonad m

126 => [Block] -- ^ List of block elements

135 => [Block] -- ^ List of block elements

127 -> Muse m Doc

136 -> Muse m Doc

@@ -141,16 +150,10 @@ flatBlockListToMuse [] = return mempty

141blockListToMuse :: PandocMonad m

150blockListToMuse :: PandocMonad m

142 => [Block] -- ^ List of block elements

151 => [Block] -- ^ List of block elements

143 -> Muse m Doc

152 -> Muse m Doc

144−blockListToMuse blocks = do

153+blockListToMuse =

145− oldState <- get

154+ local (\env -> env { envTopLevel = not (envInsideBlock env)

146− modify $ \s -> s { stTopLevel = not $ stInsideBlock s

155+ , envInsideBlock = True

147− , stInsideBlock = True

148− }

149− result <- flatBlockListToMuse blocks

156+ }) . flatBlockListToMuse

150− modify $ \s -> s { stTopLevel = stTopLevel oldState

151− , stInsideBlock = stInsideBlock oldState

152− }

153− return result

154

157

155-- | Convert Pandoc block element to Muse.

158-- | Convert Pandoc block element to Muse.

156blockToMuse :: PandocMonad m

159blockToMuse :: PandocMonad m

@@ -180,7 +183,7 @@ blockToMuse (OrderedList (start, style, _) items) = do

180 (start, style, Period)

183 (start, style, Period)

181 contents <- zipWithM orderedListItemToMuse markers items

184 contents <- zipWithM orderedListItemToMuse markers items

182 -- ensure that sublists have preceding blank line

185 -- ensure that sublists have preceding blank line

183− topLevel <- gets stTopLevel

186+ topLevel <- asks envTopLevel

184 return $ cr $$ (if topLevel then nest 1 else id) (vcat contents) $$ blankline

187 return $ cr $$ (if topLevel then nest 1 else id) (vcat contents) $$ blankline

185 where orderedListItemToMuse :: PandocMonad m

188 where orderedListItemToMuse :: PandocMonad m

186 => String -- ^ marker for list item

189 => String -- ^ marker for list item

@@ -192,7 +195,7 @@ blockToMuse (OrderedList (start, style, _) items) = do

192blockToMuse (BulletList items) = do

195blockToMuse (BulletList items) = do

193 contents <- mapM bulletListItemToMuse items

196 contents <- mapM bulletListItemToMuse items

194 -- ensure that sublists have preceding blank line

197 -- ensure that sublists have preceding blank line

195− topLevel <- gets stTopLevel

198+ topLevel <- asks envTopLevel

196 return $ cr $$ (if topLevel then nest 1 else id) (vcat contents) $$ blankline

199 return $ cr $$ (if topLevel then nest 1 else id) (vcat contents) $$ blankline

197 where bulletListItemToMuse :: PandocMonad m

200 where bulletListItemToMuse :: PandocMonad m

198 => [Block]

201 => [Block]

@@ -203,7 +206,7 @@ blockToMuse (BulletList items) = do

203blockToMuse (DefinitionList items) = do

206blockToMuse (DefinitionList items) = do

204 contents <- mapM definitionListItemToMuse items

207 contents <- mapM definitionListItemToMuse items

205 -- ensure that sublists have preceding blank line

208 -- ensure that sublists have preceding blank line

206− topLevel <- gets stTopLevel

209+ topLevel <- asks envTopLevel

207 return $ cr $$ (if topLevel then nest 1 else id) (vcat contents) $$ blankline

210 return $ cr $$ (if topLevel then nest 1 else id) (vcat contents) $$ blankline

208 where definitionListItemToMuse :: PandocMonad m

211 where definitionListItemToMuse :: PandocMonad m

209 => ([Inline], [[Block]])

212 => ([Inline], [[Block]])

@@ -218,7 +221,7 @@ blockToMuse (DefinitionList items) = do

218 -> Muse m Doc

221 -> Muse m Doc

219 descriptionToMuse desc = hang 4 " :: " <$> blockListToMuse desc

222 descriptionToMuse desc = hang 4 " :: " <$> blockListToMuse desc

220blockToMuse (Header level (ident,_,_) inlines) = do

223blockToMuse (Header level (ident,_,_) inlines) = do

221− opts <- gets stOptions

224+ opts <- asks envOptions

222 contents <- inlineListToMuse inlines

225 contents <- inlineListToMuse inlines

223

226

224 ids <- gets stIds

227 ids <- gets stIds

@@ -383,7 +386,7 @@ renderInlineList :: PandocMonad m

383renderInlineList True [] = pure "<verbatim></verbatim>"

386renderInlineList True [] = pure "<verbatim></verbatim>"

384renderInlineList False [] = pure ""

387renderInlineList False [] = pure ""

385renderInlineList start (x:xs) = do r <- inlineToMuse x

388renderInlineList start (x:xs) = do r <- inlineToMuse x

386− opts <- gets stOptions

389+ opts <- asks envOptions

387 lst' <- renderInlineList ((x == SoftBreak && writerWrapText opts == WrapPreserve) || x == LineBreak) xs

390 lst' <- renderInlineList ((x == SoftBreak && writerWrapText opts == WrapPreserve) || x == LineBreak) xs

388 if start && fixOrEscape x

391 if start && fixOrEscape x

389 then pure (text "<verbatim></verbatim>" <> r <> lst')

392 then pure (text "<verbatim></verbatim>" <> r <> lst')

@@ -443,7 +446,7 @@ inlineToMuse (RawInline (Format f) str) =

443inlineToMuse LineBreak = return $ "<br>" <> cr

446inlineToMuse LineBreak = return $ "<br>" <> cr

444inlineToMuse Space = return space

447inlineToMuse Space = return space

445inlineToMuse SoftBreak = do

448inlineToMuse SoftBreak = do

446− wrapText <- gets $ writerWrapText . stOptions

449+ wrapText <- asks $ writerWrapText . envOptions

447 return $ if wrapText == WrapPreserve then cr else space

450 return $ if wrapText == WrapPreserve then cr else space

448inlineToMuse (Link _ txt (src, _)) =

451inlineToMuse (Link _ txt (src, _)) =

449 case txt of

452 case txt of

@@ -458,7 +461,7 @@ inlineToMuse (Link _ txt (src, _)) =

458inlineToMuse (Image attr alt (source,'f':'i':'g':':':title)) =

461inlineToMuse (Image attr alt (source,'f':'i':'g':':':title)) =

459 inlineToMuse (Image attr alt (source,title))

462 inlineToMuse (Image attr alt (source,title))

460inlineToMuse (Image attr inlines (source, title)) = do

463inlineToMuse (Image attr inlines (source, title)) = do

461− opts <- gets stOptions

464+ opts <- asks envOptions

462 alt <- inlineListToMuse inlines

465 alt <- inlineListToMuse inlines

463 let title' = if null title

466 let title' = if null title

464 then if null inlines

467 then if null inlines