37a82b0b11
Quite a few modules were missing copyright notices. This commit adds copyright notices everywhere via haddock module headers. The old license boilerplate comment is redundant with this and has been removed. Update copyright years to 2019. Closes #4592.
58 lines
1.8 KiB
Haskell
58 lines
1.8 KiB
Haskell
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{- |
|
|
Module : Text.Pandoc.CSS
|
|
Copyright : © 2006-2019 John MacFarlane <jgm@berkeley.edu>,
|
|
2015-2016 Mauro Bieg,
|
|
2015 Ophir Lifshitz <hangfromthefloor@gmail.com>
|
|
License : GNU GPL, version 2 or above
|
|
|
|
Maintainer : John MacFarlane <jgm@berkeley@edu>
|
|
Stability : alpha
|
|
Portability : portable
|
|
|
|
Tools for working with CSS.
|
|
-}
|
|
module Text.Pandoc.CSS ( foldOrElse
|
|
, pickStyleAttrProps
|
|
, pickStylesToKVs
|
|
)
|
|
where
|
|
|
|
import Prelude
|
|
import Text.Pandoc.Shared (trim)
|
|
import Text.Parsec
|
|
import Text.Parsec.String
|
|
|
|
ruleParser :: Parser (String, String)
|
|
ruleParser = do
|
|
p <- many1 (noneOf ":") <* char ':'
|
|
v <- many1 (noneOf ":;") <* optional (char ';') <* spaces
|
|
return (trim p, trim v)
|
|
|
|
styleAttrParser :: Parser [(String, String)]
|
|
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
|
|
|
|
-- | takes a list of keys/properties and a CSS string and
|
|
-- returns the corresponding key-value-pairs.
|
|
pickStylesToKVs :: [String] -> String -> [(String, String)]
|
|
pickStylesToKVs props styleAttr =
|
|
case parse styleAttrParser "" styleAttr of
|
|
Left _ -> []
|
|
Right styles -> filter (\s -> fst s `elem` props) styles
|
|
|
|
-- | takes a list of key/property synonyms and a CSS string and maybe
|
|
-- returns the value of the first match (in order of the supplied list)
|
|
pickStyleAttrProps :: [String] -> String -> Maybe String
|
|
pickStyleAttrProps lookupProps styleAttr = do
|
|
styles <- eitherToMaybe $ parse styleAttrParser "" styleAttr
|
|
foldOrElse Nothing $ map (`lookup` styles) lookupProps
|