{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Graphics.Blank.Types.CSS where

import           Data.String

import           Graphics.Blank.JavaScript
import           Graphics.Blank.Parser
import           Graphics.Blank.Types

import           Prelude.Compat

import           Text.ParserCombinators.ReadP (choice)
import           Text.ParserCombinators.ReadPrec (lift)
import           Text.Read (Read(..), readListPrecDefault)

import           TextShow (TextShow(..), FromTextShow(..))

-- | Denotes CSS distance measurements, especially in the context of 'Font's.
data Length = Em   { Length -> Double
runLength :: Double } -- ^ The height of the current font.
            | Ex   { runLength :: Double } -- ^ The height of the character @x@ (x-height) in the current font.
            | Ch   { runLength :: Double } -- ^ The width of the character @0@ in the current font.
            | Rem  { runLength :: Double } -- ^ The height of the font relative to the root element.
            | Vh   { runLength :: Double } -- ^ One percent of the height of the viewport.
            | Vw   { runLength :: Double } -- ^ One percent of the width of the viewport.
            | Vmin { runLength :: Double } -- ^ One percent of the minimum of the viewport height and width.
            | Vmax { runLength :: Double } -- ^ One percent of the maximum of the viewport height and width.
            | Px   { runLength :: Double } -- ^ One device pixel (dot) of the display.
            | Mm   { runLength :: Double } -- ^ One millimeter.
            | Cm   { runLength :: Double } -- ^ One centimeter (10 millimeters).
            | In   { runLength :: Double } -- ^ One inch (~2.54 centimeters).
            | Pt   { runLength :: Double } -- ^ One point (1/72 inches).
            | Pc   { runLength :: Double } -- ^ One pica (12 points).
  deriving (Length -> Length -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Length -> Length -> Bool
$c/= :: Length -> Length -> Bool
== :: Length -> Length -> Bool
$c== :: Length -> Length -> Bool
Eq, Eq Length
Length -> Length -> Bool
Length -> Length -> Ordering
Length -> Length -> Length
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 :: Length -> Length -> Length
$cmin :: Length -> Length -> Length
max :: Length -> Length -> Length
$cmax :: Length -> Length -> Length
>= :: Length -> Length -> Bool
$c>= :: Length -> Length -> Bool
> :: Length -> Length -> Bool
$c> :: Length -> Length -> Bool
<= :: Length -> Length -> Bool
$c<= :: Length -> Length -> Bool
< :: Length -> Length -> Bool
$c< :: Length -> Length -> Bool
compare :: Length -> Length -> Ordering
$ccompare :: Length -> Length -> Ordering
Ord)

-- | Designates CSS properties that can consist of a 'Length'.
class LengthProperty a where
    -- Create a CSS property value from a 'Length'.
    fromLength :: Length -> a

instance LengthProperty Length where
    fromLength :: Length -> Length
fromLength = forall a. a -> a
id

-- | Constructs a 'LengthProperty' value with 'Em' units.
em :: LengthProperty a => Double -> a
em :: forall a. LengthProperty a => Double -> a
em = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Em

-- | Constructs a 'LengthProperty' value with 'Ex' units.
ex :: LengthProperty a => Double -> a
ex :: forall a. LengthProperty a => Double -> a
ex = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Ex

-- | Constructs a 'LengthProperty' value with 'Ch' units.
ch :: LengthProperty a => Double -> a
ch :: forall a. LengthProperty a => Double -> a
ch = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Ch

-- | Constructs a 'LengthProperty' value with 'Rem' units. 'rem_' has an underscore
-- to distinguish it from 'rem'.
rem_ :: LengthProperty a => Double -> a
rem_ :: forall a. LengthProperty a => Double -> a
rem_ = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Rem

-- | Constructs a 'LengthProperty' value with 'Vh' units.
vh :: LengthProperty a => Double -> a
vh :: forall a. LengthProperty a => Double -> a
vh = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Vh

-- | Constructs a 'LengthProperty' value with 'Vw' units.
vw :: LengthProperty a => Double -> a
vw :: forall a. LengthProperty a => Double -> a
vw = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Vw

-- | Constructs a 'LengthProperty' value with 'Em' units.
vmin :: LengthProperty a => Double -> a
vmin :: forall a. LengthProperty a => Double -> a
vmin = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Vmin

-- | Constructs a 'LengthProperty' value with 'Vmax' units.
vmax :: LengthProperty a => Double -> a
vmax :: forall a. LengthProperty a => Double -> a
vmax = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Vmax

-- | Constructs a 'LengthProperty' value with 'Px' units.
px :: LengthProperty a => Double -> a
px :: forall a. LengthProperty a => Double -> a
px = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Px

-- | Constructs a 'LengthProperty' value with 'Mm' units.
mm :: LengthProperty a => Double -> a
mm :: forall a. LengthProperty a => Double -> a
mm = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Mm

-- | Constructs a 'LengthProperty' value with 'Cm' units.
cm :: LengthProperty a => Double -> a
cm :: forall a. LengthProperty a => Double -> a
cm = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Cm

-- | Constructs a 'LengthProperty' value with 'Im' units. This function has an
--   underscore to distinguish it from the Haskell keyword.
in_ :: LengthProperty a => Double -> a
in_ :: forall a. LengthProperty a => Double -> a
in_ = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
In

-- | Constructs a 'LengthProperty' value with 'Pt' units.
pt :: LengthProperty a => Double -> a
pt :: forall a. LengthProperty a => Double -> a
pt = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Pt

-- | Constructs a 'LengthProperty' value with 'Pc' units.
pc :: LengthProperty a => Double -> a
pc :: forall a. LengthProperty a => Double -> a
pc = forall a. LengthProperty a => Length -> a
fromLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Length
Pc

instance IsString Length where
    fromString :: String -> Length
fromString = forall a. Read a => String -> a
read

instance Read Length where
    readPrec :: ReadPrec Length
readPrec = do
        Double
d <- forall a. Read a => ReadPrec a
readPrec
        forall a. ReadP a -> ReadPrec a
lift forall a b. (a -> b) -> a -> b
$ forall a. [ReadP a] -> ReadP a
choice
            [ Double -> Length
Em Double
d   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"em"
            , Double -> Length
Ex Double
d   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"ex"
            , Double -> Length
Ch Double
d   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"ch"
            , Double -> Length
Rem Double
d  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"rem"
            , Double -> Length
Vh Double
d   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"vh"
            , Double -> Length
Vw Double
d   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"vw"
            , Double -> Length
Vmin Double
d forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"vmin"
            , Double -> Length
Vmax Double
d forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"vmax"
            , Double -> Length
Px Double
d   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"px"
            , Double -> Length
Mm Double
d   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"mm"
            , Double -> Length
Cm Double
d   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"cm"
            , Double -> Length
In Double
d   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"in"
            , Double -> Length
Pt Double
d   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"pt"
            , Double -> Length
Pc Double
d   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"pc"
            ]
    readListPrec :: ReadPrec [Length]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

instance Show Length where
    showsPrec :: Int -> Length -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromTextShow a
FromTextShow

instance TextShow Length where
    showb :: Length -> Builder
showb Length
l = Double -> Builder
jsDouble (Length -> Double
runLength Length
l) forall a. Semigroup a => a -> a -> a
<> forall {a}. IsString a => Length -> a
showbUnits Length
l
      where
        showbUnits :: Length -> a
showbUnits (Em   Double
_) = a
"em"
        showbUnits (Ex   Double
_) = a
"ex"
        showbUnits (Ch   Double
_) = a
"ch"
        showbUnits (Rem  Double
_) = a
"rem"
        showbUnits (Vh   Double
_) = a
"vh"
        showbUnits (Vw   Double
_) = a
"vw"
        showbUnits (Vmin Double
_) = a
"vmin"
        showbUnits (Vmax Double
_) = a
"vmax"
        showbUnits (Px   Double
_) = a
"px"
        showbUnits (Mm   Double
_) = a
"mm"
        showbUnits (Cm   Double
_) = a
"cm"
        showbUnits (In   Double
_) = a
"in"
        showbUnits (Pt   Double
_) = a
"pt"
        showbUnits (Pc   Double
_) = a
"pc"

-- | Designates CSS properties that can consist of a 'Percentage'.
class PercentageProperty a where
    -- | Create a CSS property value from a 'Percentage'.
    percent :: Percentage -> a

instance PercentageProperty Percentage where
    percent :: Double -> Double
percent = forall a. a -> a
id