From 23c5b0d0f1901aa3ab68391f927de4f5278b5942 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Sat, 26 Nov 2016 23:43:54 -0500
Subject: [PATCH] Implement Errors in PandocMonad
Errors can be thrown purely with `throwError`. At the moment there are
only three kinds of errors:
1. PandocFileReadError FilePath (for problems reading a file from the
filesystem)
2. PandocShouldNeverHappenError String (for stuff that should never
happen but we need to pattern-match anyway)
3. PandocSomeError String (a grab bag of everything else)
Of course, we need to subdivide the third item in this list.
---
src/Text/Pandoc/Class.hs | 18 +++---
src/Text/Pandoc/Writers/EPUB.hs | 28 +++++----
src/Text/Pandoc/Writers/FB2.hs | 5 +-
src/Text/Pandoc/Writers/HTML.hs | 70 ++++++++++++-----------
src/Text/Pandoc/Writers/Man.hs | 57 +++++++++---------
src/Text/Pandoc/Writers/Markdown.hs | 19 +++---
src/Text/Pandoc/Writers/OPML.hs | 16 ++++--
src/Text/Pandoc/Writers/RTF.hs | 11 ++--
src/Text/Pandoc/Writers/Texinfo.hs | 89 +++++++++++++++++------------
9 files changed, 179 insertions(+), 134 deletions(-)
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 64fd7e907..69d2bb761 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -107,8 +107,10 @@ getPOSIXTime = utcTimeToPOSIXSeconds <$> getCurrentTime
-- We can add to this as we go
-data PandocExecutionError = PandocFileReadError String
- deriving (Show, Typeable)
+data PandocExecutionError = PandocFileReadError FilePath
+ | PandocShouldNeverHappenError String
+ | PandocSomeError String
+ deriving (Show, Typeable)
-- Nothing in this for now, but let's put it there anyway.
data PandocStateIO = PandocStateIO
@@ -125,7 +127,9 @@ runIOorExplode ma = do
eitherVal <- runIO ma
case eitherVal of
Right x -> return x
- Left (PandocFileReadError s) -> error s
+ Left (PandocFileReadError fp) -> error $ "promple reading " ++ fp
+ Left (PandocShouldNeverHappenError s) -> error s
+ Left (PandocSomeError s) -> error s
newtype PandocIO a = PandocIO {
unPandocIO :: ExceptT PandocExecutionError (StateT PandocStateIO IO) a
@@ -142,13 +146,13 @@ instance PandocMonad PandocIO where
eitherBS <- liftIO (tryIOError $ BL.readFile s)
case eitherBS of
Right bs -> return bs
- Left _ -> throwError $ PandocFileReadError $ "file not found: " ++ s
+ Left _ -> throwError $ PandocFileReadError s
-- TODO: Make this more sensitive to the different sorts of failure
readDataFile mfp fname = do
eitherBS <- liftIO (tryIOError $ IO.readDataFile mfp fname)
case eitherBS of
Right bs -> return bs
- Left _ -> throwError $ PandocFileReadError $ "file not found: " ++ fname
+ Left _ -> throwError $ PandocFileReadError fname
fail = M.fail
fetchItem ms s = liftIO $ IO.fetchItem ms s
fetchItem' mb ms s = liftIO $ IO.fetchItem' mb ms s
@@ -235,7 +239,7 @@ instance PandocMonad PandocPure where
fps <- asks envFiles
case lookup fp fps of
Just bs -> return (BL.fromStrict bs)
- Nothing -> throwError $ PandocFileReadError "file not in state"
+ Nothing -> throwError $ PandocFileReadError fp
readDataFile Nothing "reference.docx" = do
(B.concat . BL.toChunks . fromArchive) <$> (getDefaultReferenceDocx Nothing)
readDataFile Nothing "reference.odt" = do
@@ -253,7 +257,7 @@ instance PandocMonad PandocPure where
fps <- asks envFiles
case lookup fp fps of
Just bs -> return (Right (bs, getMimeType fp))
- Nothing -> return (Left $ E.toException $ PandocFileReadError "oops")
+ Nothing -> return (Left $ E.toException $ PandocFileReadError fp)
fetchItem' media sourceUrl nm = do
case lookupMedia nm media of
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index 298561db6..580b12210 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -64,7 +64,8 @@ import Data.Char ( toLower, isDigit, isAlphaNum )
import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)
-import Text.Pandoc.Class (PandocMonad)
+import Control.Monad.Except (throwError)
+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))
import qualified Text.Pandoc.Class as P
-- A Chapter includes a list of blocks and maybe a section
@@ -532,9 +533,9 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
let tocTitle = fromMaybe plainTitle $
metaValueToString <$> lookupMeta "toc-title" meta
- let uuid = case epubIdentifier metadata of
- (x:_) -> identifierText x -- use first identifier as UUID
- [] -> error "epubIdentifier is null" -- shouldn't happen
+ uuid <- case epubIdentifier metadata of
+ (x:_) -> return $ identifierText x -- use first identifier as UUID
+ [] -> throwError $ PandocShouldNeverHappenError "epubIdentifier is null" -- shouldn't happen
currentTime <- lift $ P.getCurrentTime
let contentsData = UTF8.fromStringLazy $ ppTopElement $
unode "package" ! [("version", case version of
@@ -590,8 +591,9 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
let tocLevel = writerTOCDepth opts
- let navPointNode :: (Int -> String -> String -> [Element] -> Element)
- -> S.Element -> State Int Element
+ let navPointNode :: PandocMonad m
+ => (Int -> String -> String -> [Element] -> Element)
+ -> S.Element -> StateT Int m Element
navPointNode formatter (S.Sec _ nums (ident,_,_) ils children) = do
n <- get
modify (+1)
@@ -601,15 +603,15 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
let tit = if writerNumberSections opts && not (null nums)
then showNums nums ++ " " ++ tit'
else tit'
- let src = case lookup ident reftable of
- Just x -> x
- Nothing -> error (ident ++ " not found in reftable")
+ src <- case lookup ident reftable of
+ Just x -> return x
+ Nothing -> throwError $ PandocSomeError $ ident ++ " not found in reftable"
let isSec (S.Sec lev _ _ _ _) = lev <= tocLevel
isSec _ = False
let subsecs = filter isSec children
subs <- mapM (navPointNode formatter) subsecs
return $ formatter n tit src subs
- navPointNode _ (S.Blk _) = error "navPointNode encountered Blk"
+ navPointNode _ (S.Blk _) = throwError $ PandocSomeError "navPointNode encountered Blk"
let navMapFormatter :: Int -> String -> String -> [Element] -> Element
navMapFormatter n tit src subs = unode "navPoint" !
@@ -622,6 +624,7 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
[ unode "navLabel" $ unode "text" (stringify $ docTitle' meta)
, unode "content" ! [("src","title_page.xhtml")] $ () ]
+ navMap <- lift $ evalStateT (mapM (navPointNode navMapFormatter) secs) 1
let tocData = UTF8.fromStringLazy $ ppTopElement $
unode "ncx" ! [("version","2005-1")
,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $
@@ -640,7 +643,7 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
("content", toId img)] $ ()]
, unode "docTitle" $ unode "text" $ plainTitle
, unode "navMap" $
- tpNode : evalState (mapM (navPointNode navMapFormatter) secs) 1
+ tpNode : navMap
]
let tocEntry = mkEntry "toc.ncx" tocData
@@ -654,11 +657,12 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
(_:_) -> [unode "ol" ! [("class","toc")] $ subs]
let navtag = if epub3 then "nav" else "div"
+ tocBlocks <- lift $ evalStateT (mapM (navPointNode navXhtmlFormatter) secs) 1
let navBlocks = [RawBlock (Format "html") $ ppElement $
unode navtag ! ([("epub:type","toc") | epub3] ++
[("id","toc")]) $
[ unode "h1" ! [("id","toc-title")] $ tocTitle
- , unode "ol" ! [("class","toc")] $ evalState (mapM (navPointNode navXhtmlFormatter) secs) 1]]
+ , unode "ol" ! [("class","toc")] $ tocBlocks ]]
let landmarks = if epub3
then [RawBlock (Format "html") $ ppElement $
unode "nav" ! [("epub:type","landmarks")
diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs
index 58bfe7615..5c22c8586 100644
--- a/src/Text/Pandoc/Writers/FB2.hs
+++ b/src/Text/Pandoc/Writers/FB2.hs
@@ -39,13 +39,14 @@ import Text.XML.Light
import qualified Text.XML.Light as X
import qualified Text.XML.Light.Cursor as XC
import qualified Data.ByteString.Char8 as B8
+import Control.Monad.Except (throwError)
import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def)
import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize,
linesToPara)
-import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))
import qualified Text.Pandoc.Class as P
-- | Data to be written at the end of the document:
@@ -348,7 +349,7 @@ blockToXml (DefinitionList defs) =
needsBreak (Plain ins) = LineBreak `notElem` ins
needsBreak _ = True
blockToXml (Header _ _ _) = -- should never happen, see renderSections
- error "unexpected header in section text"
+ throwError $ PandocShouldNeverHappenError "unexpected header in section text"
blockToXml HorizontalRule = return
[ el "empty-line" ()
, el "p" (txt (replicate 10 '—'))
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 6f25939f0..4520708e4 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -68,7 +68,8 @@ import Text.XML.Light (unode, elChildren, unqual)
import qualified Text.XML.Light as XML
import System.FilePath (takeExtension)
import Data.Aeson (Value)
-import Text.Pandoc.Class (PandocMonad)
+import Control.Monad.Except (throwError)
+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))
data WriterState = WriterState
{ stNotes :: [Html] -- ^ List of notes
@@ -101,26 +102,27 @@ nl opts = if writerWrapText opts == WrapNone
-- | Convert Pandoc document to Html string.
writeHtmlString :: PandocMonad m => WriterOptions -> Pandoc -> m String
-writeHtmlString opts d = return $
- let (body, context) = evalState (pandocToHtml opts d) defaultWriterState
- in case writerTemplate opts of
- Nothing -> renderHtml body
- Just tpl -> renderTemplate' tpl $
- defField "body" (renderHtml body) context
+writeHtmlString opts d = do
+ (body, context) <- evalStateT (pandocToHtml opts d) defaultWriterState
+ return $ case writerTemplate opts of
+ Nothing -> renderHtml body
+ Just tpl -> renderTemplate' tpl $
+ defField "body" (renderHtml body) context
-- | Convert Pandoc document to Html structure.
writeHtml :: PandocMonad m => WriterOptions -> Pandoc -> m Html
-writeHtml opts d = return $
- let (body, context) = evalState (pandocToHtml opts d) defaultWriterState
- in case writerTemplate opts of
- Nothing -> body
- Just tpl -> renderTemplate' tpl $
- defField "body" (renderHtml body) context
+writeHtml opts d = do
+ (body, context) <- evalStateT (pandocToHtml opts d) defaultWriterState
+ return $ case writerTemplate opts of
+ Nothing -> renderHtml body
+ Just tpl -> renderTemplate' tpl $
+ defField "body" (renderHtml body) context
-- result is (title, authors, date, toc, body, new variables)
-pandocToHtml :: WriterOptions
+pandocToHtml :: PandocMonad m
+ => WriterOptions
-> Pandoc
- -> State WriterState (Html, Value)
+ -> StateT WriterState m (Html, Value)
pandocToHtml opts (Pandoc meta blocks) = do
metadata <- metaToJSON opts
(fmap renderHtml . blockListToHtml opts)
@@ -222,7 +224,7 @@ defList :: WriterOptions -> [Html] -> Html
defList opts items = toList H.dl opts (items ++ [nl opts])
-- | Construct table of contents from list of elements.
-tableOfContents :: WriterOptions -> [Element] -> State WriterState (Maybe Html)
+tableOfContents :: PandocMonad m => WriterOptions -> [Element] -> StateT WriterState m (Maybe Html)
tableOfContents _ [] = return Nothing
tableOfContents opts sects = do
let opts' = opts { writerIgnoreNotes = True }
@@ -238,7 +240,7 @@ showSecNum = concat . intersperse "." . map show
-- | Converts an Element to a list item for a table of contents,
-- retrieving the appropriate identifier from state.
-elementToListItem :: WriterOptions -> Element -> State WriterState (Maybe Html)
+elementToListItem :: PandocMonad m => WriterOptions -> Element -> StateT WriterState m (Maybe Html)
-- Don't include the empty headers created in slide shows
-- shows when an hrule is used to separate slides without a new title:
elementToListItem _ (Sec _ _ _ [Str "\0"] _) = return Nothing
@@ -266,7 +268,7 @@ elementToListItem opts (Sec lev num (id',classes,_) headerText subsecs)
elementToListItem _ _ = return Nothing
-- | Convert an Element to Html.
-elementToHtml :: Int -> WriterOptions -> Element -> State WriterState Html
+elementToHtml :: PandocMonad m => Int -> WriterOptions -> Element -> StateT WriterState m Html
elementToHtml _slideLevel opts (Blk block) = blockToHtml opts block
elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elements) = do
let slide = writerSlideVariant opts /= NoSlides && level <= slideLevel
@@ -347,9 +349,9 @@ parseMailto s = do
_ -> fail "not a mailto: URL"
-- | Obfuscate a "mailto:" link.
-obfuscateLink :: WriterOptions -> Attr -> Html -> String -> Html
+obfuscateLink :: PandocMonad m => WriterOptions -> Attr -> Html -> String -> m Html
obfuscateLink opts attr txt s | writerEmailObfuscation opts == NoObfuscation =
- addAttrs opts attr $ H.a ! A.href (toValue s) $ txt
+ return $ addAttrs opts attr $ H.a ! A.href (toValue s) $ txt
obfuscateLink opts attr (renderHtml -> txt) s =
let meth = writerEmailObfuscation opts
s' = map toLower (take 7 s) ++ drop 7 s
@@ -365,9 +367,11 @@ obfuscateLink opts attr (renderHtml -> txt) s =
in case meth of
ReferenceObfuscation ->
-- need to use preEscapedString or &'s are escaped to & in URL
+ return $
preEscapedString $ "<a href=\"" ++ (obfuscateString s')
++ "\" class=\"email\">" ++ (obfuscateString txt) ++ "</a>"
JavascriptObfuscation ->
+ return $
(H.script ! A.type_ "text/javascript" $
preEscapedString ("\n<!--\nh='" ++
obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++
@@ -375,8 +379,8 @@ obfuscateLink opts attr (renderHtml -> txt) s =
"document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\" clas'+'s=\"em' + 'ail\">'+" ++
linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) >>
H.noscript (preEscapedString $ obfuscateString altText)
- _ -> error $ "Unknown obfuscation method: " ++ show meth
- _ -> addAttrs opts attr $ H.a ! A.href (toValue s) $ toHtml txt -- malformed email
+ _ -> throwError $ PandocSomeError $ "Unknown obfuscation method: " ++ show meth
+ _ -> return $ addAttrs opts attr $ H.a ! A.href (toValue s) $ toHtml txt -- malformed email
-- | Obfuscate character as entity.
obfuscateChar :: Char -> String
@@ -435,7 +439,7 @@ treatAsImage fp =
in null ext || ext `elem` imageExts
-- | Convert Pandoc block element to HTML.
-blockToHtml :: WriterOptions -> Block -> State WriterState Html
+blockToHtml :: PandocMonad m => WriterOptions -> Block -> StateT WriterState m Html
blockToHtml _ Null = return mempty
blockToHtml opts (Plain lst) = inlineListToHtml opts lst
-- title beginning with fig: indicates that the image is a figure
@@ -625,11 +629,12 @@ blockToHtml opts (Table capt aligns widths headers rows') = do
else tbl ! A.style (toValue $ "width:" ++
show (round (totalWidth * 100) :: Int) ++ "%;")
-tableRowToHtml :: WriterOptions
+tableRowToHtml :: PandocMonad m
+ => WriterOptions
-> [Alignment]
-> Int
-> [[Block]]
- -> State WriterState Html
+ -> StateT WriterState m Html
tableRowToHtml opts aligns rownum cols' = do
let mkcell = if rownum == 0 then H.th else H.td
let rowclass = case rownum of
@@ -649,11 +654,12 @@ alignmentToString alignment = case alignment of
AlignCenter -> "center"
AlignDefault -> ""
-tableItemToHtml :: WriterOptions
+tableItemToHtml :: PandocMonad m
+ => WriterOptions
-> (Html -> Html)
-> Alignment
-> [Block]
- -> State WriterState Html
+ -> StateT WriterState m Html
tableItemToHtml opts tag' align' item = do
contents <- blockListToHtml opts item
let alignStr = alignmentToString align'
@@ -671,12 +677,12 @@ toListItems opts items = map (toListItem opts) items ++ [nl opts]
toListItem :: WriterOptions -> Html -> Html
toListItem opts item = nl opts >> H.li item
-blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
+blockListToHtml :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml opts lst =
fmap (mconcat . intersperse (nl opts)) $ mapM (blockToHtml opts) lst
-- | Convert list of Pandoc inline elements to HTML.
-inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html
+inlineListToHtml :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml opts lst =
mapM (inlineToHtml opts) lst >>= return . mconcat
@@ -695,7 +701,7 @@ annotateMML e tex = math (unode "semantics" [cs, unode "annotation" (annotAttrs,
-- | Convert Pandoc inline element to HTML.
-inlineToHtml :: WriterOptions -> Inline -> State WriterState Html
+inlineToHtml :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml opts inline =
case inline of
(Str str) -> return $ strToHtml str
@@ -818,7 +824,7 @@ inlineToHtml opts inline =
| otherwise -> return mempty
(Link attr txt (s,_)) | "mailto:" `isPrefixOf` s -> do
linkText <- inlineListToHtml opts txt
- return $ obfuscateLink opts attr linkText s
+ lift $ obfuscateLink opts attr linkText s
(Link attr txt (s,tit)) -> do
linkText <- inlineListToHtml opts txt
let s' = case s of
@@ -878,7 +884,7 @@ inlineToHtml opts inline =
then result ! customAttribute "data-cites" (toValue citationIds)
else result
-blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html
+blockListToNote :: PandocMonad m => WriterOptions -> String -> [Block] -> StateT WriterState m Html
blockListToNote opts ref blocks =
-- If last block is Para or Plain, include the backlink at the end of
-- that block. Otherwise, insert a new Plain block with the backlink.
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 75c026463..c9530e4e1 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -41,7 +41,8 @@ import Data.Maybe (fromMaybe)
import Text.Pandoc.Pretty
import Text.Pandoc.Builder (deleteMeta)
import Control.Monad.State
-import Text.Pandoc.Class (PandocMonad)
+import Control.Monad.Except (throwError)
+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))
type Notes = [[Block]]
data WriterState = WriterState { stNotes :: Notes
@@ -49,10 +50,10 @@ data WriterState = WriterState { stNotes :: Notes
-- | Convert Pandoc to Man.
writeMan :: PandocMonad m => WriterOptions -> Pandoc -> m String
-writeMan opts document = return $ evalState (pandocToMan opts document) (WriterState [] False)
+writeMan opts document = evalStateT (pandocToMan opts document) (WriterState [] False)
-- | Return groff man representation of document.
-pandocToMan :: WriterOptions -> Pandoc -> State WriterState String
+pandocToMan :: PandocMonad m => WriterOptions -> Pandoc -> StateT WriterState m String
pandocToMan opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
@@ -94,7 +95,7 @@ pandocToMan opts (Pandoc meta blocks) = do
Just tpl -> return $ renderTemplate' tpl context
-- | Return man representation of notes.
-notesToMan :: WriterOptions -> [[Block]] -> State WriterState Doc
+notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState m Doc
notesToMan opts notes =
if null notes
then return empty
@@ -102,7 +103,7 @@ notesToMan opts notes =
return . (text ".SH NOTES" $$) . vcat
-- | Return man representation of a note.
-noteToMan :: WriterOptions -> Int -> [Block] -> State WriterState Doc
+noteToMan :: PandocMonad m => WriterOptions -> Int -> [Block] -> StateT WriterState m Doc
noteToMan opts num note = do
contents <- blockListToMan opts note
let marker = cr <> text ".SS " <> brackets (text (show num))
@@ -161,9 +162,10 @@ splitSentences xs =
in if null rest then [sent] else sent : splitSentences rest
-- | Convert Pandoc block element to man.
-blockToMan :: WriterOptions -- ^ Options
- -> Block -- ^ Block element
- -> State WriterState Doc
+blockToMan :: PandocMonad m
+ => WriterOptions -- ^ Options
+ -> Block -- ^ Block element
+ -> StateT WriterState m Doc
blockToMan _ Null = return empty
blockToMan opts (Div _ bs) = blockListToMan opts bs
blockToMan opts (Plain inlines) =
@@ -237,7 +239,7 @@ blockToMan opts (DefinitionList items) = do
return (vcat contents)
-- | Convert bullet list item (list of blocks) to man.
-bulletListItemToMan :: WriterOptions -> [Block] -> State WriterState Doc
+bulletListItemToMan :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m Doc
bulletListItemToMan _ [] = return empty
bulletListItemToMan opts ((Para first):rest) =
bulletListItemToMan opts ((Plain first):rest)
@@ -255,11 +257,12 @@ bulletListItemToMan opts (first:rest) = do
return $ text "\\[bu] .RS 2" $$ first' $$ rest' $$ text ".RE"
-- | Convert ordered list item (a list of blocks) to man.
-orderedListItemToMan :: WriterOptions -- ^ options
- -> String -- ^ order marker for list item
- -> Int -- ^ number of spaces to indent
- -> [Block] -- ^ list item (list of blocks)
- -> State WriterState Doc
+orderedListItemToMan :: PandocMonad m
+ => WriterOptions -- ^ options
+ -> String -- ^ order marker for list item
+ -> Int -- ^ number of spaces to indent
+ -> [Block] -- ^ list item (list of blocks)
+ -> StateT WriterState m Doc
orderedListItemToMan _ _ _ [] = return empty
orderedListItemToMan opts num indent ((Para first):rest) =
orderedListItemToMan opts num indent ((Plain first):rest)
@@ -274,18 +277,19 @@ orderedListItemToMan opts num indent (first:rest) = do
return $ first'' $$ rest''
-- | Convert definition list item (label, list of blocks) to man.
-definitionListItemToMan :: WriterOptions
- -> ([Inline],[[Block]])
- -> State WriterState Doc
+definitionListItemToMan :: PandocMonad m
+ => WriterOptions
+ -> ([Inline],[[Block]])
+ -> StateT WriterState m Doc
definitionListItemToMan opts (label, defs) = do
labelText <- inlineListToMan opts label
contents <- if null defs
then return empty
else liftM vcat $ forM defs $ \blocks -> do
- let (first, rest) = case blocks of
- ((Para x):y) -> (Plain x,y)
- (x:y) -> (x,y)
- [] -> error "blocks is null"
+ (first, rest) <- case blocks of
+ ((Para x):y) -> return (Plain x,y)
+ (x:y) -> return (x,y)
+ [] -> throwError $ PandocSomeError "blocks is null"
rest' <- liftM vcat $
mapM (\item -> blockToMan opts item) rest
first' <- blockToMan opts first
@@ -293,18 +297,19 @@ definitionListItemToMan opts (label, defs) = do
return $ text ".TP" $$ nowrap (text ".B " <> labelText) $$ contents
-- | Convert list of Pandoc block elements to man.
-blockListToMan :: WriterOptions -- ^ Options
- -> [Block] -- ^ List of block elements
- -> State WriterState Doc
+blockListToMan :: PandocMonad m
+ => WriterOptions -- ^ Options
+ -> [Block] -- ^ List of block elements
+ -> StateT WriterState m Doc
blockListToMan opts blocks =
mapM (blockToMan opts) blocks >>= (return . vcat)
-- | Convert list of Pandoc inline elements to man.
-inlineListToMan :: WriterOptions -> [Inline] -> State WriterState Doc
+inlineListToMan :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Doc
inlineListToMan opts lst = mapM (inlineToMan opts) lst >>= (return . hcat)
-- | Convert Pandoc inline element to man.
-inlineToMan :: WriterOptions -> Inline -> State WriterState Doc
+inlineToMan :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m Doc
inlineToMan opts (Span _ ils) = inlineListToMan opts ils
inlineToMan opts (Emph lst) = do
contents <- inlineListToMan opts lst
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 787db10f9..4c33de65d 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -46,6 +46,7 @@ import Data.Ord ( comparing )
import Text.Pandoc.Pretty
import Control.Monad.Reader
import Control.Monad.State
+import Control.Monad.Except (throwError)
import Text.Pandoc.Writers.HTML (writeHtmlString)
import Text.Pandoc.Readers.TeXMath (texMathToInlines)
import Text.HTML.TagSoup (parseTags, isTagText, Tag(..))
@@ -57,7 +58,7 @@ import qualified Data.Vector as V
import qualified Data.Text as T
import qualified Data.Set as Set
import Network.HTTP ( urlEncode )
-import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))
type Notes = [[Block]]
type Ref = ([Inline], Target, Attr)
@@ -800,14 +801,14 @@ getReference attr label target = do
case find (\(_,t,a) -> t == target && a == attr) (stRefs st) of
Just (ref, _, _) -> return ref
Nothing -> do
- let label' = case find (\(l,_,_) -> l == label) (stRefs st) of
- Just _ -> -- label is used; generate numerical label
- case find (\n -> notElem [Str (show n)]
- (map (\(l,_,_) -> l) (stRefs st)))
- [1..(10000 :: Integer)] of
- Just x -> [Str (show x)]
- Nothing -> error "no unique label"
- Nothing -> label
+ label' <- case find (\(l,_,_) -> l == label) (stRefs st) of
+ Just _ -> -- label is used; generate numerical label
+ case find (\n -> notElem [Str (show n)]
+ (map (\(l,_,_) -> l) (stRefs st)))
+ [1..(10000 :: Integer)] of
+ Just x -> return [Str (show x)]
+ Nothing -> throwError $ PandocSomeError "no unique label"
+ Nothing -> return label
modify (\s -> s{ stRefs = (label', target, attr) : stRefs st })
return label'
diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs
index ce415264d..4f832f962 100644
--- a/src/Text/Pandoc/Writers/OPML.hs
+++ b/src/Text/Pandoc/Writers/OPML.hs
@@ -40,7 +40,8 @@ import Text.Pandoc.Writers.Markdown (writeMarkdown)
import Text.Pandoc.Pretty
import Text.Pandoc.Compat.Time
import qualified Text.Pandoc.Builder as B
-import Text.Pandoc.Class (PandocMonad)
+import Control.Monad.Except (throwError)
+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))
-- | Convert Pandoc document to string in OPML format.
writeOPML :: PandocMonad m => WriterOptions -> Pandoc -> m String
@@ -82,15 +83,20 @@ convertDate ils = maybe "" showDateTimeRFC822 $
elementToOPML :: PandocMonad m => WriterOptions -> Element -> m Doc
elementToOPML _ (Blk _) = return empty
elementToOPML opts (Sec _ _num _ title elements) = do
- let isBlk (Blk _) = True
+ let isBlk :: Element -> Bool
+ isBlk (Blk _) = True
isBlk _ = False
- fromBlk (Blk x) = x
- fromBlk _ = error "fromBlk called on non-block"
+
+ fromBlk :: PandocMonad m => Element -> m Block
+ fromBlk (Blk x) = return x
+ fromBlk _ = throwError $ PandocSomeError "fromBlk called on non-block"
+
(blocks, rest) = span isBlk elements
htmlIls <- writeHtmlInlines title
md <- if null blocks
then return []
- else writeMarkdown def $ Pandoc nullMeta $ map fromBlk blocks
+ else do blks <- mapM fromBlk blocks
+ writeMarkdown def $ Pandoc nullMeta blks
let attrs = [("text", htmlIls)] ++ [("_note", md)]
o <- mapM (elementToOPML opts) rest
return $ inTags True "outline" attrs $ vcat o
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index 75b97a648..1ac906756 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -43,7 +43,8 @@ import qualified Data.ByteString as B
import qualified Data.Map as M
import Text.Printf ( printf )
import Text.Pandoc.ImageSize
-import Text.Pandoc.Class (PandocMonad)
+import Control.Monad.Except (throwError)
+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))
import qualified Text.Pandoc.Class as P
-- | Convert Image inlines into a raw RTF embedded image, read from a file,
@@ -56,10 +57,10 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do
Right (imgdata, Just mime)
| mime == "image/jpeg" || mime == "image/png" -> do
let bytes = map (printf "%02x") $ B.unpack imgdata
- let filetype = case mime of
- "image/jpeg" -> "\\jpegblip"
- "image/png" -> "\\pngblip"
- _ -> error "Unknown file type"
+ filetype <- case mime of
+ "image/jpeg" -> return "\\jpegblip"
+ "image/png" -> return "\\pngblip"
+ _ -> throwError $ PandocSomeError "Unknown file type"
sizeSpec <- case imageSize imgdata of
Left msg -> do
P.warn $ "Could not determine image size in `" ++
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
index fac7f02ab..dd5d5ee5d 100644
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/src/Text/Pandoc/Writers/Texinfo.hs
@@ -44,7 +44,8 @@ import Text.Pandoc.ImageSize
import Network.URI ( isURI, unEscapeString )
import System.FilePath
import qualified Data.Set as Set
-import Text.Pandoc.Class ( PandocMonad )
+import Control.Monad.Except (throwError)
+import Text.Pandoc.Class ( PandocMonad, PandocExecutionError(..) )
data WriterState =
WriterState { stStrikeout :: Bool -- document contains strikeout
@@ -60,10 +61,12 @@ data WriterState =
- generated .texi files don't work when run through texi2dvi
-}
+type TI m = StateT WriterState m
+
-- | Convert Pandoc to Texinfo.
writeTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> m String
-writeTexinfo options document = return $
- evalState (pandocToTexinfo options $ wrapTop document) $
+writeTexinfo options document =
+ evalStateT (pandocToTexinfo options $ wrapTop document) $
WriterState { stStrikeout = False, stSuperscript = False,
stEscapeComma = False, stSubscript = False,
stIdentifiers = Set.empty, stOptions = options}
@@ -73,7 +76,7 @@ wrapTop :: Pandoc -> Pandoc
wrapTop (Pandoc meta blocks) =
Pandoc meta (Header 0 nullAttr (docTitle meta) : blocks)
-pandocToTexinfo :: WriterOptions -> Pandoc -> State WriterState String
+pandocToTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> TI m String
pandocToTexinfo options (Pandoc meta blocks) = do
let titlePage = not $ all null
$ docTitle meta : docDate meta : docAuthors meta
@@ -111,7 +114,7 @@ stringToTexinfo = escapeStringUsing texinfoEscapes
, ('\x2019', "'")
]
-escapeCommas :: State WriterState Doc -> State WriterState Doc
+escapeCommas :: PandocMonad m => TI m Doc -> TI m Doc
escapeCommas parser = do
oldEscapeComma <- gets stEscapeComma
modify $ \st -> st{ stEscapeComma = True }
@@ -124,8 +127,9 @@ inCmd :: String -> Doc -> Doc
inCmd cmd contents = char '@' <> text cmd <> braces contents
-- | Convert Pandoc block element to Texinfo.
-blockToTexinfo :: Block -- ^ Block to convert
- -> State WriterState Doc
+blockToTexinfo :: PandocMonad m
+ => Block -- ^ Block to convert
+ -> TI m Doc
blockToTexinfo Null = return empty
@@ -221,17 +225,19 @@ blockToTexinfo (Header level _ lst) = do
idsUsed <- gets stIdentifiers
let id' = uniqueIdent lst idsUsed
modify $ \st -> st{ stIdentifiers = Set.insert id' idsUsed }
+ sec <- seccmd level
return $ if (level > 0) && (level <= 4)
then blankline <> text "@node " <> node $$
- text (seccmd level) <> txt $$
+ text sec <> txt $$
text "@anchor" <> braces (text $ '#':id')
else txt
where
- seccmd 1 = "@chapter "
- seccmd 2 = "@section "
- seccmd 3 = "@subsection "
- seccmd 4 = "@subsubsection "
- seccmd _ = error "illegal seccmd level"
+ seccmd :: PandocMonad m => Int -> TI m String
+ seccmd 1 = return "@chapter "
+ seccmd 2 = return "@section "
+ seccmd 3 = return "@subsection "
+ seccmd 4 = return "@subsubsection "
+ seccmd _ = throwError $ PandocSomeError "illegal seccmd level"
blockToTexinfo (Table caption aligns widths heads rows) = do
headers <- if all null heads
@@ -257,28 +263,32 @@ blockToTexinfo (Table caption aligns widths heads rows) = do
inCmd "caption" captionText $$
text "@end float"
-tableHeadToTexinfo :: [Alignment]
+tableHeadToTexinfo :: PandocMonad m
+ => [Alignment]
-> [[Block]]
- -> State WriterState Doc
+ -> TI m Doc
tableHeadToTexinfo = tableAnyRowToTexinfo "@headitem "
-tableRowToTexinfo :: [Alignment]
+tableRowToTexinfo :: PandocMonad m
+ => [Alignment]
-> [[Block]]
- -> State WriterState Doc
+ -> TI m Doc
tableRowToTexinfo = tableAnyRowToTexinfo "@item "
-tableAnyRowToTexinfo :: String
+tableAnyRowToTexinfo :: PandocMonad m
+ => String
-> [Alignment]
-> [[Block]]
- -> State WriterState Doc
+ -> TI m Doc
tableAnyRowToTexinfo itemtype aligns cols =
zipWithM alignedBlock aligns cols >>=
return . (text itemtype $$) . foldl (\row item -> row $$
(if isEmpty row then empty else text " @tab ") <> item) empty
-alignedBlock :: Alignment
+alignedBlock :: PandocMonad m
+ => Alignment
-> [Block]
- -> State WriterState Doc
+ -> TI m Doc
-- XXX @flushleft and @flushright text won't get word wrapped. Since word
-- wrapping is more important than alignment, we ignore the alignment.
alignedBlock _ = blockListToTexinfo
@@ -293,8 +303,9 @@ alignedBlock _ col = blockListToTexinfo col
-}
-- | Convert Pandoc block elements to Texinfo.
-blockListToTexinfo :: [Block]
- -> State WriterState Doc
+blockListToTexinfo :: PandocMonad m
+ => [Block]
+ -> TI m Doc
blockListToTexinfo [] = return empty
blockListToTexinfo (x:xs) = do
x' <- blockToTexinfo x
@@ -336,15 +347,17 @@ collectNodes level (x:xs) =
_ ->
collectNodes level xs
-makeMenuLine :: Block
- -> State WriterState Doc
+makeMenuLine :: PandocMonad m
+ => Block
+ -> TI m Doc
makeMenuLine (Header _ _ lst) = do
txt <- inlineListForNode lst
return $ text "* " <> txt <> text "::"
-makeMenuLine _ = error "makeMenuLine called with non-Header block"
+makeMenuLine _ = throwError $ PandocSomeError "makeMenuLine called with non-Header block"
-listItemToTexinfo :: [Block]
- -> State WriterState Doc
+listItemToTexinfo :: PandocMonad m
+ => [Block]
+ -> TI m Doc
listItemToTexinfo lst = do
contents <- blockListToTexinfo lst
let spacer = case reverse lst of
@@ -352,8 +365,9 @@ listItemToTexinfo lst = do
_ -> empty
return $ text "@item" $$ contents <> spacer
-defListItemToTexinfo :: ([Inline], [[Block]])
- -> State WriterState Doc
+defListItemToTexinfo :: PandocMonad m
+ => ([Inline], [[Block]])
+ -> TI m Doc
defListItemToTexinfo (term, defs) = do
term' <- inlineListToTexinfo term
let defToTexinfo bs = do d <- blockListToTexinfo bs
@@ -364,13 +378,15 @@ defListItemToTexinfo (term, defs) = do
return $ text "@item " <> term' $+$ vcat defs'
-- | Convert list of inline elements to Texinfo.
-inlineListToTexinfo :: [Inline] -- ^ Inlines to convert
- -> State WriterState Doc
+inlineListToTexinfo :: PandocMonad m
+ => [Inline] -- ^ Inlines to convert
+ -> TI m Doc
inlineListToTexinfo lst = mapM inlineToTexinfo lst >>= return . hcat
-- | Convert list of inline elements to Texinfo acceptable for a node name.
-inlineListForNode :: [Inline] -- ^ Inlines to convert
- -> State WriterState Doc
+inlineListForNode :: PandocMonad m
+ => [Inline] -- ^ Inlines to convert
+ -> TI m Doc
inlineListForNode = return . text . stringToTexinfo .
filter (not . disallowedInNode) . stringify
@@ -379,8 +395,9 @@ disallowedInNode :: Char -> Bool
disallowedInNode c = c `elem` (".,:()" :: String)
-- | Convert inline element to Texinfo
-inlineToTexinfo :: Inline -- ^ Inline to convert
- -> State WriterState Doc
+inlineToTexinfo :: PandocMonad m
+ => Inline -- ^ Inline to convert
+ -> TI m Doc
inlineToTexinfo (Span _ lst) =
inlineListToTexinfo lst