7252777 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Muse writer: define Muse type

7252777Alexander Krotov9 years ago

src/Text/Pandoc/Writers/Muse.hs+18−16

compare with master

unifiedsplit

@@ -69,6 +69,8 @@ data WriterState =

69 , stIds :: Set.Set String

70 }

72+type Muse = StateT WriterState

73+

72-- | Convert Pandoc to Muse.

74-- | Convert Pandoc to Muse.

73writeMuse :: PandocMonad m

75writeMuse :: PandocMonad m

74 => WriterOptions

76 => WriterOptions

@@ -86,7 +88,7 @@ writeMuse opts document =

86-- | Return Muse representation of document.

88-- | Return Muse representation of document.

87pandocToMuse :: PandocMonad m

89pandocToMuse :: PandocMonad m

88 => Pandoc

90 => Pandoc

89− -> StateT WriterState m Text

91+ -> Muse m Text

90pandocToMuse (Pandoc meta blocks) = do

92pandocToMuse (Pandoc meta blocks) = do

91 opts <- gets stOptions

93 opts <- gets stOptions

92 let colwidth = if writerWrapText opts == WrapAuto

94 let colwidth = if writerWrapText opts == WrapAuto

@@ -111,7 +113,7 @@ pandocToMuse (Pandoc meta blocks) = do

111catWithBlankLines :: PandocMonad m

113catWithBlankLines :: PandocMonad m

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

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

113 -> Int -- ^ Number of blank lines

115 -> Int -- ^ Number of blank lines

114− -> StateT WriterState m Doc

116+ -> Muse m Doc

115catWithBlankLines (b : bs) n = do

117catWithBlankLines (b : bs) n = do

116 b' <- blockToMuse b

118 b' <- blockToMuse b

117 bs' <- flatBlockListToMuse bs

119 bs' <- flatBlockListToMuse bs

@@ -122,7 +124,7 @@ catWithBlankLines _ _ = error "Expected at least one block"

122-- | without setting stTopLevel.

124-- | without setting stTopLevel.

123flatBlockListToMuse :: PandocMonad m

125flatBlockListToMuse :: PandocMonad m

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

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

125− -> StateT WriterState m Doc

127+ -> Muse m Doc

126flatBlockListToMuse bs@(BulletList _ : BulletList _ : _) = catWithBlankLines bs 2

128flatBlockListToMuse bs@(BulletList _ : BulletList _ : _) = catWithBlankLines bs 2

127flatBlockListToMuse bs@(OrderedList (_, style1, _) _ : OrderedList (_, style2, _) _ : _) =

129flatBlockListToMuse bs@(OrderedList (_, style1, _) _ : OrderedList (_, style2, _) _ : _) =

128 catWithBlankLines bs (if style1' == style2' then 2 else 0)

130 catWithBlankLines bs (if style1' == style2' then 2 else 0)

@@ -138,7 +140,7 @@ flatBlockListToMuse [] = return mempty

138-- | Convert list of Pandoc block elements to Muse.

140-- | Convert list of Pandoc block elements to Muse.

139blockListToMuse :: PandocMonad m

141blockListToMuse :: PandocMonad m

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

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

141− -> StateT WriterState m Doc

143+ -> Muse m Doc

142blockListToMuse blocks = do

144blockListToMuse blocks = do

143 oldState <- get

145 oldState <- get

