diff options
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/Readers/Docx.hs | 9 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/EPUB.hs | 6 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Odt.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 5 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 13 |
5 files changed, 23 insertions, 14 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 604bc20de..9c7c3b264 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -100,12 +100,13 @@ import Text.Pandoc.Compat.Except readDocxWithWarnings :: ReaderOptions -> B.ByteString -> Either PandocError (Pandoc, MediaBag, [String]) -readDocxWithWarnings opts bytes = - case archiveToDocxWithWarnings (toArchive bytes) of - Right (docx, warnings) -> do +readDocxWithWarnings opts bytes + | Right archive <- toArchiveOrFail bytes + , Right (docx, warnings) <- archiveToDocxWithWarnings archive = do (meta, blks, mediaBag) <- docxToOutput opts docx return (Pandoc meta blks, mediaBag, warnings) - Left _ -> Left (ParseFailure "couldn't parse docx file") +readDocxWithWarnings _ _ = + Left (ParseFailure "couldn't parse docx file") readDocx :: ReaderOptions -> B.ByteString diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs index 07d282708..144ba9ca2 100644 --- a/src/Text/Pandoc/Readers/EPUB.hs +++ b/src/Text/Pandoc/Readers/EPUB.hs @@ -19,7 +19,7 @@ import Text.Pandoc.Compat.Except (MonadError, throwError, runExcept, Except) import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.MIME (MimeType) import qualified Text.Pandoc.Builder as B -import Codec.Archive.Zip ( Archive (..), toArchive, fromEntry +import Codec.Archive.Zip ( Archive (..), toArchiveOrFail, fromEntry , findEntryByPath, Entry) import qualified Data.ByteString.Lazy as BL (ByteString) import System.FilePath ( takeFileName, (</>), dropFileName, normalise @@ -39,7 +39,9 @@ import Text.Pandoc.Error type Items = M.Map String (FilePath, MimeType) readEPUB :: ReaderOptions -> BL.ByteString -> Either PandocError (Pandoc, MediaBag) -readEPUB opts bytes = runEPUB (archiveToEPUB opts $ toArchive bytes) +readEPUB opts bytes = case toArchiveOrFail bytes of + Right archive -> runEPUB $ archiveToEPUB opts $ archive + Left _ -> Left $ ParseFailure "Couldn't extract ePub file" runEPUB :: Except PandocError a -> Either PandocError a runEPUB = runExcept diff --git a/src/Text/Pandoc/Readers/Odt.hs b/src/Text/Pandoc/Readers/Odt.hs index a925c1d84..68e89263c 100644 --- a/src/Text/Pandoc/Readers/Odt.hs +++ b/src/Text/Pandoc/Readers/Odt.hs @@ -59,7 +59,9 @@ readOdt _ bytes = case bytesToOdt bytes of -- bytesToOdt :: B.ByteString -> Either PandocError Pandoc -bytesToOdt bytes = archiveToOdt $ toArchive bytes +bytesToOdt bytes = case toArchiveOrFail bytes of + Right archive -> archiveToOdt archive + Left _ -> Left $ ParseFailure "Couldn't parse odt file." -- archiveToOdt :: Archive -> Either PandocError Pandoc diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index c5b6a6db2..d8b8384e7 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -855,13 +855,12 @@ inlineToHtml opts inline = (Note contents) | writerIgnoreNotes opts -> return mempty | otherwise -> do - st <- get - let notes = stNotes st + notes <- gets stNotes let number = (length notes) + 1 let ref = show number htmlContents <- blockListToNote opts ref contents -- push contents onto front of notes - put $ st {stNotes = (htmlContents:notes)} + modify $ \st -> st {stNotes = (htmlContents:notes)} let revealSlash = ['/' | writerSlideVariant opts == RevealJsSlides] let link = H.a ! A.href (toValue $ "#" ++ diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 038f27480..283c8bc44 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -40,7 +40,8 @@ import Text.Printf ( printf ) import Network.URI ( isURI, unEscapeString ) import Data.Aeson (object, (.=), FromJSON) import Data.List ( (\\), isInfixOf, stripPrefix, intercalate, intersperse, nub, nubBy ) -import Data.Char ( toLower, isPunctuation, isAscii, isLetter, isDigit, ord ) +import Data.Char ( toLower, isPunctuation, isAscii, isLetter, isDigit, + ord, isAlphaNum ) import Data.Maybe ( fromMaybe, isJust, catMaybes ) import qualified Data.Text as T import Control.Applicative ((<|>)) @@ -471,23 +472,27 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do st <- get let params = if writerListings (stOptions st) then (case getListingsLanguage classes of - Just l -> [ "language=" ++ l ] + Just l -> [ "language=" ++ mbBraced l ] Nothing -> []) ++ [ "numbers=left" | "numberLines" `elem` classes || "number" `elem` classes || "number-lines" `elem` classes ] ++ [ (if key == "startFrom" then "firstnumber" - else key) ++ "=" ++ attr | + else key) ++ "=" ++ mbBraced attr | (key,attr) <- keyvalAttr ] ++ (if identifier == "" then [] else [ "label=" ++ ref ]) else [] + mbBraced x = if not (all isAlphaNum x) + then "{" <> x <> "}" + else x printParams | null params = empty - | otherwise = brackets $ hcat (intersperse ", " (map text params)) + | otherwise = brackets $ hcat (intersperse ", " + (map text params)) return $ flush ("\\begin{lstlisting}" <> printParams $$ text str $$ "\\end{lstlisting}") $$ cr let highlightedCodeBlock = |