{-# 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 :: forall url. (url -> [(Text, Text)] -> Text) -> CssUrl url -> Text
renderCssUrl url -> [(Text, Text)] -> Text
r CssUrl url
s = Css -> Text
renderCss 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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> [Char]
$cshow :: Color -> [Char]
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 forall a b. (a -> b) -> a -> b
$ [Char] -> Text
TS.pack forall a b. (a -> b) -> a -> b
$ Char
'#' forall a. a -> [a] -> [a]
:
            if Char
r1 forall a. Eq a => a -> a -> Bool
== Char
r2 Bool -> Bool -> Bool
&& Char
g1 forall a. Eq a => a -> a -> Bool
== Char
g2 Bool -> Bool -> Bool
&& Char
b1 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 forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftR Word8
x Int
4, Word8 -> Char
toChar forall a b. (a -> b) -> a -> b
$ Word8
x forall a. Bits a => a -> a -> a
.&. Word8
15)
        toChar :: Word8 -> Char
        toChar :: Word8 -> Char
toChar Word8
c
            | Word8
c 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 =
            forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word8
a forall a. Num a => a -> a -> a
- Word8
b' forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (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 :: [Char] -> ExpQ
mkSize [Char]
s = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE ExpQ
nameE ExpQ
valueE
  where [(Double
value, [Char]
unit)] = forall a. Read a => ReadS a
reads [Char]
s :: [(Double, String)]
        absoluteSizeE :: ExpQ
absoluteSizeE = forall (m :: * -> *). Quote m => Name -> m Exp
varE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"absoluteSize"
        nameE :: ExpQ
nameE = case [Char]
unit of
          [Char]
"cm" -> forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE ExpQ
absoluteSizeE (forall (m :: * -> *). Quote m => Name -> m Exp
conE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"Centimeter")
          [Char]
"em" -> forall (m :: * -> *). Quote m => Name -> m Exp
conE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"EmSize"
          [Char]
"ex" -> forall (m :: * -> *). Quote m => Name -> m Exp
conE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"ExSize"
          [Char]
"in" -> forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE ExpQ
absoluteSizeE (forall (m :: * -> *). Quote m => Name -> m Exp
conE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"Inch")
          [Char]
"mm" -> forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE ExpQ
absoluteSizeE (forall (m :: * -> *). Quote m => Name -> m Exp
conE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"Millimeter")
          [Char]
"pc" -> forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE ExpQ
absoluteSizeE (forall (m :: * -> *). Quote m => Name -> m Exp
conE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"Pica")
          [Char]
"pt" -> forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE ExpQ
absoluteSizeE (forall (m :: * -> *). Quote m => Name -> m Exp
conE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"Point")
          [Char]
"px" -> forall (m :: * -> *). Quote m => Name -> m Exp
conE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"PixelSize"
          [Char]
"%" -> forall (m :: * -> *). Quote m => Name -> m Exp
varE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"percentageSize"
          [Char]
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"In mkSize, invalid unit: " forall a. [a] -> [a] -> [a]
++ [Char]
unit
        valueE :: ExpQ
valueE = forall (m :: * -> *). Quote m => Lit -> m Exp
litE forall a b. (a -> b) -> a -> b
$ Rational -> Lit
rationalL (forall a. Real a => a -> Rational
toRational Double
value)

-- | Absolute size units.
data AbsoluteUnit = Centimeter
                  | Inch
                  | Millimeter
                  | Pica
                  | Point
                  deriving (AbsoluteUnit -> AbsoluteUnit -> Bool
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AbsoluteUnit] -> ShowS
$cshowList :: [AbsoluteUnit] -> ShowS
show :: AbsoluteUnit -> [Char]
$cshow :: AbsoluteUnit -> [Char]
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 forall a. Num a => a -> a -> a
* AbsoluteUnit -> Rational
absoluteUnitRate AbsoluteUnit
Point
absoluteUnitRate AbsoluteUnit
Point = Rational
1 forall a. Fractional a => a -> a -> a
/ Rational
72 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 forall a. Num a => a -> a -> a
* AbsoluteUnit -> Rational
absoluteUnitRate AbsoluteUnit
unit)

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

instance Eq AbsoluteSize where
  (AbsoluteSize AbsoluteUnit
_ Rational
v1) == :: AbsoluteSize -> AbsoluteSize -> Bool
== (AbsoluteSize AbsoluteUnit
_ Rational
v2) = Rational
v1 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) = 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 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 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 forall a. Num a => a -> a -> a
- Rational
v2)
  abs :: AbsoluteSize -> AbsoluteSize
abs (AbsoluteSize AbsoluteUnit
u Rational
v) = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
u (forall a. Num a => a -> a
abs Rational
v)
  signum :: AbsoluteSize -> AbsoluteSize
signum (AbsoluteSize AbsoluteUnit
u Rational
v) = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
u (forall a. Num a => a -> a
abs Rational
v)
  fromInteger :: Integer -> AbsoluteSize
fromInteger Integer
x = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
Centimeter (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 forall a. Fractional a => a -> a -> a
/ Rational
v2)
  fromRational :: Rational -> AbsoluteSize
fromRational Rational
x = AbsoluteUnit -> Rational -> AbsoluteSize
AbsoluteSize AbsoluteUnit
Centimeter (forall a. Fractional a => Rational -> a
fromRational Rational
x)

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

-- | Not intended for direct use, see 'mkSize'.
data PercentageSize = PercentageSize
    { PercentageSize -> Rational
percentageSizeValue :: Rational -- ^ Normalized value, 1 == 100%.
    }
                    deriving (PercentageSize -> PercentageSize -> Bool
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
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
Ord)

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

instance Show PercentageSize where
  show :: PercentageSize -> [Char]
show (PercentageSize Rational
value') = forall r. PrintfType r => [Char] -> r
printf [Char]
"%f" Double
value forall a. [a] -> [a] -> [a]
++ [Char]
"%"
    where value :: Double
value = forall a. Fractional a => Rational -> a
fromRational (Rational
value' 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 forall a. Num a => a -> a -> a
+ Rational
v2)
  (PercentageSize Rational
v1) * :: PercentageSize -> PercentageSize -> PercentageSize
* (PercentageSize Rational
v2) = Rational -> PercentageSize
PercentageSize (Rational
v1 forall a. Num a => a -> a -> a
* Rational
v2)
  (PercentageSize Rational
v1) - :: PercentageSize -> PercentageSize -> PercentageSize
- (PercentageSize Rational
v2) = Rational -> PercentageSize
PercentageSize (Rational
v1 forall a. Num a => a -> a -> a
- Rational
v2)
  abs :: PercentageSize -> PercentageSize
abs (PercentageSize Rational
v) = Rational -> PercentageSize
PercentageSize (forall a. Num a => a -> a
abs Rational
v)
  signum :: PercentageSize -> PercentageSize
signum (PercentageSize Rational
v) = Rational -> PercentageSize
PercentageSize (forall a. Num a => a -> a
abs Rational
v)
  fromInteger :: Integer -> PercentageSize
fromInteger Integer
x = Rational -> PercentageSize
PercentageSize (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 forall a. Fractional a => a -> a -> a
/ Rational
v2)
  fromRational :: Rational -> PercentageSize
fromRational Rational
x = Rational -> PercentageSize
PercentageSize (forall a. Fractional a => Rational -> a
fromRational Rational
x)

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

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

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