{-# 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 r :: url -> [(Text, Text)] -> Text
r s :: 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 r :: Word8
r g :: Word8
g b :: Word8
b) =
        let (r1 :: Char
r1, r2 :: Char
r2) = Word8 -> (Char, Char)
toHex Word8
r
            (g1 :: Char
g1, g2 :: Char
g2) = Word8 -> (Char, Char)
toHex Word8
g
            (b1 :: Char
b1, b2 :: 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 -> 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 x :: 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 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
.&. 15)
        toChar :: Word8 -> Char
        toChar :: Word8 -> Char
toChar c :: Word8
c
            | Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< 10 = Word8 -> Word8 -> Char -> Char
mkChar Word8
c 0 '0'
            | Bool
otherwise = Word8 -> Word8 -> Char -> Char
mkChar Word8
c 10 'A'
        mkChar :: Word8 -> Word8 -> Char -> Char
        mkChar :: Word8 -> Word8 -> Char -> Char
mkChar a :: Word8
a b' :: Word8
b' c :: 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 255 0 0

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

-- CSS size wrappers

-- | Create a CSS size, e.g. $(mkSize "100px").
mkSize :: String -> ExpQ
mkSize :: String -> ExpQ
mkSize s :: String
s = ExpQ -> ExpQ -> ExpQ
appE ExpQ
nameE ExpQ
valueE
  where [(value :: Double
value, unit :: 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 "absoluteSize"
        nameE :: ExpQ
nameE = case String
unit of
          "cm" -> ExpQ -> ExpQ -> ExpQ
appE ExpQ
absoluteSizeE (Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "Centimeter")
          "em" -> Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "EmSize"
          "ex" -> Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "ExSize"
          "in" -> ExpQ -> ExpQ -> ExpQ
appE ExpQ
absoluteSizeE (Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "Inch")
          "mm" -> ExpQ -> ExpQ -> ExpQ
appE ExpQ
absoluteSizeE (Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "Millimeter")
          "pc" -> ExpQ -> ExpQ -> ExpQ
appE ExpQ
absoluteSizeE (Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "Pica")
          "pt" -> ExpQ -> ExpQ -> ExpQ
appE ExpQ
absoluteSizeE (Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "Point")
          "px" -> Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "PixelSize"
          "%" -> Name -> ExpQ
varE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "percentageSize"
          _ -> String -> ExpQ
forall a. HasCallStack => String -> a
error (String -> ExpQ) -> String -> ExpQ
forall a b. (a -> b) -> a -> b
$ "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 Centimeter = 1
absoluteUnitRate Inch = 2.54
absoluteUnitRate Millimeter = 0.1
absoluteUnitRate Pica = 12 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* AbsoluteUnit -> Rational
absoluteUnitRate AbsoluteUnit
Point
absoluteUnitRate Point = 1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ 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 unit :: AbsoluteUnit
unit value :: 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 unit :: AbsoluteUnit
unit value' :: Rational
value') = String -> Double -> String
forall r. PrintfType r => String -> r
printf "%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
            Centimeter -> "cm"
            Inch -> "in"
            Millimeter -> "mm"
            Pica -> "pc"
            Point -> "pt"

instance Eq AbsoluteSize where
  (AbsoluteSize _ v1 :: Rational
v1) == :: AbsoluteSize -> AbsoluteSize -> Bool
== (AbsoluteSize _ v2 :: 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 _ v1 :: Rational
v1) (AbsoluteSize _ v2 :: Rational
v2) = Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Rational
v1 Rational
v2

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

instance Fractional AbsoluteSize where
  (AbsoluteSize u1 :: AbsoluteUnit
u1 v1 :: Rational
v1) / :: AbsoluteSize -> AbsoluteSize -> AbsoluteSize
/ (AbsoluteSize _ v2 :: 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 x :: 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 value :: Rational
value = Rational -> PercentageSize
PercentageSize (Rational
value Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ 100)

instance Show PercentageSize where
  show :: PercentageSize -> String
show (PercentageSize value' :: Rational
value') = String -> Double -> String
forall r. PrintfType r => String -> r
printf "%f" Double
value String -> ShowS
forall a. [a] -> [a] -> [a]
++ "%"
    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
* 100) :: Double

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

instance Fractional PercentageSize where
  (PercentageSize v1 :: Rational
v1) / :: PercentageSize -> PercentageSize -> PercentageSize
/ (PercentageSize v2 :: Rational
v2) = Rational -> PercentageSize
PercentageSize (Rational
v1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
v2)
  fromRational :: Rational -> PercentageSize
fromRational x :: 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 value' :: Rational
value' unit :: String
unit = String -> Double -> String
forall r. PrintfType r => String -> r
printf "%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"