{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Defines the types used to describes CSS elements
module Graphics.SvgTree.CssTypes
  ( CssSelector( .. )
  , CssSelectorRule
  , CssRule( .. )
  , CssDescriptor( .. )
  , CssDeclaration( .. )
  , CssElement( .. )

  , CssMatcheable( .. )
  , CssContext
  , Dpi
  , Number( .. )
  , serializeNumber
  , findMatchingDeclarations
  , toUserUnit
  , mapNumber
  , tserialize
  ) where

import           Data.Hashable          (Hashable)
import           Data.List              (intersperse)
import qualified Data.Text              as T
import qualified Data.Text.Lazy.Builder as TB
import           GHC.Generics           (Generic)
import           Text.Printf

import           Codec.Picture          (PixelRGBA8 (..))

import           Graphics.SvgTree.Misc

-- | Alias describing a "dot per inch" information
-- used for size calculation (see toUserUnit).
type Dpi = Int

-- | Helper typeclass for serialization to Text.
class TextBuildable a where
    -- | Serialize an element to a text builder.
    tserialize :: a -> TB.Builder

-- | Describes an element of a CSS selector. Multiple
-- elements can be combined in a CssSelector type.
data CssDescriptor
  = OfClass T.Text    -- ^ .IDENT
  | OfName  T.Text    -- ^ IDENT
  | OfId    T.Text    -- ^ #IDENT
  | OfPseudoClass T.Text     -- ^ `:IDENT` (ignore function syntax)
  | AnyElem                  -- ^ '*'
  | WithAttrib T.Text T.Text -- ^ ``
  deriving (CssDescriptor -> CssDescriptor -> Bool
(CssDescriptor -> CssDescriptor -> Bool)
-> (CssDescriptor -> CssDescriptor -> Bool) -> Eq CssDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssDescriptor -> CssDescriptor -> Bool
$c/= :: CssDescriptor -> CssDescriptor -> Bool
== :: CssDescriptor -> CssDescriptor -> Bool
$c== :: CssDescriptor -> CssDescriptor -> Bool
Eq, Int -> CssDescriptor -> ShowS
[CssDescriptor] -> ShowS
CssDescriptor -> String
(Int -> CssDescriptor -> ShowS)
-> (CssDescriptor -> String)
-> ([CssDescriptor] -> ShowS)
-> Show CssDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssDescriptor] -> ShowS
$cshowList :: [CssDescriptor] -> ShowS
show :: CssDescriptor -> String
$cshow :: CssDescriptor -> String
showsPrec :: Int -> CssDescriptor -> ShowS
$cshowsPrec :: Int -> CssDescriptor -> ShowS
Show)

instance TextBuildable CssDescriptor where
  tserialize :: CssDescriptor -> Builder
tserialize CssDescriptor
d = case CssDescriptor
d of
      OfClass Text
c       -> Char -> Builder
si Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
ft Text
c
      OfName  Text
n       -> Text -> Builder
ft Text
n
      OfId    Text
i       -> Char -> Builder
si Char
'#' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
ft Text
i
      OfPseudoClass Text
c -> Char -> Builder
si Char
'#' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
ft Text
c
      CssDescriptor
AnyElem         -> Char -> Builder
si Char
'*'
      WithAttrib Text
a Text
b  -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Char -> Builder
si Char
'[', Text -> Builder
ft Text
a, Char -> Builder
si Char
'=', Text -> Builder
ft Text
b, Char -> Builder
si Char
']']
     where
      ft :: Text -> Builder
ft = Text -> Builder
TB.fromText
      si :: Char -> Builder
si = Char -> Builder
TB.singleton

