Skip to content

Commit

Permalink
Muse writer: Add endnote support
Browse files Browse the repository at this point in the history
  • Loading branch information
Alexander Krotov committed Dec 15, 2017
1 parent ac006b0 commit de649bf
Show file tree
Hide file tree
Showing 2 changed files with 28 additions and 11 deletions.
34 changes: 23 additions & 11 deletions src/Text/Pandoc/Writers/Muse.hs
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,7 @@ import qualified Data.Set as Set
type Notes = [[Block]]
data WriterState =
WriterState { stNotes :: Notes
, stEndNotes :: Notes
, stOptions :: WriterOptions
, stTopLevel :: Bool
, stInsideBlock :: Bool
Expand All @@ -72,6 +73,7 @@ writeMuse :: PandocMonad m
-> m Text
writeMuse opts document =
let st = WriterState { stNotes = []
, stEndNotes = []
, stOptions = opts
, stTopLevel = True
, stInsideBlock = False
Expand All @@ -95,8 +97,9 @@ pandocToMuse (Pandoc meta blocks) = do
(fmap render' . inlineListToMuse)
meta
body <- blockListToMuse blocks
notes <- liftM (reverse . stNotes) get >>= notesToMuse
let main = render colwidth $ body $+$ notes
notes <- liftM (reverse . stNotes) get >>= notesToMuse ('[', ']')
endNotes <- liftM (reverse . stEndNotes) get >>= notesToMuse ('{', '}')
let main = render colwidth $ body $+$ notes $+$ endNotes
let context = defField "body" main metadata
case writerTemplate opts of
Nothing -> return main
Expand Down Expand Up @@ -261,18 +264,20 @@ blockToMuse Null = return empty

-- | Return Muse representation of notes.
notesToMuse :: PandocMonad m
=> Notes
=> (Char, Char)
-> Notes
-> StateT WriterState m Doc
notesToMuse notes = liftM vsep (zipWithM noteToMuse [1 ..] notes)
notesToMuse lr notes = liftM vsep (zipWithM (noteToMuse lr) [1 ..] notes)

-- | Return Muse representation of a note.
noteToMuse :: PandocMonad m
=> Int
=> (Char, Char)
-> Int
-> [Block]
-> StateT WriterState m Doc
noteToMuse num note = do
noteToMuse (l, r) num note = do
contents <- blockListToMuse note
let marker = "[" ++ show num ++ "] "
let marker = l : (show num ++ (r : " "))
return $ hang (length marker) (text marker) contents

-- | Escape special characters for Muse.
Expand Down Expand Up @@ -385,12 +390,19 @@ inlineToMuse (Image _ inlines (source, title)) = do
else "[" <> alt <> "]"
else "[" <> text title <> "]"
return $ "[[" <> text source <> "]" <> title' <> "]"
inlineToMuse (Note _ contents) = do
inlineToMuse (Note notetype contents) = do
-- add to notes in state
notes <- gets stNotes
modify $ \st -> st { stNotes = contents:notes }
let ref = show $ length notes + 1
return $ "[" <> text ref <> "]"
endNotes <- gets stEndNotes
modify $ case notetype of
EndNote -> \st -> st { stEndNotes = contents:endNotes }
_ -> \st -> st { stNotes = contents:notes }
let ref = show $ 1 + length (case notetype of
EndNote -> endNotes
_ -> notes)
case notetype of
EndNote -> return $ "{" <> text ref <> "}"
_ -> return $ "[" <> text ref <> "]"
inlineToMuse (Span (_,name:_,_) inlines) = do
contents <- inlineListToMuse inlines
return $ "<class name=\"" <> text name <> "\">" <> contents <> "</class>"
Expand Down
5 changes: 5 additions & 0 deletions test/Tests/Writers/Muse.hs
Original file line number Diff line number Diff line change
Expand Up @@ -338,6 +338,11 @@ tests = [ testGroup "block elements"
, ""
, "[1] Foo"
]
, "endnote" =: endNote (plain (text "Foo"))
=?> unlines [ "{1}"
, ""
, "{1} Foo"
]
, "span" =: spanWith ("",["foobar"],[]) (str "Some text")
=?> "<class name=\"foobar\">Some text</class>"
, testGroup "combined"
Expand Down

0 comments on commit de649bf

Please sign in to comment.