{- |
Module      : Text.Pandoc.CSS
Copyright   : © 2006-2023 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
  ( cssAttributes
  , pickStyleAttrProps
  , pickStylesToKVs
  )
where

import Data.Either (fromRight)
import Data.Maybe (mapMaybe, listToMaybe)
import Data.Text (Text, pack)
import Text.Pandoc.Shared (trim)
import Text.Pandoc.Parsing

type Parser = Parsec Text ()

ruleParser :: Parser (Text, Text)
ruleParser :: Parser (Text, Text)
ruleParser = do
    [Char]
p <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
":")  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':'
    [Char]
v <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
":;") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
';') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
    forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text
trim forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack [Char]
p, Text -> Text
trim forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack [Char]
v)

styleAttrParser :: Parser [(Text, Text)]
styleAttrParser :: Parser [(Text, Text)]
styleAttrParser = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parser (Text, Text)
ruleParser

-- | Parses a style string, returning the CSS attributes.
-- Returns an empty list on failure.
cssAttributes :: Text -> [(Text, Text)]
cssAttributes :: Text -> [(Text, Text)]
cssAttributes Text
styleString =
  forall b a. b -> Either a b -> b
fromRight [] forall a b. (a -> b) -> a -> b
$ forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parser [(Text, Text)]
styleAttrParser [Char]
"" Text
styleString

-- | takes a list of keys/properties and a CSS string and
-- returns the corresponding key-value-pairs.
pickStylesToKVs :: [Text] -> Text -> [(Text, Text)]
pickStylesToKVs :: [Text] -> Text -> [(Text, Text)]
pickStylesToKVs [Text]
props Text
styleAttr =
  forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text, Text)
s -> forall a b. (a, b) -> a
fst (Text, Text)
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
props) forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)]
cssAttributes Text
styleAttr

-- | 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 :: [Text] -> Text -> Maybe Text
pickStyleAttrProps :: [Text] -> Text -> Maybe Text
pickStyleAttrProps [Text]
lookupProps Text
styleAttr = do
    [(Text, Text)]
styles <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parser [(Text, Text)]
styleAttrParser [Char]
"" Text
styleAttr
    forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Text, Text)]
styles) [Text]
lookupProps