diff options
Diffstat (limited to 'src/Text/Pandoc/Readers')
50 files changed, 1287 insertions, 525 deletions
diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs index 6fbc09c17..79a4abbc2 100644 --- a/src/Text/Pandoc/Readers/CommonMark.hs +++ b/src/Text/Pandoc/Readers/CommonMark.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2015-2018 John MacFarlane <jgm@berkeley.edu> @@ -32,6 +33,7 @@ CommonMark is a strongly specified variant of Markdown: http://commonmark.org. module Text.Pandoc.Readers.CommonMark (readCommonMark) where +import Prelude import CMarkGFM import Control.Monad.State import Data.Char (isAlphaNum, isLetter, isSpace, toLower) diff --git a/src/Text/Pandoc/Readers/Creole.hs b/src/Text/Pandoc/Readers/Creole.hs index 505d1686d..4fd38c0fd 100644 --- a/src/Text/Pandoc/Readers/Creole.hs +++ b/src/Text/Pandoc/Readers/Creole.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2017 Sascha Wilde <wilde@sha-bang.de> @@ -35,10 +36,10 @@ Conversion of creole text to 'Pandoc' document. module Text.Pandoc.Readers.Creole ( readCreole ) where +import Prelude import Control.Monad.Except (guard, liftM2, throwError) import qualified Data.Foldable as F import Data.Maybe (fromMaybe) -import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import qualified Text.Pandoc.Builder as B @@ -67,7 +68,7 @@ type CRLParser = ParserT [Char] ParserState -- Utility functions -- -(<+>) :: (Monad m, Monoid a) => m a -> m a -> m a +(<+>) :: (Monad m, Semigroup a) => m a -> m a -> m a (<+>) = liftM2 (<>) -- we have to redefine `enclosed' from Text.Pandoc.Parsing, because it diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index 728f77a05..3d48c7ee8 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -1,5 +1,35 @@ -{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE NoImplicitPrelude #-} +{- +Copyright (C) 2006-2018 John MacFarlane <jgm@berkeley.edu> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Readers.DocBook + Copyright : Copyright (C) 2006-2018 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley.edu> + Stability : alpha + Portability : portable + +Conversion of DocBook XML to 'Pandoc' document. +-} module Text.Pandoc.Readers.DocBook ( readDocBook ) where +import Prelude import Control.Monad.State.Strict import Data.Char (isSpace, toUpper) import Data.Default @@ -235,7 +265,7 @@ List of all DocBook tags, with [x] indicating implemented, [ ] manvolnum - A reference volume number [x] markup - A string of formatting markup in text that is to be represented literally -[ ] mathphrase - A mathematical phrase, an expression that can be represented +[x] mathphrase - A mathematical phrase, an expression that can be represented with ordinary text and a small amount of markup [ ] medialabel - A name that identifies the physical medium on which some information resides @@ -697,6 +727,8 @@ parseBlock (Elem e) = "bibliodiv" -> sect 1 "biblioentry" -> parseMixed para (elContent e) "bibliomixed" -> parseMixed para (elContent e) + "equation" -> para <$> equation e displayMath + "informalequation" -> para <$> equation e displayMath "glosssee" -> para . (\ils -> text "See " <> ils <> str ".") <$> getInlines e "glossseealso" -> para . (\ils -> text "See also " <> ils <> str ".") @@ -923,9 +955,9 @@ parseInline (CRef ref) = return $ maybe (text $ map toUpper ref) text $ lookupEntity ref parseInline (Elem e) = case qName (elName e) of - "equation" -> equation displayMath - "informalequation" -> equation displayMath - "inlineequation" -> equation math + "equation" -> equation e displayMath + "informalequation" -> equation e displayMath + "inlineequation" -> equation e math "subscript" -> subscript <$> innerInlines "superscript" -> superscript <$> innerInlines "inlinemediaobject" -> getMediaobject e @@ -1004,13 +1036,6 @@ parseInline (Elem e) = _ -> innerInlines where innerInlines = (trimInlines . mconcat) <$> mapM parseInline (elContent e) - equation constructor = return $ mconcat $ - map (constructor . writeTeX) - $ rights - $ map (readMathML . showElement . everywhere (mkT removePrefix)) - $ filterChildren (\x -> qName (elName x) == "math" && - qPrefix (elName x) == Just "mml") e - removePrefix elname = elname { qPrefix = Nothing } codeWithLang = do let classes' = case attrValue "language" e of "" -> [] @@ -1048,6 +1073,7 @@ parseInline (Elem e) = | not (null xrefLabel) = xrefLabel | otherwise = case qName (elName el) of "chapter" -> descendantContent "title" el + "section" -> descendantContent "title" el "sect1" -> descendantContent "title" el "sect2" -> descendantContent "title" el "sect3" -> descendantContent "title" el @@ -1060,3 +1086,45 @@ parseInline (Elem e) = xrefLabel = attrValue "xreflabel" el descendantContent name = maybe "???" strContent . filterElementName (\n -> qName n == name) + +-- | Extract a math equation from an element +-- +-- asciidoc can generate Latex math in CDATA sections. +-- +-- Note that if some MathML can't be parsed it is silently ignored! +equation + :: Monad m + => Element + -- ^ The element from which to extract a mathematical equation + -> (String -> Inlines) + -- ^ A constructor for some Inlines, taking the TeX code as input + -> m Inlines +equation e constructor = + return $ mconcat $ map constructor $ mathMLEquations ++ latexEquations + where + mathMLEquations :: [String] + mathMLEquations = map writeTeX $ rights $ readMath + (\x -> qName (elName x) == "math" && qPrefix (elName x) == Just "mml") + (readMathML . showElement) + + latexEquations :: [String] + latexEquations = readMath (\x -> qName (elName x) == "mathphrase") + (concat . fmap showVerbatimCData . elContent) + + readMath :: (Element -> Bool) -> (Element -> b) -> [b] + readMath childPredicate fromElement = + ( map (fromElement . everywhere (mkT removePrefix)) + $ filterChildren childPredicate e + ) + +-- | Get the actual text stored in a verbatim CData block. 'showContent' +-- returns the text still surrounded by the [[CDATA]] tags. +-- +-- Returns 'showContent' if this is not a verbatim CData +showVerbatimCData :: Content -> String +showVerbatimCData (Text (CData CDataVerbatim d _)) = d +showVerbatimCData c = showContent c + +-- | Set the prefix of a name to 'Nothing' +removePrefix :: QName -> QName +removePrefix elname = elname { qPrefix = Nothing } diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 5f2ca0fff..ca9f8c8dd 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} @@ -74,6 +75,7 @@ module Text.Pandoc.Readers.Docx ( readDocx ) where +import Prelude import Codec.Archive.Zip import Control.Monad.Reader import Control.Monad.State.Strict @@ -122,7 +124,6 @@ data DState = DState { docxAnchorMap :: M.Map String String , docxImmedPrevAnchor :: Maybe String , docxMediaBag :: MediaBag , docxDropCap :: Inlines - , docxWarnings :: [String] -- keep track of (numId, lvl) values for -- restarting , docxListState :: M.Map (String, String) Integer @@ -135,18 +136,16 @@ instance Default DState where , docxImmedPrevAnchor = Nothing , docxMediaBag = mempty , docxDropCap = mempty - , docxWarnings = [] , docxListState = M.empty , docxPrevPara = mempty } data DEnv = DEnv { docxOptions :: ReaderOptions , docxInHeaderBlock :: Bool - , docxCustomStyleAlready :: Bool } instance Default DEnv where - def = DEnv def False False + def = DEnv def False type DocxContext m = ReaderT DEnv (StateT DState m) @@ -252,103 +251,88 @@ parPartToString _ = "" blacklistedCharStyles :: [String] blacklistedCharStyles = ["Hyperlink"] -resolveDependentRunStyle :: RunStyle -> RunStyle +resolveDependentRunStyle :: PandocMonad m => RunStyle -> DocxContext m RunStyle resolveDependentRunStyle rPr | Just (s, _) <- rStyle rPr, s `elem` blacklistedCharStyles = - rPr - | Just (_, cs) <- rStyle rPr = - let rPr' = resolveDependentRunStyle cs - in - RunStyle { isBold = case isBold rPr of - Just bool -> Just bool - Nothing -> isBold rPr' - , isItalic = case isItalic rPr of - Just bool -> Just bool - Nothing -> isItalic rPr' - , isSmallCaps = case isSmallCaps rPr of - Just bool -> Just bool - Nothing -> isSmallCaps rPr' - , isStrike = case isStrike rPr of - Just bool -> Just bool - Nothing -> isStrike rPr' - , rVertAlign = case rVertAlign rPr of - Just valign -> Just valign - Nothing -> rVertAlign rPr' - , rUnderline = case rUnderline rPr of - Just ulstyle -> Just ulstyle - Nothing -> rUnderline rPr' - , rStyle = rStyle rPr } - | otherwise = rPr - -extraRunStyleInfo :: PandocMonad m => RunStyle -> DocxContext m (Inlines -> Inlines) -extraRunStyleInfo rPr - | Just (s, _) <- rStyle rPr = do - already <- asks docxCustomStyleAlready + return rPr + | Just (_, cs) <- rStyle rPr = do opts <- asks docxOptions - return $ if isEnabled Ext_styles opts && not already - then spanWith ("", [], [("custom-style", s)]) - else id - | otherwise = return id + if isEnabled Ext_styles opts + then return rPr + else do rPr' <- resolveDependentRunStyle cs + return $ + RunStyle { isBold = case isBold rPr of + Just bool -> Just bool + Nothing -> isBold rPr' + , isItalic = case isItalic rPr of + Just bool -> Just bool + Nothing -> isItalic rPr' + , isSmallCaps = case isSmallCaps rPr of + Just bool -> Just bool + Nothing -> isSmallCaps rPr' + , isStrike = case isStrike rPr of + Just bool -> Just bool + Nothing -> isStrike rPr' + , rVertAlign = case rVertAlign rPr of + Just valign -> Just valign + Nothing -> rVertAlign rPr' + , rUnderline = case rUnderline rPr of + Just ulstyle -> Just ulstyle + Nothing -> rUnderline rPr' + , rStyle = rStyle rPr } + | otherwise = return rPr runStyleToTransform :: PandocMonad m => RunStyle -> DocxContext m (Inlines -> Inlines) runStyleToTransform rPr | Just (s, _) <- rStyle rPr , s `elem` spansToKeep = do - let rPr' = rPr{rStyle = Nothing} - transform <- runStyleToTransform rPr' + transform <- runStyleToTransform rPr{rStyle = Nothing} return $ spanWith ("", [s], []) . transform + | Just (s, _) <- rStyle rPr = do + opts <- asks docxOptions + let extraInfo = if isEnabled Ext_styles opts + then spanWith ("", [], [("custom-style", s)]) + else id + transform <- runStyleToTransform rPr{rStyle = Nothing} + return $ extraInfo . transform | Just True <- isItalic rPr = do - extraInfo <- extraRunStyleInfo rPr - transform <- local (\e -> e{docxCustomStyleAlready = True}) $ - runStyleToTransform rPr {isItalic = Nothing} - return $ extraInfo . emph . transform + transform <- runStyleToTransform rPr{isItalic = Nothing} + return $ emph . transform | Just True <- isBold rPr = do - extraInfo <- extraRunStyleInfo rPr - transform <- local (\e -> e{docxCustomStyleAlready = True}) $ - runStyleToTransform rPr {isBold = Nothing} - return $ extraInfo . strong . transform + transform <- runStyleToTransform rPr{isBold = Nothing} + return $ strong . transform | Just True <- isSmallCaps rPr = do - extraInfo <- extraRunStyleInfo rPr - transform <- local (\e -> e{docxCustomStyleAlready = True}) $ - runStyleToTransform rPr {isSmallCaps = Nothing} - return $ extraInfo . smallcaps . transform + transform <- runStyleToTransform rPr{isSmallCaps = Nothing} + return $ smallcaps . transform | Just True <- isStrike rPr = do - extraInfo <- extraRunStyleInfo rPr - transform <- local (\e -> e{docxCustomStyleAlready = True}) $ - runStyleToTransform rPr {isStrike = Nothing} - return $ extraInfo . strikeout . transform + transform <- runStyleToTransform rPr{isStrike = Nothing} + return $ strikeout . transform | Just SupScrpt <- rVertAlign rPr = do - extraInfo <- extraRunStyleInfo rPr - transform <- local (\e -> e{docxCustomStyleAlready = True}) $ - runStyleToTransform rPr {rVertAlign = Nothing} - return $ extraInfo . superscript . transform + transform <- runStyleToTransform rPr{rVertAlign = Nothing} + return $ superscript . transform | Just SubScrpt <- rVertAlign rPr = do - extraInfo <- extraRunStyleInfo rPr - transform <- local (\e -> e{docxCustomStyleAlready = True}) $ - runStyleToTransform rPr {rVertAlign = Nothing} - return $ extraInfo . subscript . transform + transform <- runStyleToTransform rPr{rVertAlign = Nothing} + return $ subscript . transform | Just "single" <- rUnderline rPr = do - extraInfo <- extraRunStyleInfo rPr - transform <- local (\e -> e{docxCustomStyleAlready = True}) $ - runStyleToTransform rPr {rUnderline = Nothing} - return $ extraInfo . underlineSpan . transform - | otherwise = extraRunStyleInfo rPr + transform <- runStyleToTransform rPr{rUnderline = Nothing} + return $ underlineSpan . transform + | otherwise = return id runToInlines :: PandocMonad m => Run -> DocxContext m Inlines runToInlines (Run rs runElems) | Just (s, _) <- rStyle rs - , s `elem` codeStyles = - let rPr = resolveDependentRunStyle rs - codeString = code $ concatMap runElemToString runElems - in - return $ case rVertAlign rPr of - Just SupScrpt -> superscript codeString - Just SubScrpt -> subscript codeString - _ -> codeString + , s `elem` codeStyles = do + rPr <- resolveDependentRunStyle rs + let codeString = code $ concatMap runElemToString runElems + return $ case rVertAlign rPr of + Just SupScrpt -> superscript codeString + Just SubScrpt -> subscript codeString + _ -> codeString | otherwise = do - let ils = smushInlines (map runElemToInlines runElems) - transform <- runStyleToTransform $ resolveDependentRunStyle rs - return $ transform ils + rPr <- resolveDependentRunStyle rs + let ils = smushInlines (map runElemToInlines runElems) + transform <- runStyleToTransform rPr + return $ transform ils runToInlines (Footnote bps) = do blksList <- smushBlocks <$> mapM bodyPartToBlocks bps return $ note blksList @@ -385,7 +369,7 @@ blocksToInlinesWarn cmtId blks = do parPartToInlines :: PandocMonad m => ParPart -> DocxContext m Inlines parPartToInlines parPart = case parPart of - (BookMark _ anchor) | notElem anchor dummyAnchors -> do + (BookMark _ anchor) | anchor `notElem` dummyAnchors -> do inHdrBool <- asks docxInHeaderBlock ils <- parPartToInlines' parPart immedPrevAnchor <- gets docxImmedPrevAnchor @@ -478,8 +462,6 @@ parPartToInlines' (ExternalHyperLink target runs) = do return $ link target "" ils parPartToInlines' (PlainOMath exps) = return $ math $ writeTeX exps -parPartToInlines' (SmartTag runs) = - smushInlines <$> mapM runToInlines runs parPartToInlines' (Field info runs) = case info of HyperlinkField url -> parPartToInlines' $ ExternalHyperLink url runs @@ -706,6 +688,10 @@ bodyPartToBlocks (Tbl cap _ look parts@(r:rs)) = do rowLength :: Row -> Int rowLength (Row c) = length c + -- pad cells. New Text.Pandoc.Builder will do that for us, + -- so this is for compatibility while we switch over. + let cells' = map (\row -> take width (row ++ repeat mempty)) cells + hdrCells <- case hdr of Just r' -> rowToBlocksList r' Nothing -> return $ replicate width mempty @@ -718,7 +704,7 @@ bodyPartToBlocks (Tbl cap _ look parts@(r:rs)) = do let alignments = replicate width AlignDefault widths = replicate width 0 :: [Double] - return $ table caption (zip alignments widths) hdrCells cells + return $ table caption (zip alignments widths) hdrCells cells' bodyPartToBlocks (OMathPara e) = return $ para $ displayMath (writeTeX e) diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index 003265e6e..108c4bbe5 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -7,6 +8,7 @@ module Text.Pandoc.Readers.Docx.Combine ( smushInlines ) where +import Prelude import Data.List import Data.Sequence (ViewL (..), ViewR (..), viewl, viewr, (><), (|>)) import qualified Data.Sequence as Seq (null) @@ -133,6 +135,10 @@ combineBlocks bs cs | bs' :> BlockQuote bs'' <- viewr (unMany bs) , BlockQuote cs'' :< cs' <- viewl (unMany cs) = Many $ (bs' |> BlockQuote (bs'' <> cs'')) >< cs' + | bs' :> CodeBlock attr codeStr <- viewr (unMany bs) + , CodeBlock attr' codeStr' :< cs' <- viewl (unMany cs) + , attr == attr' = + Many $ (bs' |> CodeBlock attr (codeStr <> "\n" <> codeStr')) >< cs' combineBlocks bs cs = bs <> cs instance (Monoid a, Eq a) => Eq (Modifier a) where diff --git a/src/Text/Pandoc/Readers/Docx/Fields.hs b/src/Text/Pandoc/Readers/Docx/Fields.hs index 6eeb55d2f..c3f54560b 100644 --- a/src/Text/Pandoc/Readers/Docx/Fields.hs +++ b/src/Text/Pandoc/Readers/Docx/Fields.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2014-2018 Jesse Rosenthal <jrosenthal@jhu.edu> @@ -32,6 +33,7 @@ module Text.Pandoc.Readers.Docx.Fields ( FieldInfo(..) , parseFieldInfo ) where +import Prelude import Text.Parsec import Text.Parsec.String (Parser) diff --git a/src/Text/Pandoc/Readers/Docx/Lists.hs b/src/Text/Pandoc/Readers/Docx/Lists.hs index c0f05094a..49ea71601 100644 --- a/src/Text/Pandoc/Readers/Docx/Lists.hs +++ b/src/Text/Pandoc/Readers/Docx/Lists.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2014-2018 Jesse Rosenthal <jrosenthal@jhu.edu> @@ -33,6 +34,7 @@ module Text.Pandoc.Readers.Docx.Lists ( blocksToBullets , listParagraphDivs ) where +import Prelude import Data.List import Data.Maybe import Text.Pandoc.Generic (bottomUp) diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index c123a0018..4c4c06073 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ViewPatterns #-} @@ -58,6 +59,7 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..) , archiveToDocx , archiveToDocxWithWarnings ) where +import Prelude import Codec.Archive.Zip import Control.Applicative ((<|>)) import Control.Monad.Except @@ -132,21 +134,23 @@ mapD f xs = in concatMapM handler xs -unwrapSDT :: NameSpaces -> Content -> [Content] -unwrapSDT ns (Elem element) +unwrap :: NameSpaces -> Content -> [Content] +unwrap ns (Elem element) | isElem ns "w" "sdt" element , Just sdtContent <- findChildByName ns "w" "sdtContent" element - = map Elem $ elChildren sdtContent -unwrapSDT _ content = [content] + = concatMap ((unwrap ns) . Elem) (elChildren sdtContent) + | isElem ns "w" "smartTag" element + = concatMap ((unwrap ns) . Elem) (elChildren element) +unwrap _ content = [content] -unwrapSDTchild :: NameSpaces -> Content -> Content -unwrapSDTchild ns (Elem element) = - Elem $ element { elContent = concatMap (unwrapSDT ns) (elContent element) } -unwrapSDTchild _ content = content +unwrapChild :: NameSpaces -> Content -> Content +unwrapChild ns (Elem element) = + Elem $ element { elContent = concatMap (unwrap ns) (elContent element) } +unwrapChild _ content = content walkDocument' :: NameSpaces -> XMLC.Cursor -> XMLC.Cursor walkDocument' ns cur = - let modifiedCur = XMLC.modifyContent (unwrapSDTchild ns) cur + let modifiedCur = XMLC.modifyContent (unwrapChild ns) cur in case XMLC.nextDF modifiedCur of Just cur' -> walkDocument' ns cur' @@ -275,7 +279,6 @@ data ParPart = PlainRun Run | Drawing FilePath String String B.ByteString Extent -- title, alt | Chart -- placeholder for now | PlainOMath [Exp] - | SmartTag [Run] | Field FieldInfo [Run] | NullParPart -- when we need to return nothing, but -- not because of an error. @@ -826,10 +829,6 @@ elemToParPart ns element runs <- mapD (elemToRun ns) (elChildren element) return $ ChangedRuns change runs elemToParPart ns element - | isElem ns "w" "smartTag" element = do - runs <- mapD (elemToRun ns) (elChildren element) - return $ SmartTag runs -elemToParPart ns element | isElem ns "w" "bookmarkStart" element , Just bmId <- findAttrByName ns "w" "id" element , Just bmName <- findAttrByName ns "w" "name" element = diff --git a/src/Text/Pandoc/Readers/Docx/StyleMap.hs b/src/Text/Pandoc/Readers/Docx/StyleMap.hs index b32a73770..6ccda3ccc 100644 --- a/src/Text/Pandoc/Readers/Docx/StyleMap.hs +++ b/src/Text/Pandoc/Readers/Docx/StyleMap.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} module Text.Pandoc.Readers.Docx.StyleMap ( StyleMaps(..) , alterMap , getMap @@ -7,6 +8,7 @@ module Text.Pandoc.Readers.Docx.StyleMap ( StyleMaps(..) , hasStyleName ) where +import Prelude import Control.Monad.State.Strict import Data.Char (toLower) import qualified Data.Map as M diff --git a/src/Text/Pandoc/Readers/Docx/Util.hs b/src/Text/Pandoc/Readers/Docx/Util.hs index d9d65bc07..088950d26 100644 --- a/src/Text/Pandoc/Readers/Docx/Util.hs +++ b/src/Text/Pandoc/Readers/Docx/Util.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} module Text.Pandoc.Readers.Docx.Util ( NameSpaces , elemName @@ -8,6 +9,7 @@ module Text.Pandoc.Readers.Docx.Util ( , findAttrByName ) where +import Prelude import Data.Maybe (mapMaybe) import Text.XML.Light diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs index 3b13bbe13..c26447641 100644 --- a/src/Text/Pandoc/Readers/EPUB.hs +++ b/src/Text/Pandoc/Readers/EPUB.hs @@ -1,12 +1,41 @@ -{-# LANGUAGE FlexibleContexts #-} - -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +{- +Copyright (C) 2014-2018 Matthew Pickering + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Readers.EPUB + Copyright : Copyright (C) 2014-2018 Matthew Pickering + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley.edu> + Stability : alpha + Portability : portable + +Conversion of EPUB to 'Pandoc' document. +-} module Text.Pandoc.Readers.EPUB (readEPUB) where +import Prelude import Codec.Archive.Zip (Archive (..), Entry, findEntryByPath, fromEntry, toArchiveOrFail) import Control.DeepSeq (NFData, deepseq) @@ -16,7 +45,6 @@ import qualified Data.ByteString.Lazy as BL (ByteString) import Data.List (isInfixOf, isPrefixOf) import qualified Data.Map as M (Map, elems, fromList, lookup) import Data.Maybe (fromMaybe, mapMaybe) -import Data.Monoid ((<>)) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import Network.URI (unEscapeString) @@ -93,7 +121,7 @@ fetchImages mimes root arc (query iq -> links) = mapM_ (uncurry3 insertMedia) (mapMaybe getEntry links) where getEntry link = - let abslink = normalise (root </> link) in + let abslink = normalise (unEscapeString (root </> link)) in (link , lookup link mimes, ) . fromEntry <$> findEntryByPath abslink arc @@ -264,7 +292,7 @@ findAttrE :: PandocMonad m => QName -> Element -> m String findAttrE q e = mkE "findAttr" $ findAttr q e findEntryByPathE :: PandocMonad m => FilePath -> Archive -> m Entry -findEntryByPathE (normalise -> path) a = +findEntryByPathE (normalise . unEscapeString -> path) a = mkE ("No entry on path: " ++ path) $ findEntryByPath path a parseXMLDocE :: PandocMonad m => String -> m Element diff --git a/src/Text/Pandoc/Readers/FB2.hs b/src/Text/Pandoc/Readers/FB2.hs new file mode 100644 index 000000000..577fc85b6 --- /dev/null +++ b/src/Text/Pandoc/Readers/FB2.hs @@ -0,0 +1,404 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TupleSections #-} +{- +Copyright (C) 2018 Alexander Krotov <ilabdsf@gmail.com> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Readers.FB2 + Copyright : Copyright (C) 2018 Alexander Krotov + License : GNU GPL, version 2 or above + + Maintainer : Alexander Krotov <ilabdsf@gmail.com> + Stability : alpha + Portability : portable + +Conversion of FB2 to 'Pandoc' document. +-} + +{- + +TODO: + - Tables + - Named styles + - Parse ID attribute for all elements that have it + +-} + +module Text.Pandoc.Readers.FB2 ( readFB2 ) where +import Prelude +import Control.Monad.Except (throwError) +import Control.Monad.State.Strict +import Data.ByteString.Lazy.Char8 ( pack ) +import Data.ByteString.Base64.Lazy +import Data.Char (isSpace, toUpper) +import Data.Functor +import Data.List (dropWhileEnd, intersperse) +import Data.List.Split (splitOn) +import Data.Text (Text) +import Data.Default +import Data.Maybe +import Text.HTML.TagSoup.Entity (lookupEntity) +import Text.Pandoc.Builder +import Text.Pandoc.Class (PandocMonad, insertMedia, report) +import Text.Pandoc.Error +import Text.Pandoc.Logging +import Text.Pandoc.Options +import Text.Pandoc.Shared (crFilter) +import Text.XML.Light + +type FB2 m = StateT FB2State m + +data FB2State = FB2State{ fb2SectionLevel :: Int + , fb2Meta :: Meta + , fb2Authors :: [String] + } deriving Show + +instance Default FB2State where + def = FB2State{ fb2SectionLevel = 1 + , fb2Meta = mempty + , fb2Authors = [] + } + +instance HasMeta FB2State where + setMeta field v s = s {fb2Meta = setMeta field v (fb2Meta s)} + deleteMeta field s = s {fb2Meta = deleteMeta field (fb2Meta s)} + +readFB2 :: PandocMonad m => ReaderOptions -> Text -> m Pandoc +readFB2 _ inp = do + (bs, st) <- runStateT (mapM parseBlock $ parseXML (crFilter inp)) def + let authors = if null $ fb2Authors st + then id + else setMeta "author" (map text $ reverse $ fb2Authors st) + pure $ Pandoc (authors $ fb2Meta st) (toList . mconcat $ bs) + +-- * Utility functions + +trim :: String -> String +trim = dropWhileEnd isSpace . dropWhile isSpace + +removeHash :: String -> String +removeHash ('#':xs) = xs +removeHash xs = xs + +convertEntity :: String -> String +convertEntity e = fromMaybe (map toUpper e) (lookupEntity e) + +parseInline :: PandocMonad m => Content -> FB2 m Inlines +parseInline (Elem e) = + case qName $ elName e of + "strong" -> strong <$> parseStyleType e + "emphasis" -> emph <$> parseStyleType e + "style" -> parseNamedStyle e + "a" -> parseLinkType e + "strikethrough" -> strikeout <$> parseStyleType e + "sub" -> subscript <$> parseStyleType e + "sup" -> superscript <$> parseStyleType e + "code" -> pure $ code $ strContent e + "image" -> parseInlineImageElement e + name -> throwError $ PandocParseError ("Couldn't parse FB2 file: unexpected element " ++ name ++ ".") +parseInline (Text x) = pure $ text $ cdData x +parseInline (CRef r) = pure $ str $ convertEntity r + +parseSubtitle :: PandocMonad m => Element -> FB2 m Blocks +parseSubtitle e = headerWith ("", ["unnumbered"], []) <$> gets fb2SectionLevel <*> parsePType e + +-- * Root element parser + +parseBlock :: PandocMonad m => Content -> FB2 m Blocks +parseBlock (Elem e) = + case qName $ elName e of + "?xml" -> pure mempty + "FictionBook" -> mconcat <$> mapM parseFictionBookChild (elChildren e) + name -> report (UnexpectedXmlElement name "root") $> mempty +parseBlock _ = pure mempty + +-- | Parse a child of @\<FictionBook>@ element. +parseFictionBookChild :: PandocMonad m => Element -> FB2 m Blocks +parseFictionBookChild e = + case qName $ elName e of + "stylesheet" -> pure mempty -- stylesheet is ignored + "description" -> mempty <$ mapM_ parseDescriptionChild (elChildren e) + "body" -> mconcat <$> mapM parseBodyChild (elChildren e) + "binary" -> mempty <$ parseBinaryElement e + name -> report (UnexpectedXmlElement name "FictionBook") $> mempty + +-- | Parse a child of @\<description>@ element. +parseDescriptionChild :: PandocMonad m => Element -> FB2 m () +parseDescriptionChild e = + case qName $ elName e of + "title-info" -> mapM_ parseTitleInfoChild (elChildren e) + "src-title-info" -> pure () -- ignore + "document-info" -> pure () + "publish-info" -> pure () + "custom-info" -> pure () + "output" -> pure () + name -> throwError $ PandocParseError ("Couldn't parse FB2 file: unexpected element " ++ name ++ "in description.") + +-- | Parse a child of @\<body>@ element. +parseBodyChild :: PandocMonad m => Element -> FB2 m Blocks +parseBodyChild e = + case qName $ elName e of + "image" -> parseImageElement e + "title" -> header <$> gets fb2SectionLevel <*> parseTitleType (elContent e) + "epigraph" -> parseEpigraph e + "section" -> parseSection e + name -> throwError $ PandocParseError ("Couldn't parse FB2 file: unexpected element " ++ name ++ " in body.") + +-- | Parse a @\<binary>@ element. +parseBinaryElement :: PandocMonad m => Element -> FB2 m () +parseBinaryElement e = + case (findAttr (QName "id" Nothing Nothing) e, findAttr (QName "content-type" Nothing Nothing) e) of + (Nothing, _) -> throwError $ PandocParseError "<binary> element must have an \"id\" attribute" + (Just _, Nothing) -> throwError $ PandocParseError "<binary> element must have a \"content-type\" attribute" + (Just filename, contentType) -> insertMedia filename contentType (decodeLenient (pack (strContent e))) + +-- * Type parsers + +-- | Parse @authorType@ +parseAuthor :: PandocMonad m => Element -> FB2 m String +parseAuthor e = unwords <$> mapM parseAuthorChild (elChildren e) + +parseAuthorChild :: PandocMonad m => Element -> FB2 m String +parseAuthorChild e = + case qName $ elName e of + "first-name" -> pure $ strContent e + "middle-name" -> pure $ strContent e + "last-name" -> pure $ strContent e + "nickname" -> pure $ strContent e + "home-page" -> pure $ strContent e + "email" -> pure $ strContent e + name -> throwError $ PandocParseError ("Couldn't parse FB2 file: unexpected element " ++ name ++ " in author.") + +-- | Parse @titleType@ +parseTitle :: PandocMonad m => Element -> FB2 m Blocks +parseTitle e = header <$> gets fb2SectionLevel <*> parseTitleType (elContent e) + +parseTitleType :: PandocMonad m => [Content] -> FB2 m Inlines +parseTitleType c = mconcat . intersperse linebreak . catMaybes <$> mapM parseTitleContent c + +parseTitleContent :: PandocMonad m => Content -> FB2 m (Maybe Inlines) +parseTitleContent (Elem e) = + case qName $ elName e of + "p" -> Just <$> parsePType e + "empty-line" -> pure $ Just mempty + _ -> pure mempty +parseTitleContent _ = pure Nothing + +-- | Parse @imageType@ +parseImageElement :: PandocMonad m => Element -> FB2 m Blocks +parseImageElement e = + case href of + Just src -> pure $ para $ imageWith (imgId, [], []) (removeHash src) title alt + Nothing -> throwError $ PandocParseError "Couldn't parse FB2 file: image without href." + where alt = maybe mempty str $ findAttr (QName "alt" Nothing Nothing) e + title = fromMaybe "" $ findAttr (QName "title" Nothing Nothing) e + imgId = fromMaybe "" $ findAttr (QName "id" Nothing Nothing) e + href = findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e + +-- | Parse @pType@ +parsePType :: PandocMonad m => Element -> FB2 m Inlines +parsePType = parseStyleType -- TODO add support for optional "id" and "style" attributes + +-- | Parse @citeType@ +parseCite :: PandocMonad m => Element -> FB2 m Blocks +parseCite e = blockQuote . mconcat <$> mapM parseCiteChild (elChildren e) + +-- | Parse @citeType@ child +parseCiteChild :: PandocMonad m => Element -> FB2 m Blocks +parseCiteChild e = + case qName $ elName e of + "p" -> para <$> parsePType e + "poem" -> parsePoem e + "empty-line" -> pure horizontalRule + "subtitle" -> parseSubtitle e + "table" -> parseTable e + "text-author" -> para <$> parsePType e + name -> report (UnexpectedXmlElement name "cite") $> mempty + +-- | Parse @poemType@ +parsePoem :: PandocMonad m => Element -> FB2 m Blocks +parsePoem e = mconcat <$> mapM parsePoemChild (elChildren e) + +parsePoemChild :: PandocMonad m => Element -> FB2 m Blocks +parsePoemChild e = + case qName $ elName e of + "title" -> parseTitle e + "subtitle" -> parseSubtitle e + "epigraph" -> parseEpigraph e + "stanza" -> parseStanza e + "text-author" -> para <$> parsePType e + "date" -> pure $ para $ text $ strContent e + name -> report (UnexpectedXmlElement name "poem") $> mempty + +parseStanza :: PandocMonad m => Element -> FB2 m Blocks +parseStanza e = fromList . joinLineBlocks . toList . mconcat <$> mapM parseStanzaChild (elChildren e) + +joinLineBlocks :: [Block] -> [Block] +joinLineBlocks (LineBlock xs:LineBlock ys:zs) = joinLineBlocks (LineBlock (xs ++ ys) : zs) +joinLineBlocks (x:xs) = x:joinLineBlocks xs +joinLineBlocks [] = [] + +parseStanzaChild :: PandocMonad m => Element -> FB2 m Blocks +parseStanzaChild e = + case qName $ elName e of + "title" -> parseTitle e + "subtitle" -> parseSubtitle e + "v" -> lineBlock . (:[]) <$> parsePType e + name -> report (UnexpectedXmlElement name "stanza") $> mempty + +-- | Parse @epigraphType@ +parseEpigraph :: PandocMonad m => Element -> FB2 m Blocks +parseEpigraph e = + divWith (divId, ["epigraph"], []) . mconcat <$> mapM parseEpigraphChild (elChildren e) + where divId = fromMaybe "" $ findAttr (QName "id" Nothing Nothing) e + +parseEpigraphChild :: PandocMonad m => Element -> FB2 m Blocks +parseEpigraphChild e = + case qName $ elName e of + "p" -> para <$> parsePType e + "poem" -> parsePoem e + "cite" -> parseCite e + "empty-line" -> pure horizontalRule + "text-author" -> para <$> parsePType e + name -> report (UnexpectedXmlElement name "epigraph") $> mempty + +-- | Parse @annotationType@ +parseAnnotation :: PandocMonad m => Element -> FB2 m Blocks +parseAnnotation e = mconcat <$> mapM parseAnnotationChild (elChildren e) + +parseAnnotationChild :: PandocMonad m => Element -> FB2 m Blocks +parseAnnotationChild e = + case qName $ elName e of + "p" -> para <$> parsePType e + "poem" -> parsePoem e + "cite" -> parseCite e + "subtitle" -> parseSubtitle e + "table" -> parseTable e + "empty-line" -> pure horizontalRule + name -> report (UnexpectedXmlElement name "annotation") $> mempty + +-- | Parse @sectionType@ +parseSection :: PandocMonad m => Element -> FB2 m Blocks +parseSection e = do + n <- gets fb2SectionLevel + modify $ \st -> st{ fb2SectionLevel = n + 1 } + let sectionId = fromMaybe "" $ findAttr (QName "id" Nothing Nothing) e + bs <- divWith (sectionId, ["section"], []) . mconcat <$> mapM parseSectionChild (elChildren e) + modify $ \st -> st{ fb2SectionLevel = n } + pure bs + +parseSectionChild :: PandocMonad m => Element -> FB2 m Blocks +parseSectionChild e = + case qName $ elName e of + "title" -> parseBodyChild e + "epigraph" -> parseEpigraph e + "image" -> parseImageElement e + "annotation" -> parseAnnotation e + "poem" -> parsePoem e + "cite" -> parseCite e + "empty-line" -> pure horizontalRule + "table" -> parseTable e + "subtitle" -> parseSubtitle e + "p" -> para <$> parsePType e + "section" -> parseSection e + name -> report (UnexpectedXmlElement name "section") $> mempty + +-- | parse @styleType@ +parseStyleType :: PandocMonad m => Element -> FB2 m Inlines +parseStyleType e = mconcat <$> mapM parseInline (elContent e) + +-- | Parse @namedStyleType@ +parseNamedStyle :: PandocMonad m => Element -> FB2 m Inlines +parseNamedStyle e = do + content <- mconcat <$> mapM parseNamedStyleChild (elContent e) + let lang = maybeToList $ ("lang",) <$> findAttr (QName "lang" Nothing (Just "xml")) e + case findAttr (QName "name" Nothing Nothing) e of + Just name -> pure $ spanWith ("", [name], lang) content + Nothing -> throwError $ PandocParseError "Couldn't parse FB2 file: link without required name." + +parseNamedStyleChild :: PandocMonad m => Content -> FB2 m Inlines +parseNamedStyleChild (Elem e) = + case qName (elName e) of + "strong" -> strong <$> parseStyleType e + "emphasis" -> emph <$> parseStyleType e + "style" -> parseNamedStyle e + "a" -> parseLinkType e + "strikethrough" -> strikeout <$> parseStyleType e + "sub" -> subscript <$> parseStyleType e + "sup" -> superscript <$> parseStyleType e + "code" -> pure $ code $ strContent e + "image" -> parseInlineImageElement e + name -> throwError $ PandocParseError ("Couldn't parse FB2 file: unexpected element " ++ name ++ ".") +parseNamedStyleChild x = parseInline x + +-- | Parse @linkType@ +parseLinkType :: PandocMonad m => Element -> FB2 m Inlines +parseLinkType e = do + content <- mconcat <$> mapM parseStyleLinkType (elContent e) + case findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e of + Just href -> pure $ link href "" content + Nothing -> throwError $ PandocParseError "Couldn't parse FB2 file: link without required href." + +-- | Parse @styleLinkType@ +parseStyleLinkType :: PandocMonad m => Content -> FB2 m Inlines +parseStyleLinkType x@(Elem e) = + case qName (elName e) of + "a" -> throwError $ PandocParseError "Couldn't parse FB2 file: links cannot be nested." + _ -> parseInline x +parseStyleLinkType x = parseInline x + +-- | Parse @tableType@ +parseTable :: PandocMonad m => Element -> FB2 m Blocks +parseTable _ = pure mempty -- TODO: tables are not supported yet + +-- | Parse @title-infoType@ +parseTitleInfoChild :: PandocMonad m => Element -> FB2 m () +parseTitleInfoChild e = + case qName (elName e) of + "genre" -> pure () + "author" -> parseAuthor e >>= \author -> modify (\st -> st {fb2Authors = author:fb2Authors st}) + "book-title" -> modify (setMeta "title" (text $ strContent e)) + "annotation" -> parseAnnotation e >>= modify . setMeta "abstract" + "keywords" -> modify (setMeta "keywords" (map (MetaString . trim) $ splitOn "," $ strContent e)) + "date" -> modify (setMeta "date" (text $ strContent e)) + "coverpage" -> parseCoverPage e + "lang" -> pure () + "src-lang" -> pure () + "translator" -> pure () + "sequence" -> pure () + name -> throwError $ PandocParseError ("Couldn't parse FB2 file: unexpected element " ++ name ++ " in title-info.") + +parseCoverPage :: PandocMonad m => Element -> FB2 m () +parseCoverPage e = + case findChild (QName "image" (Just "http://www.gribuser.ru/xml/fictionbook/2.0") Nothing) e of + Just img -> case href of + Just src -> modify (setMeta "cover-image" (MetaString $ removeHash src)) + Nothing -> pure () + where href = findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) img + Nothing -> pure () + +-- | Parse @inlineImageType@ element +parseInlineImageElement :: PandocMonad m + => Element + -> FB2 m Inlines +parseInlineImageElement e = + case href of + Just src -> pure $ imageWith ("", [], []) (removeHash src) "" alt + Nothing -> throwError $ PandocParseError "Couldn't parse FB2 file: inline image without href." + where alt = maybe mempty str $ findAttr (QName "alt" Nothing Nothing) e + href = findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 0e79f9ec3..32a1ba5a6 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -42,6 +43,7 @@ module Text.Pandoc.Readers.HTML ( readHtml , isCommentTag ) where +import Prelude import Control.Applicative ((<|>)) import Control.Arrow (first) import Control.Monad (guard, mplus, msum, mzero, unless, void) @@ -54,7 +56,7 @@ import Data.List (isPrefixOf) import Data.List.Split (wordsBy, splitWhen) import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust, isNothing) -import Data.Monoid (First (..), (<>)) +import Data.Monoid (First (..)) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T @@ -508,14 +510,16 @@ pTable = try $ do [Plain _] -> True _ -> False let isSimple = all isSinglePlain $ concat (head':rows''') - let cols = length $ if null head' then head rows''' else head' + let cols = if null head' + then maximum (map length rows''') + else length head' -- add empty cells to short rows let addEmpties r = case cols - length r of n | n > 0 -> r <> replicate n mempty | otherwise -> r let rows = map addEmpties rows''' let aligns = case rows'' of - (cs:_) -> map fst cs + (cs:_) -> take cols $ map fst cs ++ repeat AlignDefault _ -> replicate cols AlignDefault let widths = if null widths' then if isSimple diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs index e98c79ed8..967037e4e 100644 --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} {- | Module : Text.Pandoc.Readers.Haddock @@ -14,13 +15,13 @@ module Text.Pandoc.Readers.Haddock ( readHaddock ) where +import Prelude import Control.Monad.Except (throwError) import Data.List (intersperse, stripPrefix) import Data.Maybe (fromMaybe) -import Data.Monoid ((<>)) import Data.Text (Text, unpack) import Documentation.Haddock.Parser -import Documentation.Haddock.Types +import Documentation.Haddock.Types as H import Text.Pandoc.Builder (Blocks, Inlines) import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class (PandocMonad) @@ -86,6 +87,20 @@ docHToBlocks d' = DocProperty s -> B.codeBlockWith ("",["property","haskell"],[]) (trim s) DocExamples es -> mconcat $ map (\e -> makeExample ">>>" (exampleExpression e) (exampleResult e)) es +#if MIN_VERSION_haddock_library(1,5,0) + DocTable H.Table{ tableHeaderRows = headerRows + , tableBodyRows = bodyRows + } + -> let toCells = map (docHToBlocks . tableCellContents) . tableRowCells + (header, body) = + if null headerRows + then ([], map toCells bodyRows) + else (toCells (head headerRows), + map toCells (tail headerRows ++ bodyRows)) + colspecs = replicate (maximum (map length body)) + (AlignDefault, 0.0) + in B.table mempty colspecs header body +#endif where inlineFallback = B.plain $ docHToInlines False d' consolidatePlains = B.fromList . consolidatePlains' . B.toList @@ -134,6 +149,9 @@ docHToInlines isCode d' = DocAName s -> B.spanWith (s,["anchor"],[]) mempty DocProperty _ -> mempty DocExamples _ -> mempty +#if MIN_VERSION_haddock_library(1,5,0) + DocTable _ -> mempty +#endif -- | Create an 'Example', stripping superfluous characters as appropriate makeExample :: String -> String -> [String] -> Blocks diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs index 8158a4511..59af76d23 100644 --- a/src/Text/Pandoc/Readers/JATS.hs +++ b/src/Text/Pandoc/Readers/JATS.hs @@ -1,5 +1,37 @@ -{-# LANGUAGE ExplicitForAll, TupleSections #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TupleSections #-} +{- +Copyright (C) 2017-2018 Hamish Mackenzie + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Readers.JATS + Copyright : Copyright (C) 2017-2018 Hamish Mackenzie + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley.edu> + Stability : alpha + Portability : portable + +Conversion of JATS XML to 'Pandoc' document. +-} + module Text.Pandoc.Readers.JATS ( readJATS ) where +import Prelude import Control.Monad.State.Strict import Data.Char (isDigit, isSpace, toUpper) import Data.Default diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index cb70b6403..39dffde76 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} @@ -42,11 +43,12 @@ module Text.Pandoc.Readers.LaTeX ( readLaTeX, untokenize ) where +import Prelude import Control.Applicative (many, optional, (<|>)) import Control.Monad import Control.Monad.Except (throwError) import Control.Monad.Trans (lift) -import Data.Char (chr, isAlphaNum, isDigit, isLetter, ord, toLower) +import Data.Char (chr, isAlphaNum, isDigit, isLetter, ord, toLower, toUpper) import Data.Default import Data.List (intercalate, isPrefixOf) import qualified Data.Map as M @@ -60,7 +62,7 @@ import Text.Pandoc.BCP47 (Lang (..), renderLang) import Text.Pandoc.Builder import Text.Pandoc.Class (PandocMonad, PandocPure, getResourcePath, lookupEnv, readFileFromDirs, report, setResourcePath, - setTranslations, translateTerm) + setTranslations, translateTerm, trace) import Text.Pandoc.Error (PandocError (PandocMacroLoop, PandocParseError, PandocParsecError)) import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension) import Text.Pandoc.ImageSize (numUnit, showFl) @@ -74,6 +76,7 @@ import Text.Pandoc.Shared import qualified Text.Pandoc.Translations as Translations import Text.Pandoc.Walk import Text.Parsec.Pos +import qualified Text.Pandoc.Builder as B -- for debugging: -- import Text.Pandoc.Extensions (getDefaultExtensions) @@ -161,6 +164,7 @@ data LaTeXState = LaTeXState{ sOptions :: ReaderOptions , sInTableCell :: Bool , sLastHeaderNum :: HeaderNum , sLabels :: M.Map String [Inline] + , sHasChapters :: Bool , sToggles :: M.Map String Bool } deriving Show @@ -180,6 +184,7 @@ defaultLaTeXState = LaTeXState{ sOptions = def , sInTableCell = False , sLastHeaderNum = HeaderNum [] , sLabels = M.empty + , sHasChapters = False , sToggles = M.empty } @@ -237,21 +242,30 @@ withVerbatimMode parser = do return result rawLaTeXParser :: (PandocMonad m, HasMacros s, HasReaderOptions s) - => LP m a -> ParserT String s m (a, String) -rawLaTeXParser parser = do + => LP m a -> LP m a -> ParserT String s m (a, String) +rawLaTeXParser parser valParser = do inp <- getInput let toks = tokenize "source" $ T.pack inp pstate <- getState - let lstate = def{ sOptions = extractReaderOptions pstate - , sMacros = extractMacros pstate } - let rawparser = (,) <$> withRaw parser <*> getState - res <- lift $ runParserT rawparser lstate "chunk" toks - case res of + let lstate = def{ sOptions = extractReaderOptions pstate } + let lstate' = lstate { sMacros = extractMacros pstate } + let rawparser = (,) <$> withRaw valParser <*> getState + res' <- lift $ runParserT (snd <$> withRaw parser) lstate "chunk" toks + case res' of Left _ -> mzero - Right ((val, raw), st) -> do - updateState (updateMacros (sMacros st <>)) - rawstring <- takeP (T.length (untokenize raw)) - return (val, rawstring) + Right toks' -> do + res <- lift $ runParserT (do doMacros 0 + -- retokenize, applying macros + ts <- many (satisfyTok (const True)) + setInput ts + rawparser) + lstate' "chunk" toks' + case res of + Left _ -> mzero + Right ((val, raw), st) -> do + updateState (updateMacros (sMacros st <>)) + _ <- takeP (T.length (untokenize toks')) + return (val, T.unpack (untokenize raw)) applyMacros :: (PandocMonad m, HasMacros s, HasReaderOptions s) => String -> ParserT String s m String @@ -272,19 +286,18 @@ rawLaTeXBlock = do lookAhead (try (char '\\' >> letter)) -- we don't want to apply newly defined latex macros to their own -- definitions: - snd <$> rawLaTeXParser macroDef - <|> ((snd <$> rawLaTeXParser (environment <|> blockCommand)) >>= applyMacros) + snd <$> rawLaTeXParser (environment <|> macroDef <|> blockCommand) blocks rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s) => ParserT String s m String rawLaTeXInline = do lookAhead (try (char '\\' >> letter)) - rawLaTeXParser (inlineEnvironment <|> inlineCommand') >>= applyMacros . snd + snd <$> rawLaTeXParser (inlineEnvironment <|> inlineCommand') inlines inlineCommand :: PandocMonad m => ParserT String ParserState m Inlines inlineCommand = do lookAhead (try (char '\\' >> letter)) - fst <$> rawLaTeXParser (inlineEnvironment <|> inlineCommand') + fst <$> rawLaTeXParser (inlineEnvironment <|> inlineCommand') inlines tokenize :: SourceName -> Text -> [Tok] tokenize sourcename = totoks (initialPos sourcename) @@ -665,7 +678,7 @@ dosiunitx = do skipopts value <- tok valueprefix <- option "" $ bracketed tok - unit <- tok + unit <- inlineCommand' <|> tok let emptyOr160 "" = "" emptyOr160 _ = "\160" return . mconcat $ [valueprefix, @@ -674,6 +687,12 @@ dosiunitx = do emptyOr160 unit, unit] +-- siunitx's \square command +dosquare :: PandocMonad m => LP m Inlines +dosquare = do + unit <- inlineCommand' <|> tok + return . mconcat $ [unit, "\178"] + lit :: String -> LP m Inlines lit = pure . str @@ -1034,13 +1053,28 @@ dollarsMath :: PandocMonad m => LP m Inlines dollarsMath = do symbol '$' display <- option False (True <$ symbol '$') - contents <- trim . toksToString <$> - many (notFollowedBy (symbol '$') >> anyTok) - if display - then - mathDisplay contents <$ try (symbol '$' >> symbol '$') - <|> (guard (null contents) >> return (mathInline "")) - else mathInline contents <$ symbol '$' + (do contents <- try $ T.unpack <$> pDollarsMath 0 + if display + then (mathDisplay contents <$ symbol '$') + else return $ mathInline contents) + <|> (guard display >> return (mathInline "")) + +-- Int is number of embedded groupings +pDollarsMath :: PandocMonad m => Int -> LP m Text +pDollarsMath n = do + Tok _ toktype t <- anyTok + case toktype of + Symbol | t == "$" + , n == 0 -> return mempty + | t == "\\" -> do + Tok _ _ t' <- anyTok + return (t <> t') + | t == "{" -> (t <>) <$> pDollarsMath (n+1) + | t == "}" -> + if n > 0 + then (t <>) <$> pDollarsMath (n-1) + else mzero + _ -> (t <>) <$> pDollarsMath n -- citations @@ -1161,7 +1195,7 @@ singleChar = try $ do else return $ Tok pos toktype t opt :: PandocMonad m => LP m Inlines -opt = bracketed inline +opt = bracketed inline <|> (str . T.unpack <$> rawopt) rawopt :: PandocMonad m => LP m Text rawopt = do @@ -1304,6 +1338,12 @@ inlineCommands = M.union inlineLanguageCommands $ M.fromList , ("slshape", extractSpaces emph <$> inlines) , ("scshape", extractSpaces smallcaps <$> inlines) , ("bfseries", extractSpaces strong <$> inlines) + , ("MakeUppercase", makeUppercase <$> tok) + , ("MakeTextUppercase", makeUppercase <$> tok) -- textcase + , ("uppercase", makeUppercase <$> tok) + , ("MakeLowercase", makeLowercase <$> tok) + , ("MakeTextLowercase", makeLowercase <$> tok) + , ("lowercase", makeLowercase <$> tok) , ("/", pure mempty) -- italic correction , ("aa", lit "å") , ("AA", lit "Å") @@ -1467,6 +1507,13 @@ inlineCommands = M.union inlineLanguageCommands $ M.fromList , ("acsp", doAcronymPlural "abbrv") -- siuntix , ("SI", dosiunitx) + -- units of siuntix + , ("celsius", lit "°C") + , ("degreeCelsius", lit "°C") + , ("gram", lit "g") + , ("meter", lit "m") + , ("milli", lit "m") + , ("square", dosquare) -- hyphenat , ("bshyp", lit "\\\173") , ("fshyp", lit "/\173") @@ -1497,6 +1544,16 @@ inlineCommands = M.union inlineLanguageCommands $ M.fromList , ("foreignlanguage", foreignlanguage) ] +makeUppercase :: Inlines -> Inlines +makeUppercase = fromList . walk (alterStr (map toUpper)) . toList + +makeLowercase :: Inlines -> Inlines +makeLowercase = fromList . walk (alterStr (map toLower)) . toList + +alterStr :: (String -> String) -> Inline -> Inline +alterStr f (Str xs) = Str (f xs) +alterStr _ x = x + foreignlanguage :: PandocMonad m => LP m Inlines foreignlanguage = do babelLang <- T.unpack . untokenize <$> braced @@ -1669,6 +1726,9 @@ treatAsBlock = Set.fromList , "clearpage" , "pagebreak" , "titleformat" + , "listoffigures" + , "listoftables" + , "write" ] isInlineCommand :: Text -> Bool @@ -1968,9 +2028,13 @@ section starred (ident, classes, kvs) lvl = do try (spaces >> controlSeq "label" >> spaces >> toksToString <$> braced) let classes' = if starred then "unnumbered" : classes else classes + when (lvl == 0) $ + updateState $ \st -> st{ sHasChapters = True } unless starred $ do hn <- sLastHeaderNum <$> getState - let num = incrementHeaderNum lvl hn + hasChapters <- sHasChapters <$> getState + let lvl' = lvl + if hasChapters then 1 else 0 + let num = incrementHeaderNum lvl' hn updateState $ \st -> st{ sLastHeaderNum = num } updateState $ \st -> st{ sLabels = M.insert lab [Str (renderHeaderNum num)] @@ -2095,6 +2159,7 @@ environments :: PandocMonad m => M.Map Text (LP m Blocks) environments = M.fromList [ ("document", env "document" blocks) , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract")) + , ("sloppypar", env "sloppypar" $ blocks) , ("letter", env "letter" letterContents) , ("minipage", env "minipage" $ skipopts *> spaces *> optional braced *> spaces *> blocks) @@ -2126,19 +2191,6 @@ environments = M.fromList codeBlockWith attr <$> verbEnv "lstlisting") , ("minted", minted) , ("obeylines", obeylines) - , ("displaymath", mathEnvWith para Nothing "displaymath") - , ("equation", mathEnvWith para Nothing "equation") - , ("equation*", mathEnvWith para Nothing "equation*") - , ("gather", mathEnvWith para (Just "gathered") "gather") - , ("gather*", mathEnvWith para (Just "gathered") "gather*") - , ("multline", mathEnvWith para (Just "gathered") "multline") - , ("multline*", mathEnvWith para (Just "gathered") "multline*") - , ("eqnarray", mathEnvWith para (Just "aligned") "eqnarray") - , ("eqnarray*", mathEnvWith para (Just "aligned") "eqnarray*") - , ("align", mathEnvWith para (Just "aligned") "align") - , ("align*", mathEnvWith para (Just "aligned") "align*") - , ("alignat", mathEnvWith para (Just "aligned") "alignat") - , ("alignat*", mathEnvWith para (Just "aligned") "alignat*") , ("tikzpicture", rawVerbEnv "tikzpicture") -- etoolbox , ("ifstrequal", ifstrequal) @@ -2149,11 +2201,14 @@ environments = M.fromList ] environment :: PandocMonad m => LP m Blocks -environment = do +environment = try $ do controlSeq "begin" name <- untokenize <$> braced - M.findWithDefault mzero name environments - <|> rawEnv name + M.findWithDefault mzero name environments <|> + if M.member name (inlineEnvironments + :: M.Map Text (LP PandocPure Inlines)) + then mzero + else rawEnv name env :: PandocMonad m => Text -> LP m a -> LP m a env name p = p <* end_ name @@ -2532,13 +2587,16 @@ addTableCaption = walkM go block :: PandocMonad m => LP m Blocks -block = (mempty <$ spaces1) +block = do + res <- (mempty <$ spaces1) <|> environment <|> include <|> macroDef <|> blockCommand <|> paragraph <|> grouped block + trace (take 60 $ show $ B.toList res) + return res blocks :: PandocMonad m => LP m Blocks blocks = mconcat <$> many block diff --git a/src/Text/Pandoc/Readers/LaTeX/Types.hs b/src/Text/Pandoc/Readers/LaTeX/Types.hs index c9cbaa9b9..fa832114b 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Types.hs +++ b/src/Text/Pandoc/Readers/LaTeX/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2017-2018 John MacFarlane <jgm@berkeley.edu> @@ -34,6 +35,7 @@ module Text.Pandoc.Readers.LaTeX.Types ( Tok(..) , SourcePos ) where +import Prelude import Data.Text (Text) import Text.Parsec.Pos (SourcePos) diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 14cf73de4..156b2b622 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RelaxedPolyRec #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -32,6 +33,7 @@ Conversion of markdown-formatted plain text to 'Pandoc' document. -} module Text.Pandoc.Readers.Markdown ( readMarkdown ) where +import Prelude import Control.Monad import Control.Monad.Except (throwError) import Data.Char (isAlphaNum, isPunctuation, isSpace, toLower) @@ -39,7 +41,6 @@ import qualified Data.HashMap.Strict as H import Data.List (intercalate, sortBy, transpose, elemIndex) import qualified Data.Map as M import Data.Maybe -import Data.Monoid ((<>)) import Data.Ord (comparing) import Data.Scientific (base10Exponent, coefficient) import qualified Data.Set as Set @@ -162,7 +163,7 @@ inlinesInBalancedBrackets = stripBracket xs = if last xs == ']' then init xs else xs go :: PandocMonad m => Int -> MarkdownParser m () go 0 = return () - go openBrackets = + go openBrackets = (() <$ (escapedChar <|> code <|> rawHtmlInline <|> @@ -673,6 +674,8 @@ keyValAttr = try $ do char '=' val <- enclosed (char '"') (char '"') litChar <|> enclosed (char '\'') (char '\'') litChar + <|> ("" <$ try (string "\"\"")) + <|> ("" <$ try (string "''")) <|> many (escapedChar' <|> noneOf " \t\n\r}") return $ \(id',cs,kvs) -> case key of @@ -909,6 +912,17 @@ listContinuation continuationIndent = try $ do blanks <- many blankline return $ concat (x:xs) ++ blanks +-- Variant of blanklines that doesn't require blank lines +-- before a fence or eof. +blanklines' :: PandocMonad m => MarkdownParser m [Char] +blanklines' = blanklines <|> try checkDivCloser + where checkDivCloser = do + guardEnabled Ext_fenced_divs + divLevel <- stateFencedDivLevel <$> getState + guard (divLevel >= 1) + lookAhead divFenceEnd + return "" + notFollowedByDivCloser :: PandocMonad m => MarkdownParser m () notFollowedByDivCloser = guardDisabled Ext_fenced_divs <|> @@ -1250,7 +1264,7 @@ alignType strLst len = -- Parse a table footer - dashed lines followed by blank line. tableFooter :: PandocMonad m => MarkdownParser m String -tableFooter = try $ skipNonindentSpaces >> many1 (dashedLine '-') >> blanklines +tableFooter = try $ skipNonindentSpaces >> many1 (dashedLine '-') >> blanklines' -- Parse a table separator - dashed line. tableSep :: PandocMonad m => MarkdownParser m Char @@ -1261,7 +1275,7 @@ rawTableLine :: PandocMonad m => [Int] -> MarkdownParser m [String] rawTableLine indices = do - notFollowedBy' (blanklines <|> tableFooter) + notFollowedBy' (blanklines' <|> tableFooter) line <- many1Till anyChar newline return $ map trim $ tail $ splitStringByIndices (init indices) line @@ -1299,7 +1313,7 @@ simpleTable headless = do (aligns, _widths, heads', lines') <- tableWith (simpleTableHeader headless) tableLine (return ()) - (if headless then tableFooter else tableFooter <|> blanklines) + (if headless then tableFooter else tableFooter <|> blanklines') -- Simple tables get 0s for relative column widths (i.e., use default) return (aligns, replicate (length aligns) 0, heads', lines') @@ -1327,11 +1341,16 @@ multilineTableHeader headless = try $ do newline let (lengths, lines') = unzip dashes let indices = scanl (+) (length initSp) lines' + -- compensate for the fact that intercolumn spaces are + -- not included in the last index: + let indices' = case reverse indices of + [] -> [] + (x:xs) -> reverse (x+1:xs) rawHeadsList <- if headless then fmap (map (:[]) . tail . - splitStringByIndices (init indices)) $ lookAhead anyLine + splitStringByIndices (init indices')) $ lookAhead anyLine else return $ transpose $ map - (tail . splitStringByIndices (init indices)) + (tail . splitStringByIndices (init indices')) rawContent let aligns = zipWith alignType rawHeadsList lengths let rawHeads = if headless @@ -1339,7 +1358,7 @@ multilineTableHeader headless = try $ do else map (unlines . map trim) rawHeadsList heads <- fmap sequence $ mapM ((parseFromString' (mconcat <$> many plain)).trim) rawHeads - return (heads, aligns, indices) + return (heads, aligns, indices') -- Parse a grid table: starts with row of '-' on top, then header -- (which may be grid), then the rows, @@ -2145,7 +2164,6 @@ singleQuoted = try $ do doubleQuoted :: PandocMonad m => MarkdownParser m (F Inlines) doubleQuoted = try $ do doubleQuoteStart - contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline) - withQuoteContext InDoubleQuote (doubleQuoteEnd >> return - (fmap B.doubleQuoted . trimInlinesF $ contents)) - <|> return (return (B.str "\8220") <> contents) + withQuoteContext InDoubleQuote $ + fmap B.doubleQuoted . trimInlinesF . mconcat <$> + many1Till inline doubleQuoteEnd diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index c19ef2f46..764b57f18 100644 --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE RelaxedPolyRec #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RelaxedPolyRec #-} -- RelaxedPolyRec needed for inlinesBetween on GHC < 7 {- Copyright (C) 2012-2018 John MacFarlane <jgm@berkeley.edu> @@ -38,6 +37,7 @@ _ parse templates? -} module Text.Pandoc.Readers.MediaWiki ( readMediaWiki ) where +import Prelude import Control.Monad import Control.Monad.Except (throwError) import Data.Char (isDigit, isSpace) @@ -45,7 +45,6 @@ import qualified Data.Foldable as F import Data.List (intercalate, intersperse, isPrefixOf) import qualified Data.Map as M import Data.Maybe (fromMaybe, maybeToList) -import Data.Monoid ((<>)) import Data.Sequence (ViewL (..), viewl, (<|)) import qualified Data.Set as Set import Data.Text (Text, unpack) @@ -231,7 +230,8 @@ para = do table :: PandocMonad m => MWParser m Blocks table = do tableStart - styles <- option [] parseAttrs + styles <- option [] $ + parseAttrs <* skipMany spaceChar <* optional (char '|') skipMany spaceChar optional blanklines let tableWidth = case lookup "width" styles of @@ -282,17 +282,29 @@ rowsep = try $ guardColumnOne *> skipSpaces *> sym "|-" <* cellsep :: PandocMonad m => MWParser m () cellsep = try $ do + col <- sourceColumn <$> getPosition skipSpaces - (char '|' *> notFollowedBy (oneOf "-}+") *> optional (char '|')) - <|> (char '!' *> optional (char '!')) + let pipeSep = do + char '|' + notFollowedBy (oneOf "-}+") + if col == 1 + then optional (char '|') + else void (char '|') + let exclSep = do + char '!' + if col == 1 + then optional (char '!') + else void (char '!') + pipeSep <|> exclSep tableCaption :: PandocMonad m => MWParser m Inlines tableCaption = try $ do guardColumnOne skipSpaces sym "|+" - optional (try $ parseAttr *> skipSpaces *> char '|' *> skipSpaces) - (trimInlines . mconcat) <$> many (notFollowedBy (cellsep <|> rowsep) *> inline) + optional (try $ parseAttr *> skipSpaces *> char '|' *> blanklines) + (trimInlines . mconcat) <$> + many (notFollowedBy (cellsep <|> rowsep) *> inline) tableRow :: PandocMonad m => MWParser m [((Alignment, Double), Blocks)] tableRow = try $ skipMany htmlComment *> many tableCell diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 1fb37aa16..fe6b3698c 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TupleSections #-} {- Copyright (C) 2017-2018 Alexander Krotov <ilabdsf@gmail.com> @@ -34,13 +36,14 @@ TODO: - Org tables - table.el tables - Images with attributes (floating and width) -- Citations and <biblio> -- <play> environment +- <cite> tag -} module Text.Pandoc.Readers.Muse (readMuse) where +import Prelude import Control.Monad import Control.Monad.Except (throwError) +import Data.Bifunctor import Data.Char (isLetter) import Data.Default import Data.List (stripPrefix, intercalate) @@ -81,24 +84,21 @@ data MuseState = MuseState { museMeta :: F Meta -- ^ Document metadata , museLastStrPos :: Maybe SourcePos -- ^ Position after last str parsed , museLogMessages :: [LogMessage] , museNotes :: M.Map String (SourcePos, F Blocks) - , museInLink :: Bool - , museInPara :: Bool + , museInLink :: Bool -- ^ True when parsing a link description to avoid nested links + , museInPara :: Bool -- ^ True when looking for a paragraph terminator } instance Default MuseState where - def = defaultMuseState - -defaultMuseState :: MuseState -defaultMuseState = MuseState { museMeta = return nullMeta - , museOptions = def - , museHeaders = M.empty - , museIdentifierList = Set.empty - , museLastStrPos = Nothing - , museLogMessages = [] - , museNotes = M.empty - , museInLink = False - , museInPara = False - } + def = MuseState { museMeta = return nullMeta + , museOptions = def + , museHeaders = M.empty + , museIdentifierList = Set.empty + , museLastStrPos = Nothing + , museLogMessages = [] + , museNotes = M.empty + , museInLink = False + , museInPara = False + } type MuseParser = ParserT String MuseState @@ -121,10 +121,7 @@ instance HasLogMessages MuseState where addLogMessage m s = s{ museLogMessages = m : museLogMessages s } getLogMessages = reverse . museLogMessages --- --- main parser --- - +-- | Parse Muse document parseMuse :: PandocMonad m => MuseParser m Pandoc parseMuse = do many directive @@ -136,14 +133,56 @@ parseMuse = do reportLogMessages return doc --- --- utility functions --- +-- * Utility functions + +commonPrefix :: String -> String -> String +commonPrefix _ [] = [] +commonPrefix [] _ = [] +commonPrefix (x:xs) (y:ys) + | x == y = x : commonPrefix xs ys + | otherwise = [] + +-- | Trim up to one newline from the beginning of the string. +lchop :: String -> String +lchop s = case s of + '\n':ss -> ss + _ -> s + +-- | Trim up to one newline from the end of the string. +rchop :: String -> String +rchop = reverse . lchop . reverse + +dropSpacePrefix :: [String] -> [String] +dropSpacePrefix lns = + map (drop maxIndent) lns + where flns = filter (not . all (== ' ')) lns + maxIndent = if null flns then maximum (map length lns) else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns + +atStart :: PandocMonad m => MuseParser m a -> MuseParser m a +atStart p = do + pos <- getPosition + st <- getState + guard $ museLastStrPos st /= Just pos + p +-- * Parsers + +-- | Parse end-of-line, which can be either a newline or end-of-file. eol :: Stream s m Char => ParserT s st m () eol = void newline <|> eof -htmlElement :: PandocMonad m => String -> MuseParser m (Attr, String) +someUntil :: (Stream s m t) + => ParserT s u m a + -> ParserT s u m b + -> ParserT s u m ([a], b) +someUntil p end = first <$> ((:) <$> p) <*> manyUntil p end + +-- ** HTML parsers + +-- | Parse HTML tag, returning its attributes and literal contents. +htmlElement :: PandocMonad m + => String -- ^ Tag name + -> MuseParser m (Attr, String) htmlElement tag = try $ do (TagOpen _ attr, _) <- htmlTag (~== TagOpen tag []) content <- manyTill anyChar endtag @@ -151,12 +190,16 @@ htmlElement tag = try $ do where endtag = void $ htmlTag (~== TagClose tag) -htmlBlock :: PandocMonad m => String -> MuseParser m (Attr, String) +htmlBlock :: PandocMonad m + => String -- ^ Tag name + -> MuseParser m (Attr, String) htmlBlock tag = try $ do + many spaceChar res <- htmlElement tag manyTill spaceChar eol return res +-- | Convert HTML attributes to Pandoc 'Attr' htmlAttrToPandoc :: [Attribute String] -> Attr htmlAttrToPandoc attrs = (ident, classes, keyvals) where @@ -165,48 +208,24 @@ htmlAttrToPandoc attrs = (ident, classes, keyvals) keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"] parseHtmlContent :: PandocMonad m - => String -> MuseParser m (Attr, F Blocks) -parseHtmlContent tag = do + => String -- ^ Tag name + -> MuseParser m (Attr, F Blocks) +parseHtmlContent tag = try $ do + many spaceChar + pos <- getPosition (TagOpen _ attr, _) <- htmlTag (~== TagOpen tag []) manyTill spaceChar eol - content <- parseBlocksTill (manyTill spaceChar endtag) + content <- parseBlocksTill $ try $ count (sourceColumn pos - 1) spaceChar >> endtag manyTill spaceChar eol -- closing tag must be followed by optional whitespace and newline return (htmlAttrToPandoc attr, content) where endtag = void $ htmlTag (~== TagClose tag) -commonPrefix :: String -> String -> String -commonPrefix _ [] = [] -commonPrefix [] _ = [] -commonPrefix (x:xs) (y:ys) - | x == y = x : commonPrefix xs ys - | otherwise = [] - -atStart :: PandocMonad m => MuseParser m a -> MuseParser m a -atStart p = do - pos <- getPosition - st <- getState - guard $ museLastStrPos st /= Just pos - p - -someUntil :: (Stream s m t) - => ParserT s u m a - -> ParserT s u m b - -> ParserT s u m ([a], b) -someUntil p end = do - first <- p - (rest, e) <- manyUntil p end - return (first:rest, e) - --- --- directive parsers --- +-- ** Directive parsers -- While not documented, Emacs Muse allows "-" in directive name parseDirectiveKey :: PandocMonad m => MuseParser m String -parseDirectiveKey = do - char '#' - many (letter <|> char '-') +parseDirectiveKey = char '#' *> many (letter <|> char '-') parseEmacsDirective :: PandocMonad m => MuseParser m (String, F Inlines) parseEmacsDirective = do @@ -233,55 +252,42 @@ directive = do where translateKey "cover" = "cover-image" translateKey x = x --- --- block parsers --- +-- ** Block parsers parseBlocks :: PandocMonad m => MuseParser m (F Blocks) parseBlocks = - try parseEnd <|> - try blockStart <|> - try listStart <|> - try paraStart + try (parseEnd <|> + blockStart <|> + listStart <|> + paraStart) where parseEnd = mempty <$ eof - blockStart = do first <- header <|> blockElements <|> emacsNoteBlock - rest <- parseBlocks - return $ first B.<> rest + blockStart = ((B.<>) <$> (emacsHeading <|> blockElements <|> emacsNoteBlock) + <*> parseBlocks) <|> (uncurry (B.<>) <$> amuseHeadingUntil parseBlocks) listStart = do updateState (\st -> st { museInPara = False }) - (first, rest) <- anyListUntil parseBlocks <|> amuseNoteBlockUntil parseBlocks - return $ first B.<> rest + uncurry (B.<>) <$> (anyListUntil parseBlocks <|> amuseNoteBlockUntil parseBlocks) paraStart = do indent <- length <$> many spaceChar - (first, rest) <- paraUntil parseBlocks - let first' = if indent >= 2 && indent < 6 then B.blockQuote <$> first else first - return $ first' B.<> rest + uncurry (B.<>) . first (p indent) <$> paraUntil parseBlocks + where p indent = if indent >= 2 && indent < 6 then fmap B.blockQuote else id parseBlocksTill :: PandocMonad m => MuseParser m a -> MuseParser m (F Blocks) parseBlocksTill end = - try parseEnd <|> - try blockStart <|> - try listStart <|> - try paraStart + try (parseEnd <|> + blockStart <|> + listStart <|> + paraStart) where parseEnd = mempty <$ end - blockStart = do first <- blockElements - rest <- continuation - return $ first B.<> rest + blockStart = (B.<>) <$> blockElements <*> continuation listStart = do updateState (\st -> st { museInPara = False }) - (first, e) <- anyListUntil ((Left <$> end) <|> (Right <$> continuation)) - case e of - Left _ -> return first - Right rest -> return $ first B.<> rest - paraStart = do (first, e) <- paraUntil ((Left <$> end) <|> (Right <$> continuation)) - case e of - Left _ -> return first - Right rest -> return $ first B.<> rest + uncurry (B.<>) <$> anyListUntil (parseEnd <|> continuation) + paraStart = uncurry (B.<>) <$> paraUntil (parseEnd <|> continuation) continuation = parseBlocksTill end listItemContentsUntil :: PandocMonad m @@ -294,24 +300,17 @@ listItemContentsUntil col pre end = try listStart <|> try paraStart where - parsePre = do e <- pre - return (mempty, e) - parseEnd = do e <- end - return (mempty, e) + parsePre = (mempty,) <$> pre + parseEnd = (mempty,) <$> end paraStart = do - (first, e) <- paraUntil ((Left <$> pre) <|> (Right <$> continuation) <|> (Left <$> end)) - case e of - Left ee -> return (first, ee) - Right (rest, ee) -> return (first B.<> rest, ee) - blockStart = do first <- blockElements - (rest, e) <- parsePre <|> continuation <|> parseEnd - return (first B.<> rest, e) + (f, (r, e)) <- paraUntil (parsePre <|> continuation <|> parseEnd) + return (f B.<> r, e) + blockStart = first <$> ((B.<>) <$> blockElements) + <*> (parsePre <|> continuation <|> parseEnd) listStart = do updateState (\st -> st { museInPara = False }) - (first, e) <- anyListUntil ((Left <$> pre) <|> (Right <$> continuation) <|> (Left <$> end)) - case e of - Left ee -> return (first, ee) - Right (rest, ee) -> return (first B.<> rest, ee) + (f, (r, e)) <- anyListUntil (parsePre <|> continuation <|> parseEnd) + return (f B.<> r, e) continuation = try $ do blank <- optionMaybe blankline skipMany blankline indentWith col @@ -338,19 +337,24 @@ blockElements = do , rightTag , quoteTag , divTag + , biblioTag + , playTag , verseTag , lineBlock , table , commentTag ] +-- | Parse a line comment, starting with @;@ in the first column. comment :: PandocMonad m => MuseParser m (F Blocks) comment = try $ do + getPosition >>= \pos -> guard (sourceColumn pos == 1) char ';' optional (spaceChar >> many (noneOf "\n")) eol return mempty +-- | Parse a horizontal rule, consisting of 4 or more @\'-\'@ characters. separator :: PandocMonad m => MuseParser m (F Blocks) separator = try $ do string "----" @@ -359,17 +363,37 @@ separator = try $ do eol return $ return B.horizontalRule -header :: PandocMonad m => MuseParser m (F Blocks) -header = try $ do +-- | Parse a single-line heading. +emacsHeading :: PandocMonad m => MuseParser m (F Blocks) +emacsHeading = try $ do + guardDisabled Ext_amuse + anchorId <- option "" $ try (parseAnchor <* manyTill spaceChar eol) getPosition >>= \pos -> guard (sourceColumn pos == 1) level <- fmap length $ many1 $ char '*' guard $ level <= 5 spaceChar content <- trimInlinesF . mconcat <$> manyTill inline eol - anchorId <- option "" parseAnchor attr <- registerHeader (anchorId, [], []) (runF content def) return $ B.headerWith attr level <$> content +-- | Parse a multi-line heading. +-- It is a Text::Amuse extension, Emacs Muse does not allow heading to span multiple lines. +amuseHeadingUntil :: PandocMonad m + => MuseParser m a -- ^ Terminator parser + -> MuseParser m (F Blocks, a) +amuseHeadingUntil end = try $ do + guardEnabled Ext_amuse + anchorId <- option "" $ try (parseAnchor <* manyTill spaceChar eol) + getPosition >>= \pos -> guard (sourceColumn pos == 1) + level <- fmap length $ many1 $ char '*' + guard $ level <= 5 + spaceChar + (content, e) <- paraContentsUntil end + attr <- registerHeader (anchorId, [], []) (runF content def) + return (B.headerWith attr level <$> content, e) + +-- | Parse an example between @{{{@ and @}}}@. +-- It is an Amusewiki extension influenced by Creole wiki, as described in @Text::Amuse@ documentation. example :: PandocMonad m => MuseParser m (F Blocks) example = try $ do string "{{{" @@ -377,57 +401,63 @@ example = try $ do contents <- manyTill anyChar $ try (optional blankline >> string "}}}") return $ return $ B.codeBlock contents --- Trim up to one newline from the beginning and the end, --- in case opening and/or closing tags are on separate lines. -chop :: String -> String -chop = lchop . rchop - -lchop :: String -> String -lchop s = case s of - '\n':ss -> ss - _ -> s - -rchop :: String -> String -rchop = reverse . lchop . reverse - -dropSpacePrefix :: [String] -> [String] -dropSpacePrefix lns = - map (drop maxIndent) lns - where flns = filter (not . all (== ' ')) lns - maxIndent = if null flns then maximum (map length lns) else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns - +-- | Parse an @\<example>@ tag. exampleTag :: PandocMonad m => MuseParser m (F Blocks) exampleTag = try $ do - many spaceChar (attr, contents) <- htmlBlock "example" return $ return $ B.codeBlockWith attr $ rchop $ intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop contents +-- | Parse a @\<literal>@ tag as a raw block. +-- For 'RawInline' @\<literal>@ parser, see 'inlineLiteralTag'. literalTag :: PandocMonad m => MuseParser m (F Blocks) -literalTag = do - guardDisabled Ext_amuse -- Text::Amuse does not support <literal> - (return . rawBlock) <$> htmlBlock "literal" +literalTag = try $ do + many spaceChar + (TagOpen _ attr, _) <- htmlTag (~== TagOpen "literal" []) + manyTill spaceChar eol + content <- manyTill anyChar endtag + manyTill spaceChar eol + return $ return $ rawBlock (htmlAttrToPandoc attr, content) where + endtag = void $ htmlTag (~== TagClose "literal") -- FIXME: Emacs Muse inserts <literal> without style into all output formats, but we assume HTML format (_, _, kvs) = fromMaybe "html" $ lookup "style" kvs - rawBlock (attrs, content) = B.rawBlock (format attrs) $ chop content + rawBlock (attrs, content) = B.rawBlock (format attrs) $ rchop $ intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop content --- <center> tag is ignored +-- | Parse @\<center>@ tag. +-- Currently it is ignored as Pandoc cannot represent centered blocks. centerTag :: PandocMonad m => MuseParser m (F Blocks) centerTag = snd <$> parseHtmlContent "center" --- <right> tag is ignored +-- | Parse @\<right>@ tag. +-- Currently it is ignored as Pandoc cannot represent centered blocks. rightTag :: PandocMonad m => MuseParser m (F Blocks) rightTag = snd <$> parseHtmlContent "right" +-- | Parse @\<quote>@ tag. quoteTag :: PandocMonad m => MuseParser m (F Blocks) quoteTag = fmap B.blockQuote . snd <$> parseHtmlContent "quote" --- <div> tag is supported by Emacs Muse, but not Amusewiki 2.025 +-- | Parse @\<div>@ tag. +-- @\<div>@ tag is supported by Emacs Muse, but not Amusewiki 2.025. divTag :: PandocMonad m => MuseParser m (F Blocks) divTag = do (attrs, content) <- parseHtmlContent "div" return $ B.divWith attrs <$> content +-- | Parse @\<biblio>@ tag, the result is the same as @\<div class="biblio">@. +-- @\<biblio>@ tag is supported only in Text::Amuse mode. +biblioTag :: PandocMonad m => MuseParser m (F Blocks) +biblioTag = do + guardEnabled Ext_amuse + fmap (B.divWith ("", ["biblio"], [])) . snd <$> parseHtmlContent "biblio" + +-- | Parse @\<play>@ tag, the result is the same as @\<div class="play">@. +-- @\<play>@ tag is supported only in Text::Amuse mode. +playTag :: PandocMonad m => MuseParser m (F Blocks) +playTag = do + guardEnabled Ext_amuse + fmap (B.divWith ("", ["play"], [])) . snd <$> parseHtmlContent "play" + verseLine :: PandocMonad m => MuseParser m (F Inlines) verseLine = do indent <- (B.str <$> many1 (char ' ' >> pure '\160')) <|> pure mempty @@ -439,32 +469,39 @@ verseLines = do lns <- many verseLine return $ B.lineBlock <$> sequence lns +-- | Parse @\<verse>@ tag. verseTag :: PandocMonad m => MuseParser m (F Blocks) verseTag = do (_, content) <- htmlBlock "verse" parseFromString verseLines (intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop content) +-- | Parse @\<comment>@ tag. commentTag :: PandocMonad m => MuseParser m (F Blocks) commentTag = htmlBlock "comment" >> return mempty --- Indented paragraph is either center, right or quote +-- | Parse paragraph contents. +paraContentsUntil :: PandocMonad m + => MuseParser m a -- ^ Terminator parser + -> MuseParser m (F Inlines, a) +paraContentsUntil end = do + updateState (\st -> st { museInPara = True }) + (l, e) <- someUntil inline $ try (manyTill spaceChar eol >> end) + updateState (\st -> st { museInPara = False }) + return (trimInlinesF $ mconcat l, e) + +-- | Parse a paragraph. paraUntil :: PandocMonad m - => MuseParser m a + => MuseParser m a -- ^ Terminator parser -> MuseParser m (F Blocks, a) paraUntil end = do state <- getState guard $ not $ museInPara state - setState $ state{ museInPara = True } - (l, e) <- someUntil inline $ try (manyTill spaceChar eol >> end) - updateState (\st -> st { museInPara = False }) - return (fmap B.para $ trimInlinesF $ mconcat l, e) + first (fmap B.para) <$> paraContentsUntil end noteMarker :: PandocMonad m => MuseParser m String noteMarker = try $ do char '[' - first <- oneOf "123456789" - rest <- manyTill digit (char ']') - return $ first:rest + (:) <$> oneOf "123456789" <*> manyTill digit (char ']') -- Amusewiki version of note -- Parsing is similar to list item, except that note marker is used instead of list marker @@ -473,14 +510,13 @@ amuseNoteBlockUntil :: PandocMonad m -> MuseParser m (F Blocks, a) amuseNoteBlockUntil end = try $ do guardEnabled Ext_amuse - pos <- getPosition ref <- noteMarker <* spaceChar + pos <- getPosition updateState (\st -> st { museInPara = False }) - (content, e) <- listItemContentsUntil (sourceColumn pos) (fail "x") end + (content, e) <- listItemContentsUntil (sourceColumn pos - 1) (fail "x") end oldnotes <- museNotes <$> getState - case M.lookup ref oldnotes of - Just _ -> logMessage $ DuplicateNoteReference ref pos - Nothing -> return () + when (M.member ref oldnotes) + (logMessage $ DuplicateNoteReference ref pos) updateState $ \s -> s{ museNotes = M.insert ref (pos, content) oldnotes } return (mempty, e) @@ -493,9 +529,8 @@ emacsNoteBlock = try $ do ref <- noteMarker <* skipSpaces content <- mconcat <$> blocksTillNote oldnotes <- museNotes <$> getState - case M.lookup ref oldnotes of - Just _ -> logMessage $ DuplicateNoteReference ref pos - Nothing -> return () + when (M.member ref oldnotes) + (logMessage $ DuplicateNoteReference ref pos) updateState $ \s -> s{ museNotes = M.insert ref (pos, content) oldnotes } return mempty where @@ -509,9 +544,10 @@ emacsNoteBlock = try $ do lineVerseLine :: PandocMonad m => MuseParser m (F Inlines) lineVerseLine = try $ do string "> " - indent <- B.str <$> many (char ' ' >> pure '\160') + indent <- many (char ' ' >> pure '\160') + let indentEl = if null indent then mempty else B.str indent rest <- manyTill (choice inlineList) eol - return $ trimInlinesF $ mconcat (pure indent : rest) + return $ trimInlinesF $ mconcat (pure indentEl : rest) blanklineVerseLine :: PandocMonad m => MuseParser m (F Inlines) blanklineVerseLine = try $ do @@ -519,29 +555,28 @@ blanklineVerseLine = try $ do blankline pure mempty +-- | Parse a line block indicated by @\'>\'@ characters. lineBlock :: PandocMonad m => MuseParser m (F Blocks) lineBlock = try $ do + many spaceChar col <- sourceColumn <$> getPosition lns <- (blanklineVerseLine <|> lineVerseLine) `sepBy1'` try (indentWith (col - 1)) return $ B.lineBlock <$> sequence lns --- --- lists --- +-- *** List parsers bulletListItemsUntil :: PandocMonad m - => Int - -> MuseParser m a + => Int -- ^ Indentation + -> MuseParser m a -- ^ Terminator parser -> MuseParser m ([F Blocks], a) bulletListItemsUntil indent end = try $ do char '-' void spaceChar <|> lookAhead eol updateState (\st -> st { museInPara = False }) - (x, e) <- listItemContentsUntil (indent + 2) (Right <$> try (optional blankline >> indentWith indent >> bulletListItemsUntil indent end)) (Left <$> end) - case e of - Left ee -> return ([x], ee) - Right (xs, ee) -> return (x:xs, ee) + (x, (xs, e)) <- listItemContentsUntil (indent + 2) (try (optional blankline >> indentWith indent >> bulletListItemsUntil indent end)) (([],) <$> end) + return (x:xs, e) +-- | Parse a bullet list. bulletListUntil :: PandocMonad m => MuseParser m a -> MuseParser m (F Blocks, a) @@ -563,16 +598,15 @@ anyMuseOrderedListMarker = do museOrderedListMarker :: PandocMonad m => ListNumberStyle -> MuseParser m Int -museOrderedListMarker style = do - (_, start) <- case style of - Decimal -> decimal - UpperRoman -> upperRoman - LowerRoman -> lowerRoman - UpperAlpha -> upperAlpha - LowerAlpha -> lowerAlpha - _ -> fail "Unhandled case" - char '.' - return start +museOrderedListMarker style = + snd <$> p <* char '.' + where p = case style of + Decimal -> decimal + UpperRoman -> upperRoman + LowerRoman -> lowerRoman + UpperAlpha -> upperAlpha + LowerAlpha -> lowerAlpha + _ -> fail "Unhandled case" orderedListItemsUntil :: PandocMonad m => Int @@ -586,11 +620,10 @@ orderedListItemsUntil indent style end = pos <- getPosition void spaceChar <|> lookAhead eol updateState (\st -> st { museInPara = False }) - (x, e) <- listItemContentsUntil (sourceColumn pos) (Right <$> try (optionMaybe blankline >> indentWith indent >> museOrderedListMarker style >> continuation)) (Left <$> end) - case e of - Left ee -> return ([x], ee) - Right (xs, ee) -> return (x:xs, ee) + (x, (xs, e)) <- listItemContentsUntil (sourceColumn pos) (try (optional blankline >> indentWith indent >> museOrderedListMarker style >> continuation)) (([],) <$> end) + return (x:xs, e) +-- | Parse an ordered list. orderedListUntil :: PandocMonad m => MuseParser m a -> MuseParser m (F Blocks, a) @@ -611,10 +644,8 @@ descriptionsUntil :: PandocMonad m descriptionsUntil indent end = do void spaceChar <|> lookAhead eol updateState (\st -> st { museInPara = False }) - (x, e) <- listItemContentsUntil indent (Right <$> try (optional blankline >> indentWith indent >> manyTill spaceChar (string "::") >> descriptionsUntil indent end)) (Left <$> end) - case e of - Right (xs, ee) -> return (x:xs, ee) - Left ee -> return ([x], ee) + (x, (xs, e)) <- listItemContentsUntil indent (try (optional blankline >> indentWith indent >> manyTill spaceChar (string "::") >> descriptionsUntil indent end)) (([],) <$> end) + return (x:xs, e) definitionListItemsUntil :: PandocMonad m => Int @@ -625,37 +656,31 @@ definitionListItemsUntil indent end = where continuation = try $ do pos <- getPosition - term <- trimInlinesF . mconcat <$> manyTill (choice inlineList) (string "::") - (x, e) <- descriptionsUntil (sourceColumn pos) ((Right <$> try (optional blankline >> indentWith indent >> continuation)) <|> (Left <$> end)) - let xx = do - term' <- term - x' <- sequence x - return (term', x') - case e of - Left ee -> return ([xx], ee) - Right (xs, ee) -> return (xx:xs, ee) + term <- trimInlinesF . mconcat <$> manyTill (choice inlineList) (try $ string "::") + (x, (xs, e)) <- descriptionsUntil (sourceColumn pos) (try (optional blankline >> indentWith indent >> continuation) <|> (([],) <$> end)) + let xx = (,) <$> term <*> sequence x + return (xx:xs, e) +-- | Parse a definition list. definitionListUntil :: PandocMonad m - => MuseParser m a + => MuseParser m a -- ^ Terminator parser -> MuseParser m (F Blocks, a) definitionListUntil end = try $ do many spaceChar pos <- getPosition let indent = sourceColumn pos - 1 guardDisabled Ext_amuse <|> guard (indent /= 0) -- Initial space is required by Amusewiki, but not Emacs Muse - (items, e) <- definitionListItemsUntil indent end - return (B.definitionList <$> sequence items, e) + first (fmap B.definitionList . sequence) <$> definitionListItemsUntil indent end anyListUntil :: PandocMonad m - => MuseParser m a + => MuseParser m a -- ^ Terminator parser -> MuseParser m (F Blocks, a) anyListUntil end = bulletListUntil end <|> orderedListUntil end <|> definitionListUntil end --- --- tables --- +-- *** Table parsers +-- | Internal Muse table representation. data MuseTable = MuseTable { museTableCaption :: Inlines , museTableHeaders :: [[Blocks]] @@ -663,10 +688,10 @@ data MuseTable = MuseTable , museTableFooters :: [[Blocks]] } -data MuseTableElement = MuseHeaderRow (F [Blocks]) - | MuseBodyRow (F [Blocks]) - | MuseFooterRow (F [Blocks]) - | MuseCaption (F Inlines) +data MuseTableElement = MuseHeaderRow [Blocks] + | MuseBodyRow [Blocks] + | MuseFooterRow [Blocks] + | MuseCaption Inlines museToPandocTable :: MuseTable -> Blocks museToPandocTable (MuseTable caption headers body footers) = @@ -676,73 +701,66 @@ museToPandocTable (MuseTable caption headers body footers) = headRow = if null headers then [] else head headers rows = (if null headers then [] else tail headers) ++ body ++ footers -museAppendElement :: MuseTable - -> MuseTableElement - -> F MuseTable -museAppendElement tbl element = +museAppendElement :: MuseTableElement + -> MuseTable + -> MuseTable +museAppendElement element tbl = case element of - MuseHeaderRow row -> do - row' <- row - return tbl{ museTableHeaders = museTableHeaders tbl ++ [row'] } - MuseBodyRow row -> do - row' <- row - return tbl{ museTableRows = museTableRows tbl ++ [row'] } - MuseFooterRow row-> do - row' <- row - return tbl{ museTableFooters = museTableFooters tbl ++ [row'] } - MuseCaption inlines -> do - inlines' <- inlines - return tbl{ museTableCaption = inlines' } + MuseHeaderRow row -> tbl{ museTableHeaders = row : museTableHeaders tbl } + MuseBodyRow row -> tbl{ museTableRows = row : museTableRows tbl } + MuseFooterRow row -> tbl{ museTableFooters = row : museTableFooters tbl } + MuseCaption inlines -> tbl{ museTableCaption = inlines } tableCell :: PandocMonad m => MuseParser m (F Blocks) tableCell = try $ fmap B.plain . trimInlinesF . mconcat <$> manyTill inline (lookAhead cellEnd) where cellEnd = try $ void (many1 spaceChar >> char '|') <|> eol -tableElements :: PandocMonad m => MuseParser m [MuseTableElement] -tableElements = tableParseElement `sepEndBy1` eol +tableElements :: PandocMonad m => MuseParser m (F [MuseTableElement]) +tableElements = sequence <$> (tableParseElement `sepEndBy1` eol) -elementsToTable :: [MuseTableElement] -> F MuseTable -elementsToTable = foldM museAppendElement emptyTable +elementsToTable :: [MuseTableElement] -> MuseTable +elementsToTable = foldr museAppendElement emptyTable where emptyTable = MuseTable mempty mempty mempty mempty +-- | Parse a table. table :: PandocMonad m => MuseParser m (F Blocks) -table = try $ do - rows <- tableElements - let tbl = elementsToTable rows - let pandocTbl = museToPandocTable <$> tbl :: F Blocks - return pandocTbl +table = try $ fmap (museToPandocTable . elementsToTable) <$> tableElements -tableParseElement :: PandocMonad m => MuseParser m MuseTableElement +tableParseElement :: PandocMonad m => MuseParser m (F MuseTableElement) tableParseElement = tableParseHeader <|> tableParseBody <|> tableParseFooter <|> tableParseCaption -tableParseRow :: PandocMonad m => Int -> MuseParser m (F [Blocks]) +tableParseRow :: PandocMonad m + => Int -- ^ Number of separator characters + -> MuseParser m (F [Blocks]) tableParseRow n = try $ do fields <- tableCell `sepBy2` fieldSep return $ sequence fields where p `sepBy2` sep = (:) <$> p <*> many1 (sep >> p) fieldSep = many1 spaceChar >> count n (char '|') >> (void (many1 spaceChar) <|> void (lookAhead newline)) -tableParseHeader :: PandocMonad m => MuseParser m MuseTableElement -tableParseHeader = MuseHeaderRow <$> tableParseRow 2 +-- | Parse a table header row. +tableParseHeader :: PandocMonad m => MuseParser m (F MuseTableElement) +tableParseHeader = fmap MuseHeaderRow <$> tableParseRow 2 -tableParseBody :: PandocMonad m => MuseParser m MuseTableElement -tableParseBody = MuseBodyRow <$> tableParseRow 1 +-- | Parse a table body row. +tableParseBody :: PandocMonad m => MuseParser m (F MuseTableElement) +tableParseBody = fmap MuseBodyRow <$> tableParseRow 1 -tableParseFooter :: PandocMonad m => MuseParser m MuseTableElement -tableParseFooter = MuseFooterRow <$> tableParseRow 3 +-- | Parse a table footer row. +tableParseFooter :: PandocMonad m => MuseParser m (F MuseTableElement) +tableParseFooter = fmap MuseFooterRow <$> tableParseRow 3 -tableParseCaption :: PandocMonad m => MuseParser m MuseTableElement +-- | Parse table caption. +tableParseCaption :: PandocMonad m => MuseParser m (F MuseTableElement) tableParseCaption = try $ do many spaceChar string "|+" - MuseCaption <$> (trimInlinesF . mconcat <$> many1Till inline (string "+|")) + fmap MuseCaption <$> (trimInlinesF . mconcat <$> many1Till inline (string "+|")) --- --- inline parsers --- +-- ** Inline parsers inlineList :: PandocMonad m => [MuseParser m (F Inlines)] inlineList = [ whitespace @@ -758,10 +776,12 @@ inlineList = [ whitespace , subscriptTag , strikeoutTag , verbatimTag + , classTag , nbsp , link , code , codeTag + , mathTag , inlineLiteralTag , str , symbol @@ -770,28 +790,30 @@ inlineList = [ whitespace inline :: PandocMonad m => MuseParser m (F Inlines) inline = endline <|> choice inlineList <?> "inline" +-- | Parse a soft break. endline :: PandocMonad m => MuseParser m (F Inlines) endline = try $ do newline notFollowedBy blankline - returnF B.softbreak + return $ return B.softbreak parseAnchor :: PandocMonad m => MuseParser m String parseAnchor = try $ do getPosition >>= \pos -> guard (sourceColumn pos == 1) char '#' - first <- letter - rest <- many (letter <|> digit) - skipMany spaceChar <|> void newline - return $ first:rest + (:) <$> letter <*> many (letter <|> digit <|> char '-') anchor :: PandocMonad m => MuseParser m (F Inlines) anchor = try $ do anchorId <- parseAnchor + skipMany spaceChar <|> void newline return $ return $ B.spanWith (anchorId, [], []) mempty +-- | Parse a footnote reference. footnote :: PandocMonad m => MuseParser m (F Inlines) footnote = try $ do + inLink <- museInLink <$> getState + guard $ not inLink ref <- noteMarker return $ do notes <- asksF museNotes @@ -799,7 +821,7 @@ footnote = try $ do Nothing -> return $ B.str $ "[" ++ ref ++ "]" Just (_pos, contents) -> do st <- askF - let contents' = runF contents st { museNotes = M.empty } + let contents' = runF contents st { museNotes = M.delete ref (museNotes st) } return $ B.note contents' whitespace :: PandocMonad m => MuseParser m (F Inlines) @@ -807,6 +829,7 @@ whitespace = try $ do skipMany1 spaceChar return $ return B.space +-- | Parse @\<br>@ tag. br :: PandocMonad m => MuseParser m (F Inlines) br = try $ do string "<br>" @@ -822,49 +845,68 @@ enclosedInlines :: (PandocMonad m, Show a, Show b) enclosedInlines start end = try $ trimInlinesF . mconcat <$> (enclosed (atStart start) end inline <* notFollowedBy (satisfy isLetter)) +-- | Parse an inline tag, such as @\<em>@ and @\<strong>@. inlineTag :: PandocMonad m - => (Inlines -> Inlines) - -> String + => String -- ^ Tag name -> MuseParser m (F Inlines) -inlineTag f tag = try $ do +inlineTag tag = try $ do htmlTag (~== TagOpen tag []) - res <- manyTill inline (void $ htmlTag (~== TagClose tag)) - return $ f <$> mconcat res - -strongTag :: PandocMonad m => MuseParser m (F Inlines) -strongTag = inlineTag B.strong "strong" + mconcat <$> manyTill inline (void $ htmlTag (~== TagClose tag)) +-- | Parse strong inline markup, indicated by @**@. strong :: PandocMonad m => MuseParser m (F Inlines) strong = fmap B.strong <$> emphasisBetween (string "**") +-- | Parse emphasis inline markup, indicated by @*@. emph :: PandocMonad m => MuseParser m (F Inlines) emph = fmap B.emph <$> emphasisBetween (char '*') +-- | Parse underline inline markup, indicated by @_@. +-- Supported only in Emacs Muse mode, not Text::Amuse. underlined :: PandocMonad m => MuseParser m (F Inlines) underlined = do guardDisabled Ext_amuse -- Supported only by Emacs Muse fmap underlineSpan <$> emphasisBetween (char '_') +-- | Parse @\<strong>@ tag. +strongTag :: PandocMonad m => MuseParser m (F Inlines) +strongTag = fmap B.strong <$> inlineTag "strong" + +-- | Parse @\<em>@ tag. emphTag :: PandocMonad m => MuseParser m (F Inlines) -emphTag = inlineTag B.emph "em" +emphTag = fmap B.emph <$> inlineTag "em" +-- | Parse @\<sup>@ tag. superscriptTag :: PandocMonad m => MuseParser m (F Inlines) -superscriptTag = inlineTag B.superscript "sup" +superscriptTag = fmap B.superscript <$> inlineTag "sup" +-- | Parse @\<sub>@ tag. subscriptTag :: PandocMonad m => MuseParser m (F Inlines) -subscriptTag = inlineTag B.subscript "sub" +subscriptTag = fmap B.subscript <$> inlineTag "sub" +-- | Parse @\<del>@ tag. strikeoutTag :: PandocMonad m => MuseParser m (F Inlines) -strikeoutTag = inlineTag B.strikeout "del" +strikeoutTag = fmap B.strikeout <$> inlineTag "del" +-- | Parse @\<verbatim>@ tag. verbatimTag :: PandocMonad m => MuseParser m (F Inlines) verbatimTag = return . B.text . snd <$> htmlElement "verbatim" +-- | Parse @\<class>@ tag. +classTag :: PandocMonad m => MuseParser m (F Inlines) +classTag = do + (TagOpen _ attrs, _) <- htmlTag (~== TagOpen "class" []) + res <- manyTill inline (void $ htmlTag (~== TagClose "class")) + let classes = maybe [] words $ lookup "name" attrs + return $ B.spanWith ("", classes, []) <$> mconcat res + +-- | Parse "~~" as nonbreaking space. nbsp :: PandocMonad m => MuseParser m (F Inlines) nbsp = try $ do string "~~" return $ return $ B.str "\160" +-- | Parse code markup, indicated by @\'=\'@ characters. code :: PandocMonad m => MuseParser m (F Inlines) code = try $ do atStart $ char '=' @@ -875,14 +917,18 @@ code = try $ do notFollowedBy $ satisfy isLetter return $ return $ B.code contents +-- | Parse @\<code>@ tag. codeTag :: PandocMonad m => MuseParser m (F Inlines) -codeTag = do - (attrs, content) <- htmlElement "code" - return $ return $ B.codeWith attrs content +codeTag = return . uncurry B.codeWith <$> htmlElement "code" +-- | Parse @\<math>@ tag. +-- @\<math>@ tag is an Emacs Muse extension enabled by @(require 'muse-latex2png)@ +mathTag :: PandocMonad m => MuseParser m (F Inlines) +mathTag = return . B.math . snd <$> htmlElement "math" + +-- | Parse inline @\<literal>@ tag as a raw inline. inlineLiteralTag :: PandocMonad m => MuseParser m (F Inlines) -inlineLiteralTag = do - guardDisabled Ext_amuse -- Text::Amuse does not support <literal> +inlineLiteralTag = (return . rawInline) <$> htmlElement "literal" where -- FIXME: Emacs Muse inserts <literal> without style into all output formats, but we assume HTML @@ -890,39 +936,35 @@ inlineLiteralTag = do rawInline (attrs, content) = B.rawInline (format attrs) content str :: PandocMonad m => MuseParser m (F Inlines) -str = do - result <- many1 alphaNum - updateLastStrPos - return $ return $ B.str result +str = return . B.str <$> many1 alphaNum <* updateLastStrPos symbol :: PandocMonad m => MuseParser m (F Inlines) symbol = return . B.str <$> count 1 nonspaceChar +-- | Parse a link or image. link :: PandocMonad m => MuseParser m (F Inlines) link = try $ do st <- getState guard $ not $ museInLink st setState $ st{ museInLink = True } - (url, title, content) <- linkText + (url, content) <- linkText updateState (\state -> state { museInLink = False }) return $ case stripPrefix "URL:" url of Nothing -> if isImageUrl url - then B.image url title <$> fromMaybe (return mempty) content - else B.link url title <$> fromMaybe (return $ B.str url) content - Just url' -> B.link url' title <$> fromMaybe (return $ B.str url') content + then B.image url "" <$> fromMaybe (return mempty) content + else B.link url "" <$> fromMaybe (return $ B.str url) content + Just url' -> B.link url' "" <$> fromMaybe (return $ B.str url') content where -- Taken from muse-image-regexp defined in Emacs Muse file lisp/muse-regexps.el imageExtensions = [".eps", ".gif", ".jpg", ".jpeg", ".pbm", ".png", ".tiff", ".xbm", ".xpm"] isImageUrl = (`elem` imageExtensions) . takeExtension linkContent :: PandocMonad m => MuseParser m (F Inlines) -linkContent = do - char '[' - trimInlinesF . mconcat <$> many1Till inline (string "]") +linkContent = char '[' >> trimInlinesF . mconcat <$> manyTill inline (string "]") -linkText :: PandocMonad m => MuseParser m (String, String, Maybe (F Inlines)) +linkText :: PandocMonad m => MuseParser m (String, Maybe (F Inlines)) linkText = do string "[[" - url <- many1Till anyChar $ char ']' + url <- manyTill anyChar $ char ']' content <- optionMaybe linkContent char ']' - return (url, "", content) + return (url, content) diff --git a/src/Text/Pandoc/Readers/Native.hs b/src/Text/Pandoc/Readers/Native.hs index 88f6bfe8f..ef200aa19 100644 --- a/src/Text/Pandoc/Readers/Native.hs +++ b/src/Text/Pandoc/Readers/Native.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2011-2018 John MacFarlane <jgm@berkeley.edu> @@ -30,6 +31,7 @@ Conversion of a string representation of a pandoc type (@Pandoc@, -} module Text.Pandoc.Readers.Native ( readNative ) where +import Prelude import Text.Pandoc.Definition import Text.Pandoc.Options (ReaderOptions) import Text.Pandoc.Shared (safeRead) diff --git a/src/Text/Pandoc/Readers/OPML.hs b/src/Text/Pandoc/Readers/OPML.hs index 82266748f..1a489ab94 100644 --- a/src/Text/Pandoc/Readers/OPML.hs +++ b/src/Text/Pandoc/Readers/OPML.hs @@ -1,5 +1,36 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{- +Copyright (C) 2013-2018 John MacFarlane <jgm@berkeley.edu> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Readers.OPML + Copyright : Copyright (C) 2013-2018 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley.edu> + Stability : alpha + Portability : portable + +Conversion of OPML to 'Pandoc' document. +-} + module Text.Pandoc.Readers.OPML ( readOPML ) where +import Prelude import Control.Monad.State.Strict import Data.Char (toUpper) import Data.Default diff --git a/src/Text/Pandoc/Readers/Odt.hs b/src/Text/Pandoc/Readers/Odt.hs index 875c18a85..30016e444 100644 --- a/src/Text/Pandoc/Readers/Odt.hs +++ b/src/Text/Pandoc/Readers/Odt.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PatternGuards #-} {- @@ -32,6 +33,7 @@ Entry point to the odt reader. module Text.Pandoc.Readers.Odt ( readOdt ) where +import Prelude import Codec.Archive.Zip import qualified Text.XML.Light as XML diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs index 73bed545e..971442613 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs @@ -1,4 +1,4 @@ - +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TupleSections #-} {- @@ -38,15 +38,13 @@ faster and easier to implement this way. module Text.Pandoc.Readers.Odt.Arrows.State where +import Prelude import Prelude hiding (foldl, foldr) import Control.Arrow import qualified Control.Category as Cat import Control.Monad -import Data.Foldable -import Data.Monoid - import Text.Pandoc.Readers.Odt.Arrows.Utils import Text.Pandoc.Readers.Odt.Generic.Fallible @@ -131,7 +129,7 @@ withSubStateF' unlift a = ArrowState go -- and one with any function. foldS :: (Foldable f, Monoid m) => ArrowState s x m -> ArrowState s (f x) m foldS a = ArrowState $ \(s,f) -> foldr a' (s,mempty) f - where a' x (s',m) = second (m <>) $ runArrowState a (s',x) + where a' x (s',m) = second (mappend m) $ runArrowState a (s',x) -- | Fold a state arrow through something 'Foldable'. Collect the results in a -- 'MonadPlus'. diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs index ef8b2d18a..d3db3a9e2 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2015 Martin Linnemann <theCodingMarlin@googlemail.com> @@ -39,6 +40,7 @@ with an equivalent return value. -- We export everything module Text.Pandoc.Readers.Odt.Arrows.Utils where +import Prelude import Control.Arrow import Control.Monad (join) @@ -61,13 +63,13 @@ and6 :: (Arrow a) => a b c0->a b c1->a b c2->a b c3->a b c4->a b c5 -> a b (c0,c1,c2,c3,c4,c5 ) -and3 a b c = (and2 a b ) &&& c +and3 a b c = and2 a b &&& c >>^ \((z,y ) , x) -> (z,y,x ) -and4 a b c d = (and3 a b c ) &&& d +and4 a b c d = and3 a b c &&& d >>^ \((z,y,x ) , w) -> (z,y,x,w ) -and5 a b c d e = (and4 a b c d ) &&& e +and5 a b c d e = and4 a b c d &&& e >>^ \((z,y,x,w ) , v) -> (z,y,x,w,v ) -and6 a b c d e f = (and5 a b c d e ) &&& f +and6 a b c d e f = and5 a b c d e &&& f >>^ \((z,y,x,w,v ) , u) -> (z,y,x,w,v,u ) liftA2 :: (Arrow a) => (x -> y -> z) -> a b x -> a b y -> a b z diff --git a/src/Text/Pandoc/Readers/Odt/Base.hs b/src/Text/Pandoc/Readers/Odt/Base.hs index 51c2da788..5e731aefe 100644 --- a/src/Text/Pandoc/Readers/Odt/Base.hs +++ b/src/Text/Pandoc/Readers/Odt/Base.hs @@ -1,5 +1,3 @@ - - {- Copyright (C) 2015 Martin Linnemann <theCodingMarlin@googlemail.com> diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index 380f16c66..78881914d 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Arrows #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-} @@ -39,6 +40,7 @@ module Text.Pandoc.Readers.Odt.ContentReader , read_body ) where +import Prelude import Control.Applicative hiding (liftA, liftA2, liftA3) import Control.Arrow @@ -520,7 +522,7 @@ matchingElement :: (Monoid e) matchingElement ns name reader = (ns, name, asResultAccumulator reader) where asResultAccumulator :: (ArrowChoice a, Monoid m) => a m m -> a m (Fallible m) - asResultAccumulator a = liftAsSuccess $ keepingTheValue a >>% (<>) + asResultAccumulator a = liftAsSuccess $ keepingTheValue a >>% mappend -- matchChildContent' :: (Monoid result) @@ -554,7 +556,7 @@ read_plain_text = fst ^&&& read_plain_text' >>% recover read_plain_text' = ( second ( arr extractText ) >>^ spreadChoice >>?! second text ) - >>?% (<>) + >>?% mappend -- extractText :: XML.Content -> Fallible String extractText (XML.Text cData) = succeedWith (XML.cdData cData) @@ -565,7 +567,7 @@ read_text_seq = matchingElement NsText "sequence" $ matchChildContent [] read_plain_text --- specifically. I honor that, although the current implementation of '(<>)' +-- specifically. I honor that, although the current implementation of 'mappend' -- for 'Inlines' in "Text.Pandoc.Builder" will collapse them again. -- The rational is to be prepared for future modifications. read_spaces :: InlineMatcher diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs b/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs index f8ea5c605..1fb5b5477 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- @@ -38,8 +39,7 @@ compatible instances of "ArrowChoice". -- We export everything module Text.Pandoc.Readers.Odt.Generic.Fallible where - -import Data.Monoid ((<>)) +import Prelude -- | Default for now. Will probably become a class at some point. type Failure = () @@ -90,7 +90,7 @@ collapseEither (Right (Right x)) = Right x -- (possibly combined) non-error. If both values represent an error, an error -- is returned. chooseMax :: (Monoid a, Monoid b) => Either a b -> Either a b -> Either a b -chooseMax = chooseMaxWith (<>) +chooseMax = chooseMaxWith mappend -- | If either of the values represents a non-error, the result is a -- (possibly combined) non-error. If both values represent an error, an error @@ -100,7 +100,7 @@ chooseMaxWith :: (Monoid a) => (b -> b -> b) -> Either a b -> Either a b chooseMaxWith (><) (Right a) (Right b) = Right $ a >< b -chooseMaxWith _ (Left a) (Left b) = Left $ a <> b +chooseMaxWith _ (Left a) (Left b) = Left $ a `mappend` b chooseMaxWith _ (Right a) _ = Right a chooseMaxWith _ _ (Right b) = Right b diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Namespaces.hs b/src/Text/Pandoc/Readers/Odt/Generic/Namespaces.hs index 82ae3e20e..6d96897aa 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/Namespaces.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/Namespaces.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2015 Martin Linnemann <theCodingMarlin@googlemail.com> @@ -31,6 +32,7 @@ typesafe Haskell namespace identifiers and unsafe "real world" namespaces. module Text.Pandoc.Readers.Odt.Generic.Namespaces where +import Prelude import qualified Data.Map as M -- diff --git a/src/Text/Pandoc/Readers/Odt/Generic/SetMap.hs b/src/Text/Pandoc/Readers/Odt/Generic/SetMap.hs index afd7d616c..b0543b6d1 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/SetMap.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/SetMap.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2015 Martin Linnemann <theCodingMarlin@googlemail.com> @@ -30,6 +31,7 @@ A map of values to sets of values. module Text.Pandoc.Readers.Odt.Generic.SetMap where +import Prelude import qualified Data.Map as M import qualified Data.Set as S diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs index 556517259..616d9290b 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeOperators #-} @@ -51,6 +52,7 @@ module Text.Pandoc.Readers.Odt.Generic.Utils , composition ) where +import Prelude import Control.Category (Category, (<<<), (>>>)) import qualified Control.Category as Cat (id) import Control.Monad (msum) diff --git a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs index 428048427..81392e16b 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Arrows #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE GADTs #-} @@ -67,6 +68,7 @@ module Text.Pandoc.Readers.Odt.Generic.XMLConverter , matchContent ) where +import Prelude import Control.Applicative hiding ( liftA, liftA2 ) import Control.Monad ( MonadPlus ) import Control.Arrow diff --git a/src/Text/Pandoc/Readers/Odt/Namespaces.hs b/src/Text/Pandoc/Readers/Odt/Namespaces.hs index 92e12931d..28865182f 100644 --- a/src/Text/Pandoc/Readers/Odt/Namespaces.hs +++ b/src/Text/Pandoc/Readers/Odt/Namespaces.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2015 Martin Linnemann <theCodingMarlin@googlemail.com> @@ -31,6 +32,7 @@ Namespaces used in odt files. module Text.Pandoc.Readers.Odt.Namespaces ( Namespace (..) ) where +import Prelude import Data.List (isPrefixOf) import qualified Data.Map as M (empty, insert) import Data.Maybe (fromMaybe, listToMaybe) diff --git a/src/Text/Pandoc/Readers/Odt/StyleReader.hs b/src/Text/Pandoc/Readers/Odt/StyleReader.hs index 58be8e4a3..e0444559b 100644 --- a/src/Text/Pandoc/Readers/Odt/StyleReader.hs +++ b/src/Text/Pandoc/Readers/Odt/StyleReader.hs @@ -1,5 +1,6 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE Arrows #-} - {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} @@ -57,6 +58,7 @@ module Text.Pandoc.Readers.Odt.StyleReader , readStylesAt ) where +import Prelude import Control.Applicative hiding (liftA, liftA2, liftA3) import Control.Arrow @@ -80,7 +82,6 @@ import Text.Pandoc.Readers.Odt.Generic.XMLConverter import Text.Pandoc.Readers.Odt.Base import Text.Pandoc.Readers.Odt.Namespaces - readStylesAt :: XML.Element -> Fallible Styles readStylesAt e = runConverter' readAllStyles mempty e @@ -183,13 +184,14 @@ data Styles = Styles deriving ( Show ) -- Styles from a monoid under union -instance Monoid Styles where - mempty = Styles M.empty M.empty M.empty - mappend (Styles sBn1 dSm1 lsBn1) - (Styles sBn2 dSm2 lsBn2) +instance Semigroup Styles where + (Styles sBn1 dSm1 lsBn1) <> (Styles sBn2 dSm2 lsBn2) = Styles (M.union sBn1 sBn2) (M.union dSm1 dSm2) (M.union lsBn1 lsBn2) +instance Monoid Styles where + mempty = Styles M.empty M.empty M.empty + mappend = (<>) -- Not all families from the specifications are implemented, only those we need. -- But there are none that are not mentioned here. diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 292830bd2..75b99e079 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2014-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -27,6 +28,7 @@ Conversion of org-mode formatted plain text to 'Pandoc' document. -} module Text.Pandoc.Readers.Org ( readOrg ) where +import Prelude import Text.Pandoc.Readers.Org.Blocks (blockList, meta) import Text.Pandoc.Readers.Org.ParserState (optionsToParserState) import Text.Pandoc.Readers.Org.Parsing (OrgParser, readWithM) diff --git a/src/Text/Pandoc/Readers/Org/BlockStarts.hs b/src/Text/Pandoc/Readers/Org/BlockStarts.hs index 424102cb0..5dbce01bd 100644 --- a/src/Text/Pandoc/Readers/Org/BlockStarts.hs +++ b/src/Text/Pandoc/Readers/Org/BlockStarts.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2014-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -40,6 +41,7 @@ module Text.Pandoc.Readers.Org.BlockStarts , endOfBlock ) where +import Prelude import Control.Monad (void) import Text.Pandoc.Readers.Org.Parsing diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index fa016283c..888cd9307 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2014-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -31,6 +32,7 @@ module Text.Pandoc.Readers.Org.Blocks , meta ) where +import Prelude import Text.Pandoc.Readers.Org.BlockStarts import Text.Pandoc.Readers.Org.DocumentTree (documentTree, headlineToBlocks) import Text.Pandoc.Readers.Org.Inlines @@ -51,7 +53,6 @@ import Data.Char (isSpace, toLower, toUpper) import Data.Default (Default) import Data.List (foldl', isPrefixOf) import Data.Maybe (fromMaybe, isJust, isNothing) -import Data.Monoid ((<>)) import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.Walk as Walk diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs index f77778ec9..c9465581a 100644 --- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs +++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2014-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -32,11 +33,11 @@ module Text.Pandoc.Readers.Org.DocumentTree , headlineToBlocks ) where +import Prelude import Control.Arrow ((***)) import Control.Monad (guard, void) import Data.Char (toLower, toUpper) import Data.List (intersperse) -import Data.Monoid ((<>)) import Text.Pandoc.Builder (Blocks, Inlines) import Text.Pandoc.Class (PandocMonad) import Text.Pandoc.Definition diff --git a/src/Text/Pandoc/Readers/Org/ExportSettings.hs b/src/Text/Pandoc/Readers/Org/ExportSettings.hs index 6a70c50b9..d02eb37c5 100644 --- a/src/Text/Pandoc/Readers/Org/ExportSettings.hs +++ b/src/Text/Pandoc/Readers/Org/ExportSettings.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2016-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -29,6 +30,7 @@ module Text.Pandoc.Readers.Org.ExportSettings ( exportSettings ) where +import Prelude import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Readers.Org.Parsing diff --git a/src/Text/Pandoc/Readers/Org/Inlines.hs b/src/Text/Pandoc/Readers/Org/Inlines.hs index 3a12f38d0..7d1568b80 100644 --- a/src/Text/Pandoc/Readers/Org/Inlines.hs +++ b/src/Text/Pandoc/Readers/Org/Inlines.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2014-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -33,6 +34,7 @@ module Text.Pandoc.Readers.Org.Inlines , linkTarget ) where +import Prelude import Text.Pandoc.Readers.Org.BlockStarts (endOfBlock, noteMarker) import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Readers.Org.Parsing @@ -55,9 +57,6 @@ import Data.Char (isAlphaNum, isSpace) import Data.List (intersperse) import qualified Data.Map as M import Data.Maybe (fromMaybe) -import Data.Monoid ((<>)) -import Data.Traversable (sequence) -import Prelude hiding (sequence) -- -- Functions acting on the parser state diff --git a/src/Text/Pandoc/Readers/Org/Meta.hs b/src/Text/Pandoc/Readers/Org/Meta.hs index 6ad403fd8..965e33d94 100644 --- a/src/Text/Pandoc/Readers/Org/Meta.hs +++ b/src/Text/Pandoc/Readers/Org/Meta.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TupleSections #-} {- @@ -33,6 +34,7 @@ module Text.Pandoc.Readers.Org.Meta , metaLine ) where +import Prelude import Text.Pandoc.Readers.Org.BlockStarts import Text.Pandoc.Readers.Org.ExportSettings (exportSettings) import Text.Pandoc.Readers.Org.Inlines @@ -48,6 +50,7 @@ import Text.Pandoc.Shared (safeRead) import Control.Monad (mzero, void, when) import Data.Char (toLower) import Data.List (intersperse) +import Data.Maybe (fromMaybe) import qualified Data.Map as M import Network.HTTP (urlEncode) @@ -189,16 +192,12 @@ parseFormat = try $ replacePlain <|> replaceUrl <|> justAppend setEmphasisPreChar :: Maybe [Char] -> OrgParserState -> OrgParserState setEmphasisPreChar csMb st = - let preChars = case csMb of - Nothing -> orgStateEmphasisPreChars defaultOrgParserState - Just cs -> cs + let preChars = fromMaybe (orgStateEmphasisPostChars defaultOrgParserState) csMb in st { orgStateEmphasisPreChars = preChars } setEmphasisPostChar :: Maybe [Char] -> OrgParserState -> OrgParserState setEmphasisPostChar csMb st = - let postChars = case csMb of - Nothing -> orgStateEmphasisPostChars defaultOrgParserState - Just cs -> cs + let postChars = fromMaybe (orgStateEmphasisPostChars defaultOrgParserState) csMb in st { orgStateEmphasisPostChars = postChars } emphChars :: Monad m => OrgParser m (Maybe [Char]) diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 6316766fa..4cb5bb626 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {- @@ -54,6 +55,7 @@ module Text.Pandoc.Readers.Org.ParserState , optionsToParserState ) where +import Prelude import Control.Monad.Reader (ReaderT, asks, local) import Data.Default (Default (..)) diff --git a/src/Text/Pandoc/Readers/Org/Parsing.hs b/src/Text/Pandoc/Readers/Org/Parsing.hs index 36420478b..e014de65e 100644 --- a/src/Text/Pandoc/Readers/Org/Parsing.hs +++ b/src/Text/Pandoc/Readers/Org/Parsing.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2014-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -112,6 +113,7 @@ module Text.Pandoc.Readers.Org.Parsing , getPosition ) where +import Prelude import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Parsing hiding (F, anyLine, blanklines, newline, diff --git a/src/Text/Pandoc/Readers/Org/Shared.hs b/src/Text/Pandoc/Readers/Org/Shared.hs index cba72cc07..07dbeca2a 100644 --- a/src/Text/Pandoc/Readers/Org/Shared.hs +++ b/src/Text/Pandoc/Readers/Org/Shared.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2014-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -33,6 +34,7 @@ module Text.Pandoc.Readers.Org.Shared , translateLang ) where +import Prelude import Data.Char (isAlphaNum) import Data.List (isPrefixOf, isSuffixOf) diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index e88d997f0..71a38cf82 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -31,6 +32,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion from reStructuredText to 'Pandoc' document. -} module Text.Pandoc.Readers.RST ( readRST ) where +import Prelude import Control.Arrow (second) import Control.Monad (forM_, guard, liftM, mplus, mzero, when) import Control.Monad.Except (throwError) @@ -40,7 +42,6 @@ import Data.List (deleteFirstsBy, elemIndex, intercalate, isInfixOf, isSuffixOf, nub, sort, transpose, union) import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust) -import Data.Monoid ((<>)) import Data.Sequence (ViewR (..), viewr) import Data.Text (Text) import qualified Data.Text as T @@ -80,7 +81,7 @@ type RSTParser m = ParserT [Char] ParserState m --- bulletListMarkers :: [Char] -bulletListMarkers = "*+-" +bulletListMarkers = "*+-•‣⁃" underlineChars :: [Char] underlineChars = "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~" @@ -650,11 +651,15 @@ directive' = do skipMany spaceChar top <- many $ satisfy (/='\n') <|> try (char '\n' <* - notFollowedBy' (rawFieldListItem 3) <* - count 3 (char ' ') <* + notFollowedBy' (rawFieldListItem 1) <* + many1 (char ' ') <* notFollowedBy blankline) newline - fields <- many $ rawFieldListItem 3 + fields <- do + fieldIndent <- length <$> lookAhead (many (char ' ')) + if fieldIndent == 0 + then return [] + else many $ rawFieldListItem fieldIndent body <- option "" $ try $ blanklines >> indentedBlock optional blanklines let body' = body ++ "\n\n" @@ -1085,10 +1090,15 @@ targetURI :: Monad m => ParserT [Char] st m [Char] targetURI = do skipSpaces optional newline - contents <- many1 (try (many spaceChar >> newline >> - many1 spaceChar >> noneOf " \t\n") <|> noneOf "\n") + contents <- trim <$> + many1 (satisfy (/='\n') + <|> try (newline >> many1 spaceChar >> noneOf " \t\n")) blanklines - return $ escapeURI $ trim contents + case reverse contents of + -- strip backticks + '_':'`':xs -> return (dropWhile (=='`') (reverse xs) ++ "_") + '_':_ -> return contents + _ -> return (escapeURI contents) substKey :: PandocMonad m => RSTParser m () substKey = try $ do diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs index 75e3f89eb..1f230ae7e 100644 --- a/src/Text/Pandoc/Readers/TWiki.hs +++ b/src/Text/Pandoc/Readers/TWiki.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE RelaxedPolyRec #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RelaxedPolyRec #-} + -- RelaxedPolyRec needed for inlinesBetween on GHC < 7 {- Copyright (C) 2014 Alexander Sulfrian <alexander.sulfrian@fu-berlin.de> @@ -35,6 +35,7 @@ Conversion of twiki text to 'Pandoc' document. module Text.Pandoc.Readers.TWiki ( readTWiki ) where +import Prelude import Control.Monad import Control.Monad.Except (throwError) import Data.Char (isAlphaNum) diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 30bb6a715..bc3bcaf26 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2010-2012 Paul Rivier <paul*rivier#demotera*com> | tr '*#' '.@' 2010-2018 John MacFarlane @@ -52,11 +53,11 @@ TODO : refactor common patterns across readers : module Text.Pandoc.Readers.Textile ( readTextile) where +import Prelude import Control.Monad (guard, liftM) import Control.Monad.Except (throwError) import Data.Char (digitToInt, isUpper) import Data.List (intercalate, intersperse, transpose) -import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import Text.HTML.TagSoup (Tag (..), fromAttrib) @@ -394,7 +395,7 @@ table = try $ do (toprow:rest) | any (fst . fst) toprow -> (toprow, rest) _ -> (mempty, rawrows) - let nbOfCols = max (length headers) (length $ head rows) + let nbOfCols = maximum $ map length (headers:rows) let aligns = map minimum $ transpose $ map (map (snd . fst)) (headers:rows) return $ B.table caption (zip aligns (replicate nbOfCols 0.0)) diff --git a/src/Text/Pandoc/Readers/TikiWiki.hs b/src/Text/Pandoc/Readers/TikiWiki.hs index a92f7bed2..5c7507248 100644 --- a/src/Text/Pandoc/Readers/TikiWiki.hs +++ b/src/Text/Pandoc/Readers/TikiWiki.hs @@ -1,13 +1,12 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RelaxedPolyRec #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RelaxedPolyRec #-} {- | Module : Text.Pandoc.Readers.TikiWiki Copyright : Copyright (C) 2017 Robin Lee Powell - License : GPLv2 + License : GNU GPL, version 2 or above Maintainer : Robin Lee Powell <robinleepowell@gmail.com> Stability : alpha @@ -19,6 +18,7 @@ Conversion of TikiWiki text to 'Pandoc' document. module Text.Pandoc.Readers.TikiWiki ( readTikiWiki ) where +import Prelude import Control.Monad import Control.Monad.Except (throwError) import qualified Data.Foldable as F diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index f4dda7a11..bed49fd46 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com> @@ -31,6 +32,7 @@ module Text.Pandoc.Readers.Txt2Tags ( readTxt2Tags ) where +import Prelude import Control.Monad (guard, void, when) import Control.Monad.Except (catchError, throwError) import Control.Monad.Reader (Reader, asks, runReader) @@ -38,7 +40,6 @@ import Data.Char (toLower) import Data.Default import Data.List (intercalate, transpose) import Data.Maybe (fromMaybe) -import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Format (formatTime) @@ -46,7 +47,7 @@ import Text.Pandoc.Builder (Blocks, Inlines, trimInlines) import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class (PandocMonad) import qualified Text.Pandoc.Class as P -import Text.Pandoc.Compat.Time (defaultTimeLocale) +import Data.Time (defaultTimeLocale) import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Parsing hiding (space, spaces, uri) @@ -444,7 +445,7 @@ inlineMarkup p f c special = try $ do let end' = case drop 2 end of "" -> mempty xs -> special xs - return $ f (start' <> body' <> end') + return $ f (start' `mappend` body' `mappend` end') Nothing -> do -- Either bad or case such as ***** guard (l >= 5) let body' = replicate (l - 4) c diff --git a/src/Text/Pandoc/Readers/Vimwiki.hs b/src/Text/Pandoc/Readers/Vimwiki.hs index d717a1ba8..824a912c3 100644 --- a/src/Text/Pandoc/Readers/Vimwiki.hs +++ b/src/Text/Pandoc/Readers/Vimwiki.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE CPP #-} {- Copyright (C) 2017-2018 Yuchen Pei <me@ypei.me> @@ -63,12 +65,12 @@ Conversion of vimwiki text to 'Pandoc' document. module Text.Pandoc.Readers.Vimwiki ( readVimwiki ) where +import Prelude import Control.Monad (guard) import Control.Monad.Except (throwError) import Data.Default import Data.List (isInfixOf, isPrefixOf) import Data.Maybe -import Data.Monoid ((<>)) import Data.Text (Text, unpack) import Text.Pandoc.Builder (Blocks, Inlines, fromList, toList, trimInlines) import qualified Text.Pandoc.Builder as B (blockQuote, bulletList, code, |