-- | Defines complex selector.
data CssSelector
  = Nearby          -- ^ Corresponds to the `+` CSS selector.
  | DirectChildren  -- ^ Corresponds to the `>` CSS selectro.
  | AllOf [CssDescriptor] -- ^ Grouping construct, all the elements
                          -- of the list must be matched.
  deriving (CssSelector -> CssSelector -> Bool
(CssSelector -> CssSelector -> Bool)
-> (CssSelector -> CssSelector -> Bool) -> Eq CssSelector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssSelector -> CssSelector -> Bool
$c/= :: CssSelector -> CssSelector -> Bool
== :: CssSelector -> CssSelector -> Bool
$c== :: CssSelector -> CssSelector -> Bool
Eq, Int -> CssSelector -> ShowS
[CssSelector] -> ShowS
CssSelector -> String
(Int -> CssSelector -> ShowS)
-> (CssSelector -> String)
-> ([CssSelector] -> ShowS)
-> Show CssSelector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssSelector] -> ShowS
$cshowList :: [CssSelector] -> ShowS
show :: CssSelector -> String
$cshow :: CssSelector -> String
showsPrec :: Int -> CssSelector -> ShowS
$cshowsPrec :: Int -> CssSelector -> ShowS
Show)

instance TextBuildable CssSelector where
  tserialize :: CssSelector -> Builder
tserialize CssSelector
s = case CssSelector
s of
      CssSelector
Nearby         -> Char -> Builder
si Char
'+'
      CssSelector
DirectChildren -> Char -> Builder
si Char
'>'
      AllOf [CssDescriptor]
lst      -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (CssDescriptor -> Builder) -> [CssDescriptor] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map CssDescriptor -> Builder
forall a. TextBuildable a => a -> Builder
tserialize [CssDescriptor]
lst
    where
      si :: Char -> Builder
si = Char -> Builder
TB.singleton

-- | A CssSelectorRule is a list of all the elements
-- that must be met in a depth first search fashion.
type CssSelectorRule = [CssSelector]

-- | Represents a CSS selector and the different declarations
-- to apply to the matched elemens.
data CssRule = CssRule
    { -- | At the first level represents a list of elements
      -- to be matched. If any match is made, you can apply
      -- the declarations. At the second level
      CssRule -> [[CssSelector]]
cssRuleSelector :: ![CssSelectorRule]
      -- | Declarations to apply to the matched element.
    , CssRule -> [CssDeclaration]
cssDeclarations :: ![CssDeclaration]
    }
    deriving (CssRule -> CssRule -> Bool
(CssRule -> CssRule -> Bool)
-> (CssRule -> CssRule -> Bool) -> Eq CssRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssRule -> CssRule -> Bool
$c/= :: CssRule -> CssRule -> Bool
== :: CssRule -> CssRule -> Bool
$c== :: CssRule -> CssRule -> Bool
Eq, Int -> CssRule -> ShowS
[CssRule] -> ShowS
CssRule -> String
(Int -> CssRule -> ShowS)
-> (CssRule -> String) -> ([CssRule] -> ShowS) -> Show CssRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssRule] -> ShowS
$cshowList :: [CssRule] -> ShowS
show :: CssRule -> String
$cshow :: CssRule -> String
showsPrec :: Int -> CssRule -> ShowS
$cshowsPrec :: Int -> CssRule -> ShowS
Show)

instance TextBuildable CssRule where
  tserialize :: CssRule -> Builder
tserialize (CssRule [[CssSelector]]
selectors [CssDeclaration]
decl) =
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
tselectors
                 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
ft Text
" {\n"
                 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((CssDeclaration -> Builder) -> [CssDeclaration] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CssDeclaration -> Builder
forall a. TextBuildable a => a -> Builder
tserializeDecl [CssDeclaration]
decl)
                 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
ft Text
"}\n"
     where
      ft :: Text -> Builder
ft = Text -> Builder
TB.fromText
      tserializeDecl :: a -> Builder
tserializeDecl a
d = Text -> Builder
ft Text
"  " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. TextBuildable a => a -> Builder
tserialize a
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
ft Text
";\n"
      tselector :: [CssSelector] -> Builder
