{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards     #-}
module Graphics.SvgTree.CssParser
  ( CssElement( .. )
  , complexNumber
  , declaration
  , ruleSet
  , styleString
  , dashArray
  , numberList
  , num
  , cssRulesOfText
  ) where

import           Control.Applicative        (many, (<|>))
import           Data.Attoparsec.Text       (Parser, char, digit, double,
                                             letter, notChar, parseOnly, sepBy1,
                                             skipMany, skipSpace, string, (<?>))
import qualified Data.Attoparsec.Text       as AT

import           Data.Attoparsec.Combinator (many1, option, sepBy)

import           Codec.Picture              (PixelRGBA8 (..))
import qualified Data.Map                   as M
import qualified Data.Text                  as T
import           Graphics.SvgTree.ColorParser   (colorParser)
import           Graphics.SvgTree.CssTypes
import           Graphics.SvgTree.NamedColors   (svgNamedColors)

num :: Parser Double
num :: Parser Double
num = Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Double) -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
skipSpace Parser () -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Double
plusMinus Parser Double -> Parser () -> Parser Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace)
  where doubleNumber :: Parser Double
doubleNumber = Char -> Parser Char
char Char
'.' Parser Char -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Double -> Double
forall a. (RealFrac a, Floating a) => a -> a
scale (Double -> Double) -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
double)
                    Parser Double -> Parser Double -> Parser Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Double
double

        scalingCoeff :: a -> a
scalingCoeff a
n = a
10 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
digitCount
          where digitCount :: Int
                digitCount :: Int
