diff options
33 files changed, 307 insertions, 340 deletions
@@ -36,4 +36,3 @@ import Text.Pandoc.Error (handleError) main :: IO () main = E.catch (parseOptions options defaultOpts >>= convertWithOpts) (handleError . Left) - diff --git a/src/Text/Pandoc/CSV.hs b/src/Text/Pandoc/CSV.hs index 924052dca..e25b684f8 100644 --- a/src/Text/Pandoc/CSV.hs +++ b/src/Text/Pandoc/CSV.hs @@ -100,4 +100,3 @@ endline :: Parser () endline = do optional (void $ char '\r') void $ char '\n' - diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index 592ec11e5..7c518e84b 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -997,4 +997,3 @@ instance PandocMonad m => PandocMonad (ParsecT s st m) where else "") (return ()) logOutput = lift . logOutput - diff --git a/src/Text/Pandoc/Emoji.hs b/src/Text/Pandoc/Emoji.hs index c9f368abc..3766960ea 100644 --- a/src/Text/Pandoc/Emoji.hs +++ b/src/Text/Pandoc/Emoji.hs @@ -903,4 +903,3 @@ emojis = M.fromList ,("zero","0\65039\8419") ,("zzz","\128164") ] - diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 61ff006cf..27d5c6a9c 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -602,4 +602,3 @@ tagTypeTable = M.fromList , (0xa300, FileSource) , (0xa301, SceneType) ] - diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs index 0a7b61578..3eb14eba3 100644 --- a/src/Text/Pandoc/Lua/StackInstances.hs +++ b/src/Text/Pandoc/Lua/StackInstances.hs @@ -208,18 +208,18 @@ peekBlock idx = do case tag of "BlockQuote" -> BlockQuote <$> elementContent "BulletList" -> BulletList <$> elementContent - "CodeBlock" -> (withAttr CodeBlock) <$> elementContent + "CodeBlock" -> withAttr CodeBlock <$> elementContent "DefinitionList" -> DefinitionList <$> elementContent - "Div" -> (withAttr Div) <$> elementContent + "Div" -> withAttr Div <$> elementContent "Header" -> (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst) <$> elementContent "HorizontalRule" -> return HorizontalRule "LineBlock" -> LineBlock <$> elementContent - "OrderedList" -> (uncurry OrderedList) <$> elementContent + "OrderedList" -> uncurry OrderedList <$> elementContent "Null" -> return Null "Para" -> Para <$> elementContent "Plain" -> Plain <$> elementContent - "RawBlock" -> (uncurry RawBlock) <$> elementContent + "RawBlock" -> uncurry RawBlock <$> elementContent "Table" -> (\(capt, aligns, widths, headers, body) -> Table capt aligns widths headers body) <$> elementContent @@ -257,8 +257,8 @@ peekInline :: StackIndex -> Lua Inline peekInline idx = do tag <- getTag idx case tag of - "Cite" -> (uncurry Cite) <$> elementContent - "Code" -> (withAttr Code) <$> elementContent + "Cite" -> uncurry Cite <$> elementContent + "Code" -> withAttr Code <$> elementContent "Emph" -> Emph <$> elementContent "Image" -> (\(LuaAttr attr, lst, tgt) -> Image attr lst tgt) <$> elementContent @@ -266,13 +266,13 @@ peekInline idx = do <$> elementContent "LineBreak" -> return LineBreak "Note" -> Note <$> elementContent - "Math" -> (uncurry Math) <$> elementContent - "Quoted" -> (uncurry Quoted) <$> elementContent - "RawInline" -> (uncurry RawInline) <$> elementContent + "Math" -> uncurry Math <$> elementContent + "Quoted" -> uncurry Quoted <$> elementContent + "RawInline" -> uncurry RawInline <$> elementContent "SmallCaps" -> SmallCaps <$> elementContent "SoftBreak" -> return SoftBreak "Space" -> return Space - "Span" -> (withAttr Span) <$> elementContent + "Span" -> withAttr Span <$> elementContent "Str" -> Str <$> elementContent "Strikeout" -> Strikeout <$> elementContent "Strong" -> Strong <$> elementContent diff --git a/src/Text/Pandoc/MIME.hs b/src/Text/Pandoc/MIME.hs index 162112634..fb85910bb 100644 --- a/src/Text/Pandoc/MIME.hs +++ b/src/Text/Pandoc/MIME.hs @@ -525,4 +525,3 @@ mimeTypesList = -- List borrowed from happstack-server. ,("zip","application/zip") ,("zmt","chemical/x-mopac-input") ] - diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs index cafb4a226..beb3c569f 100644 --- a/src/Text/Pandoc/PDF.hs +++ b/src/Text/Pandoc/PDF.hs @@ -438,4 +438,3 @@ context2pdf verbosity tmpDir source = inDirectory tmpDir $ do return $ Left logmsg (ExitSuccess, Nothing) -> return $ Left "" (ExitSuccess, Just pdf) -> return $ Right pdf - diff --git a/src/Text/Pandoc/Readers/Creole.hs b/src/Text/Pandoc/Readers/Creole.hs index 3b330e544..4da259c0e 100644 --- a/src/Text/Pandoc/Readers/Creole.hs +++ b/src/Text/Pandoc/Readers/Creole.hs @@ -282,7 +282,7 @@ placeholder = B.text <$> try (string "<<<" >> manyTill anyChar (string ">>>") >> return "") whitespace :: PandocMonad m => CRLParser m B.Inlines -whitespace = (lb <|> regsp) +whitespace = lb <|> regsp where lb = try $ skipMany spaceChar >> linebreak >> return B.space regsp = try $ skipMany1 spaceChar >> return B.space diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 465c3abec..1874a011a 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -139,7 +139,7 @@ instance Default DEnv where type DocxContext m = ReaderT DEnv (StateT DState m) evalDocxContext :: PandocMonad m => DocxContext m a -> DEnv -> DState -> m a -evalDocxContext ctx env st = flip evalStateT st $ flip runReaderT env $ ctx +evalDocxContext ctx env st = flip evalStateT st $flip runReaderT env ctx -- This is empty, but we put it in for future-proofing. spansToKeep :: [String] @@ -156,7 +156,7 @@ metaStyles = M.fromList [ ("Title", "title") , ("Abstract", "abstract")] sepBodyParts :: [BodyPart] -> ([BodyPart], [BodyPart]) -sepBodyParts = span (\bp -> (isMetaPar bp || isEmptyPar bp)) +sepBodyParts = span (\bp -> isMetaPar bp || isEmptyPar bp) isMetaPar :: BodyPart -> Bool isMetaPar (Paragraph pPr _) = @@ -183,7 +183,7 @@ bodyPartsToMeta' (bp : bps) remaining <- bodyPartsToMeta' bps let f (MetaInlines ils) (MetaInlines ils') = MetaBlocks [Para ils, Para ils'] - f (MetaInlines ils) (MetaBlocks blks) = MetaBlocks ((Para ils) : blks) + f (MetaInlines ils) (MetaBlocks blks) = MetaBlocks (Para ils : blks) f m (MetaList mv) = MetaList (m : mv) f m n = MetaList [m, n] return $ M.insertWith f metaField (MetaInlines (toList inlines)) remaining @@ -215,17 +215,17 @@ codeDivs = ["SourceCode"] runElemToInlines :: RunElem -> Inlines runElemToInlines (TextRun s) = text s -runElemToInlines (LnBrk) = linebreak -runElemToInlines (Tab) = space -runElemToInlines (SoftHyphen) = text "\xad" -runElemToInlines (NoBreakHyphen) = text "\x2011" +runElemToInlines LnBrk = linebreak +runElemToInlines Tab = space +runElemToInlines SoftHyphen = text "\xad" +runElemToInlines NoBreakHyphen = text "\x2011" runElemToString :: RunElem -> String runElemToString (TextRun s) = s -runElemToString (LnBrk) = ['\n'] -runElemToString (Tab) = ['\t'] -runElemToString (SoftHyphen) = ['\xad'] -runElemToString (NoBreakHyphen) = ['\x2011'] +runElemToString LnBrk = ['\n'] +runElemToString Tab = ['\t'] +runElemToString SoftHyphen = ['\xad'] +runElemToString NoBreakHyphen = ['\x2011'] runToString :: Run -> String runToString (Run _ runElems) = concatMap runElemToString runElems @@ -274,21 +274,21 @@ runStyleToTransform rPr , s `elem` spansToKeep = let rPr' = rPr{rStyle = Nothing} in - (spanWith ("", [s], [])) . (runStyleToTransform rPr') + spanWith ("", [s], []) . runStyleToTransform rPr' | Just True <- isItalic rPr = - emph . (runStyleToTransform rPr {isItalic = Nothing}) + emph . runStyleToTransform rPr {isItalic = Nothing} | Just True <- isBold rPr = - strong . (runStyleToTransform rPr {isBold = Nothing}) + strong . runStyleToTransform rPr {isBold = Nothing} | Just True <- isSmallCaps rPr = - smallcaps . (runStyleToTransform rPr {isSmallCaps = Nothing}) + smallcaps . runStyleToTransform rPr {isSmallCaps = Nothing} | Just True <- isStrike rPr = - strikeout . (runStyleToTransform rPr {isStrike = Nothing}) + strikeout . runStyleToTransform rPr {isStrike = Nothing} | Just SupScrpt <- rVertAlign rPr = - superscript . (runStyleToTransform rPr {rVertAlign = Nothing}) + superscript . runStyleToTransform rPr {rVertAlign = Nothing} | Just SubScrpt <- rVertAlign rPr = - subscript . (runStyleToTransform rPr {rVertAlign = Nothing}) + subscript . runStyleToTransform rPr {rVertAlign = Nothing} | Just "single" <- rUnderline rPr = - underlineSpan . (runStyleToTransform rPr {rUnderline = Nothing}) + underlineSpan . runStyleToTransform rPr {rUnderline = Nothing} | otherwise = id runToInlines :: PandocMonad m => Run -> DocxContext m Inlines @@ -306,10 +306,10 @@ runToInlines (Run rs runElems) let ils = smushInlines (map runElemToInlines runElems) return $ (runStyleToTransform $ resolveDependentRunStyle rs) ils runToInlines (Footnote bps) = do - blksList <- smushBlocks <$> (mapM bodyPartToBlocks bps) + blksList <- smushBlocks <$> mapM bodyPartToBlocks bps return $ note blksList runToInlines (Endnote bps) = do - blksList <- smushBlocks <$> (mapM bodyPartToBlocks bps) + blksList <- smushBlocks <$> mapM bodyPartToBlocks bps return $ note blksList runToInlines (InlineDrawing fp title alt bs ext) = do (lift . lift) $ P.insertMedia fp Nothing bs @@ -330,7 +330,7 @@ blocksToInlinesWarn cmtId blks = do notParaOrPlain (Para _) = False notParaOrPlain (Plain _) = False notParaOrPlain _ = True - when (not $ null $ filter notParaOrPlain blkList) $ + unless (null $ filter notParaOrPlain blkList) $ lift $ P.report $ DocxParserWarning $ "Docx comment " ++ cmtId ++ " will not retain formatting" return $ fromList $ blocksToInlines blkList @@ -390,7 +390,7 @@ parPartToInlines (BookMark _ anchor) = -- are not defined in pandoc, it seems like a necessary evil to -- avoid an extra pass. let newAnchor = - if not inHdrBool && anchor `elem` (M.elems anchorMap) + if not inHdrBool && anchor `elem` M.elems anchorMap then uniqueIdent [Str anchor] (Set.fromList $ M.elems anchorMap) else anchor unless inHdrBool @@ -399,7 +399,7 @@ parPartToInlines (BookMark _ anchor) = parPartToInlines (Drawing fp title alt bs ext) = do (lift . lift) $ P.insertMedia fp Nothing bs return $ imageWith (extentToAttr ext) fp title $ text alt -parPartToInlines Chart = do +parPartToInlines Chart = return $ spanWith ("", ["chart"], []) $ text "[CHART]" parPartToInlines (InternalHyperLink anchor runs) = do ils <- smushInlines <$> mapM runToInlines runs @@ -407,11 +407,10 @@ parPartToInlines (InternalHyperLink anchor runs) = do parPartToInlines (ExternalHyperLink target runs) = do ils <- smushInlines <$> mapM runToInlines runs return $ link target "" ils -parPartToInlines (PlainOMath exps) = do +parPartToInlines (PlainOMath exps) = return $ math $ writeTeX exps parPartToInlines (SmartTag runs) = do - ils <- smushInlines <$> mapM runToInlines runs - return ils + smushInlines <$> mapM runToInlines runs isAnchorSpan :: Inline -> Bool isAnchorSpan (Span (_, classes, kvs) _) = @@ -454,7 +453,7 @@ makeHeaderAnchor' blk = return blk -- Rewrite a standalone paragraph block as a plain singleParaToPlain :: Blocks -> Blocks singleParaToPlain blks - | (Para (ils) :< seeq) <- viewl $ unMany blks + | (Para ils :< seeq) <- viewl $ unMany blks , Seq.null seeq = singleton $ Plain ils singleParaToPlain blks = blks @@ -471,7 +470,7 @@ rowToBlocksList (Row cells) = do -- like trimInlines, but also take out linebreaks trimSps :: Inlines -> Inlines -trimSps (Many ils) = Many $ Seq.dropWhileL isSp $ Seq.dropWhileR isSp $ ils +trimSps (Many ils) = Many $ Seq.dropWhileL isSp $Seq.dropWhileR isSp ils where isSp Space = True isSp SoftBreak = True isSp LineBreak = True @@ -483,17 +482,17 @@ parStyleToTransform pPr , c `elem` divsToKeep = let pPr' = pPr { pStyle = cs } in - (divWith ("", [c], [])) . (parStyleToTransform pPr') + divWith ("", [c], []) . parStyleToTransform pPr' | (c:cs) <- pStyle pPr, c `elem` listParagraphDivs = let pPr' = pPr { pStyle = cs, indentation = Nothing} in - (divWith ("", [c], [])) . (parStyleToTransform pPr') + divWith ("", [c], []) . parStyleToTransform pPr' | (_:cs) <- pStyle pPr , Just True <- pBlockQuote pPr = let pPr' = pPr { pStyle = cs } in - blockQuote . (parStyleToTransform pPr') + blockQuote . parStyleToTransform pPr' | (_:cs) <- pStyle pPr = let pPr' = pPr { pStyle = cs} in @@ -523,7 +522,7 @@ bodyPartToBlocks (Paragraph pPr parparts) $ codeBlock $ concatMap parPartToString parparts | Just (style, n) <- pHeading pPr = do - ils <- local (\s-> s{docxInHeaderBlock=True}) $ + ils <-local (\s-> s{docxInHeaderBlock=True}) (smushInlines <$> mapM parPartToInlines parparts) makeHeaderAnchor $ headerWith ("", delete style (pStyle pPr), []) n ils @@ -545,7 +544,7 @@ bodyPartToBlocks (ListItem pPr numId lvl (Just levelInfo) parparts) = do , ("num-id", numId) , ("format", fmt) , ("text", txt) - , ("start", (show start)) + , ("start", show start) ] (_, fmt, txt, Nothing) -> [ ("level", lvl) @@ -556,7 +555,7 @@ bodyPartToBlocks (ListItem pPr numId lvl (Just levelInfo) parparts) = do blks <- bodyPartToBlocks (Paragraph pPr parparts) return $ divWith ("", ["list-item"], kvs) blks bodyPartToBlocks (ListItem pPr _ _ _ parparts) = - let pPr' = pPr {pStyle = "ListParagraph": (pStyle pPr)} + let pPr' = pPr {pStyle = "ListParagraph": pStyle pPr} in bodyPartToBlocks $ Paragraph pPr' parparts bodyPartToBlocks (Tbl _ _ _ []) = @@ -588,7 +587,7 @@ bodyPartToBlocks (Tbl cap _ look (r:rs)) = do widths = replicate width 0 :: [Double] return $ table caption (zip alignments widths) hdrCells cells -bodyPartToBlocks (OMathPara e) = do +bodyPartToBlocks (OMathPara e) = return $ para $ displayMath (writeTeX e) @@ -597,7 +596,7 @@ rewriteLink' :: PandocMonad m => Inline -> DocxContext m Inline rewriteLink' l@(Link attr ils ('#':target, title)) = do anchorMap <- gets docxAnchorMap return $ case M.lookup target anchorMap of - Just newTarget -> (Link attr ils ('#':newTarget, title)) + Just newTarget -> Link attr ils ('#':newTarget, title) Nothing -> l rewriteLink' il = return il @@ -610,7 +609,7 @@ bodyToOutput (Body bps) = do meta <- bodyPartsToMeta metabps blks <- smushBlocks <$> mapM bodyPartToBlocks blkbps blks' <- rewriteLinks $ blocksToDefinitions $ blocksToBullets $ toList blks - return $ (meta, blks') + return (meta, blks') docxToOutput :: PandocMonad m => ReaderOptions diff --git a/src/Text/Pandoc/Readers/Docx/Lists.hs b/src/Text/Pandoc/Readers/Docx/Lists.hs index c7f4adc98..53840c609 100644 --- a/src/Text/Pandoc/Readers/Docx/Lists.hs +++ b/src/Text/Pandoc/Readers/Docx/Lists.hs @@ -156,7 +156,7 @@ flatToBullets :: [Block] -> [Block] flatToBullets elems = flatToBullets' (-1) elems singleItemHeaderToHeader :: Block -> Block -singleItemHeaderToHeader (OrderedList _ [[h@(Header{})]]) = h +singleItemHeaderToHeader (OrderedList _ [[h@Header{}]]) = h singleItemHeaderToHeader blk = blk diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 1aa69f62e..fea595027 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -303,8 +303,7 @@ archiveToDocument zf = do elemToBody :: NameSpaces -> Element -> D Body elemToBody ns element | isElem ns "w" "body" element = - mapD (elemToBodyPart ns) (elChildren element) >>= - (return . Body) + fmap Body (mapD (elemToBodyPart ns) (elChildren element)) elemToBody _ _ = throwError WrongElem archiveToStyles :: Archive -> (CharStyleMap, ParStyleMap) @@ -374,7 +373,7 @@ buildBasedOnList ns element rootStyle = case getStyleChildren ns element rootStyle of [] -> [] stys -> stys ++ - concatMap (\s -> buildBasedOnList ns element (Just s)) stys + concatMap (buildBasedOnList ns element . Just) stys archiveToNotes :: Archive -> Notes archiveToNotes zf = @@ -577,7 +576,7 @@ testBitMask :: String -> Int -> Bool testBitMask bitMaskS n = case (reads ("0x" ++ bitMaskS) :: [(Int, String)]) of [] -> False - ((n', _) : _) -> ((n' .|. n) /= 0) + ((n', _) : _) -> (n' .|. n) /= 0 stringToInteger :: String -> Maybe Integer stringToInteger s = listToMaybe $ map fst (reads s :: [(Integer, String)]) @@ -654,12 +653,8 @@ getTitleAndAlt :: NameSpaces -> Element -> (String, String) getTitleAndAlt ns element = let mbDocPr = findChildByName ns "wp" "inline" element >>= findChildByName ns "wp" "docPr" - title = case mbDocPr >>= findAttrByName ns "" "title" of - Just title' -> title' - Nothing -> "" - alt = case mbDocPr >>= findAttrByName ns "" "descr" of - Just alt' -> alt' - Nothing -> "" + title = fromMaybe "" (mbDocPr >>= findAttrByName ns "" "title") + alt = fromMaybe "" (mbDocPr >>= findAttrByName ns "" "descr") in (title, alt) elemToParPart :: NameSpaces -> Element -> D ParPart @@ -727,7 +722,7 @@ elemToParPart ns element runs <- mapD (elemToRun ns) (elChildren element) rels <- asks envRelationships case lookupRelationship location relId rels of - Just target -> do + Just target -> case findAttrByName ns "w" "anchor" element of Just anchor -> return $ ExternalHyperLink (target ++ '#':anchor) runs Nothing -> return $ ExternalHyperLink target runs @@ -750,7 +745,7 @@ elemToParPart ns element return $ CommentEnd cmtId elemToParPart ns element | isElem ns "m" "oMath" element = - (eitherToD $ readOMML $ showElement element) >>= (return . PlainOMath) + fmap PlainOMath (eitherToD $ readOMML $ showElement element) elemToParPart _ _ = throwError WrongElem elemToCommentStart :: NameSpaces -> Element -> D ParPart @@ -764,10 +759,10 @@ elemToCommentStart ns element elemToCommentStart _ _ = throwError WrongElem lookupFootnote :: String -> Notes -> Maybe Element -lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s) +lookupFootnote s (Notes _ fns _) = fns >>= M.lookup s lookupEndnote :: String -> Notes -> Maybe Element -lookupEndnote s (Notes _ _ ens) = ens >>= (M.lookup s) +lookupEndnote s (Notes _ _ ens) = ens >>= M.lookup s elemToExtent :: Element -> Extent elemToExtent drawingElem = @@ -1035,11 +1030,10 @@ elemToRunElems ns element let font = do fontElem <- findElement (qualName "rFonts") element stringToFont =<< - (foldr (<|>) Nothing $ + foldr (<|>) Nothing ( map (flip findAttr fontElem . qualName) ["ascii", "hAnsi"]) local (setFont font) (mapD (elemToRunElem ns) (elChildren element)) elemToRunElems _ _ = throwError WrongElem setFont :: Maybe Font -> ReaderEnv -> ReaderEnv setFont f s = s{envFont = f} - diff --git a/src/Text/Pandoc/Readers/Docx/Util.hs b/src/Text/Pandoc/Readers/Docx/Util.hs index 8415dbf68..d9d65bc07 100644 --- a/src/Text/Pandoc/Readers/Docx/Util.hs +++ b/src/Text/Pandoc/Readers/Docx/Util.hs @@ -44,4 +44,3 @@ findAttrByName :: NameSpaces -> String -> String -> Element -> Maybe String findAttrByName ns pref name el = let ns' = ns ++ elemToNameSpaces el in findAttr (elemName ns' pref name) el - diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs index d38a40c8d..c1eb6ca59 100644 --- a/src/Text/Pandoc/Readers/EPUB.hs +++ b/src/Text/Pandoc/Readers/EPUB.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE StandaloneDeriving #-} + {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} @@ -39,7 +39,7 @@ type Items = M.Map String (FilePath, MimeType) readEPUB :: PandocMonad m => ReaderOptions -> BL.ByteString -> m Pandoc readEPUB opts bytes = case toArchiveOrFail bytes of - Right archive -> archiveToEPUB opts $ archive + Right archive -> archiveToEPUB opts archive Left _ -> throwError $ PandocParseError "Couldn't extract ePub file" -- runEPUB :: Except PandocError a -> Either PandocError a @@ -61,7 +61,7 @@ archiveToEPUB os archive = do Pandoc _ bs <- foldM' (\a b -> ((a <>) . walk (prependHash escapedSpine)) `liftM` parseSpineElem root b) mempty spine - let ast = coverDoc <> (Pandoc meta bs) + let ast = coverDoc <> Pandoc meta bs fetchImages (M.elems items) root archive ast return ast where @@ -79,7 +79,7 @@ archiveToEPUB os archive = do return $ fixInternalReferences path html mimeToReader s _ (unEscapeString -> path) | s `elem` imageMimes = return $ imageToPandoc path - | otherwise = return $ mempty + | otherwise = return mempty -- paths should be absolute when this function is called -- renameImages should do this @@ -122,7 +122,7 @@ parseManifest content = do let items = findChildren (dfName "item") manifest r <- mapM parseItem items let cover = findAttr (emptyName "href") =<< filterChild findCover manifest - return (cover, (M.fromList r)) + return (cover, M.fromList r) where findCover e = maybe False (isInfixOf "cover-image") (findAttr (emptyName "properties") e) @@ -136,7 +136,7 @@ parseSpine :: PandocMonad m => Items -> Element -> m [(FilePath, MimeType)] parseSpine is e = do spine <- findElementE (dfName "spine") e let itemRefs = findChildren (dfName "itemref") spine - mapM (mkE "parseSpine" . (flip M.lookup is)) $ mapMaybe parseItemRef itemRefs + mapM (mkE "parseSpine" . flip M.lookup is) $ mapMaybe parseItemRef itemRefs where parseItemRef ref = do let linear = maybe True (== "yes") (findAttr (emptyName "linear") ref) @@ -167,21 +167,21 @@ getManifest archive = do docElem <- (parseXMLDocE . UTF8.toStringLazy . fromEntry) metaEntry let namespaces = mapMaybe attrToNSPair (elAttribs docElem) ns <- mkE "xmlns not in namespaces" (lookup "xmlns" namespaces) - as <- liftM ((map attrToPair) . elAttribs) + as <- fmap (map attrToPair . elAttribs) (findElementE (QName "rootfile" (Just ns) Nothing) docElem) manifestFile <- mkE "Root not found" (lookup "full-path" as) let rootdir = dropFileName manifestFile --mime <- lookup "media-type" as manifest <- findEntryByPathE manifestFile archive - liftM ((,) rootdir) (parseXMLDocE . UTF8.toStringLazy . fromEntry $ manifest) + fmap ((,) rootdir) (parseXMLDocE . UTF8.toStringLazy . fromEntry $ manifest) -- Fixup fixInternalReferences :: FilePath -> Pandoc -> Pandoc fixInternalReferences pathToFile = - (walk $ renameImages root) - . (walk $ fixBlockIRs filename) - . (walk $ fixInlineIRs filename) + walk (renameImages root) + . walk (fixBlockIRs filename) + . walk (fixInlineIRs filename) where (root, escapeURI -> filename) = splitFileName pathToFile diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs index 9d0610e01..e98c79ed8 100644 --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -142,7 +142,7 @@ makeExample prompt expression result = <> B.space <> B.codeWith ([], ["haskell","expr"], []) (trim expression) <> B.linebreak - <> (mconcat $ intersperse B.linebreak $ map coder result') + <> mconcat (intersperse B.linebreak $ map coder result') where -- 1. drop trailing whitespace from the prompt, remember the prefix prefix = takeWhile (`elem` " \t") prompt diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 665ed6548..c91e8bd79 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -107,7 +107,7 @@ parseLaTeX = do (if bottomLevel < 1 then walk (adjustHeaders (1 - bottomLevel)) else id) $ - walk (resolveRefs (sLabels st)) $ doc' + walk (resolveRefs (sLabels st)) doc' return $ Pandoc meta bs' resolveRefs :: M.Map String [Inline] -> Inline -> Inline @@ -246,7 +246,7 @@ rawLaTeXParser parser = do case res of Left _ -> mzero Right (raw, st) -> do - updateState (updateMacros ((sMacros st) <>)) + updateState (updateMacros (sMacros st <>)) takeP (T.length (untokenize raw)) applyMacros :: (PandocMonad m, HasMacros s, HasReaderOptions s) @@ -333,7 +333,7 @@ totoks pos t = : totoks (incSourceColumn pos (1 + T.length ws + T.length ss)) rest''' | d == '\t' || d == '\n' -> - Tok pos Symbol ("\\") + Tok pos Symbol "\\" : totoks (incSourceColumn pos 1) rest | otherwise -> Tok pos (CtrlSeq (T.singleton d)) (T.pack [c,d]) @@ -403,7 +403,7 @@ satisfyTok f = doMacros :: PandocMonad m => Int -> LP m () doMacros n = do verbatimMode <- sVerbatimMode <$> getState - when (not verbatimMode) $ do + unless verbatimMode $ do inp <- getInput case inp of Tok spos (CtrlSeq "begin") _ : Tok _ Symbol "{" : @@ -543,7 +543,7 @@ bgroup = try $ do symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup" egroup :: PandocMonad m => LP m Tok -egroup = (symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup") +egroup = symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup" grouped :: (PandocMonad m, Monoid a) => LP m a -> LP m a grouped parser = try $ do @@ -577,7 +577,7 @@ dimenarg :: PandocMonad m => LP m Text dimenarg = try $ do ch <- option False $ True <$ symbol '=' Tok _ _ s <- satisfyTok isWordTok - guard $ (T.take 2 (T.reverse s)) `elem` + guard $ T.take 2 (T.reverse s) `elem` ["pt","pc","in","bp","cm","mm","dd","cc","sp"] let num = T.take (T.length s - 2) s guard $ T.length num > 0 @@ -633,7 +633,7 @@ mkImage options src = do _ -> return $ imageWith attr src "" alt doxspace :: PandocMonad m => LP m Inlines -doxspace = do +doxspace = (space <$ lookAhead (satisfyTok startsWithLetter)) <|> return mempty where startsWithLetter (Tok _ Word t) = case T.uncons t of @@ -662,22 +662,22 @@ lit = pure . str removeDoubleQuotes :: Text -> Text removeDoubleQuotes t = - maybe t id $ T.stripPrefix "\"" t >>= T.stripSuffix "\"" + Data.Maybe.fromMaybe t $ T.stripPrefix "\"" t >>= T.stripSuffix "\"" doubleQuote :: PandocMonad m => LP m Inlines -doubleQuote = do +doubleQuote = quoted' doubleQuoted (try $ count 2 $ symbol '`') - (void $ try $ count 2 $ symbol '\'') + (void $ try $ count 2 $ symbol '\'') <|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”') -- the following is used by babel for localized quotes: <|> quoted' doubleQuoted (try $ sequence [symbol '"', symbol '`']) (void $ try $ sequence [symbol '"', symbol '\'']) singleQuote :: PandocMonad m => LP m Inlines -singleQuote = do +singleQuote = quoted' singleQuoted ((:[]) <$> symbol '`') - (try $ symbol '\'' >> - notFollowedBy (satisfyTok startsWithLetter)) + (try $ symbol '\'' >> + notFollowedBy (satisfyTok startsWithLetter)) <|> quoted' singleQuoted ((:[]) <$> symbol '‘') (try $ symbol '’' >> notFollowedBy (satisfyTok startsWithLetter)) @@ -726,8 +726,8 @@ doAcronymPlural form = do acro <- braced plural <- lit "s" return . mconcat $ [spanWith ("",[],[("acronym-label", toksToString acro), - ("acronym-form", "plural+" ++ form)]) $ mconcat - $ [str $ toksToString acro, plural]] + ("acronym-form", "plural+" ++ form)]) $ + mconcat [str $ toksToString acro, plural]] doverb :: PandocMonad m => LP m Inlines doverb = do @@ -748,7 +748,7 @@ verbTok stopchar = do let (t1, t2) = T.splitAt i txt inp <- getInput setInput $ Tok (incSourceColumn pos i) Symbol (T.singleton stopchar) - : (totoks (incSourceColumn pos (i + 1)) (T.drop 1 t2)) ++ inp + : totoks (incSourceColumn pos (i + 1)) (T.drop 1 t2) ++ inp return $ Tok pos toktype t1 dolstinline :: PandocMonad m => LP m Inlines @@ -773,8 +773,8 @@ keyval = try $ do val <- option [] $ do symbol '=' optional sp - braced <|> (many1 (satisfyTok isWordTok <|> satisfyTok isSpecSym - <|> anyControlSeq)) + braced <|> many1 (satisfyTok isWordTok <|> satisfyTok isSpecSym + <|> anyControlSeq) optional sp optional (symbol ',') optional sp @@ -1020,10 +1020,10 @@ dollarsMath = do contents <- trim . toksToString <$> many (notFollowedBy (symbol '$') >> anyTok) if display - then do + then mathDisplay contents <$ try (symbol '$' >> symbol '$') - <|> (guard (null contents) >> return (mathInline "")) - else mathInline contents <$ (symbol '$') + <|> (guard (null contents) >> return (mathInline "")) + else mathInline contents <$ symbol '$' -- citations @@ -1041,7 +1041,7 @@ simpleCiteArgs :: PandocMonad m => LP m [Citation] simpleCiteArgs = try $ do first <- optionMaybe $ toList <$> opt second <- optionMaybe $ toList <$> opt - keys <- try $ bgroup *> (manyTill citationLabel egroup) + keys <- try $ bgroup *> manyTill citationLabel egroup let (pre, suf) = case (first , second ) of (Just s , Nothing) -> (mempty, s ) (Just s , Just t ) -> (s , t ) @@ -1080,7 +1080,7 @@ cites mode multi = try $ do citation :: PandocMonad m => String -> CitationMode -> Bool -> LP m Inlines citation name mode multi = do (c,raw) <- withRaw $ cites mode multi - return $ cite c (rawInline "latex" $ "\\" ++ name ++ (toksToString raw)) + return $ cite c (rawInline "latex" $ "\\" ++ name ++ toksToString raw) handleCitationPart :: Inlines -> [Citation] handleCitationPart ils = @@ -1139,7 +1139,7 @@ singleChar = try $ do then do let (t1, t2) = (T.take 1 t, T.drop 1 t) inp <- getInput - setInput $ (Tok (incSourceColumn pos 1) toktype t2) : inp + setInput $ Tok (incSourceColumn pos 1) toktype t2 : inp return $ Tok pos toktype t1 else return $ Tok pos toktype t @@ -1606,7 +1606,7 @@ getRawCommand name txt = do void braced skipopts void $ count 4 braced - "def" -> do + "def" -> void $ manyTill anyTok braced _ -> do skipangles @@ -1715,14 +1715,14 @@ inlines = mconcat <$> many inline -- block elements: begin_ :: PandocMonad m => Text -> LP m () -begin_ t = (try $ do +begin_ t = try (do controlSeq "begin" spaces txt <- untokenize <$> braced guard (t == txt)) <?> ("\\begin{" ++ T.unpack t ++ "}") end_ :: PandocMonad m => Text -> LP m () -end_ t = (try $ do +end_ t = try (do controlSeq "end" spaces txt <- untokenize <$> braced @@ -1766,7 +1766,7 @@ insertIncluded :: PandocMonad m insertIncluded dirs f = do pos <- getPosition containers <- getIncludeFiles <$> getState - when (f `elem` containers) $ do + when (f `elem` containers) $ throwError $ PandocParseError $ "Include file loop at " ++ show pos updateState $ addIncludeFile f mbcontents <- readFileFromDirs dirs f @@ -1800,7 +1800,7 @@ authors = try $ do addMeta "author" (map trimInlines auths) macroDef :: PandocMonad m => LP m Blocks -macroDef = do +macroDef = mempty <$ ((commandDef <|> environmentDef) <* doMacros 0) where commandDef = do (name, macro') <- newcommand <|> letmacro <|> defmacro @@ -2177,9 +2177,9 @@ fancyverbEnv name = do codeBlockWith attr <$> verbEnv name obeylines :: PandocMonad m => LP m Blocks -obeylines = do +obeylines = para . fromList . removeLeadingTrailingBreaks . - walk softBreakToHard . toList <$> env "obeylines" inlines + walk softBreakToHard . toList <$> env "obeylines" inlines where softBreakToHard SoftBreak = LineBreak softBreakToHard x = x removeLeadingTrailingBreaks = reverse . dropWhile isLineBreak . @@ -2368,7 +2368,7 @@ splitWordTok :: PandocMonad m => LP m () splitWordTok = do inp <- getInput case inp of - (Tok spos Word t : rest) -> do + (Tok spos Word t : rest) -> setInput $ map (Tok spos Symbol . T.singleton) (T.unpack t) ++ rest _ -> return () @@ -2433,9 +2433,9 @@ parseTableRow envname prefsufs = do suffpos <- getPosition option [] (count 1 amp) return $ map (setpos prefpos) pref ++ contents ++ map (setpos suffpos) suff - rawcells <- sequence (map celltoks prefsufs) + rawcells <- mapM celltoks prefsufs oldInput <- getInput - cells <- sequence $ map (\ts -> setInput ts >> parseTableCell) rawcells + cells <- mapM (\ts -> setInput ts >> parseTableCell) rawcells setInput oldInput spaces let numcells = length cells diff --git a/src/Text/Pandoc/Readers/LaTeX/Types.hs b/src/Text/Pandoc/Readers/LaTeX/Types.hs index 9e441714d..b24b2ad0a 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Types.hs +++ b/src/Text/Pandoc/Readers/LaTeX/Types.hs @@ -49,4 +49,3 @@ data ExpansionPoint = ExpandWhenDefined | ExpandWhenUsed data Macro = Macro ExpansionPoint Int (Maybe [Tok]) [Tok] deriving Show - diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 48719a678..69e70f9f5 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -74,7 +74,7 @@ readMarkdown :: PandocMonad m -> Text -- ^ String to parse (assuming @'\n'@ line endings) -> m Pandoc readMarkdown opts s = do - parsed <- (readWithM parseMarkdown) def{ stateOptions = opts } + parsed <- readWithM parseMarkdown def{ stateOptions = opts } (T.unpack (crFilter s) ++ "\n\n") case parsed of Right result -> return result @@ -162,7 +162,7 @@ charsInBalancedBrackets openBrackets = (char '[' >> charsInBalancedBrackets (openBrackets + 1)) <|> (char ']' >> charsInBalancedBrackets (openBrackets - 1)) <|> (( (() <$ code) - <|> (() <$ (escapedChar')) + <|> (() <$ escapedChar') <|> (newline >> notFollowedBy blankline) <|> skipMany1 (noneOf "[]`\n\\") <|> (() <$ count 1 (oneOf "`\\")) @@ -241,7 +241,7 @@ yamlMetaBlock = try $ do case Yaml.decodeEither' $ UTF8.fromString rawYaml of Right (Yaml.Object hashmap) -> do let alist = H.toList hashmap - mapM_ (\(k, v) -> do + mapM_ (\(k, v) -> if ignorable k then return () else do @@ -320,7 +320,7 @@ yamlToMeta (Yaml.Array xs) = do return $ B.toMetaValue xs'' yamlToMeta (Yaml.Object o) = do let alist = H.toList o - foldM (\m (k,v) -> do + foldM (\m (k,v) -> if ignorable k then return m else do @@ -353,7 +353,7 @@ kvPair allowEmpty = try $ do (try $ newline >> lookAhead (blankline <|> nonspaceChar)) guard $ allowEmpty || not (null val) let key' = concat $ words $ map toLower key - let val' = MetaBlocks $ B.toList $ B.plain $ B.text $ val + let val' = MetaBlocks $ B.toList $ B.plain $B.text val return (key',val') parseMarkdown :: PandocMonad m => MarkdownParser m Pandoc @@ -364,8 +364,7 @@ parseMarkdown = do -- check for notes with no corresponding note references let notesUsed = stateNoteRefs st let notesDefined = M.keys (stateNotes' st) - mapM_ (\n -> unless (n `Set.member` notesUsed) $ do - -- lookup to get sourcepos + mapM_ (\n -> unless (n `Set.member` notesUsed) $ case M.lookup n (stateNotes' st) of Just (pos, _) -> report (NoteDefinedButNotUsed n pos) Nothing -> throwError $ @@ -384,7 +383,7 @@ referenceKey = try $ do (_,raw) <- reference char ':' skipSpaces >> optional newline >> skipSpaces >> notFollowedBy (char '[') - let sourceURL = liftM unwords $ many $ try $ do + let sourceURL = fmap unwords $ many $ try $ do skipMany spaceChar notFollowedBy' referenceTitle notFollowedBy' $ guardEnabled Ext_link_attributes >> attributes @@ -533,7 +532,7 @@ atxChar = do atxHeader :: PandocMonad m => MarkdownParser m (F Blocks) atxHeader = try $ do - level <- atxChar >>= many1 . char >>= return . length + level <- fmap length (atxChar >>= many1 . char) notFollowedBy $ guardEnabled Ext_fancy_lists >> (char '.' <|> char ')') -- this would be a list guardDisabled Ext_space_in_atx_header <|> notFollowedBy nonspaceChar @@ -588,7 +587,7 @@ setextHeader = try $ do underlineChar <- oneOf setextHChars many (char underlineChar) blanklines - let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1 + let level = fromMaybe 0 (findIndex (== underlineChar) setextHChars) + 1 attr' <- registerHeader attr (runF text defaultParserState) guardDisabled Ext_implicit_header_references <|> registerImplicitHeader raw attr' @@ -629,8 +628,7 @@ blockDelimiter f len = try $ do c <- lookAhead (satisfy f) case len of Just l -> count l (char c) >> many (char c) >> return l - Nothing -> count 3 (char c) >> many (char c) >>= - return . (+ 3) . length + Nothing -> fmap ((+ 3) . length) (count 3 (char c) >> many (char c)) attributes :: PandocMonad m => MarkdownParser m Attr attributes = try $ do @@ -794,7 +792,7 @@ blockQuote :: PandocMonad m => MarkdownParser m (F Blocks) blockQuote = do raw <- emailBlockQuote -- parse the extracted block, which may contain various block elements: - contents <- parseFromString' parseBlocks $ (intercalate "\n" raw) ++ "\n\n" + contents <- parseFromString' parseBlocks $ intercalate "\n" raw ++ "\n\n" return $ B.blockQuote <$> contents -- @@ -840,7 +838,7 @@ orderedListStart mbstydelim = try $ do return (num, style, delim)) listStart :: PandocMonad m => MarkdownParser m () -listStart = bulletListStart <|> (orderedListStart Nothing >> return ()) +listStart = bulletListStart <|> (Control.Monad.void (orderedListStart Nothing)) listLine :: PandocMonad m => Int -> MarkdownParser m String listLine continuationIndent = try $ do @@ -854,7 +852,7 @@ listLine continuationIndent = try $ do listLineCommon :: PandocMonad m => MarkdownParser m String listLineCommon = concat <$> manyTill ( many1 (satisfy $ \c -> c /= '\n' && c /= '<') - <|> liftM snd (htmlTag isCommentTag) + <|> fmap snd (htmlTag isCommentTag) <|> count 1 anyChar ) newline @@ -973,7 +971,7 @@ defRawBlock compact = try $ do <|> notFollowedBy defListMarker anyLine ) rawlines <- many dline - cont <- liftM concat $ many $ try $ do + cont <- fmap concat $ many $ try $ do trailing <- option "" blanklines ln <- indentSpaces >> notFollowedBy blankline >> anyLine lns <- many dline @@ -984,7 +982,7 @@ defRawBlock compact = try $ do definitionList :: PandocMonad m => MarkdownParser m (F Blocks) definitionList = try $ do lookAhead (anyLine >> - optional (blankline >> notFollowedBy (table >> return ())) >> + optional (blankline >> notFollowedBy (Control.Monad.void table)) >> -- don't capture table caption as def list! defListMarker) compactDefinitionList <|> normalDefinitionList @@ -1052,7 +1050,7 @@ plain = fmap B.plain . trimInlinesF <$> inlines1 htmlElement :: PandocMonad m => MarkdownParser m String htmlElement = rawVerbatimBlock <|> strictHtmlBlock - <|> liftM snd (htmlTag isBlockTag) + <|> fmap snd (htmlTag isBlockTag) htmlBlock :: PandocMonad m => MarkdownParser m (F Blocks) htmlBlock = do @@ -1183,17 +1181,17 @@ simpleTableHeader headless = try $ do let (lengths, lines') = unzip dashes let indices = scanl (+) (length initSp) lines' -- If no header, calculate alignment on basis of first row of text - rawHeads <- liftM (tail . splitStringByIndices (init indices)) $ + rawHeads <- fmap (tail . splitStringByIndices (init indices)) $ if headless then lookAhead anyLine else return rawContent - let aligns = zipWith alignType (map (\a -> [a]) rawHeads) lengths + let aligns = zipWith alignType (map ((: [])) rawHeads) lengths let rawHeads' = if headless then replicate (length dashes) "" else rawHeads heads <- fmap sequence - $ mapM (parseFromString' (mconcat <$> many plain)) - $ map trim rawHeads' + $ + mapM ((parseFromString' (mconcat <$> many plain)).trim) rawHeads' return (heads, aligns, indices) -- Returns an alignment type for a table, based on a list of strings @@ -1295,7 +1293,7 @@ multilineTableHeader headless = try $ do let (lengths, lines') = unzip dashes let indices = scanl (+) (length initSp) lines' rawHeadsList <- if headless - then liftM (map (:[]) . tail . + then fmap (map (:[]) . tail . splitStringByIndices (init indices)) $ lookAhead anyLine else return $ transpose $ map (tail . splitStringByIndices (init indices)) @@ -1305,8 +1303,7 @@ multilineTableHeader headless = try $ do then replicate (length dashes) "" else map (unlines . map trim) rawHeadsList heads <- fmap sequence $ - mapM (parseFromString' (mconcat <$> many plain)) $ - map trim rawHeads + mapM ((parseFromString' (mconcat <$> many plain)).trim) rawHeads return (heads, aligns, indices) -- Parse a grid table: starts with row of '-' on top, then header @@ -1345,7 +1342,7 @@ pipeTable = try $ do fromIntegral (len + 1) / fromIntegral numColumns) seplengths else replicate (length aligns) 0.0 - return $ (aligns, widths, heads', sequence lines'') + return (aligns, widths, heads', sequence lines'') sepPipe :: PandocMonad m => MarkdownParser m () sepPipe = try $ do @@ -1363,7 +1360,7 @@ pipeTableRow = try $ do <|> void (noneOf "|\n\r") let cellContents = ((trim . snd) <$> withRaw (many chunk)) >>= parseFromString' pipeTableCell - cells <- cellContents `sepEndBy1` (char '|') + cells <- cellContents `sepEndBy1` char '|' -- surrounding pipes needed for a one-column table: guard $ not (length cells == 1 && not openPipe) blankline @@ -1383,7 +1380,7 @@ pipeTableHeaderPart = try $ do right <- optionMaybe (char ':') skipMany spaceChar let len = length pipe + maybe 0 (const 1) left + maybe 0 (const 1) right - return $ + return ((case (left,right) of (Nothing,Nothing) -> AlignDefault (Just _,Nothing) -> AlignLeft @@ -1412,10 +1409,10 @@ tableWith headerParser rowParser lineParser footerParser = try $ do lines' <- fmap sequence $ rowParser indices `sepEndBy1` lineParser footerParser numColumns <- getOption readerColumns - let widths = if (indices == []) + let widths = if indices == [] then replicate (length aligns) 0.0 else widthsFromIndices numColumns indices - return $ (aligns, widths, heads, lines') + return (aligns, widths, heads, lines') table :: PandocMonad m => MarkdownParser m (F Blocks) table = try $ do @@ -1573,7 +1570,7 @@ enclosure c = do <|> (guard =<< notAfterString) cs <- many1 (char c) (return (B.str cs) <>) <$> whitespace - <|> do + <|> case length cs of 3 -> three c 2 -> two c mempty @@ -1723,7 +1720,7 @@ source = do skipSpaces let urlChunk = try parenthesizedChars - <|> (notFollowedBy (oneOf " )") >> (count 1 litChar)) + <|> (notFollowedBy (oneOf " )") >> count 1 litChar) <|> try (many1 spaceChar <* notFollowedBy (oneOf "\"')")) let sourceURL = (unwords . words . concat) <$> many urlChunk let betweenAngles = try $ @@ -1892,8 +1889,8 @@ rawConTeXtEnvironment :: PandocMonad m => ParserT [Char] st m String rawConTeXtEnvironment = try $ do string "\\start" completion <- inBrackets (letter <|> digit <|> spaceChar) - <|> (many1 letter) - contents <- manyTill (rawConTeXtEnvironment <|> (count 1 anyChar)) + <|> many1 letter + contents <- manyTill (rawConTeXtEnvironment <|> count 1 anyChar) (try $ string "\\stop" >> string completion) return $ "\\start" ++ completion ++ concat contents ++ "\\stop" ++ completion @@ -1999,10 +1996,9 @@ emoji = try $ do cite :: PandocMonad m => MarkdownParser m (F Inlines) cite = do guardEnabled Ext_citations - citations <- textualCite + textualCite <|> do (cs, raw) <- withRaw normalCite return $ (flip B.cite (B.text raw)) <$> cs - return citations textualCite :: PandocMonad m => MarkdownParser m (F Inlines) textualCite = try $ do @@ -2076,7 +2072,7 @@ suffix = try $ do prefix :: PandocMonad m => MarkdownParser m (F Inlines) prefix = trimInlinesF . mconcat <$> - manyTill inline (char ']' <|> liftM (const ']') (lookAhead citeKey)) + manyTill inline (char ']' <|> fmap (const ']') (lookAhead citeKey)) citeList :: PandocMonad m => MarkdownParser m (F [Citation]) citeList = fmap sequence $ sepBy1 citation (try $ char ';' >> spnl) diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 6f9b9b3c2..6cc505e3b 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -137,7 +137,7 @@ parseHtmlContentWithAttrs tag parser = do endOfContent = try $ skipMany blankline >> skipSpaces >> eof parseHtmlContent :: PandocMonad m => String -> MuseParser m a -> MuseParser m [a] -parseHtmlContent tag p = liftM snd (parseHtmlContentWithAttrs tag p) +parseHtmlContent tag p = fmap snd (parseHtmlContentWithAttrs tag p) -- -- directive parsers @@ -213,7 +213,7 @@ header = try $ do st <- stateParserContext <$> getState q <- stateQuoteContext <$> getState getPosition >>= \pos -> guard (st == NullState && q == NoQuote && sourceColumn pos == 1) - level <- liftM length $ many1 $ char '*' + level <- fmap length $ many1 $ char '*' guard $ level <= 5 spaceChar content <- trimInlinesF . mconcat <$> manyTill inline eol @@ -240,7 +240,7 @@ exampleTag = do chop = lchop . rchop literal :: PandocMonad m => MuseParser m (F Blocks) -literal = liftM (return . rawBlock) $ htmlElement "literal" +literal = fmap (return . rawBlock) $ htmlElement "literal" where format (_, _, kvs) = fromMaybe "html" $ lookup "format" kvs rawBlock (attrs, content) = B.rawBlock (format attrs) content @@ -268,7 +268,7 @@ quoteTag = withQuoteContext InDoubleQuote $ blockTag B.blockQuote "quote" divTag :: PandocMonad m => MuseParser m (F Blocks) divTag = do (attrs, content) <- parseHtmlContentWithAttrs "div" block - return $ (B.divWith attrs) <$> mconcat content + return $ B.divWith attrs <$> mconcat content verseLine :: PandocMonad m => MuseParser m String verseLine = do @@ -296,7 +296,7 @@ para :: PandocMonad m => MuseParser m (F Blocks) para = do indent <- length <$> many spaceChar let f = if indent >= 2 && indent < 6 then B.blockQuote else id - liftM (f . B.para) . trimInlinesF . mconcat <$> many1Till inline endOfParaElement + fmap (f . B.para) . trimInlinesF . mconcat <$> many1Till inline endOfParaElement where endOfParaElement = lookAhead $ endOfInput <|> endOfPara <|> newBlockElement endOfInput = try $ skipMany blankline >> skipSpaces >> eof @@ -481,7 +481,7 @@ museAppendElement tbl element = return tbl{ museTableCaption = inlines' } tableCell :: PandocMonad m => MuseParser m (F Blocks) -tableCell = try $ liftM B.plain . trimInlinesF . mconcat <$> manyTill inline (lookAhead cellEnd) +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] @@ -575,7 +575,7 @@ footnote = try $ do return $ B.note contents' whitespace :: PandocMonad m => MuseParser m (F Inlines) -whitespace = liftM return (lb <|> regsp) +whitespace = fmap return (lb <|> regsp) where lb = try $ skipMany spaceChar >> linebreak >> return B.space regsp = try $ skipMany1 spaceChar >> return B.space @@ -655,10 +655,10 @@ codeTag = do return $ return $ B.codeWith attrs $ fromEntities content str :: PandocMonad m => MuseParser m (F Inlines) -str = liftM (return . B.str) (many1 alphaNum <|> count 1 characterReference) +str = fmap (return . B.str) (many1 alphaNum <|> count 1 characterReference) symbol :: PandocMonad m => MuseParser m (F Inlines) -symbol = liftM (return . B.str) $ count 1 nonspaceChar +symbol = fmap (return . B.str) $ count 1 nonspaceChar link :: PandocMonad m => MuseParser m (F Inlines) link = try $ do diff --git a/src/Text/Pandoc/Readers/Native.hs b/src/Text/Pandoc/Readers/Native.hs index d065bff8d..ce33e080b 100644 --- a/src/Text/Pandoc/Readers/Native.hs +++ b/src/Text/Pandoc/Readers/Native.hs @@ -69,4 +69,3 @@ readInlines s = maybe ((:[]) <$> readInline s) Right (safeRead (unpack s)) readInline :: Text -> Either PandocError Inline readInline s = maybe (Left . PandocParseError $ "Could not read: " ++ unpack s) Right (safeRead (unpack s)) - diff --git a/src/Text/Pandoc/Readers/OPML.hs b/src/Text/Pandoc/Readers/OPML.hs index 167ad6d4e..e3ef67bc1 100644 --- a/src/Text/Pandoc/Readers/OPML.hs +++ b/src/Text/Pandoc/Readers/OPML.hs @@ -4,6 +4,7 @@ import Control.Monad.State.Strict import Data.Char (toUpper) import Data.Default import Data.Generics +import Data.Maybe (fromMaybe) import Data.Text (Text, pack, unpack) import Text.HTML.TagSoup.Entity (lookupEntity) import Text.Pandoc.Builder @@ -32,9 +33,9 @@ instance Default OPMLState where readOPML :: PandocMonad m => ReaderOptions -> Text -> m Pandoc readOPML _ inp = do - (bs, st') <- flip runStateT def + (bs, st') <- runStateT (mapM parseBlock $ normalizeTree $ - parseXML (unpack (crFilter inp))) + parseXML (unpack (crFilter inp))) def return $ setTitle (opmlDocTitle st') $ setAuthors (opmlDocAuthors st') $ @@ -62,9 +63,7 @@ convertEntity e = maybe (map toUpper e) id (lookupEntity e) -- convenience function to get an attribute value, defaulting to "" attrValue :: String -> Element -> String attrValue attr elt = - case lookupAttrBy (\x -> qName x == attr) (elAttribs elt) of - Just z -> z - Nothing -> "" + fromMaybe "" (lookupAttrBy (\x -> qName x == attr) (elAttribs elt)) -- exceptT :: PandocMonad m => Either PandocError a -> OPML m a -- exceptT = either throwError return @@ -73,13 +72,13 @@ asHtml :: PandocMonad m => String -> OPML m Inlines asHtml s = (\(Pandoc _ bs) -> case bs of [Plain ils] -> fromList ils - _ -> mempty) <$> (lift $ readHtml def (pack s)) + _ -> mempty) <$> lift (readHtml def (pack s)) asMarkdown :: PandocMonad m => String -> OPML m Blocks -asMarkdown s = (\(Pandoc _ bs) -> fromList bs) <$> (lift $ readMarkdown def (pack s)) +asMarkdown s = (\(Pandoc _ bs) -> fromList bs) <$> lift (readMarkdown def (pack s)) getBlocks :: PandocMonad m => Element -> OPML m Blocks -getBlocks e = mconcat <$> (mapM parseBlock $ elContent e) +getBlocks e = mconcat <$> mapM parseBlock (elContent e) parseBlock :: PandocMonad m => Content -> OPML m Blocks parseBlock (Elem e) = diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs index 0f7483431..06b2dcaaa 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Arrows #-} + {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TupleSections #-} {- @@ -139,7 +139,7 @@ iterateS :: (Foldable f, MonadPlus m) => ArrowState s x y -> ArrowState s (f x) (m y) iterateS a = ArrowState $ \(s,f) -> foldr a' (s,mzero) f - where a' x (s',m) = second ((mplus m).return) $ runArrowState a (s',x) + where a' x (s',m) = second (mplus m.return) $ runArrowState a (s',x) -- | Fold a state arrow through something 'Foldable'. Collect the results in a -- 'MonadPlus'. @@ -147,7 +147,7 @@ iterateSL :: (Foldable f, MonadPlus m) => ArrowState s x y -> ArrowState s (f x) (m y) iterateSL a = ArrowState $ \(s,f) -> foldl a' (s,mzero) f - where a' (s',m) x = second ((mplus m).return) $ runArrowState a (s',x) + where a' (s',m) x = second (mplus m.return) $ runArrowState a (s',x) -- | Fold a fallible state arrow through something 'Foldable'. diff --git a/src/Text/Pandoc/Readers/Odt/Base.hs b/src/Text/Pandoc/Readers/Odt/Base.hs index f8a0b86e7..51c2da788 100644 --- a/src/Text/Pandoc/Readers/Odt/Base.hs +++ b/src/Text/Pandoc/Readers/Odt/Base.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternGuards #-} + {- Copyright (C) 2015 Martin Linnemann <theCodingMarlin@googlemail.com> @@ -40,4 +40,3 @@ type OdtConverterState s = XMLConverterState Namespace s type XMLReader s a b = FallibleXMLConverter Namespace s a b type XMLReaderSafe s a b = XMLConverter Namespace s a b - diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs b/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs index 72509e591..f8ea5c605 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} + {- Copyright (C) 2015 Martin Linnemann <theCodingMarlin@googlemail.com> @@ -121,6 +121,6 @@ newtype SuccessList a = SuccessList { collectNonFailing :: [a] } deriving ( Eq, Ord, Show ) instance ChoiceVector SuccessList where - spreadChoice = Right . SuccessList . (foldr unTagRight []) . collectNonFailing + spreadChoice = Right . SuccessList . foldr unTagRight [] . collectNonFailing where unTagRight (Right x) = (x:) unTagRight _ = id diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs index f492ec944..556517259 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE TupleSections #-} + + {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index a57ab93d7..f8c2b8cb7 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -110,7 +110,7 @@ noteBlock = try $ do startPos <- getPosition ref <- noteMarker optional blankline - contents <- liftM unlines $ many1Till anyLine (blanklines <|> noteBlock) + contents <- fmap unlines $ many1Till anyLine (blanklines <|> noteBlock) endPos <- getPosition let newnote = (ref, contents ++ "\n") st <- getState diff --git a/src/Text/Pandoc/Readers/TikiWiki.hs b/src/Text/Pandoc/Readers/TikiWiki.hs index 16d6e633b..ad35a6935 100644 --- a/src/Text/Pandoc/Readers/TikiWiki.hs +++ b/src/Text/Pandoc/Readers/TikiWiki.hs @@ -22,7 +22,6 @@ module Text.Pandoc.Readers.TikiWiki ( readTikiWiki import Control.Monad import Control.Monad.Except (throwError) import qualified Data.Foldable as F -import Data.List (intercalate) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -58,7 +57,7 @@ tryMsg :: PandocMonad m => String -> TikiWikiParser m a -> TikiWikiParser m a tryMsg msg p = try p <?> msg skip :: PandocMonad m => TikiWikiParser m a -> TikiWikiParser m () -skip parser = parser >> return () +skip parser = Control.Monad.void parser nested :: PandocMonad m => TikiWikiParser m a -> TikiWikiParser m a nested p = do @@ -88,7 +87,7 @@ block = do <|> blockElements <|> para skipMany blankline - when (verbosity >= INFO) $ do + when (verbosity >= INFO) $ trace (printf "line %d: %s" (sourceLine pos) (take 60 $ show $ B.toList res)) return res @@ -112,7 +111,7 @@ hr = try $ do string "----" many (char '-') newline - return $ B.horizontalRule + return B.horizontalRule -- ! header -- @@ -122,18 +121,18 @@ hr = try $ do -- header :: PandocMonad m => TikiWikiParser m B.Blocks header = tryMsg "header" $ do - level <- many1 (char '!') >>= return . length + level <- fmap length (many1 (char '!')) guard $ level <= 6 skipSpaces content <- B.trimInlines . mconcat <$> manyTill inline newline attr <- registerHeader nullAttr content - return $ B.headerWith attr level $ content + return $B.headerWith attr level content tableRow :: PandocMonad m => TikiWikiParser m [B.Blocks] tableRow = try $ do -- row <- sepBy1 (many1Till inline $ oneOf "\n|") (try $ string "|" <* notFollowedBy (oneOf "|\n")) -- return $ map (B.plain . mconcat) row - row <- sepBy1 ((many1 $ noneOf "\n|") >>= parseColumn) (try $ string "|" <* notFollowedBy (oneOf "|\n")) + row <- sepBy1 (many1 (noneOf "\n|") >>= parseColumn) (try $ string "|" <* notFollowedBy (oneOf "|\n")) return $ map B.plain row where parseColumn x = do @@ -165,14 +164,14 @@ table = try $ do string "||" newline -- return $ B.simpleTable (headers rows) $ trace ("rows: " ++ (show rows)) rows - return $ B.simpleTable (headers rows) $ rows + return $B.simpleTable (headers rows) rows where -- The headers are as many empty srings as the number of columns -- in the first row - headers rows = map (B.plain . B.str) $ take (length $ rows !! 0) $ repeat "" + headers rows = map (B.plain . B.str) $replicate (length $ rows !! 0) "" para :: PandocMonad m => TikiWikiParser m B.Blocks -para = many1Till inline endOfParaElement >>= return . result . mconcat +para = fmap (result . mconcat) ( many1Till inline endOfParaElement) where endOfParaElement = lookAhead $ endOfInput <|> endOfPara <|> newBlockElement endOfInput = try $ skipMany blankline >> skipSpaces >> eof @@ -189,7 +188,7 @@ para = many1Till inline endOfParaElement >>= return . result . mconcat -- definitionList :: PandocMonad m => TikiWikiParser m B.Blocks definitionList = tryMsg "definitionList" $ do - elements <- many1 $ parseDefinitionListItem + elements <-many1 parseDefinitionListItem return $ B.definitionList elements where parseDefinitionListItem :: PandocMonad m => TikiWikiParser m (B.Inlines, [B.Blocks]) @@ -197,7 +196,7 @@ definitionList = tryMsg "definitionList" $ do skipSpaces >> char ';' <* skipSpaces term <- many1Till inline $ char ':' <* skipSpaces line <- listItemLine 1 - return $ (mconcat term, [B.plain line]) + return (mconcat term, [B.plain line]) data ListType = None | Numbered | Bullet deriving (Ord, Eq, Show) @@ -233,15 +232,15 @@ mixedList = try $ do -- figre out a fold or something. fixListNesting :: [B.Blocks] -> [B.Blocks] fixListNesting [] = [] -fixListNesting (first:[]) = [recurseOnList first] +fixListNesting [first] = [recurseOnList first] -- fixListNesting nestall | trace ("\n\nfixListNesting: " ++ (show nestall)) False = undefined -- fixListNesting nestall@(first:second:rest) = fixListNesting (first:second:rest) = let secondBlock = head $ B.toList second in case secondBlock of - BulletList _ -> fixListNesting $ [(mappend (recurseOnList first) (recurseOnList second))] ++ rest - OrderedList _ _ -> fixListNesting $ [(mappend (recurseOnList first) (recurseOnList second))] ++ rest - _ -> [recurseOnList first] ++ fixListNesting (second:rest) + BulletList _ -> fixListNesting $ (mappend (recurseOnList first) (recurseOnList second)) : rest + OrderedList _ _ -> fixListNesting $ (mappend (recurseOnList first) (recurseOnList second)) : rest + _ -> recurseOnList first : fixListNesting (second:rest) -- This function walks the Block structure for fixListNesting, -- because it's a bit complicated, what with converting to and from @@ -249,7 +248,7 @@ fixListNesting (first:second:rest) = recurseOnList :: B.Blocks -> B.Blocks -- recurseOnList item | trace ("rOL: " ++ (show $ length $ B.toList item) ++ ", " ++ (show $ B.toList item)) False = undefined recurseOnList items - | (length $ B.toList items) == 1 = + | length (B.toList items) == 1 = let itemBlock = head $ B.toList items in case itemBlock of BulletList listItems -> B.bulletList $ fixListNesting $ map B.fromList listItems @@ -272,11 +271,11 @@ recurseOnList items -- sections. spanFoldUpList :: ListNesting -> [(ListNesting, B.Blocks)] -> [B.Blocks] spanFoldUpList _ [] = [] -spanFoldUpList ln (first:[]) = +spanFoldUpList ln [first] = listWrap ln (fst first) [snd first] spanFoldUpList ln (first:rest) = let (span1, span2) = span (splitListNesting (fst first)) rest - newTree1 = listWrap ln (fst first) $ [snd first] ++ spanFoldUpList (fst first) span1 + newTree1 = listWrap ln (fst first) $ snd first : spanFoldUpList (fst first) span1 newTree2 = spanFoldUpList ln span2 in newTree1 ++ newTree2 @@ -285,14 +284,13 @@ spanFoldUpList ln (first:rest) = -- item, which is true if the second item is at a deeper nesting -- level and of the same type. splitListNesting :: ListNesting -> (ListNesting, B.Blocks) -> Bool -splitListNesting ln1 (ln2, _) = - if (lnnest ln1) < (lnnest ln2) then - True - else - if ln1 == ln2 then - True - else - False +splitListNesting ln1 (ln2, _) + | (lnnest ln1) < (lnnest ln2) = + True + | ln1 == ln2 = + True + | otherwise = + False -- If we've moved to a deeper nesting level, wrap the new level in -- the appropriate type of list. @@ -323,7 +321,7 @@ bulletItem = try $ do prefix <- many1 $ char '*' many1 $ char ' ' content <- listItemLine (length prefix) - return $ (LN Bullet (length prefix), B.plain content) + return (LN Bullet (length prefix), B.plain content) -- # Start each line -- # with a number (1.). @@ -335,17 +333,17 @@ numberedItem = try $ do prefix <- many1 $ char '#' many1 $ char ' ' content <- listItemLine (length prefix) - return $ (LN Numbered (length prefix), B.plain content) + return (LN Numbered (length prefix), B.plain content) listItemLine :: PandocMonad m => Int -> TikiWikiParser m B.Inlines -listItemLine nest = lineContent >>= parseContent >>= return +listItemLine nest = lineContent >>= parseContent where lineContent = do content <- anyLine continuation <- optionMaybe listContinuation - return $ filterSpaces content ++ "\n" ++ (maybe "" id continuation) + return $ filterSpaces content ++ "\n" ++ maybe "" id continuation filterSpaces = reverse . dropWhile (== ' ') . reverse - listContinuation = string (take nest (repeat '+')) >> lineContent + listContinuation = string (replicate nest '+') >> lineContent parseContent x = do parsed <- parseFromString (many1 inline) x return $ mconcat parsed @@ -373,7 +371,7 @@ codeMacro = try $ do string ")}" body <- manyTill anyChar (try (string "{CODE}")) newline - if length rawAttrs > 0 + if not (null rawAttrs) then return $ B.codeBlockWith (mungeAttrs rawAttrs) body else @@ -412,7 +410,7 @@ inline = choice [ whitespace ] <?> "inline" whitespace :: PandocMonad m => TikiWikiParser m B.Inlines -whitespace = (lb <|> regsp) >>= return +whitespace = (lb <|> regsp) where lb = try $ skipMany spaceChar >> linebreak >> return B.space regsp = try $ skipMany1 spaceChar >> return B.space @@ -452,7 +450,7 @@ enclosed sep p = between sep (try $ sep <* endMarker) p nestedInlines :: (Show a, PandocMonad m) => TikiWikiParser m a -> TikiWikiParser m B.Inlines nestedInlines end = innerSpace <|> nestedInline where - innerSpace = try $ whitespace <* (notFollowedBy end) + innerSpace = try $ whitespace <* notFollowedBy end nestedInline = notFollowedBy whitespace >> nested inline -- {img attId="39" imalign="right" link="http://info.tikiwiki.org" alt="Panama Hat"} @@ -470,13 +468,13 @@ image = try $ do let title = fromMaybe src $ lookup "desc" rawAttrs let alt = fromMaybe title $ lookup "alt" rawAttrs let classes = map fst $ filter (\(_,b) -> b == "" || b == "y") rawAttrs - if length src > 0 + if not (null src) then return $ B.imageWith ("", classes, rawAttrs) src title (B.str alt) else - return $ B.str $ " NOT SUPPORTED: image without src attribute BEGIN: {img " ++ (printAttrs rawAttrs) ++ "} :END " + return $ B.str $ " NOT SUPPORTED: image without src attribute BEGIN: {img " ++ printAttrs rawAttrs ++ "} :END " where - printAttrs attrs = intercalate " " $ map (\(a, b) -> a ++ "=\"" ++ b ++ "\"") attrs + printAttrs attrs = unwords $ map (\(a, b) -> a ++ "=\"" ++ b ++ "\"") attrs imageAttr :: PandocMonad m => TikiWikiParser m (String, String) imageAttr = try $ do @@ -491,11 +489,11 @@ imageAttr = try $ do -- __strong__ strong :: PandocMonad m => TikiWikiParser m B.Inlines -strong = try $ enclosed (string "__") nestedInlines >>= return . B.strong +strong = try $ fmap B.strong (enclosed (string "__") nestedInlines) -- ''emph'' emph :: PandocMonad m => TikiWikiParser m B.Inlines -emph = try $ enclosed (string "''") nestedInlines >>= return . B.emph +emph = try $ fmap B.emph (enclosed (string "''") nestedInlines) -- ~246~ escapedChar :: PandocMonad m => TikiWikiParser m B.Inlines @@ -503,7 +501,7 @@ escapedChar = try $ do string "~" inner <- many1 $ oneOf "0123456789" string "~" - return $ B.str $ [(toEnum ((read inner) :: Int)) :: Char] + return $B.str [(toEnum ((read inner) :: Int)) :: Char] -- UNSUPPORTED, as there doesn't seem to be any facility in calibre -- for this @@ -543,10 +541,10 @@ boxed = try $ do -- --text-- strikeout :: PandocMonad m => TikiWikiParser m B.Inlines -strikeout = try $ enclosed (string "--") nestedInlines >>= return . B.strikeout +strikeout = try $ fmap B.strikeout (enclosed (string "--") nestedInlines) nestedString :: (Show a, PandocMonad m) => TikiWikiParser m a -> TikiWikiParser m String -nestedString end = innerSpace <|> (count 1 nonspaceChar) +nestedString end = innerSpace <|> count 1 nonspaceChar where innerSpace = try $ many1 spaceChar <* notFollowedBy end @@ -555,7 +553,7 @@ breakChars = try $ string "%%%" >> return B.linebreak -- superscript: foo{TAG(tag=>sup)}super{TAG}foo / bar{SUP()}super2{SUP}bar superTag :: PandocMonad m => TikiWikiParser m B.Inlines -superTag = try $ between (string "{TAG(tag=>sup)}") (string "{TAG}") nestedString >>= return . B.superscript . B.text . fromEntities +superTag = try $ fmap (B.superscript . B.text . fromEntities) ( between (string "{TAG(tag=>sup)}") (string "{TAG}") nestedString) superMacro :: PandocMonad m => TikiWikiParser m B.Inlines superMacro = try $ do @@ -566,7 +564,7 @@ superMacro = try $ do -- subscript: baz{TAG(tag=>sub)}sub{TAG}qux / qux{SUB()}sub2{SUB}qux subTag :: PandocMonad m => TikiWikiParser m B.Inlines -subTag = try $ between (string "{TAG(tag=>sub)}") (string "{TAG}") nestedString >>= return . B.subscript . B.text . fromEntities +subTag = try $ fmap (B.subscript . B.text . fromEntities) ( between (string "{TAG(tag=>sub)}") (string "{TAG}") nestedString) subMacro :: PandocMonad m => TikiWikiParser m B.Inlines subMacro = try $ do @@ -577,7 +575,7 @@ subMacro = try $ do -- -+text+- code :: PandocMonad m => TikiWikiParser m B.Inlines -code = try $ between (string "-+") (string "+-") nestedString >>= return . B.code . fromEntities +code = try $ fmap (B.code . fromEntities) ( between (string "-+") (string "+-") nestedString) macroAttr :: PandocMonad m => TikiWikiParser m (String, String) macroAttr = try $ do @@ -590,8 +588,7 @@ macroAttr = try $ do macroAttrs :: PandocMonad m => TikiWikiParser m [(String, String)] macroAttrs = try $ do - attrs <- sepEndBy macroAttr spaces - return attrs + sepEndBy macroAttr spaces -- ~np~ __not bold__ ~/np~ noparse :: PandocMonad m => TikiWikiParser m B.Inlines @@ -601,10 +598,10 @@ noparse = try $ do return $ B.str body str :: PandocMonad m => TikiWikiParser m B.Inlines -str = (many1 alphaNum <|> count 1 characterReference) >>= return . B.str +str = fmap B.str (many1 alphaNum <|> count 1 characterReference) symbol :: PandocMonad m => TikiWikiParser m B.Inlines -symbol = count 1 nonspaceChar >>= return . B.str +symbol = fmap B.str (count 1 nonspaceChar) -- [[not a link] notExternalLink :: PandocMonad m => TikiWikiParser m B.Inlines @@ -627,7 +624,7 @@ makeLink start middle end = try $ do (url, title, anchor) <- wikiLinkText start middle end parsedTitle <- parseFromString (many1 inline) title setState $ st{ stateAllowLinks = True } - return $ B.link (url++anchor) "" $ mconcat $ parsedTitle + return $ B.link (url++anchor) "" $mconcat parsedTitle wikiLinkText :: PandocMonad m => String -> String -> String -> TikiWikiParser m (String, String, String) wikiLinkText start middle end = do @@ -643,9 +640,9 @@ wikiLinkText start middle end = do return (url, seg1, "") where linkContent = do - (char '|') + char '|' mystr <- many (noneOf middle) - return $ mystr + return mystr externalLink :: PandocMonad m => TikiWikiParser m B.Inlines externalLink = makeLink "[" "]|" "]" @@ -657,4 +654,3 @@ externalLink = makeLink "[" "]|" "]" -- [see also this other post](My Other Page) is perfectly valid. wikiLink :: PandocMonad m => TikiWikiParser m B.Inlines wikiLink = makeLink "((" ")|" "))" - diff --git a/src/Text/Pandoc/Readers/Vimwiki.hs b/src/Text/Pandoc/Readers/Vimwiki.hs index 37c8c32d0..49da5a6c6 100644 --- a/src/Text/Pandoc/Readers/Vimwiki.hs +++ b/src/Text/Pandoc/Readers/Vimwiki.hs @@ -91,14 +91,13 @@ import Text.Pandoc.Parsing (F, ParserState, ParserT, blanklines, emailAddress, registerHeader, runF, spaceChar, stateMeta', stateOptions, uri) import Text.Pandoc.Shared (crFilter, splitBy, stringify, stripFirstAndLast) -import Text.Parsec.Char (alphaNum, anyChar, char, newline, noneOf, spaces, - string) -import Text.Parsec.Char (oneOf, space) -import Text.Parsec.Combinator (choice, count, eof, many1, manyTill, - notFollowedBy, option, skipMany1) -import Text.Parsec.Combinator (between, lookAhead) -import Text.Parsec.Prim (getState, many, try, updateState) -import Text.Parsec.Prim ((<|>)) +import Text.Parsec.Char + (alphaNum, anyChar, char, newline, noneOf, spaces, string, oneOf, + space) +import Text.Parsec.Combinator + (choice, count, eof, many1, manyTill, notFollowedBy, option, + skipMany1, between, lookAhead) +import Text.Parsec.Prim (getState, many, try, updateState, (<|>)) readVimwiki :: PandocMonad m => ReaderOptions -> Text -> m Pandoc readVimwiki opts s = do @@ -161,9 +160,9 @@ header = try $ do let lev = length eqs guard $ lev <= 6 contents <- trimInlines . mconcat <$> manyTill inline (try $ spaceChar - >> (string eqs) >> many spaceChar >> newline) + >> string eqs >> many spaceChar >> newline) attr <- registerHeader (makeId contents, - (if sp == "" then [] else ["justcenter"]), []) contents + if sp == "" then [] else ["justcenter"], []) contents return $ B.headerWith attr lev contents para :: PandocMonad m => VwParser m Blocks @@ -191,22 +190,22 @@ blockQuote = try $ do definitionList :: PandocMonad m => VwParser m Blocks definitionList = try $ - B.definitionList <$> (many1 (dlItemWithDT <|> dlItemWithoutDT)) + B.definitionList <$> many1 (dlItemWithDT <|> dlItemWithoutDT) dlItemWithDT :: PandocMonad m => VwParser m (Inlines, [Blocks]) dlItemWithDT = do dt <- definitionTerm dds <- many definitionDef - return $ (dt, dds) + return (dt, dds) dlItemWithoutDT :: PandocMonad m => VwParser m (Inlines, [Blocks]) dlItemWithoutDT = do dds <- many1 definitionDef - return $ (mempty, dds) + return (mempty, dds) definitionDef :: PandocMonad m => VwParser m Blocks definitionDef = try $ - (notFollowedBy definitionTerm) >> many spaceChar + notFollowedBy definitionTerm >> many spaceChar >> (definitionDef1 <|> definitionDef2) definitionDef1 :: PandocMonad m => VwParser m Blocks @@ -220,16 +219,16 @@ definitionDef2 = try $ B.plain <$> definitionTerm :: PandocMonad m => VwParser m Inlines definitionTerm = try $ do x <- definitionTerm1 <|> definitionTerm2 - guard $ (stringify x /= "") + guard (stringify x /= "") return x definitionTerm1 :: PandocMonad m => VwParser m Inlines definitionTerm1 = try $ - trimInlines . mconcat <$> manyTill inline' (try $ defMarkerE) + trimInlines . mconcat <$> manyTill inline' (try defMarkerE) definitionTerm2 :: PandocMonad m => VwParser m Inlines definitionTerm2 = try $ trimInlines . mconcat <$> manyTill inline' - (try $ lookAhead $ (defMarkerM >> notFollowedBy hasDefMarkerM)) + (try $lookAhead (defMarkerM >> notFollowedBy hasDefMarkerM)) defMarkerM :: PandocMonad m => VwParser m Char defMarkerM = string "::" >> spaceChar @@ -247,14 +246,14 @@ preformatted = try $ do lookAhead newline contents <- manyTill anyChar (try (char '\n' >> many spaceChar >> string "}}}" >> many spaceChar >> newline)) - if (not $ contents == "") && (head contents == '\n') + if not (contents == "") && (head contents == '\n') then return $ B.codeBlockWith (makeAttr attrText) (tail contents) else return $ B.codeBlockWith (makeAttr attrText) contents makeAttr :: String -> Attr makeAttr s = let xs = splitBy (`elem` " \t") s in - ("", [], catMaybes $ map nameValue xs) + ("", [], mapMaybe nameValue xs) nameValue :: String -> Maybe (String, String) nameValue s = @@ -262,7 +261,7 @@ nameValue s = if length t /= 2 then Nothing else let (a, b) = (head t, last t) in - if ((length b) < 2) || ((head b, last b) /= ('"', '"')) + if (length b < 2) || ((head b, last b) /= ('"', '"')) then Nothing else Just (a, stripFirstAndLast b) @@ -317,12 +316,12 @@ mixedList' prevInd = do if lowInd >= curInd then do (sameIndList, endInd) <- (mixedList' lowInd) - let curList = (combineList curLine subList) ++ sameIndList + let curList = combineList curLine subList ++ sameIndList if curInd > prevInd then return ([listBuilder curList], endInd) else return (curList, endInd) else do - let (curList, endInd) = ((combineList curLine subList), + let (curList, endInd) = (combineList curLine subList, lowInd) if curInd > prevInd then return ([listBuilder curList], endInd) @@ -335,7 +334,7 @@ plainInlineML' w = do return $ B.plain $ trimInlines $ mconcat $ w:xs plainInlineML :: PandocMonad m => VwParser m Blocks -plainInlineML = (notFollowedBy listStart) >> spaceChar >> plainInlineML' mempty +plainInlineML = notFollowedBy listStart >> spaceChar >> plainInlineML' mempty listItemContent :: PandocMonad m => VwParser m Blocks @@ -372,9 +371,9 @@ makeListMarkerSpan x = combineList :: Blocks -> [Blocks] -> [Blocks] combineList x [y] = case toList y of - [BulletList z] -> [fromList $ (toList x) + [BulletList z] -> [fromList $ toList x ++ [BulletList z]] - [OrderedList attr z] -> [fromList $ (toList x) + [OrderedList attr z] -> [fromList $ toList x ++ [OrderedList attr z]] _ -> x:[y] combineList x xs = x:xs @@ -391,7 +390,7 @@ bulletListMarkers = "ul" <$ (char '*' <|> char '-') orderedListMarkers :: PandocMonad m => VwParser m String orderedListMarkers = - ("ol" <$ (choice $ (orderedListMarker Decimal Period):(($OneParen) + ("ol" <$choice ((orderedListMarker Decimal Period):(($OneParen) <$> orderedListMarker <$> [Decimal, LowerRoman, UpperRoman, LowerAlpha, UpperAlpha]))) <|> ("ol" <$ char '#') @@ -418,11 +417,11 @@ table1 = try $ do table2 :: PandocMonad m => VwParser m ([Blocks], [[Blocks]]) table2 = try $ do trs <- many1 tableRow - return (take (length $ head trs) $ repeat mempty, trs) + return (replicate (length $ head trs) mempty, trs) tableHeaderSeparator :: PandocMonad m => VwParser m () tableHeaderSeparator = try $ do - many spaceChar >> char '|' >> many1 ((many1 $ char '-') >> char '|') + many spaceChar >> char '|' >> many1 (many1 (char '-') >> char '|') >> many spaceChar >> newline return () @@ -438,16 +437,16 @@ tableRow = try $ do tableCell :: PandocMonad m => VwParser m Blocks tableCell = try $ - B.plain <$> trimInlines . mconcat <$> (manyTill inline' (char '|')) + B.plain . trimInlines . mconcat <$> (manyTill inline' (char '|')) placeholder :: PandocMonad m => VwParser m () placeholder = try $ - (choice (ph <$> ["title", "date"])) <|> noHtmlPh <|> templatePh + choice (ph <$> ["title", "date"]) <|> noHtmlPh <|> templatePh ph :: PandocMonad m => String -> VwParser m () ph s = try $ do - many spaceChar >> (string $ '%':s) >> spaceChar - contents <- (trimInlines . mconcat <$> (manyTill inline (lookAhead newline))) + many spaceChar >>string ('%':s) >> spaceChar + contents <- trimInlines . mconcat <$> (manyTill inline (lookAhead newline)) --use lookAhead because of placeholder in the whitespace parser let meta' = return $ B.setMeta s contents nullMeta :: F Meta updateState $ \st -> st { stateMeta' = stateMeta' st <> meta' } @@ -455,17 +454,17 @@ ph s = try $ do noHtmlPh :: PandocMonad m => VwParser m () noHtmlPh = try $ () <$ (many spaceChar >> string "%nohtml" >> many spaceChar - >> (lookAhead newline)) + >> lookAhead newline) templatePh :: PandocMonad m => VwParser m () templatePh = try $ - () <$ (many spaceChar >> string "%template" >> (many $ noneOf "\n") - >> (lookAhead newline)) + () <$ (many spaceChar >> string "%template" >>many (noneOf "\n") + >> lookAhead newline) -- inline parser inline :: PandocMonad m => VwParser m Inlines -inline = choice $ (whitespace endlineP):inlineList +inline = choice $ whitespace endlineP:inlineList inlineList :: PandocMonad m => [VwParser m Inlines] inlineList = [ bareURL @@ -490,18 +489,18 @@ inline' = choice $ whitespace':inlineList -- inline parser for blockquotes inlineBQ :: PandocMonad m => VwParser m Inlines -inlineBQ = choice $ (whitespace endlineBQ):inlineList +inlineBQ = choice $ whitespace endlineBQ:inlineList -- inline parser for mixedlists inlineML :: PandocMonad m => VwParser m Inlines -inlineML = choice $ (whitespace endlineML):inlineList +inlineML = choice $ whitespace endlineML:inlineList str :: PandocMonad m => VwParser m Inlines -str = B.str <$> (many1 $ noneOf $ spaceChars ++ specialChars) +str = B.str <$>many1 (noneOf $ spaceChars ++ specialChars) whitespace :: PandocMonad m => VwParser m () -> VwParser m Inlines whitespace endline = B.space <$ (skipMany1 spaceChar <|> - (try (newline >> (comment <|> placeholder)))) + try (newline >> (comment <|> placeholder))) <|> B.softbreak <$ endline whitespace' :: PandocMonad m => VwParser m Inlines @@ -518,31 +517,31 @@ bareURL = try $ do strong :: PandocMonad m => VwParser m Inlines strong = try $ do s <- lookAhead $ between (char '*') (char '*') (many1 $ noneOf "*") - guard $ (not $ (head s) `elem` spaceChars) - && (not $ (last s) `elem` spaceChars) + guard $ not ((head s) `elem` spaceChars) + &¬ ((last s) `elem` spaceChars) char '*' - contents <- mconcat <$> (manyTill inline' $ char '*' + contents <- mconcat <$>manyTill inline' (char '*' >> notFollowedBy alphaNum) - return $ (B.spanWith ((makeId contents), [], []) mempty) - <> (B.strong contents) + return $ B.spanWith ((makeId contents), [], []) mempty + <> B.strong contents makeId :: Inlines -> String -makeId i = concat (stringify <$> (toList i)) +makeId i = concat (stringify <$> toList i) emph :: PandocMonad m => VwParser m Inlines emph = try $ do s <- lookAhead $ between (char '_') (char '_') (many1 $ noneOf "_") - guard $ (not $ (head s) `elem` spaceChars) - && (not $ (last s) `elem` spaceChars) + guard $ not ((head s) `elem` spaceChars) + &¬ ((last s) `elem` spaceChars) char '_' - contents <- mconcat <$> (manyTill inline' $ char '_' + contents <- mconcat <$>manyTill inline' (char '_' >> notFollowedBy alphaNum) return $ B.emph contents strikeout :: PandocMonad m => VwParser m Inlines strikeout = try $ do string "~~" - contents <- mconcat <$> (many1Till inline' $ string $ "~~") + contents <- mconcat <$>many1Till inline' (string $ "~~") return $ B.strikeout contents code :: PandocMonad m => VwParser m Inlines @@ -553,11 +552,11 @@ code = try $ do superscript :: PandocMonad m => VwParser m Inlines superscript = try $ - B.superscript <$> mconcat <$> (char '^' >> many1Till inline' (char '^')) + B.superscript . mconcat <$> (char '^' >> many1Till inline' (char '^')) subscript :: PandocMonad m => VwParser m Inlines subscript = try $ - B.subscript <$> mconcat <$> (string ",," + B.subscript . mconcat <$> (string ",," >> many1Till inline' (try $ string ",,")) link :: PandocMonad m => VwParser m Inlines @@ -587,29 +586,29 @@ images k return $ B.image (procImgurl imgurl) "" (B.str "") | k == 1 = do imgurl <- manyTill anyChar (char '|') - alt <- mconcat <$> (manyTill inline $ (try $ string "}}")) + alt <- mconcat <$> (manyTill inline (try $ string "}}")) return $ B.image (procImgurl imgurl) "" alt | k == 2 = do imgurl <- manyTill anyChar (char '|') - alt <- mconcat <$> (manyTill inline $ char '|') + alt <- mconcat <$>manyTill inline (char '|') attrText <- manyTill anyChar (try $ string "}}") return $ B.imageWith (makeAttr attrText) (procImgurl imgurl) "" alt | otherwise = do imgurl <- manyTill anyChar (char '|') - alt <- mconcat <$> (manyTill inline $ char '|') + alt <- mconcat <$>manyTill inline (char '|') attrText <- manyTill anyChar (char '|') manyTill anyChar (try $ string "}}") return $ B.imageWith (makeAttr attrText) (procImgurl imgurl) "" alt procLink' :: String -> String procLink' s - | ((take 6 s) == "local:") = "file" ++ (drop 5 s) - | ((take 6 s) == "diary:") = "diary/" ++ (drop 6 s) ++ ".html" + | (take 6 s) == "local:" = "file" ++ drop 5 s + | (take 6 s) == "diary:" = "diary/" ++ drop 6 s ++ ".html" | or ((`isPrefixOf` s) <$> [ "http:", "https:", "ftp:", "file:", "mailto:", "news:", "telnet:" ]) = s | s == "" = "" - | (last s) == '/' = s + | last s == '/' = s | otherwise = s ++ ".html" procLink :: String -> String @@ -617,7 +616,7 @@ procLink s = procLink' x ++ y where (x, y) = break (=='#') s procImgurl :: String -> String -procImgurl s = if ((take 6 s) == "local:") then "file" ++ (drop 5 s) else s +procImgurl s = if (take 6 s) == "local:" then "file" ++ drop 5 s else s inlineMath :: PandocMonad m => VwParser m Inlines inlineMath = try $ do @@ -628,10 +627,10 @@ inlineMath = try $ do tag :: PandocMonad m => VwParser m Inlines tag = try $ do char ':' - s <- manyTill (noneOf spaceChars) (try (char ':' >> (lookAhead space))) + s <- manyTill (noneOf spaceChars) (try (char ':' >> lookAhead space)) guard $ not $ "::" `isInfixOf` (":" ++ s ++ ":") let ss = splitBy (==':') s - return $ mconcat $ (makeTagSpan' $ head ss):(makeTagSpan <$> (tail ss)) + return $ mconcat $ makeTagSpan' (head ss):(makeTagSpan <$> tail ss) todoMark :: PandocMonad m => VwParser m Inlines todoMark = try $ do @@ -661,18 +660,18 @@ nFBTTBSB = notFollowedBy hasDefMarker hasDefMarker :: PandocMonad m => VwParser m () -hasDefMarker = () <$ (manyTill (noneOf "\n") (string "::" >> oneOf spaceChars)) +hasDefMarker = () <$ manyTill (noneOf "\n") (string "::" >> oneOf spaceChars) makeTagSpan' :: String -> Inlines makeTagSpan' s = B.spanWith ('-' : s, [], []) (B.str "") <> B.spanWith (s, ["tag"], []) (B.str s) makeTagSpan :: String -> Inlines -makeTagSpan s = (B.space) <> (makeTagSpan' s) +makeTagSpan s = B.space <> makeTagSpan' s mathTagParser :: PandocMonad m => VwParser m String mathTagParser = do - s <- try $ lookAhead (char '%' >> (manyTill (noneOf spaceChars) - (try $ char '%' >> many (noneOf $ '%':spaceChars) >> space))) + s <- try $ lookAhead (char '%' >> manyTill (noneOf spaceChars) + (try $ char '%' >> many (noneOf $ '%':spaceChars) >> space)) char '%' >> string s >> char '%' return $ mathTagLaTeX s diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs index b599eb62b..d3b768109 100644 --- a/src/Text/Pandoc/SelfContained.hs +++ b/src/Text/Pandoc/SelfContained.hs @@ -178,10 +178,10 @@ pCSSComment = P.try $ do return B.empty pCSSOther :: PandocMonad m => ParsecT ByteString () m ByteString -pCSSOther = do +pCSSOther = (B.pack <$> P.many1 (P.noneOf "u/ \n\r\t")) <|> - (B.singleton <$> P.char 'u') <|> - (B.singleton <$> P.char '/') + (B.singleton <$> P.char 'u') <|> + (B.singleton <$> P.char '/') pCSSUrl :: PandocMonad m => FilePath -> ParsecT ByteString () m ByteString @@ -218,9 +218,7 @@ handleCSSUrl :: PandocMonad m => FilePath -> (String, ByteString) -> ParsecT ByteString () m (Either ByteString (MimeType, ByteString)) -handleCSSUrl d (url, fallback) = do - -- pipes are used in URLs provided by Google Code fonts - -- but parseURI doesn't like them, so we escape them: +handleCSSUrl d (url, fallback) = case escapeURIString (/='|') (trim url) of '#':_ -> return $ Left fallback 'd':'a':'t':'a':':':_ -> return $ Left fallback @@ -251,8 +249,7 @@ getData mimetype src = do let ext = map toLower $ takeExtension src (raw, respMime) <- fetchItem src let raw' = if ext == ".gz" - then B.concat $ L.toChunks $ Gzip.decompress $ L.fromChunks - $ [raw] + then B.concat $ L.toChunks $ Gzip.decompress $ L.fromChunks [raw] else raw mime <- case (mimetype, respMime) of ("",Nothing) -> throwError $ PandocSomeError diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 85f13c865..9d4877c24 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -2,7 +2,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE PatternGuards #-} + {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} {- @@ -144,11 +144,11 @@ splitBy _ [] = [] splitBy isSep lst = let (first, rest) = break isSep lst rest' = dropWhile isSep rest - in first:(splitBy isSep rest') + in first:splitBy isSep rest' splitByIndices :: [Int] -> [a] -> [[a]] splitByIndices [] lst = [lst] -splitByIndices (x:xs) lst = first:(splitByIndices (map (\y -> y - x) xs) rest) +splitByIndices (x:xs) lst = first:splitByIndices (map (\y -> y - x) xs) rest where (first, rest) = splitAt x lst -- | Split string into chunks divided at specified indices. @@ -156,7 +156,7 @@ splitStringByIndices :: [Int] -> [Char] -> [[Char]] splitStringByIndices [] lst = [lst] splitStringByIndices (x:xs) lst = let (first, rest) = splitAt' x lst in - first : (splitStringByIndices (map (\y -> y - x) xs) rest) + first : splitStringByIndices (map (\y -> y - x) xs) rest splitAt' :: Int -> [Char] -> ([Char],[Char]) splitAt' _ [] = ([],[]) @@ -195,7 +195,7 @@ backslashEscapes = map (\ch -> (ch, ['\\',ch])) escapeStringUsing :: [(Char, String)] -> String -> String escapeStringUsing _ [] = "" escapeStringUsing escapeTable (x:xs) = - case (lookup x escapeTable) of + case lookup x escapeTable of Just str -> str ++ rest Nothing -> x:rest where rest = escapeStringUsing escapeTable xs @@ -219,14 +219,14 @@ trimr = reverse . triml . reverse -- | Strip leading and trailing characters from string stripFirstAndLast :: String -> String stripFirstAndLast str = - drop 1 $ take ((length str) - 1) str + drop 1 $ take (length str - 1) str -- | Change CamelCase word to hyphenated lowercase (e.g., camel-case). camelCaseToHyphenated :: String -> String camelCaseToHyphenated [] = "" camelCaseToHyphenated (a:b:rest) | isLower a && isUpper b = - a:'-':(toLower b):(camelCaseToHyphenated rest) -camelCaseToHyphenated (a:rest) = (toLower a):(camelCaseToHyphenated rest) + a:'-':toLower b:camelCaseToHyphenated rest +camelCaseToHyphenated (a:rest) = toLower a:camelCaseToHyphenated rest -- | Convert number < 4000 to uppercase roman numeral. toRomanNumeral :: Int -> String @@ -477,7 +477,7 @@ hierarchicalize blocks = S.evalState (hierarchicalizeWithIds blocks) [] hierarchicalizeWithIds :: [Block] -> S.State [Int] [Element] hierarchicalizeWithIds [] = return [] -hierarchicalizeWithIds ((Header level attr@(_,classes,_) title'):xs) = do +hierarchicalizeWithIds (Header level attr@(_,classes,_) title':xs) = do lastnum <- S.get let lastnum' = take level lastnum let newnum = case length lastnum' of @@ -490,13 +490,13 @@ hierarchicalizeWithIds ((Header level attr@(_,classes,_) title'):xs) = do sectionContents' <- hierarchicalizeWithIds sectionContents rest' <- hierarchicalizeWithIds rest return $ Sec level newnum attr title' sectionContents' : rest' -hierarchicalizeWithIds ((Div ("",["references"],[]) - (Header level (ident,classes,kvs) title' : xs)):ys) = - hierarchicalizeWithIds ((Header level (ident,("references":classes),kvs) - title') : (xs ++ ys)) +hierarchicalizeWithIds (Div ("",["references"],[]) + (Header level (ident,classes,kvs) title' : xs):ys) = + hierarchicalizeWithIds (Header level (ident,("references":classes),kvs) + title' : (xs ++ ys)) hierarchicalizeWithIds (x:rest) = do rest' <- hierarchicalizeWithIds rest - return $ (Blk x) : rest' + return $ Blk x : rest' headerLtEq :: Int -> Block -> Bool headerLtEq level (Header l _ _) = l <= level @@ -519,7 +519,7 @@ uniqueIdent title' usedIdents -- | True if block is a Header block. isHeaderBlock :: Block -> Bool -isHeaderBlock (Header _ _ _) = True +isHeaderBlock (Header{}) = True isHeaderBlock _ = False -- | Shift header levels up or down. @@ -555,15 +555,14 @@ makeMeta :: [Inline] -> [[Inline]] -> [Inline] -> Meta makeMeta title authors date = addMetaField "title" (B.fromList title) $ addMetaField "author" (map B.fromList authors) - $ addMetaField "date" (B.fromList date) - $ nullMeta + $ addMetaField "date" (B.fromList date) nullMeta -- | Remove soft breaks between East Asian characters. eastAsianLineBreakFilter :: Pandoc -> Pandoc eastAsianLineBreakFilter = bottomUp go where go (x:SoftBreak:y:zs) = case (stringify x, stringify y) of - (xs@(_:_), (c:_)) + (xs@(_:_), c:_) | charWidth (last xs) == 2 && charWidth c == 2 -> x:y:zs _ -> x:SoftBreak:y:zs go xs = xs @@ -620,8 +619,8 @@ collapseFilePath = Posix.joinPath . reverse . foldl go [] . splitDirectories where go rs "." = rs go r@(p:rs) ".." = case p of - ".." -> ("..":r) - (checkPathSeperator -> Just True) -> ("..":r) + ".." -> "..":r + (checkPathSeperator -> Just True) -> "..":r _ -> rs go _ (checkPathSeperator -> Just True) = [[Posix.pathSeparator]] go rs x = x:rs @@ -725,9 +724,9 @@ blockToInlines (DefinitionList pairslst) = where f (ils, blkslst) = ils ++ [Str ":", Space] ++ - (concatMap blocksToInlines blkslst) + concatMap blocksToInlines blkslst blockToInlines (Header _ _ ils) = ils -blockToInlines (HorizontalRule) = [] +blockToInlines HorizontalRule = [] blockToInlines (Table _ _ _ headers rows) = intercalate [LineBreak] $ map (concatMap blocksToInlines) tbl where diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs index cd7695dbe..d83735029 100644 --- a/src/Text/Pandoc/Slides.hs +++ b/src/Text/Pandoc/Slides.hs @@ -40,8 +40,8 @@ getSlideLevel = go 6 | otherwise = go least (x:xs) go least (_ : xs) = go least xs go least [] = least - nonHOrHR (Header{}) = False - nonHOrHR (HorizontalRule) = False + nonHOrHR Header{} = False + nonHOrHR HorizontalRule = False nonHOrHR _ = True -- | Prepare a block list to be passed to hierarchicalize. diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index 9f3781259..89d524d96 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} + {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} {- @@ -77,7 +77,7 @@ getDefaultTemplate writer = do -- raises an error if compilation fails. renderTemplate' :: (PandocMonad m, ToJSON a, TemplateTarget b) => String -> a -> m b -renderTemplate' template context = do +renderTemplate' template context = case applyTemplate (T.pack template) context of Left e -> throwError (PandocTemplateError e) Right r -> return r diff --git a/src/Text/Pandoc/UUID.hs b/src/Text/Pandoc/UUID.hs index 989dd20c6..1527ce435 100644 --- a/src/Text/Pandoc/UUID.hs +++ b/src/Text/Pandoc/UUID.hs @@ -75,4 +75,3 @@ getUUID gen = getRandomUUID :: IO UUID getRandomUUID = getUUID <$> getStdGen - |