{-# LANGUAGE OverloadedStrings #-}

-- | A bunch of type classes representing common values shared between multiple
-- CSS properties, like `Auto`, `Inherit`, `None`, `Normal` and several more.
--
-- All the common value type classes have an instance for the Value type,
-- making them easily derivable for custom value types.


module Clay.Common where

import Data.Text (Text)
import Clay.Property
import Data.String (IsString)

-------------------------------------------------------------------------------

class All      a where all      :: a
class Auto     a where auto     :: a
class Baseline a where baseline :: a
class Center   a where center   :: a
class Inherit  a where inherit  :: a
class None     a where none     :: a
class Normal   a where normal   :: a
class Visible  a where visible  :: a
class Hidden   a where hidden   :: a
class Initial  a where initial  :: a
class Unset    a where unset    :: a

-- | The other type class is used to escape from the type safety introduced by
-- embedding CSS properties into the typed world of Clay. `Other` allows you to
-- cast any `Value` to a specific value type.

class Other   a where other   :: Value -> a

allValue :: Value
allValue :: Value
allValue = Value
"all"
autoValue :: Value
autoValue :: Value
autoValue = Value
"auto"
baselineValue :: Value
baselineValue :: Value
baselineValue = Value
"baseline"
centerValue :: Value
centerValue :: Value
centerValue = Value
"center"
inheritValue :: Value
inheritValue :: Value
inheritValue = Value
"inherit"
normalValue :: Value
normalValue :: Value
normalValue = Value
"normal"
noneValue :: Value
noneValue :: Value
noneValue = Value
"none"
visibleValue :: Value
visibleValue :: Value
visibleValue = Value
"visible"
hiddenValue :: Value
hiddenValue :: Value
hiddenValue = Value
"hidden"
initialValue :: Value
initialValue :: Value
initialValue = Value
"initial"
unsetValue :: Value
unsetValue :: Value
unsetValue = Value
"unset"

instance All      Value where all :: Value
all      = Value
allValue
instance Auto     Value where auto :: Value
auto     = Value
autoValue
instance Baseline Value where baseline :: Value
baseline = Value
baselineValue
instance Center   Value where center :: Value
center   = Value
centerValue
instance Inherit  Value where inherit :: Value
inherit  = Value
inheritValue
instance Normal   Value where normal :: Value
normal   = Value
normalValue
instance None     Value where none :: Value
none     = Value
noneValue
instance Visible  Value where visible :: Value
visible  = Value
visibleValue
instance Hidden   Value where hidden :: Value
hidden   = Value
hiddenValue
instance Other    Value where other :: Value -> Value
other    = Value -> Value
forall a. a -> a
id
instance Initial  Value where initial :: Value
initial  = Value
initialValue
instance Unset    Value where unset :: Value
unset    = Value
unsetValue

-------------------------------------------------------------------------------

-- | Common list browser prefixes to make experimental properties work in
-- different browsers.

webkitPrefix :: (Text, Text)
webkitPrefix :: (Text, Text)
webkitPrefix = ( Text
"-webkit-", Text
"" )

emptyPrefix :: (Text, Text)
emptyPrefix :: (Text, Text)
emptyPrefix = ( Text
"", Text
"" )

webkit :: Prefixed
webkit :: Prefixed
webkit = [(Text, Text)] -> Prefixed
Prefixed ([(Text, Text)] -> Prefixed) -> [(Text, Text)] -> Prefixed
forall a b. (a -> b) -> a -> b
$
  [ (Text, Text)
webkitPrefix
  , (Text, Text)
emptyPrefix
  ]

browsers :: Prefixed
browsers :: Prefixed
browsers = [(Text, Text)] -> Prefixed
Prefixed ([(Text, Text)] -> Prefixed) -> [(Text, Text)] -> Prefixed
forall a b. (a -> b) -> a -> b
$
  [ (Text, Text)
webkitPrefix
  , ( Text
"-moz-", Text
"" )
  , (  Text
"-ms-", Text
"" )
  , (   Text
"-o-", Text
"" )
  , (Text, Text)
emptyPrefix
  ]

-------------------------------------------------------------------------------

-- | Syntax for CSS function call.

call :: (IsString s, Monoid s) => s -> s -> s
call :: s -> s -> s
call s
fn s
arg = s
fn s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
"(" s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
arg s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
")"

-------------------------------------------------------------------------------

-- | Some auxiliary mathematical functions.

fracMod :: RealFrac a => a -> a -> a
fracMod :: a -> a -> a
fracMod a
x a
y = (a
x a -> a -> a
forall a. Num a => a -> a -> a
-) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Num a => a -> a -> a
* a
y) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a b. (RealFrac a, Num b) => a -> a -> b
evenMultiples a
x a
y
    where evenMultiples :: a -> a -> b
evenMultiples a
x' a
y' = Integer -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
x' a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
y') :: Integer)

decimalRound :: RealFrac a => a -> Int -> a
decimalRound :: a -> Int -> a
decimalRound a
x Int
decimalPlaces = a -> a
forall b. Num b => a -> b
shiftedAndRounded a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
powersOf10
    where powersOf10 :: a
powersOf10 = a
10 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
decimalPlaces
          shiftedAndRounded :: a -> b
shiftedAndRounded a
x' = Integer -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> Integer) -> a -> Integer
forall a b. (a -> b) -> a -> b
$ a
x' a -> a -> a
forall a. Num a => a -> a -> a
* a
powersOf10 :: Integer)