digitCount = a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (a -> Int) -> (a -> a) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Floating a => a -> a -> a
logBase a
10 (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
n

        scale :: a -> a
scale a
n = a
n a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a a. (RealFrac a, Floating a, Num a) => a -> a
scalingCoeff a
n

        plusMinus :: Parser Double
plusMinus = Double -> Double
forall a. Num a => a -> a
negate (Double -> Double)
-> Parser Text Text -> Parser Text (Double -> Double)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"-" Parser Text (Double -> Double) -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
doubleNumber
                 Parser Double -> Parser Double -> Parser Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
string Text
"+" Parser Text Text -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Double
doubleNumber
                 Parser Double -> Parser Double -> Parser Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Double
doubleNumber


ident :: Parser T.Text
ident :: Parser Text Text
ident =
  (\Text -> Text
f Char
c -> Text -> Text
f (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.cons Char
c (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
        ((Text -> Text) -> Char -> String -> Text)
-> Parser Text (Text -> Text)
-> Parser Text (Char -> String -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Text -> Text)
trailingSub
        Parser Text (Char -> String -> Text)
-> Parser Char -> Parser Text (String -> Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char
nmstart Parser Text (String -> Text)
-> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text String
nmchar
  where
    trailingSub :: Parser Text (Text -> Text)
trailingSub = (Text -> Text)
-> Parser Text (Text -> Text) -> Parser Text (Text -> Text)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Text -> Text
forall a. a -> a
id (Parser Text (Text -> Text) -> Parser Text (Text -> Text))
-> Parser Text (Text -> Text) -> Parser Text (Text -> Text)
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
'-' (Text -> Text) -> Parser Char -> Parser Text (Text -> Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'-'
    underscore :: Parser Char
underscore = Char -> Parser Char
char Char
'_'
    nmstart :: Parser Char
nmstart = Parser Char
letter Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
underscore
    nmchar :: Parser Text String
nmchar = Parser Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Char
letter Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
digit Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
underscore Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
char Char
'-')

str :: Parser T.Text
str :: Parser Text Text
str = Char -> Parser Char
char Char
'"' Parser Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
AT.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') Parser Text Text -> Parser Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'"' Parser Text Text -> Parser () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
   Parser Text Text -> String -> Parser Text Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"str"

between :: Char -> Char -> Parser a -> Parser a
between :: Char -> Char -> Parser a -> Parser a
between Char
o Char
e Parser a
p =
  (Parser ()
skipSpace Parser () -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      Char -> Parser Char
char Char
o Parser Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p
           Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser a -> Parser Char -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
e Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace)
           Parser a -> String -> Parser a
forall i a. Parser i a -> String -> Parser i a
<?> (String
"between " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
o, Char
e])

bracket :: Parser a -> Parser a
bracket :: Parser a -> Parser a
bracket = Char -> Char -> Parser a -> Parser a
forall a. Char -> Char -> Parser a -> Parser a
between Char
'[' Char
']'


comment :: Parser ()
comment :: Parser ()
comment = Text -> Parser Text Text
string Text
"/*" Parser Text Text -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
toStar Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace
  where
    toStar :: Parser ()
toStar = Parser Char -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany (Char -> Parser Char
notChar Char
'*') Parser () -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
char Char
'*' Parser Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
testEnd
    testEnd :: Parser ()
testEnd = (() () -> Parser Char -> Parser ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'/') Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
toStar

cleanSpace :: Parser ()
cleanSpace :: Parser ()
cleanSpace = Parser ()
skipSpace Parser () -> Parser Text [()] -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser Text [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ()
comment

-- | combinator: '+' S* | '>' S*
combinator :: Parser CssSelector
combinator :: Parser CssSelector
combinator = Parser CssSelector
parse Parser CssSelector -> Parser () -> Parser CssSelector
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
cleanSpace where
  parse :: Parser CssSelector
parse = CssSelector
Nearby CssSelector -> Parser Char -> Parser CssSelector
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'+'
       Parser CssSelector -> Parser CssSelector -> Parser CssSelector
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CssSelector
DirectChildren CssSelector -> Parser Char -> Parser CssSelector
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'>'
       Parser CssSelector -> String -> Parser CssSelector
forall i a. Parser i a -> String -> Parser i a
<?> String
"combinator"

-- unary_operator : '-' | '+' ;

commaWsp :: Parser Char
commaWsp :: Parser Char
commaWsp = Parser ()
skipSpace Parser () -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Char
',' (Char -> Parser Char
char Char
',') Parser Char -> Parser () -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace

ruleSet :: Parser CssRule
ruleSet :: Parser CssRule
ruleSet = Parser ()
cleanSpace Parser () -> Parser CssRule -> Parser CssRule
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser CssRule
rule where
  rule :: Parser CssRule
rule = [CssSelectorRule] -> [CssDeclaration] -> CssRule
CssRule
      ([CssSelectorRule] -> [CssDeclaration] -> CssRule)
-> Parser Text [CssSelectorRule]
-> Parser Text ([CssDeclaration] -> CssRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CssSelectorRule
selector Parser CssSelectorRule
-> Parser Char -> Parser Text [CssSelectorRule]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser Char
commaWsp
      Parser Text ([CssDeclaration] -> CssRule)
-> Parser Text [CssDeclaration] -> Parser CssRule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char
-> Char
-> Parser Text [CssDeclaration]
-> Parser Text [CssDeclaration]
forall a. Char -> Char -> Parser a -> Parser a
between Char
'{' Char
'}' Parser Text [CssDeclaration]
styleString
      Parser CssRule -> String -> Parser CssRule
forall i a. Parser i a -> String -> Parser i a
<?> String
"cssrule"

styleString :: Parser [CssDeclaration]
styleString :: Parser Text [CssDeclaration]
styleString = ((Parser ()
cleanSpace Parser ()
-> Parser Text CssDeclaration -> Parser Text CssDeclaration
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text CssDeclaration
declaration) Parser Text CssDeclaration
-> Parser Char -> Parser Text [CssDeclaration]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Parser Char
semiWsp) Parser Text [CssDeclaration]
-> Parser Char -> Parser Text [CssDeclaration]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
mayWsp
           Parser Text [CssDeclaration]
-> String -> Parser Text [CssDeclaration]
forall i a. Parser i a -> String -> Parser i a
<?> String
"styleString"
  where semiWsp :: Parser Char
semiWsp = Parser ()
skipSpace Parser () -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
char Char
';' Parser Char -> Parser () -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
        mayWsp :: Parser Char
mayWsp = Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Char
';' Parser Char
semiWsp

selector :: Parser [CssSelector]
selector :: Parser CssSelectorRule
selector = (:)
        (CssSelector -> CssSelectorRule -> CssSelectorRule)
-> Parser CssSelector
-> Parser Text (CssSelectorRule -> CssSelectorRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([CssDescriptor] -> CssSelector
AllOf ([CssDescriptor] -> CssSelector)
-> Parser Text [CssDescriptor] -> Parser CssSelector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [CssDescriptor]
simpleSelector Parser CssSelector -> Parser () -> Parser CssSelector
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser CssSelector -> String -> Parser CssSelector
forall i a. Parser i a -> String -> Parser i a
<?> String
"firstpart:(")
        Parser Text (CssSelectorRule -> CssSelectorRule)
-> Parser CssSelectorRule -> Parser CssSelectorRule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Parser CssSelectorRule
next Parser CssSelectorRule
-> Parser CssSelectorRule -> Parser CssSelectorRule
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CssSelectorRule -> Parser CssSelectorRule
forall (m :: * -> *) a. Monad m => a -> m a
return []) Parser CssSelectorRule -> String -> Parser CssSelectorRule
forall i a. Parser i a -> String -> Parser i a
<?> String
"secondpart")
        Parser CssSelectorRule -> String -> Parser CssSelectorRule
forall i a. Parser i a -> String -> Parser i a
<?> String
"selector"
  where
    combOpt :: Parser ([CssSelector] -> [CssSelector])

    combOpt :: Parser Text (CssSelectorRule -> CssSelectorRule)
combOpt = Parser ()
cleanSpace Parser ()
-> Parser Text (CssSelectorRule -> CssSelectorRule)
-> Parser Text (CssSelectorRule -> CssSelectorRule)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (CssSelectorRule -> CssSelectorRule)
-> Parser Text (CssSelectorRule -> CssSelectorRule)
-> Parser Text (CssSelectorRule -> CssSelectorRule)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option CssSelectorRule -> CssSelectorRule
forall a. a -> a
id ((:) (CssSelector -> CssSelectorRule -> CssSelectorRule)
-> Parser CssSelector
-> Parser Text (CssSelectorRule -> CssSelectorRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CssSelector
combinator)
    next :: Parser [CssSelector]
    next :: Parser CssSelectorRule
next = Parser Text (CssSelectorRule -> CssSelectorRule)
combOpt Parser Text (CssSelectorRule -> CssSelectorRule)
-> Parser CssSelectorRule -> Parser CssSelectorRule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CssSelectorRule
selector

simpleSelector :: Parser [CssDescriptor]
simpleSelector :: Parser Text [CssDescriptor]
simpleSelector = (:) (CssDescriptor -> [CssDescriptor] -> [CssDescriptor])
-> Parser Text CssDescriptor
-> Parser Text ([CssDescriptor] -> [CssDescriptor])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text CssDescriptor
elementName Parser Text ([CssDescriptor] -> [CssDescriptor])
-> Parser Text [CssDescriptor] -> Parser Text [CssDescriptor]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text CssDescriptor -> Parser Text [CssDescriptor]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text CssDescriptor
whole
              Parser Text [CssDescriptor]
-> Parser Text [CssDescriptor] -> Parser Text [CssDescriptor]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text CssDescriptor -> Parser Text [CssDescriptor]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text CssDescriptor
whole Parser Text [CssDescriptor]
-> String -> Parser Text [CssDescriptor]
forall i a. Parser i a -> String -> Parser i a
<?> String
"inmany")
              Parser Text [CssDescriptor]
-> String -> Parser Text [CssDescriptor]
forall i a. Parser i a -> String -> Parser i a
<?> String
"simple selector"
 where
  whole :: Parser Text CssDescriptor
whole = Parser Text CssDescriptor
pseudo Parser Text CssDescriptor
-> Parser Text CssDescriptor -> Parser Text CssDescriptor
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text CssDescriptor
hash Parser Text CssDescriptor
-> Parser Text CssDescriptor -> Parser Text CssDescriptor
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text CssDescriptor
classParser Parser Text CssDescriptor
-> Parser Text CssDescriptor -> Parser Text CssDescriptor
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text CssDescriptor
attrib
       Parser Text CssDescriptor -> String -> Parser Text CssDescriptor
forall i a. Parser i a -> String -> Parser i a
<?> String
"whole"
  pseudo :: Parser Text CssDescriptor
pseudo = Char -> Parser Char
char Char
':' Parser Char
-> Parser Text CssDescriptor -> Parser Text CssDescriptor
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> CssDescriptor
OfPseudoClass (Text -> CssDescriptor)
-> Parser Text Text -> Parser Text CssDescriptor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
ident)
        Parser Text CssDescriptor -> String -> Parser Text CssDescriptor
forall i a. Parser i a -> String -> Parser i a
<?> String
"pseudo"
  hash :: Parser Text CssDescriptor
hash = Char -> Parser Char
char Char
'#' Parser Char
-> Parser Text CssDescriptor -> Parser Text CssDescriptor
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> CssDescriptor
OfId (Text -> CssDescriptor)
-> Parser Text Text -> Parser Text CssDescriptor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
ident)
      Parser Text CssDescriptor -> String -> Parser Text CssDescriptor
forall i a. Parser i a -> String -> Parser i a
<?> String
"hash"
  classParser :: Parser Text CssDescriptor
classParser = Char -> Parser Char
char Char
'.' Parser Char
-> Parser Text CssDescriptor -> Parser Text CssDescriptor
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> CssDescriptor
OfClass (Text -> CssDescriptor)
-> Parser Text Text -> Parser Text CssDescriptor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
ident)
              Parser Text CssDescriptor -> String -> Parser Text CssDescriptor
forall i a. Parser i a -> String -> Parser i a
<?> String
"classParser"

  elementName :: Parser Text CssDescriptor
elementName = Parser Text CssDescriptor
el Parser Text CssDescriptor -> Parser () -> Parser Text CssDescriptor
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Text CssDescriptor -> String -> Parser Text CssDescriptor
forall i a. Parser i a -> String -> Parser i a
<?> String
"elementName"
    where el :: Parser Text CssDescriptor
el = (Text -> CssDescriptor
OfName (Text -> CssDescriptor)
-> Parser Text Text -> Parser Text CssDescriptor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
ident)
            Parser Text CssDescriptor
-> Parser Text CssDescriptor -> Parser Text CssDescriptor
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CssDescriptor
AnyElem CssDescriptor -> Parser Char -> Parser Text CssDescriptor
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'*'

  attrib :: Parser Text CssDescriptor
attrib = Parser Text CssDescriptor -> Parser Text CssDescriptor
forall a. Parser a -> Parser a
bracket
    (Text -> Text -> CssDescriptor
WithAttrib (Text -> Text -> CssDescriptor)
-> Parser Text Text -> Parser Text (Text -> CssDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
ident Parser Text (Text -> CssDescriptor)
-> Parser Text Text -> Parser Text CssDescriptor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
char Char
'=' Parser Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text Text
ident Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
str))
           Parser Text CssDescriptor -> String -> Parser Text CssDescriptor
forall i a. Parser i a -> String -> Parser i a
<?> String
"attrib")

declaration :: Parser CssDeclaration
declaration :: Parser Text CssDeclaration
declaration =
  Text -> [[CssElement]] -> CssDeclaration
CssDeclaration (Text -> [[CssElement]] -> CssDeclaration)
-> Parser Text Text
-> Parser Text ([[CssElement]] -> CssDeclaration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
property
                 Parser Text ([[CssElement]] -> CssDeclaration)
-> Parser Text [[CssElement]] -> Parser Text CssDeclaration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
char Char
':'
                      Parser Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
cleanSpace
                      Parser ()
-> Parser Text [[CssElement]] -> Parser Text [[CssElement]]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text [CssElement] -> Parser Text [[CssElement]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text [CssElement]
expr
                      Parser Text [[CssElement]]
-> Parser Text Text -> Parser Text [[CssElement]]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
prio
                      )
                 Parser Text CssDeclaration -> String -> Parser Text CssDeclaration
forall i a. Parser i a -> String -> Parser i a
<?> String
"declaration"
  where
    property :: Parser Text Text
property = (Parser Text Text
ident Parser Text Text -> Parser () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
cleanSpace) Parser Text Text -> String -> Parser Text Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"property"
    prio :: Parser Text Text
prio = Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Text
"" (Parser Text Text -> Parser Text Text)
-> Parser Text Text -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
string Text
"!important"

operator :: Parser CssElement
operator :: Parser CssElement
operator = Parser ()
skipSpace Parser () -> Parser CssElement -> Parser CssElement
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser CssElement
op Parser CssElement -> Parser () -> Parser CssElement
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
  where
    op :: Parser CssElement
op = CssElement
CssOpSlash CssElement -> Parser Char -> Parser CssElement
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'/'
      Parser CssElement -> Parser CssElement -> Parser CssElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CssElement
CssOpComa CssElement -> Parser Char -> Parser CssElement
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
','
      Parser CssElement -> String -> Parser CssElement
forall i a. Parser i a -> String -> Parser i a
<?> String
"operator"

expr :: Parser [CssElement]
expr :: Parser Text [CssElement]
expr = ((:) (CssElement -> [CssElement] -> [CssElement])
-> Parser CssElement -> Parser Text ([CssElement] -> [CssElement])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CssElement
term Parser Text ([CssElement] -> [CssElement])
-> Parser Text [CssElement] -> Parser Text [CssElement]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([[CssElement]] -> [CssElement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CssElement]] -> [CssElement])
-> Parser Text [[CssElement]] -> Parser Text [CssElement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [CssElement] -> Parser Text [[CssElement]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text [CssElement]
termOp))
    Parser Text [CssElement] -> String -> Parser Text [CssElement]
forall i a. Parser i a -> String -> Parser i a
<?> String
"expr"
  where
    op :: Parser Text (CssElement -> [CssElement])
op = (CssElement -> [CssElement])
-> Parser Text (CssElement -> [CssElement])
-> Parser Text (CssElement -> [CssElement])
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option (CssElement -> [CssElement] -> [CssElement]
forall a. a -> [a] -> [a]
:[]) (Parser Text (CssElement -> [CssElement])
 -> Parser Text (CssElement -> [CssElement]))
-> Parser Text (CssElement -> [CssElement])
-> Parser Text (CssElement -> [CssElement])
forall a b. (a -> b) -> a -> b
$ (\CssElement
a CssElement
b -> [CssElement
a, CssElement
b]) (CssElement -> CssElement -> [CssElement])
-> Parser CssElement -> Parser Text (CssElement -> [CssElement])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CssElement
operator
    termOp :: Parser Text [CssElement]
termOp = (CssElement -> [CssElement]) -> CssElement -> [CssElement]
forall a b. (a -> b) -> a -> b
($) ((CssElement -> [CssElement]) -> CssElement -> [CssElement])
-> Parser Text (CssElement -> [CssElement])
-> Parser Text (CssElement -> [CssElement])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (CssElement -> [CssElement])
op Parser Text (CssElement -> [CssElement])
-> Parser CssElement -> Parser Text [CssElement]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CssElement
term

dashArray :: Parser [Number]
dashArray :: Parser [Number]
dashArray = Parser ()
skipSpace Parser () -> Parser [Number] -> Parser [Number]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Number
complexNumber Parser Number -> Parser Char -> Parser [Number]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser Char
commaWsp)

numberList :: Parser [Double]
numberList :: Parser [Double]
numberList = Parser ()
skipSpace Parser () -> Parser [Double] -> Parser [Double]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Double
num Parser Double -> Parser Char -> Parser [Double]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser Char
commaWsp)