tselector =
          [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([CssSelector] -> [Builder]) -> [CssSelector] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
ft Text
" ") ([Builder] -> [Builder])
-> ([CssSelector] -> [Builder]) -> [CssSelector] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CssSelector -> Builder) -> [CssSelector] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CssSelector -> Builder
forall a. TextBuildable a => a -> Builder
tserialize
      tselectors :: [Builder]
tselectors =
          Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
ft Text
",\n") ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ ([CssSelector] -> Builder) -> [[CssSelector]] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [CssSelector] -> Builder
tselector [[CssSelector]]
selectors

-- | Interface for elements to be matched against
-- some CssRule.
class CssMatcheable a where
  -- | For an element, tell its optional ID attribute.
  cssIdOf     :: a -> Maybe T.Text
  -- | For an element, return all of it's class attributes.
  cssClassOf  :: a -> [T.Text]
  -- | Return the name of the tagname of the element
  cssNameOf   :: a -> T.Text
  -- | Return a value of a given attribute if present
  cssAttribOf :: a -> T.Text -> Maybe T.Text

-- | Represents a zipper in depth at the first list
-- level, and the previous nodes at in the second
-- list level.
type CssContext a = [[a]]

isDescribedBy :: CssMatcheable a
              => a -> [CssDescriptor] -> Bool
isDescribedBy :: a -> [CssDescriptor] -> Bool
isDescribedBy a
e = (CssDescriptor -> Bool) -> [CssDescriptor] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CssDescriptor -> Bool
tryMatch
  where
    tryMatch :: CssDescriptor -> Bool
