{-# OPTIONS_HADDOCK hide #-}
-- | This module is only being exposed to work around a GHC bug, its API is not stable

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
module Text.Internal.CssCommon where

import Text.Internal.Css
import Text.MkSizeType
import qualified Data.Text as TS
import Text.Printf (printf)
import Language.Haskell.TH
import Data.Word (Word8)
import Data.Bits
import qualified Data.Text.Lazy as TL

renderCssUrl :: (url -> [(TS.Text, TS.Text)] -> TS.Text) -> CssUrl url -> TL.Text
renderCssUrl :: (url -> [(Text, Text)] -> Text) -> CssUrl url -> Text
renderCssUrl url -> [(Text, Text)] -> Text
r CssUrl url
s = Css -> Text
renderCss (Css -> Text) -> Css -> Text
forall a b. (a -> b) -> a -> b
$ CssUrl url
s url -> [(Text, Text)] -> Text
r

data Color = Color Word8 Word8 Word8
    deriving Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show
instance ToCss Color where
    toCss :: Color -> Builder
toCss (Color Word8
r Word8
g Word8
b) =
        let (Char
r1, Char
r2) = Word8 -> (Char, Char)
toHex Word8
r
            (Char
g1, Char
g2) = Word8 -> (Char, Char)
toHex Word8
g
            (Char
b1, Char
b2) = Word8 -> (Char, Char)
toHex Word8
b
         in Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Text
TS.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
'#' Char -> ShowS
forall a. a -> [a] -> [a]
:
            if Char
r1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
r2 Bool -> Bool -> Bool
&& Char
g1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
g2 Bool -> Bool -> Bool
&& Char
b1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b2
                then [Char
r1, Char
g1, Char
b1]
                else [Char
r1, Char
r2, Char
g1, Char
g2, Char
b1, Char
b2]
      where
        toHex :: Word8 -> (Char, Char)
        toHex :: Word8 -> (Char, Char)
toHex Word8
x = (Word8 -> Char
toChar (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftR Word8
x Int
4, Word8 -> Char
toChar (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
15)
        toChar :: Word8 -> Char
        toChar :: Word8 -> Char
toChar Word8
c
            | Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
10 = Word8 -> Word8 -> Char -> Char
mkChar Word8
c Word8
0 Char
'0'
            | Bool
otherwise = Word8 -> Word8 -> Char -> Char
mkChar Word8
c Word8
10 Char
'A'
        mkChar :: Word8 -> Word8 -> Char -> Char
        mkChar :: Word8 -> Word8 -> Char -> Char
mkChar Word8
a Word8
b' Char
c =
            Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
a Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
b' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c)

colorRed :: Color
colorRed :: Color
colorRed = Word8 -> Word8 -> Word8 -> Color
Color Word8
255 Word8
0 Word8
0

colorBlack :: Color
colorBlack :: Color
colorBlack = Word8 -> Word8 -> Word8 -> Color
Color Word8
0 Word8
0 Word8
0

-- CSS size wrappers

-- | Create a CSS size, e.g. $(mkSize "100px").
mkSize :: String -> ExpQ
mkSize :: String -> ExpQ
mkSize String
s = ExpQ -> ExpQ -> ExpQ
appE ExpQ
nameE ExpQ
valueE
  where [(Double
value, String
unit)] = ReadS Double
forall a. Read a => ReadS a
reads String
s :: [(Double, String)]
        absoluteSizeE :: ExpQ
absoluteSizeE = Name -> ExpQ
varE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"absoluteSize"
        nameE :: ExpQ
nameE = case String
unit of
          String
"cm" -> ExpQ -> ExpQ -> ExpQ
appE ExpQ
absoluteSizeE (Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Centimeter")
          String
"em" -> Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"EmSize"
          String
"ex" -> Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"ExSize"
          String
"in" -> ExpQ -> ExpQ -> ExpQ
appE ExpQ
absoluteSizeE (Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Inch")
          String
"mm" -> ExpQ -> ExpQ -> ExpQ
appE ExpQ
absoluteSizeE (Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Millimeter")
          String
"pc" -> ExpQ -> ExpQ -> ExpQ
appE ExpQ
absoluteSizeE (Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Pica")
          String
"pt" -> ExpQ -> ExpQ -> ExpQ
appE ExpQ
absoluteSizeE (Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Point")
          String
"px" -> Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"PixelSize"
          String
"%" -> Name -> ExpQ
varE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"percentageSize"
          String
_ -> String -> ExpQ
forall a. HasCallStack => String -> a
error (String -> ExpQ) -> String -> ExpQ
forall a b. (a -> b) -> a -> b
$ String
"In mkSize, invalid unit: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
unit
        valueE :: ExpQ
valueE = Lit -> ExpQ
litE (Lit -> ExpQ) -> Lit -> ExpQ
forall a b. (a -> b) -> a -> b
$ Rational -> Lit
rationalL (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
value)

-- | Absolute size units.
data AbsoluteUnit = Centimeter
                  | Inch
                  | Millimeter
                  | Pica
                  | Point
                  deriving (AbsoluteUnit -> AbsoluteUnit -> Bool
(AbsoluteUnit -> AbsoluteUnit -> Bool)
-> (AbsoluteUnit -> AbsoluteUnit -> Bool) -> Eq AbsoluteUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbsoluteUnit -> AbsoluteUnit -> Bool
$c/= :: AbsoluteUnit -> AbsoluteUnit -> Bool
== :: AbsoluteUnit -> AbsoluteUnit -> Bool
$c== :: AbsoluteUnit -> AbsoluteUnit -> Bool
Eq, Int -> AbsoluteUnit -> ShowS
[AbsoluteUnit] -> ShowS
AbsoluteUnit -> String
(Int -> AbsoluteUnit -> ShowS)
-> (AbsoluteUnit -> String)
-> ([AbsoluteUnit] -> ShowS)
-> Show AbsoluteUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbsoluteUnit] -> ShowS
$cshowList :: [AbsoluteUnit] -> ShowS
show :: AbsoluteUnit -> String
$cshow :: AbsoluteUnit -> String
showsPrec :: Int -> AbsoluteUnit -> ShowS
$cshowsPrec :: Int -> AbsoluteUnit -> ShowS
Show)

-- | Not intended for direct use, see 'mkSize'.
data AbsoluteSize = AbsoluteSize
    { AbsoluteSize -> AbsoluteUnit
absoluteSizeUnit :: AbsoluteUnit -- ^ Units used for text formatting.
    , AbsoluteSize -> Rational
absoluteSizeValue :: Rational -- ^ Normalized value in centimeters.
    }

-- | Absolute size unit convertion rate to centimeters.
absoluteUnitRate :: AbsoluteUnit -> Rational
absoluteUnitRate :: AbsoluteUnit -> Rational
absoluteUnitRate AbsoluteUnit
Centimeter = Rational
1
absoluteUnitRate AbsoluteUnit
Inch = Rational
2.54
absoluteUnitRate AbsoluteUnit
Millimeter = Rational
0.1
absoluteUnitRate AbsoluteUnit
Pica = Rational
12 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* AbsoluteUnit -> Rational
absoluteUnitRate AbsoluteUnit
Point
absoluteUnitRate AbsoluteUnit
Point = Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
72 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* AbsoluteUnit -> Rational
absoluteUnitRate AbsoluteUnit
Inch

-- | Constructs 'AbsoluteSize'. Not intended for direct use, see 'mkSize'.
absoluteSize :: AbsoluteUnit -> Rational -> AbsoluteSize
absoluteSize :: AbsoluteUnit -> Rational -> AbsoluteSize
absoluteSize AbsoluteUnit
unit Rational
value = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
unit (Rational
value Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* AbsoluteUnit -> Rational
absoluteUnitRate AbsoluteUnit
unit)

instance Show AbsoluteSize where
  show :: AbsoluteSize -> String
show (AbsoluteSize AbsoluteUnit
unit Rational
value') = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%f" Double
value String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suffix
    where value :: Double
value = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational
value' Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ AbsoluteUnit -> Rational
absoluteUnitRate AbsoluteUnit
unit) :: Double
          suffix :: String
suffix = case AbsoluteUnit
unit of
            AbsoluteUnit
Centimeter -> String
"cm"
            AbsoluteUnit
Inch -> String
"in"
            AbsoluteUnit
Millimeter -> String
"mm"
            AbsoluteUnit
Pica -> String
"pc"
            AbsoluteUnit
Point -> String
"pt"

instance Eq AbsoluteSize where
  (AbsoluteSize AbsoluteUnit
_ Rational
v1) == :: AbsoluteSize -> AbsoluteSize -> Bool
== (AbsoluteSize AbsoluteUnit
_ Rational
v2) = Rational
v1 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
v2

instance Ord AbsoluteSize where
  compare :: AbsoluteSize -> AbsoluteSize -> Ordering
compare (AbsoluteSize AbsoluteUnit
_ Rational
v1) (AbsoluteSize AbsoluteUnit
_ Rational
v2) = Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Rational
v1 Rational
v2

instance Num AbsoluteSize where
  (AbsoluteSize AbsoluteUnit
u1 Rational
v1) + :: AbsoluteSize -> AbsoluteSize -> AbsoluteSize
+ (AbsoluteSize AbsoluteUnit
_ Rational
v2) = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
u1 (Rational
v1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
v2)
  (AbsoluteSize AbsoluteUnit
u1 Rational
v1) * :: AbsoluteSize -> AbsoluteSize -> AbsoluteSize
* (AbsoluteSize AbsoluteUnit
_ Rational
v2) = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
u1 (Rational
v1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
v2)
  (AbsoluteSize AbsoluteUnit
u1 Rational
v1) - :: AbsoluteSize -> AbsoluteSize -> AbsoluteSize
- (AbsoluteSize AbsoluteUnit
_ Rational
v2) = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
u1 (Rational
v1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
v2)
  abs :: AbsoluteSize -> AbsoluteSize
abs (AbsoluteSize AbsoluteUnit
u Rational
v) = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
u (Rational -> Rational
forall a. Num a => a -> a
abs Rational
v)
  signum :: AbsoluteSize -> AbsoluteSize
signum (AbsoluteSize AbsoluteUnit
u Rational
v) = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
u (Rational -> Rational
forall a. Num a => a -> a
abs Rational
v)
  fromInteger :: Integer -> AbsoluteSize
fromInteger Integer
x = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
Centimeter (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
x)

instance Fractional AbsoluteSize where
  (AbsoluteSize AbsoluteUnit
u1 Rational
v1) / :: AbsoluteSize -> AbsoluteSize -> AbsoluteSize
/ (AbsoluteSize AbsoluteUnit
_ Rational
v2) = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
u1 (Rational
v1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
v2)
  fromRational :: Rational -> AbsoluteSize
fromRational Rational
x = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
Centimeter (Rational -> Rational
forall a. Fractional a => Rational -> a
fromRational Rational
x)

instance ToCss AbsoluteSize where
  toCss :: AbsoluteSize -> Builder
toCss = Text -> Builder
fromText (Text -> Builder)
-> (AbsoluteSize -> Text) -> AbsoluteSize -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TS.pack (String -> Text)
-> (AbsoluteSize -> String) -> AbsoluteSize -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsoluteSize -> String
forall a. Show a => a -> String
show

-- | Not intended for direct use, see 'mkSize'.
data PercentageSize = PercentageSize
    { PercentageSize -> Rational
percentageSizeValue :: Rational -- ^ Normalized value, 1 == 100%.
    }
                    deriving (PercentageSize -> PercentageSize -> Bool
(PercentageSize -> PercentageSize -> Bool)
-> (PercentageSize -> PercentageSize -> Bool) -> Eq PercentageSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PercentageSize -> PercentageSize -> Bool
$c/= :: PercentageSize -> PercentageSize -> Bool
== :: PercentageSize -> PercentageSize -> Bool
$c== :: PercentageSize -> PercentageSize -> Bool
Eq, Eq PercentageSize
Eq PercentageSize
-> (PercentageSize -> PercentageSize -> Ordering)
-> (PercentageSize -> PercentageSize -> Bool)
-> (PercentageSize -> PercentageSize -> Bool)
-> (PercentageSize -> PercentageSize -> Bool)
-> (PercentageSize -> PercentageSize -> Bool)
-> (PercentageSize -> PercentageSize -> PercentageSize)
-> (PercentageSize -> PercentageSize -> PercentageSize)
-> Ord PercentageSize
PercentageSize -> PercentageSize -> Bool
PercentageSize -> PercentageSize -> Ordering
PercentageSize -> PercentageSize -> PercentageSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PercentageSize -> PercentageSize -> PercentageSize
$cmin :: PercentageSize -> PercentageSize -> PercentageSize
max :: PercentageSize -> PercentageSize -> PercentageSize
$cmax :: PercentageSize -> PercentageSize -> PercentageSize
>= :: PercentageSize -> PercentageSize -> Bool
$c>= :: PercentageSize -> PercentageSize -> Bool
> :: PercentageSize -> PercentageSize -> Bool
$c> :: PercentageSize -> PercentageSize -> Bool
<= :: PercentageSize -> PercentageSize -> Bool
$c<= :: PercentageSize -> PercentageSize -> Bool
< :: PercentageSize -> PercentageSize -> Bool
$c< :: PercentageSize -> PercentageSize -> Bool
compare :: PercentageSize -> PercentageSize -> Ordering
$ccompare :: PercentageSize -> PercentageSize -> Ordering
$cp1Ord :: Eq PercentageSize
Ord)

-- | Constructs 'PercentageSize'. Not intended for direct use, see 'mkSize'.
percentageSize :: Rational -> PercentageSize
percentageSize :: Rational -> PercentageSize
percentageSize Rational
value = Rational -> PercentageSize
PercentageSize (Rational
value Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
100)

instance Show PercentageSize where
  show :: PercentageSize -> String
show (PercentageSize Rational
value') = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%f" Double
value String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"%"
    where value :: Double
value = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational
value' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
100) :: Double

instance Num PercentageSize where
  (PercentageSize Rational
v1) + :: PercentageSize -> PercentageSize -> PercentageSize
+ (PercentageSize Rational
v2) = Rational -> PercentageSize
PercentageSize (Rational
v1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
v2)
  (PercentageSize Rational
v1) * :: PercentageSize -> PercentageSize -> PercentageSize
* (PercentageSize Rational
v2) = Rational -> PercentageSize
PercentageSize (Rational
v1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
v2)
  (PercentageSize Rational
v1) - :: PercentageSize -> PercentageSize -> PercentageSize
- (PercentageSize Rational
v2) = Rational -> PercentageSize
PercentageSize (Rational
v1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
v2)
  abs :: PercentageSize -> PercentageSize
abs (PercentageSize Rational
v) = Rational -> PercentageSize
PercentageSize (Rational -> Rational
forall a. Num a => a -> a
abs Rational
v)
  signum :: PercentageSize -> PercentageSize
signum (PercentageSize Rational
v) = Rational -> PercentageSize
PercentageSize (Rational -> Rational
forall a. Num a => a -> a
abs Rational
v)
  fromInteger :: Integer -> PercentageSize
fromInteger Integer
x = Rational -> PercentageSize
PercentageSize (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
x)

instance Fractional PercentageSize where
  (PercentageSize Rational
v1) / :: PercentageSize -> PercentageSize -> PercentageSize
/ (PercentageSize Rational
v2) = Rational -> PercentageSize
PercentageSize (Rational
v1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
v2)
  fromRational :: Rational -> PercentageSize
fromRational Rational
x = Rational -> PercentageSize
PercentageSize (Rational -> Rational
forall a. Fractional a => Rational -> a
fromRational Rational
x)

instance ToCss PercentageSize where
  toCss :: PercentageSize -> Builder
toCss = Text -> Builder
fromText (Text -> Builder)
-> (PercentageSize -> Text) -> PercentageSize -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TS.pack (String -> Text)
-> (PercentageSize -> String) -> PercentageSize -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PercentageSize -> String
forall a. Show a => a -> String
show

-- | Converts number and unit suffix to CSS format.
showSize :: Rational -> String -> String
showSize :: Rational -> ShowS
showSize Rational
value' String
unit = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%f" Double
value String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
unit
  where value :: Double
value = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
value' :: Double

mkSizeType "EmSize" "em"
mkSizeType "ExSize" "ex"
mkSizeType "PixelSize" "px"