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

Implement Errors in PandocMonad

Browse source 
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.
This commit is contained in:
Jesse Rosenthal 2016-11-26 23:43:54 -05:00 • committed by John MacFarlane
parent 04487779b2
commit 23c5b0d0f1
9 changed files with 179 additions and 134 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
src/Text/Pandoc/Class.hs
View file

@ -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

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

@ -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")

5
src/Text/Pandoc/Writers/FB2.hs
View file

@ -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 '—'))

70
src/Text/Pandoc/Writers/HTML.hs
View file

@ -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 &amp; 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.

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

@ -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

19
src/Text/Pandoc/Writers/Markdown.hs
View file

@ -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'

16
src/Text/Pandoc/Writers/OPML.hs
View file

@ -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

11
src/Text/Pandoc/Writers/RTF.hs
View file

@ -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 `" ++

89
src/Text/Pandoc/Writers/Texinfo.hs
View file

@ -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