144 modify $ \s -> s { stTopLevel = not $ stInsideBlock s

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

@@ -153,7 +155,7 @@ blockListToMuse blocks = do

153-- | Convert Pandoc block element to Muse.

155-- | Convert Pandoc block element to Muse.

154blockToMuse :: PandocMonad m

156blockToMuse :: PandocMonad m

155 => Block -- ^ Block element

157 => Block -- ^ Block element

156− -> StateT WriterState m Doc

158+ -> Muse m Doc

157blockToMuse (Plain inlines) = inlineListToMuse' inlines

159blockToMuse (Plain inlines) = inlineListToMuse' inlines

158blockToMuse (Para inlines) = do

160blockToMuse (Para inlines) = do

159 contents <- inlineListToMuse' inlines

161 contents <- inlineListToMuse' inlines

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

183 where orderedListItemToMuse :: PandocMonad m

185 where orderedListItemToMuse :: PandocMonad m

184 => String -- ^ marker for list item

186 => String -- ^ marker for list item

185 -> [Block] -- ^ list item (list of blocks)

187 -> [Block] -- ^ list item (list of blocks)

186− -> StateT WriterState m Doc

188+ -> Muse m Doc

187 orderedListItemToMuse marker item = do

189 orderedListItemToMuse marker item = do

188 contents <- blockListToMuse item

190 contents <- blockListToMuse item

189 return $ hang (length marker + 1) (text marker <> space) contents

191 return $ hang (length marker + 1) (text marker <> space) contents

@@ -194,7 +196,7 @@ blockToMuse (BulletList items) = do

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

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

195 where bulletListItemToMuse :: PandocMonad m

197 where bulletListItemToMuse :: PandocMonad m

196 => [Block]

198 => [Block]

197− -> StateT WriterState m Doc

199+ -> Muse m Doc

198 bulletListItemToMuse item = do

200 bulletListItemToMuse item = do

199 contents <- blockListToMuse item

201 contents <- blockListToMuse item

200 return $ hang 2 "- " contents

202 return $ hang 2 "- " contents

@@ -205,7 +207,7 @@ blockToMuse (DefinitionList items) = do

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

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

206 where definitionListItemToMuse :: PandocMonad m

208 where definitionListItemToMuse :: PandocMonad m

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

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

208− -> StateT WriterState m Doc

210+ -> Muse m Doc

209 definitionListItemToMuse (label, defs) = do

211 definitionListItemToMuse (label, defs) = do

210 label' <- inlineListToMuse' label

212 label' <- inlineListToMuse' label

211 contents <- liftM vcat $ mapM descriptionToMuse defs

213 contents <- liftM vcat $ mapM descriptionToMuse defs

@@ -213,7 +215,7 @@ blockToMuse (DefinitionList items) = do

213 return $ hang ind label' contents

215 return $ hang ind label' contents

214 descriptionToMuse :: PandocMonad m

216 descriptionToMuse :: PandocMonad m

215 => [Block]

217 => [Block]

216− -> StateT WriterState m Doc

218+ -> Muse m Doc

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

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

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

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

219 opts <- gets stOptions

221 opts <- gets stOptions

@@ -261,14 +263,14 @@ blockToMuse Null = return empty

261-- | Return Muse representation of notes.

263-- | Return Muse representation of notes.

262notesToMuse :: PandocMonad m

264notesToMuse :: PandocMonad m

263 => Notes

265 => Notes

264− -> StateT WriterState m Doc

266+ -> Muse m Doc

265notesToMuse notes = liftM vsep (zipWithM noteToMuse [1 ..] notes)

267notesToMuse notes = liftM vsep (zipWithM noteToMuse [1 ..] notes)

266

268

267-- | Return Muse representation of a note.

269-- | Return Muse representation of a note.

268noteToMuse :: PandocMonad m

270noteToMuse :: PandocMonad m

269 => Int

271 => Int

270 -> [Block]

272 -> [Block]

271− -> StateT WriterState m Doc

273+ -> Muse m Doc

272noteToMuse num note = do

274noteToMuse num note = do

273 contents <- blockListToMuse note

275 contents <- blockListToMuse note

274 let marker = "[" ++ show num ++ "] "

276 let marker = "[" ++ show num ++ "] "

@@ -377,7 +379,7 @@ fixOrEscape _ = False

377renderInlineList :: PandocMonad m

379renderInlineList :: PandocMonad m

378 => Bool

380 => Bool

379 -> [Inline]

381 -> [Inline]

380− -> StateT WriterState m Doc

382+ -> Muse m Doc

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

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

382renderInlineList False [] = pure ""

384renderInlineList False [] = pure ""

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

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

@@ -391,21 +393,21 @@ renderInlineList start (x:xs) = do r <- inlineToMuse x

391inlineListToMuse'' :: PandocMonad m

393inlineListToMuse'' :: PandocMonad m

392 => Bool

394 => Bool

393 -> [Inline]

395 -> [Inline]

394− -> StateT WriterState m Doc

396+ -> Muse m Doc

395inlineListToMuse'' start lst = do

397inlineListToMuse'' start lst = do

396 lst' <- (normalizeInlineList . fixNotes) <$> preprocessInlineList (map (removeKeyValues . replaceSmallCaps) lst)

398 lst' <- (normalizeInlineList . fixNotes) <$> preprocessInlineList (map (removeKeyValues . replaceSmallCaps) lst)

397 renderInlineList start lst'

399 renderInlineList start lst'

398

400

399−inlineListToMuse' :: PandocMonad m => [Inline] -> StateT WriterState m Doc

401+inlineListToMuse' :: PandocMonad m => [Inline] -> Muse m Doc

400inlineListToMuse' = inlineListToMuse'' True

402inlineListToMuse' = inlineListToMuse'' True

401

403

402−inlineListToMuse :: PandocMonad m => [Inline] -> StateT WriterState m Doc

404+inlineListToMuse :: PandocMonad m => [Inline] -> Muse m Doc

403inlineListToMuse = inlineListToMuse'' False

405inlineListToMuse = inlineListToMuse'' False

404

406

405-- | Convert Pandoc inline element to Muse.

407-- | Convert Pandoc inline element to Muse.

406inlineToMuse :: PandocMonad m

408inlineToMuse :: PandocMonad m

407 => Inline

409 => Inline

408− -> StateT WriterState m Doc

410+ -> Muse m Doc

409inlineToMuse (Str str) = return $ text $ conditionalEscapeString str

411inlineToMuse (Str str) = return $ text $ conditionalEscapeString str

410inlineToMuse (Emph lst) = do

412inlineToMuse (Emph lst) = do

411 contents <- inlineListToMuse lst

413 contents <- inlineListToMuse lst