diff options
| -rw-r--r-- | src/Text/Pandoc/CSS.hs | 12 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/HTML.hs | 27 |
2 files changed, 12 insertions, 27 deletions
diff --git a/src/Text/Pandoc/CSS.hs b/src/Text/Pandoc/CSS.hs index 3f88d2006..80251850b 100644 --- a/src/Text/Pandoc/CSS.hs +++ b/src/Text/Pandoc/CSS.hs @@ -11,13 +11,13 @@ Portability : portable Tools for working with CSS. -} -module Text.Pandoc.CSS ( foldOrElse - , pickStyleAttrProps +module Text.Pandoc.CSS ( pickStyleAttrProps , pickStylesToKVs ) where import qualified Data.Text as T +import Data.Maybe (mapMaybe, listToMaybe) import Text.Pandoc.Shared (trim) import Text.Parsec import Text.Parsec.Text @@ -31,12 +31,6 @@ ruleParser = do styleAttrParser :: Parser [(T.Text, T.Text)] styleAttrParser = many1 ruleParser -orElse :: Eq a => a -> a -> a -> a -orElse v x y = if v == x then y else x - -foldOrElse :: Eq a => a -> [a] -> a -foldOrElse v xs = foldr (orElse v) v xs - eitherToMaybe :: Either a b -> Maybe b eitherToMaybe (Right x) = Just x eitherToMaybe _ = Nothing @@ -54,4 +48,4 @@ pickStylesToKVs props styleAttr = pickStyleAttrProps :: [T.Text] -> T.Text -> Maybe T.Text pickStyleAttrProps lookupProps styleAttr = do styles <- eitherToMaybe $ parse styleAttrParser "" styleAttr - foldOrElse Nothing $ map (`lookup` styles) lookupProps + listToMaybe $ mapMaybe (`lookup` styles) lookupProps diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index e33dface7..95f034521 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -46,7 +46,7 @@ import Text.HTML.TagSoup.Match import Text.Pandoc.Builder (Blocks, Inlines, trimInlines) import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) -import Text.Pandoc.CSS (foldOrElse, pickStyleAttrProps) +import Text.Pandoc.CSS (pickStyleAttrProps) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Definition import Text.Pandoc.Readers.HTML.Parsing @@ -290,23 +290,14 @@ pOrderedList :: PandocMonad m => TagParser m Blocks pOrderedList = try $ do TagOpen _ attribs' <- pSatisfy (matchTagOpen "ol" []) let attribs = toStringAttr attribs' - let (start, style) = (sta', sty') - where sta = fromMaybe "1" $ - lookup "start" attribs - sta' = fromMaybe 1 $ safeRead sta - - pickListStyle = pickStyleAttrProps ["list-style-type", "list-style"] - - typeAttr = fromMaybe "" $ lookup "type" attribs - classAttr = fromMaybe "" $ lookup "class" attribs - styleAttr = fromMaybe "" $ lookup "style" attribs - listStyle = fromMaybe "" $ pickListStyle styleAttr - - sty' = foldOrElse DefaultStyle - [ parseTypeAttr typeAttr - , parseListStyleType classAttr - , parseListStyleType listStyle - ] + let start = fromMaybe 1 $ lookup "start" attribs >>= safeRead + let style = fromMaybe DefaultStyle + $ (parseTypeAttr <$> lookup "type" attribs) + <|> (parseListStyleType <$> lookup "class" attribs) + <|> (parseListStyleType <$> (lookup "style" attribs >>= pickListStyle)) + where + pickListStyle = pickStyleAttrProps ["list-style-type", "list-style"] + let nonItem = pSatisfy (\t -> not (tagOpen (`elem` ["li","ol","ul","dl"]) (const True) t) && not (matchTagClose "ol" t)) |