complexNumber :: Parser Number
complexNumber :: Parser Number
complexNumber = do
    Double
n <- Parser Double
num
    (Double -> Number
Percent (Double
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100) Number -> Parser Char -> Parser Number
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'%')
        Parser Number -> Parser Number -> Parser Number
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Number
Em Double
n Number -> Parser Text Text -> Parser Number
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"em")
        Parser Number -> Parser Number -> Parser Number
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Number
Mm Double
n Number -> Parser Text Text -> Parser Number
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"mm")
        Parser Number -> Parser Number -> Parser Number
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Number
Cm Double
n Number -> Parser Text Text -> Parser Number
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"cm")
        Parser Number -> Parser Number -> Parser Number
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Number
Point Double
n Number -> Parser Text Text -> Parser Number
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"pt")
        Parser Number -> Parser Number -> Parser Number
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Number
Pc Double
n Number -> Parser Text Text -> Parser Number
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"pc")
        Parser Number -> Parser Number -> Parser Number
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Number
Px Double
n Number -> Parser Text Text -> Parser Number
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"px")
        Parser Number -> Parser Number -> Parser Number
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Number
Inches Double
n Number -> Parser Text Text -> Parser Number
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"in")
        Parser Number -> Parser Number -> Parser Number
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Number -> Parser Number
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Number
Num Double
n)