tryMatch (OfClass Text
t)       = Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` a -> [Text]
forall a. CssMatcheable a => a -> [Text]
cssClassOf a
e
    tryMatch (OfId    Text
i)       = a -> Maybe Text
forall a. CssMatcheable a => a -> Maybe Text
cssIdOf a
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i
    tryMatch (OfName  Text
n)       = a -> Text
forall a. CssMatcheable a => a -> Text
cssNameOf a
e Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n
    tryMatch (OfPseudoClass Text
_) = Bool
False
    tryMatch (WithAttrib Text
a Text
v)  = a -> Text -> Maybe Text
forall a. CssMatcheable a => a -> Text -> Maybe Text
cssAttribOf a
e Text
a Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v
    tryMatch CssDescriptor
AnyElem           = Bool
True

isMatching :: CssMatcheable a
           => CssContext a -> [CssSelector] -> Bool
isMatching :: CssContext a -> [CssSelector] -> Bool
isMatching = CssContext a -> [CssSelector] -> Bool
forall a. CssMatcheable a => [[a]] -> [CssSelector] -> Bool
go where
  go :: [[a]] -> [CssSelector] -> Bool
go  [[a]]
_ [] = Bool
True
  go []  [CssSelector]
_ = Bool
False
  go ((a
_ : [a]
near):[[a]]
upper) (CssSelector
Nearby : [CssSelector]
rest) = [[a]] -> [CssSelector] -> Bool
go ([a]
near[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
upper) [CssSelector]
rest
  go ((a
e:[a]
_):[[a]]
upper) (CssSelector
DirectChildren:AllOf [CssDescriptor]
descr:[CssSelector]
rest)
    | a -> [CssDescriptor] -> Bool
forall a. CssMatcheable a => a -> [CssDescriptor] -> Bool
isDescribedBy a
e [CssDescriptor]
descr = [[a]] -> [CssSelector] -> Bool
go [[a]]
upper [CssSelector]
rest
  go [[a]]
_ (CssSelector
DirectChildren:[CssSelector]
_) = Bool
False
  go ((a
e:[a]
_):[[a]]
upper) selectors :: [CssSelector]
selectors@(AllOf [CssDescriptor]
descr : [CssSelector]
rest)
    | a -> [CssDescriptor] -> Bool
forall a. CssMatcheable a => a -> [CssDescriptor] -> Bool
isDescribedBy a
e [CssDescriptor]
descr = [[a]] -> [CssSelector] -> Bool
go [[a]]
upper [CssSelector]
rest
    | Bool
otherwise = [[a]] -> [CssSelector] -> Bool
go [[a]]
upper [CssSelector]
selectors
  go ([a]
_:[[a]]
upper) [CssSelector]
selector = [[a]] -> [CssSelector] -> Bool
go [[a]]
upper [CssSelector]
selector

-- | Given CSS rules, find all the declarations to apply to the
-- element in a given context.
findMatchingDeclarations :: CssMatcheable a
                         => [CssRule] -> CssContext a -> [CssDeclaration]
findMatchingDeclarations :: [CssRule] -> CssContext a -> [CssDeclaration]
findMatchingDeclarations [CssRule]
rules CssContext a
context =
    [[CssDeclaration]] -> [CssDeclaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [CssRule -> [CssDeclaration]
cssDeclarations CssRule
rule
                    | CssRule
rule <- [CssRule]
rules
                    , [CssSelector]
selector <- CssRule -> [[CssSelector]]
cssRuleSelector CssRule
rule
                    , CssContext a -> [CssSelector] -> Bool
forall a. CssMatcheable a => [[a]] -> [CssSelector] -> Bool
isMatching CssContext a
context ([CssSelector] -> Bool) -> [CssSelector] -> Bool
forall a b. (a -> b) -> a -> b
$ [CssSelector] -> [CssSelector]
forall a. [a] -> [a]
reverse [CssSelector]
selector ]

-- | Represents the content to apply to some
-- CSS matched rules.
data CssDeclaration = CssDeclaration
    { -- | Property name to change (like font-family or color).
      CssDeclaration -> Text
_cssDeclarationProperty :: T.Text
      -- | List of values
    , CssDeclaration -> [[CssElement]]
_cssDecarationlValues   :: [[CssElement]]
    }
    deriving (CssDeclaration -> CssDeclaration -> Bool
(CssDeclaration -> CssDeclaration -> Bool)
-> (CssDeclaration -> CssDeclaration -> Bool) -> Eq CssDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssDeclaration -> CssDeclaration -> Bool
$c/= :: CssDeclaration -> CssDeclaration -> Bool
== :: CssDeclaration -> CssDeclaration -> Bool
$c== :: CssDeclaration -> CssDeclaration -> Bool
Eq, Int -> CssDeclaration -> ShowS
[CssDeclaration] -> ShowS
CssDeclaration -> String
(Int -> CssDeclaration -> ShowS)
-> (CssDeclaration -> String)
-> ([CssDeclaration] -> ShowS)
-> Show CssDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssDeclaration] -> ShowS
$cshowList :: [CssDeclaration] -> ShowS
show :: CssDeclaration -> String
$cshow :: CssDeclaration -> String
showsPrec :: Int -> CssDeclaration -> ShowS
$cshowsPrec :: Int -> CssDeclaration -> ShowS
Show)

instance TextBuildable CssDeclaration where
  tserialize :: CssDeclaration -> Builder
tserialize (CssDeclaration Text
n [[CssElement]]
elems) =
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> Builder
ft Text
n Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Text -> Builder
ft Text
": " Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
si Char
' ') [Builder]
finalElems
     where
      finalElems :: [Builder]
finalElems = (CssElement -> Builder) -> [CssElement] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map CssElement -> Builder
forall a. TextBuildable a => a -> Builder
tserialize ([[CssElement]] -> [CssElement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[CssElement]]
elems)
      ft :: Text -> Builder
ft = Text -> Builder
TB.fromText
      si :: Char -> Builder
si = Char -> Builder
TB.singleton


-- | Encode complex number possibly depending on the current
-- render size.
data Number
  = Num Double       -- ^ Simple coordinate in current user coordinate.
  | Px Double        -- ^ With suffix "px"
  | Em Double        -- ^ Number relative to the current font size.
  | Percent Double   -- ^ Number relative to the current viewport size.
  | Pc Double
  | Mm Double        -- ^ Number in millimeters, relative to DPI.
  | Cm Double        -- ^ Number in centimeters, relative to DPI.
  | Point Double     -- ^ Number in points, relative to DPI.
  | Inches Double    -- ^ Number in inches, relative to DPI.
  deriving (Number -> Number -> Bool
(Number -> Number -> Bool)
-> (Number -> Number -> Bool) -> Eq Number
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Number -> Number -> Bool
$c/= :: Number -> Number -> Bool
== :: Number -> Number -> Bool
$c== :: Number -> Number -> Bool
Eq, Int -> Number -> ShowS
[Number] -> ShowS
Number -> String
(Int -> Number -> ShowS)
-> (Number -> String) -> ([Number] -> ShowS) -> Show Number
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Number] -> ShowS
$cshowList :: [Number] -> ShowS
show :: Number -> String
$cshow :: Number -> String
showsPrec :: Int -> Number -> ShowS
$cshowsPrec :: Int -> Number -> ShowS
Show, (forall x. Number -> Rep Number x)
-> (forall x. Rep Number x -> Number) -> Generic Number
forall x. Rep Number x -> Number
forall x. Number -> Rep Number x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Number x -> Number
$cfrom :: forall x. Number -> Rep Number x
Generic, Int -> Number -> Int
Number -> Int
(Int -> Number -> Int) -> (Number -> Int) -> Hashable Number
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Number -> Int
$chash :: Number -> Int
hashWithSalt :: Int -> Number -> Int
$chashWithSalt :: Int -> Number -> Int
Hashable)

-- | Helper function to modify inner value of a number
mapNumber :: (Double -> Double) -> Number -> Number
mapNumber :: (Double -> Double) -> Number -> Number
mapNumber Double -> Double
f Number
nu = case Number
nu of
  Num Double
n     -> Double -> Number
Num (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
n
  Px Double
n      -> Double -> Number
Px (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
n
  Em Double
n      -> Double -> Number
Em (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
n
  Percent Double
n -> Double -> Number
Percent (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
n
  Pc Double
n      -> Double -> Number
Pc (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
n
  Mm Double
n      -> Double -> Number
Mm (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
n
  Cm Double
n      -> Double -> Number
Cm (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
n
  Point Double
n   -> Double -> Number
Point (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
n
  Inches Double
n  -> Double -> Number
Inches (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
n

-- | Encode the number to string which can be used in a
-- CSS or a svg attributes.
serializeNumber :: Number -> String
serializeNumber :: Number -> String
serializeNumber Number
n = case Number
n of
    Num Double
c     -> Double -> String
ppD Double
c
    Px Double
c      -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%spx" (Double -> String
ppD Double
c)
    Em Double
cc     -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%sem" (Double -> String
ppD Double
cc)
    Percent Double
p -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d%%" (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p :: Int)
    Pc Double
p      -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%spc" (Double -> String
ppD Double
p)
    Mm Double
m      -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%smm" (Double -> String
ppD Double
m)
    Cm Double
c      -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%scm" (Double -> String
ppD Double
c)
    Point Double
p   -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%spt" (Double -> String
ppD Double
p)
    Inches Double
i  -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%sin" (Double -> String
ppD Double
i)

instance TextBuildable Number where
   tserialize :: Number -> Builder
tserialize = Text -> Builder
TB.fromText (Text -> Builder) -> (Number -> Text) -> Number -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Number -> String) -> Number -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Number -> String
serializeNumber

-- | Value of a CSS property.
data CssElement
    = CssIdent     !T.Text
    | CssString    !T.Text
    | CssReference !T.Text
    | CssNumber    !Number
    | CssColor     !PixelRGBA8
    | CssFunction  !T.Text ![CssElement]
    | CssOpComa
    | CssOpSlash
    deriving (CssElement -> CssElement -> Bool
(CssElement -> CssElement -> Bool)
-> (CssElement -> CssElement -> Bool) -> Eq CssElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssElement -> CssElement -> Bool
$c/= :: CssElement -> CssElement -> Bool
== :: CssElement -> CssElement -> Bool
$c== :: CssElement -> CssElement -> Bool
Eq, Int -> CssElement -> ShowS
[CssElement] -> ShowS
CssElement -> String
(Int -> CssElement -> ShowS)
-> (CssElement -> String)
-> ([CssElement] -> ShowS)
-> Show CssElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssElement] -> ShowS
$cshowList :: [CssElement] -> ShowS
show :: CssElement -> String
$cshow :: CssElement -> String
showsPrec :: Int -> CssElement -> ShowS
$cshowsPrec :: Int -> CssElement -> ShowS
Show)

instance TextBuildable CssElement where
  tserialize :: CssElement -> Builder
tserialize CssElement
e = case CssElement
e of
    CssIdent    Text
n -> Text -> Builder
ft Text
n
    CssString   Text
s -> Char -> Builder
si Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
ft Text
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
si Char
'"'
    CssReference Text
r -> Char -> Builder
si Char
'#' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
ft Text
r
    CssNumber   Number
n -> Number -> Builder
forall a. TextBuildable a => a -> Builder
tserialize Number
n
    CssColor  (PixelRGBA8 Pixel8
r Pixel8
g Pixel8
b Pixel8
_) ->
      Text -> Builder
ft (Text -> Builder) -> (String -> Text) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Pixel8 -> Pixel8 -> Pixel8 -> String
forall r. PrintfType r => String -> r
printf  String
"#%02X%02X%02X" Pixel8
r Pixel8
g Pixel8
b
    CssFunction Text
t [CssElement]
els -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> Builder
ft Text
t Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Char -> Builder
si Char
'(' Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
args [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++ [Char -> Builder
si Char
')']
        where args :: [Builder]
args = Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
ft Text
", ") ((CssElement -> Builder) -> [CssElement] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map CssElement -> Builder
forall a. TextBuildable a => a -> Builder
tserialize [CssElement]
els)
    CssElement
CssOpComa -> Char -> Builder
si Char
','
    CssElement
CssOpSlash -> Char -> Builder
si Char
'/'
    where
      ft :: Text -> Builder
ft = Text -> Builder
TB.fromText
      si :: Char -> Builder
si = Char -> Builder
TB.singleton

-- | This function replaces all device dependant units with user
-- units given its DPI configuration.
-- Preserves percentage and "em" notation.
toUserUnit :: Dpi -> Number -> Number
toUserUnit :: Int -> Number -> Number
toUserUnit Int
dpi = Number -> Number
go where
  go :: Number -> Number
go Number
nu = case Number
nu of
    Num Double
_     -> Number
nu
    Px Double
p      -> Number -> Number
go (Number -> Number) -> Number -> Number
forall a b. (a -> b) -> a -> b
$ Double -> Number
Num Double
p
    Em Double
_      -> Number
nu
    Percent Double
_ -> Number
nu
    Pc Double
n      -> Number -> Number
go (Number -> Number) -> (Double -> Number) -> Double -> Number
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Number
Inches (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ (Double
12 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
n) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
72
    Inches Double
n  -> Double -> Number
Num (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dpi
    Mm Double
n      -> Number -> Number
go (Number -> Number) -> (Double -> Number) -> Double -> Number
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Number
Inches (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
25.4
    Cm Double
n      -> Number -> Number
go (Number -> Number) -> (Double -> Number) -> Double -> Number
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Number
Inches (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2.54
    Point Double
n   -> Number -> Number
go (Number -> Number) -> (Double -> Number) -> Double -> Number
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Number
Inches (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
72