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

hlint suggestions.

Browse source
This commit is contained in:
John MacFarlane 2017-10-27 23:13:55 -07:00
parent 8481298357
commit cbcb9b36c0
33 changed files with 307 additions and 340 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
pandoc.hs
View file

@ -36,4 +36,3 @@ import Text.Pandoc.Error (handleError)
main :: IO ()
main = E.catch (parseOptions options defaultOpts >>= convertWithOpts)
(handleError . Left)

1
src/Text/Pandoc/CSV.hs
View file

@ -100,4 +100,3 @@ endline :: Parser ()
endline = do
optional (void $ char '\r')
void $ char '\n'

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

@ -997,4 +997,3 @@ instance PandocMonad m => PandocMonad (ParsecT s st m) where
else "")
(return ())
logOutput = lift . logOutput

1
src/Text/Pandoc/Emoji.hs
View file

@ -903,4 +903,3 @@ emojis = M.fromList
,("zero","0\65039\8419")
,("zzz","\128164")
]

1
src/Text/Pandoc/ImageSize.hs
View file

@ -602,4 +602,3 @@ tagTypeTable = M.fromList
, (0xa300, FileSource)
, (0xa301, SceneType)
]

20
src/Text/Pandoc/Lua/StackInstances.hs
View file

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

1
src/Text/Pandoc/MIME.hs
View file

@ -525,4 +525,3 @@ mimeTypesList = -- List borrowed from happstack-server.
,("zip","application/zip")
,("zmt","chemical/x-mopac-input")
]

1
src/Text/Pandoc/PDF.hs
View file

@ -438,4 +438,3 @@ context2pdf verbosity tmpDir source = inDirectory tmpDir $ do
return $ Left logmsg
(ExitSuccess, Nothing) -> return $ Left ""
(ExitSuccess, Just pdf) -> return $ Right pdf

2
src/Text/Pandoc/Readers/Creole.hs
View file

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

75
src/Text/Pandoc/Readers/Docx.hs
View file

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

2
src/Text/Pandoc/Readers/Docx/Lists.hs
View file

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

26
src/Text/Pandoc/Readers/Docx/Parse.hs
View file

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

1
src/Text/Pandoc/Readers/Docx/Util.hs
View file

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

22
src/Text/Pandoc/Readers/EPUB.hs
View file

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

2
src/Text/Pandoc/Readers/Haddock.hs
View file

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

68
src/Text/Pandoc/Readers/LaTeX.hs
View file

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

1
src/Text/Pandoc/Readers/LaTeX/Types.hs
View file

@ -49,4 +49,3 @@ data ExpansionPoint = ExpandWhenDefined | ExpandWhenUsed
data Macro = Macro ExpansionPoint Int (Maybe [Tok]) [Tok]
deriving Show

70
src/Text/Pandoc/Readers/Markdown.hs
View file

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

18
src/Text/Pandoc/Readers/Muse.hs
View file

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

1
src/Text/Pandoc/Readers/Native.hs
View file

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

15
src/Text/Pandoc/Readers/OPML.hs
View file

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

6
src/Text/Pandoc/Readers/Odt/Arrows/State.hs
View file

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

3
src/Text/Pandoc/Readers/Odt/Base.hs
View file

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

4
src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs
View file

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

4
src/Text/Pandoc/Readers/Odt/Generic/Utils.hs
View file

@ -1,5 +1,5 @@
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}

2
src/Text/Pandoc/Readers/Textile.hs
View file

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

104
src/Text/Pandoc/Readers/TikiWiki.hs
View file

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

129
src/Text/Pandoc/Readers/Vimwiki.hs
View file

@ -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)
&&not ((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)
&&not ((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

13
src/Text/Pandoc/SelfContained.hs
View file

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

43
src/Text/Pandoc/Shared.hs
View file

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

4
src/Text/Pandoc/Slides.hs
View file

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

4
src/Text/Pandoc/Templates.hs
View file

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

1
src/Text/Pandoc/UUID.hs
View file

@ -75,4 +75,3 @@ getUUID gen =
getRandomUUID :: IO UUID
getRandomUUID = getUUID <$> getStdGen