term :: Parser CssElement
term :: Parser CssElement
term = CssElement -> CssElement
checkRgb (CssElement -> CssElement)
-> Parser CssElement -> Parser CssElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CssElement
function
    Parser CssElement -> Parser CssElement -> Parser CssElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Number -> CssElement
CssNumber (Number -> CssElement) -> Parser Number -> Parser CssElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Number
complexNumber)
    Parser CssElement -> Parser CssElement -> Parser CssElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> CssElement
CssString (Text -> CssElement) -> Parser Text Text -> Parser CssElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
str)
    Parser CssElement -> Parser CssElement -> Parser CssElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> CssElement
checkNamedColor (Text -> CssElement) -> Parser Text Text -> Parser CssElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
ident)
    Parser CssElement -> Parser CssElement -> Parser CssElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PixelRGBA8 -> CssElement
CssColor (PixelRGBA8 -> CssElement)
-> Parser Text PixelRGBA8 -> Parser CssElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text PixelRGBA8
colorParser)
  where
    comma :: Parser Char
comma = Parser ()
skipSpace Parser () -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
    checkNamedColor :: Text -> CssElement
checkNamedColor Text
n
        | Just PixelRGBA8
c <- Text -> Map Text PixelRGBA8 -> Maybe PixelRGBA8
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
n Map Text PixelRGBA8
svgNamedColors = PixelRGBA8 -> CssElement
CssColor PixelRGBA8
c
        | Bool
