@@ -54,8 +54,7 @@ import Data.List (intercalate, isPrefixOf)
54import Data.List.Split (wordsBy)
54import Data.List.Split (wordsBy)
55import qualified Data.Map as M
55import qualified Data.Map as M
56import Data.Maybe (fromMaybe, isJust, isNothing)
56import Data.Maybe (fromMaybe, isJust, isNothing)
57−import Data.Monoid (First (..))
57+import Data.Monoid (First (..), (<>))
58−import Data.Monoid ((<>))
59import qualified Data.Set as Set
58import qualified Data.Set as Set
60import Data.Text (Text)
59import Data.Text (Text)
61import qualified Data.Text as T
60import qualified Data.Text as T
@@ -89,7 +88,7 @@ readHtml opts inp = do
89 parseTagsOptions parseOptions{ optTagPosition = True }
88 parseTagsOptions parseOptions{ optTagPosition = True }
90 (crFilter inp)
89 (crFilter inp)
91 parseDoc = do
90 parseDoc = do
92− blocks <- (fixPlains False) . mconcat <$> manyTill block eof
91+ blocks <- fixPlains False . mconcat <$> manyTill block eof
93 meta <- stateMeta . parserState <$> getState
92 meta <- stateMeta . parserState <$> getState
94 bs' <- replaceNotes (B.toList blocks)
93 bs' <- replaceNotes (B.toList blocks)
95 reportLogMessages
94 reportLogMessages
@@ -223,10 +222,10 @@ eSwitch constructor parser = try $ do
223eCase :: PandocMonad m => TagParser m (Maybe Inlines)
222eCase :: PandocMonad m => TagParser m (Maybe Inlines)
224eCase = do
223eCase = do
225 skipMany pBlank
224 skipMany pBlank
226− TagOpen _ attr' <- lookAhead $ pSatisfy $ (matchTagOpen "case" [])
225+ TagOpen _ attr' <- lookAhead $ pSatisfy (matchTagOpen "case" [])
227 let attr = toStringAttr attr'
226 let attr = toStringAttr attr'
228− case (flip lookup namespaces) =<< lookup "required-namespace" attr of
227+ case flip lookup namespaces =<< lookup "required-namespace" attr of
229− Just p -> Just <$> (pInTags "case" (skipMany pBlank *> p <* skipMany pBlank))
228+ Just p -> Just <$> pInTags "case" (skipMany pBlank *> p <* skipMany pBlank)
230 Nothing -> Nothing <$ manyTill pAnyTag (pSatisfy (matchTagClose "case"))
229 Nothing -> Nothing <$ manyTill pAnyTag (pSatisfy (matchTagClose "case"))
232eFootnote :: PandocMonad m => TagParser m ()
231eFootnote :: PandocMonad m => TagParser m ()
@@ -235,20 +234,20 @@ eFootnote = try $ do
235 guardEnabled Ext_epub_html_exts
234 guardEnabled Ext_epub_html_exts
236 (TagOpen tag attr') <- lookAhead pAnyTag
235 (TagOpen tag attr') <- lookAhead pAnyTag
237 let attr = toStringAttr attr'
236 let attr = toStringAttr attr'
238− guard (maybe False (flip elem notes) (lookup "type" attr))
237+ guard $ maybe False (`elem` notes) (lookup "type" attr)
239 let ident = fromMaybe "" (lookup "id" attr)
238 let ident = fromMaybe "" (lookup "id" attr)
240 content <- pInTags tag block
239 content <- pInTags tag block
241 addNote ident content
240 addNote ident content
243addNote :: PandocMonad m => String -> Blocks -> TagParser m ()
242addNote :: PandocMonad m => String -> Blocks -> TagParser m ()
244−addNote uid cont = updateState (\s -> s {noteTable = (uid, cont) : (noteTable s)})
243+addNote uid cont = updateState (\s -> s {noteTable = (uid, cont) : noteTable s})
246eNoteref :: PandocMonad m => TagParser m Inlines
245eNoteref :: PandocMonad m => TagParser m Inlines
247eNoteref = try $ do
246eNoteref = try $ do
248 guardEnabled Ext_epub_html_exts
247 guardEnabled Ext_epub_html_exts
249− TagOpen tag attr' <- lookAhead $ pAnyTag
248+ TagOpen tag attr' <- lookAhead pAnyTag
250 let attr = toStringAttr attr'
249 let attr = toStringAttr attr'
251− guard (maybe False (== "noteref") (lookup "type" attr))
250+ guard $ lookup "type" attr == Just "noteref"
252 let ident = maybe "" (dropWhile (== '#')) (lookup "href" attr)
251 let ident = maybe "" (dropWhile (== '#')) (lookup "href" attr)
253 guard (not (null ident))
252 guard (not (null ident))
254 pInTags tag block
253 pInTags tag block
@@ -258,8 +257,8 @@ eNoteref = try $ do
258eTOC :: PandocMonad m => TagParser m ()
257eTOC :: PandocMonad m => TagParser m ()
259eTOC = try $ do
258eTOC = try $ do
260 guardEnabled Ext_epub_html_exts
259 guardEnabled Ext_epub_html_exts
261− (TagOpen tag attr) <- lookAhead $ pAnyTag
260+ (TagOpen tag attr) <- lookAhead pAnyTag
262− guard (maybe False (== "toc") (lookup "type" attr))
261+ guard $ lookup "type" attr == Just "toc"
263 void (pInTags tag block)
262 void (pInTags tag block)
265pList :: PandocMonad m => TagParser m Blocks
264pList :: PandocMonad m => TagParser m Blocks
@@ -285,7 +284,7 @@ pListItem nonItem = do
285 (Plain ils:xs) -> B.fromList (Plain
284 (Plain ils:xs) -> B.fromList (Plain
286 [Span (ident, [], []) ils] : xs)
285 [Span (ident, [], []) ils] : xs)
287 _ -> B.divWith (ident, [], []) bs
286 _ -> B.divWith (ident, [], []) bs
288− (maybe id addId (lookup "id" attr)) <$>
287+ maybe id addId (lookup "id" attr) <$>
289 pInTags "li" block <* skipMany nonItem
288 pInTags "li" block <* skipMany nonItem
291parseListStyleType :: String -> ListNumberStyle
290parseListStyleType :: String -> ListNumberStyle
@@ -356,14 +355,14 @@ fixPlains :: Bool -> Blocks -> Blocks
356fixPlains inList bs = if any isParaish bs'
355fixPlains inList bs = if any isParaish bs'
357 then B.fromList $ map plainToPara bs'
356 then B.fromList $ map plainToPara bs'
359− where isParaish (Para _) = True
358+ where isParaish Para{} = True
360− isParaish (CodeBlock _ _) = True
359+ isParaish CodeBlock{} = True
361− isParaish (Header _ _ _) = True
360+ isParaish Header{} = True
362− isParaish (BlockQuote _) = True
361+ isParaish BlockQuote{} = True
363− isParaish (BulletList _) = not inList
362+ isParaish BulletList{} = not inList
364− isParaish (OrderedList _ _) = not inList
363+ isParaish OrderedList{} = not inList
365− isParaish (DefinitionList _) = not inList
364+ isParaish DefinitionList{} = not inList
366− isParaish _ = False
365+ isParaish _ = False
367 plainToPara (Plain xs) = Para xs
366 plainToPara (Plain xs) = Para xs
368 plainToPara x = x
367 plainToPara x = x
369 bs' = B.toList bs
368 bs' = B.toList bs
@@ -427,10 +426,10 @@ eSection = try $ do
427 setInChapter (pInTags tag block)
426 setInChapter (pInTags tag block)
429headerLevel :: PandocMonad m => Text -> TagParser m Int
428headerLevel :: PandocMonad m => Text -> TagParser m Int
430−headerLevel tagtype = do
429+headerLevel tagtype =
431 case safeRead (T.unpack (T.drop 1 tagtype)) of
430 case safeRead (T.unpack (T.drop 1 tagtype)) of
432 Just level ->
431 Just level ->
433− (try $ do
432+ try (do
434 guardEnabled Ext_epub_html_exts
433 guardEnabled Ext_epub_html_exts
435 asks inChapter >>= guard
434 asks inChapter >>= guard
436 return (level - 1))
435 return (level - 1))
@@ -481,12 +480,12 @@ pTable = try $ do
481 pTBody = pOptInTag "tbody" $ many1 pTr
480 pTBody = pOptInTag "tbody" $ many1 pTr
482 head'' <- pOptInTag "thead" pTh
481 head'' <- pOptInTag "thead" pTh
483 head' <- map snd <$>
482 head' <- map snd <$>
484− (pOptInTag "tbody" $
483+ pOptInTag "tbody"
485− if null head'' then pTh else return head'')
484+ (if null head'' then pTh else return head'')
486 rowsLs <- many pTBody
485 rowsLs <- many pTBody
487 rows' <- pOptInTag "tfoot" $ many pTr
486 rows' <- pOptInTag "tfoot" $ many pTr
488 TagClose _ <- pSatisfy (matchTagClose "table")
487 TagClose _ <- pSatisfy (matchTagClose "table")
489− let rows'' = (concat rowsLs) <> rows'
488+ let rows'' = concat rowsLs <> rows'
490 let rows''' = map (map snd) rows''
489 let rows''' = map (map snd) rows''
491 -- let rows''' = map (map snd) rows''
490 -- let rows''' = map (map snd) rows''
492 -- fail on empty table
491 -- fail on empty table
@@ -691,7 +690,7 @@ pSubscript :: PandocMonad m => TagParser m Inlines
691pSubscript = pInlinesInTags "sub" B.subscript
690pSubscript = pInlinesInTags "sub" B.subscript
693pStrikeout :: PandocMonad m => TagParser m Inlines
692pStrikeout :: PandocMonad m => TagParser m Inlines
694−pStrikeout = do
693+pStrikeout =
695 pInlinesInTags "s" B.strikeout <|>
694 pInlinesInTags "s" B.strikeout <|>
696 pInlinesInTags "strike" B.strikeout <|>
695 pInlinesInTags "strike" B.strikeout <|>
697 pInlinesInTags "del" B.strikeout <|>
696 pInlinesInTags "del" B.strikeout <|>
@@ -719,7 +718,7 @@ pLink = try $ do
719 tag <- pSatisfy $ tagOpenLit "a" (const True)
718 tag <- pSatisfy $ tagOpenLit "a" (const True)
720 let title = T.unpack $ fromAttrib "title" tag
719 let title = T.unpack $ fromAttrib "title" tag
721 -- take id from id attribute if present, otherwise name
720 -- take id from id attribute if present, otherwise name
722− let uid = maybe (T.unpack $ fromAttrib "name" tag) id $
721+ let uid = fromMaybe (T.unpack $ fromAttrib "name" tag) $
723 maybeFromAttrib "id" tag
722 maybeFromAttrib "id" tag
724 let cls = words $ T.unpack $ fromAttrib "class" tag
723 let cls = words $ T.unpack $ fromAttrib "class" tag
725 lab <- trimInlines . mconcat <$> manyTill inline (pCloses "a")
724 lab <- trimInlines . mconcat <$> manyTill inline (pCloses "a")
@@ -750,7 +749,7 @@ pImage = do
750 let getAtt k = case fromAttrib k tag of
749 let getAtt k = case fromAttrib k tag of
752 v -> [(T.unpack k, T.unpack v)]
751 v -> [(T.unpack k, T.unpack v)]
753− let kvs = concat $ map getAtt ["width", "height", "sizes", "srcset"]
752+ let kvs = concatMap getAtt ["width", "height", "sizes", "srcset"]
754 return $ B.imageWith (uid, cls, kvs) (escapeURI url) title (B.text alt)
753 return $ B.imageWith (uid, cls, kvs) (escapeURI url) title (B.text alt)
756pCode :: PandocMonad m => TagParser m Inlines
755pCode :: PandocMonad m => TagParser m Inlines
@@ -846,7 +845,7 @@ pCloses :: PandocMonad m => Text -> TagParser m ()
846pCloses tagtype = try $ do
845pCloses tagtype = try $ do
847 t <- lookAhead $ pSatisfy $ \tag -> isTagClose tag || isTagOpen tag
846 t <- lookAhead $ pSatisfy $ \tag -> isTagClose tag || isTagOpen tag
848 case t of
847 case t of
849− (TagClose t') | t' == tagtype -> pAnyTag >> return ()
848+ (TagClose t') | t' == tagtype -> void pAnyTag
850 (TagOpen t' _) | t' `closes` tagtype -> return ()
849 (TagOpen t' _) | t' `closes` tagtype -> return ()
851 (TagClose "ul") | tagtype == "li" -> return ()
850 (TagClose "ul") | tagtype == "li" -> return ()
852 (TagClose "ol") | tagtype == "li" -> return ()
851 (TagClose "ol") | tagtype == "li" -> return ()
@@ -1197,7 +1196,7 @@ htmlTag f = try $ do
1197mkAttr :: [(String, String)] -> Attr
1196mkAttr :: [(String, String)] -> Attr
1198mkAttr attr = (attribsId, attribsClasses, attribsKV)
1197mkAttr attr = (attribsId, attribsClasses, attribsKV)
1199 where attribsId = fromMaybe "" $ lookup "id" attr
1198 where attribsId = fromMaybe "" $ lookup "id" attr
1200− attribsClasses = (words $ fromMaybe "" $ lookup "class" attr) <> epubTypes
1199+ attribsClasses = words (fromMaybe "" $ lookup "class" attr) <> epubTypes
1201 attribsKV = filter (\(k,_) -> k /= "class" && k /= "id") attr
1200 attribsKV = filter (\(k,_) -> k /= "class" && k /= "id") attr
1202 epubTypes = words $ fromMaybe "" $ lookup "epub:type" attr
1201 epubTypes = words $ fromMaybe "" $ lookup "epub:type" attr