otherwise = Text -> CssElement
CssIdent Text
n

    ref :: Parser Text Text
ref = Char -> Parser Char
char Char
'#' Parser Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
ident

    checkRgb :: CssElement -> CssElement
checkRgb (CssFunction Text
"rgb"
                [CssNumber Number
r, CssNumber Number
g, CssNumber Number
b]) =
        PixelRGBA8 -> CssElement
CssColor (PixelRGBA8 -> CssElement) -> PixelRGBA8 -> CssElement
forall a b. (a -> b) -> a -> b
$ Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 (Number -> Pixel8
forall p. Integral p => Number -> p
to Number
r) (Number -> Pixel8
forall p. Integral p => Number -> p
to Number
g) (Number -> Pixel8
forall p. Integral p => Number -> p
to Number
b) Pixel8
255
       where clamp :: Double -> Double
clamp = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
255
             to :: Number -> p
to (Num Double
n)     = Double -> p
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> p) -> Double -> p
forall a b. (a -> b) -> a -> b
$ Double -> Double
clamp Double
n
             to (Px Double
n)      = Double -> p
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> p) -> Double -> p
forall a b. (a -> b) -> a -> b
$ Double -> Double
clamp Double
n
             to (Percent Double
p) = Double -> p
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> p) -> (Double -> Double) -> Double -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
clamp (Double -> p) -> Double -> p
forall a b. (a -> b) -> a -> b
$ Double
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
255
             to (Em Double
c)      = Double -> p
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> p) -> Double -> p
forall a b. (a -> b) -> a -> b
$ Double -> Double
clamp Double
c
             to (Pc Double
n)      = Double -> p
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> p) -> Double -> p
forall a b. (a -> b) -> a -> b
$ Double -> Double
clamp Double
n
             to (Mm Double
n)      = Double -> p
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> p) -> Double -> p
forall a b. (a -> b) -> a -> b
$ Double -> Double
clamp Double
n
             to (Cm Double
n)      = Double -> p
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> p) -> Double -> p
forall a b. (a -> b) -> a -> b
$ Double -> Double
clamp Double
n
             to (Point Double
n)   = Double -> p
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> p) -> Double -> p
forall a b. (a -> b) -> a -> b
$ Double -> Double
clamp Double
n
             to (Inches Double
n)  = Double -> p
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> p) -> Double -> p
forall a b. (a -> b) -> a -> b
$ Double -> Double
clamp Double
n

    checkRgb CssElement
a = CssElement
a
    functionParam :: Parser CssElement
functionParam = (Text -> CssElement
CssReference (Text -> CssElement) -> Parser Text Text -> Parser CssElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
ref) Parser CssElement -> Parser CssElement -> Parser CssElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser CssElement
term

    function :: Parser CssElement
function = Text -> [CssElement] -> CssElement
CssFunction
       (Text -> [CssElement] -> CssElement)
-> Parser Text Text -> Parser Text ([CssElement] -> CssElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
ident Parser Text ([CssElement] -> CssElement)
-> Parser Char -> Parser Text ([CssElement] -> CssElement)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'('
       Parser Text ([CssElement] -> CssElement)
-> Parser Text [CssElement] -> Parser CssElement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser CssElement
functionParam Parser CssElement -> Parser Char -> Parser Text [CssElement]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Parser Char
comma) Parser CssElement -> Parser Char -> Parser CssElement
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
')' Parser CssElement -> Parser () -> Parser CssElement
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace

-- | Parse CSS text into rules.
cssRulesOfText :: T.Text -> [CssRule]
cssRulesOfText :: Text -> [CssRule]
cssRulesOfText Text
txt = case Parser [CssRule] -> Text -> Either String [CssRule]
forall a. Parser a -> Text -> Either String a
parseOnly (Parser CssRule -> Parser [CssRule]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser CssRule
ruleSet) Text
txt of
    Left String
_      -> []
    Right [CssRule]
rules -> [CssRule]
rules