{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, OverloadedStrings #-}
module Clay.Flexbox where

import Clay.Common     (Auto, Baseline, Center, Inherit, Other)
import Clay.Property
import Clay.Size       (Size)
import Clay.Stylesheet
import Data.String     (fromString)

-- | CSS Flexible Box Layout
-- http://dev.w3.org/csswg/css-flexbox-1

class FlexEnd      a where flexEnd      :: a
class FlexStart    a where flexStart    :: a
class SpaceAround  a where spaceAround  :: a
class SpaceBetween a where spaceBetween :: a
class SpaceEvenly  a where spaceEvenly  :: a
class Stretch      a where stretch      :: a

instance FlexEnd Value      where flexEnd :: Value
flexEnd      = Value
"flex-end"
instance FlexStart Value    where flexStart :: Value
flexStart    = Value
"flex-start"
instance SpaceAround Value  where spaceAround :: Value
spaceAround  = Value
"space-around"
instance SpaceBetween Value where spaceBetween :: Value
spaceBetween = Value
"space-between"
instance SpaceEvenly Value  where spaceEvenly :: Value
spaceEvenly  = Value
"space-evenly"
instance Stretch Value      where stretch :: Value
stretch      = Value
"stretch"

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

newtype AlignContentValue = AlignContentValue Value
  deriving (AlignContentValue -> Value
(AlignContentValue -> Value) -> Val AlignContentValue
forall a. (a -> Value) -> Val a
value :: AlignContentValue -> Value
$cvalue :: AlignContentValue -> Value
Val, Value -> AlignContentValue
(Value -> AlignContentValue) -> Other AlignContentValue
forall a. (Value -> a) -> Other a
other :: Value -> AlignContentValue
$cother :: Value -> AlignContentValue
Other, AlignContentValue
AlignContentValue -> Inherit AlignContentValue
forall a. a -> Inherit a
inherit :: AlignContentValue
$cinherit :: AlignContentValue
Inherit, AlignContentValue
AlignContentValue -> FlexStart AlignContentValue
forall a. a -> FlexStart a
flexStart :: AlignContentValue
$cflexStart :: AlignContentValue
FlexStart, AlignContentValue
AlignContentValue -> FlexEnd AlignContentValue
forall a. a -> FlexEnd a
flexEnd :: AlignContentValue
$cflexEnd :: AlignContentValue
FlexEnd
          , AlignContentValue
AlignContentValue -> Center AlignContentValue
forall a. a -> Center a
center :: AlignContentValue
$ccenter :: AlignContentValue
Center, AlignContentValue
AlignContentValue -> SpaceBetween AlignContentValue
forall a. a -> SpaceBetween a
spaceBetween :: AlignContentValue
$cspaceBetween :: AlignContentValue
SpaceBetween, AlignContentValue
AlignContentValue -> SpaceAround AlignContentValue
forall a. a -> SpaceAround a
spaceAround :: AlignContentValue
$cspaceAround :: AlignContentValue
SpaceAround, AlignContentValue
AlignContentValue -> SpaceEvenly AlignContentValue
forall a. a -> SpaceEvenly a
spaceEvenly :: AlignContentValue
$cspaceEvenly :: AlignContentValue
SpaceEvenly, AlignContentValue
AlignContentValue -> Stretch AlignContentValue
forall a. a -> Stretch a
stretch :: AlignContentValue
$cstretch :: AlignContentValue
Stretch)

alignContent :: AlignContentValue -> Css
alignContent :: AlignContentValue -> Css
alignContent = Key AlignContentValue -> AlignContentValue -> Css
forall a. Val a => Key a -> a -> Css
key Key AlignContentValue
"align-content"

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

newtype AlignItemsValue = AlignItemValue Value
  deriving (AlignItemsValue -> Value
(AlignItemsValue -> Value) -> Val AlignItemsValue
forall a. (a -> Value) -> Val a
value :: AlignItemsValue -> Value
$cvalue :: AlignItemsValue -> Value
Val, Value -> AlignItemsValue
(Value -> AlignItemsValue) -> Other AlignItemsValue
forall a. (Value -> a) -> Other a
other :: Value -> AlignItemsValue
$cother :: Value -> AlignItemsValue
Other, AlignItemsValue
AlignItemsValue -> Inherit AlignItemsValue
forall a. a -> Inherit a
inherit :: AlignItemsValue
$cinherit :: AlignItemsValue
Inherit, AlignItemsValue
AlignItemsValue -> Baseline AlignItemsValue
forall a. a -> Baseline a
baseline :: AlignItemsValue
$cbaseline :: AlignItemsValue
Baseline
          , AlignItemsValue
AlignItemsValue -> Center AlignItemsValue
forall a. a -> Center a
center :: AlignItemsValue
$ccenter :: AlignItemsValue
Center, AlignItemsValue
AlignItemsValue -> FlexEnd AlignItemsValue
forall a. a -> FlexEnd a
flexEnd :: AlignItemsValue
$cflexEnd :: AlignItemsValue
FlexEnd, AlignItemsValue
AlignItemsValue -> FlexStart AlignItemsValue
forall a. a -> FlexStart a
flexStart :: AlignItemsValue
$cflexStart :: AlignItemsValue
FlexStart, AlignItemsValue
AlignItemsValue -> Stretch AlignItemsValue
forall a. a -> Stretch a
stretch :: AlignItemsValue
$cstretch :: AlignItemsValue
Stretch)

alignItems :: AlignItemsValue -> Css
alignItems :: AlignItemsValue -> Css
alignItems = Key AlignItemsValue -> AlignItemsValue -> Css
forall a. Val a => Key a -> a -> Css
key Key AlignItemsValue
"align-items"

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

newtype AlignSelfValue = AlignSelfValue Value
  deriving (AlignSelfValue -> Value
(AlignSelfValue -> Value) -> Val AlignSelfValue
forall a. (a -> Value) -> Val a
value :: AlignSelfValue -> Value
$cvalue :: AlignSelfValue -> Value
Val, Value -> AlignSelfValue
(Value -> AlignSelfValue) -> Other AlignSelfValue
forall a. (Value -> a) -> Other a
other :: Value -> AlignSelfValue
$cother :: Value -> AlignSelfValue
Other, AlignSelfValue
AlignSelfValue -> Inherit AlignSelfValue
forall a. a -> Inherit a
inherit :: AlignSelfValue
$cinherit :: AlignSelfValue
Inherit, AlignSelfValue
AlignSelfValue -> Auto AlignSelfValue
forall a. a -> Auto a
auto :: AlignSelfValue
$cauto :: AlignSelfValue
Auto, AlignSelfValue
AlignSelfValue -> Baseline AlignSelfValue
forall a. a -> Baseline a
baseline :: AlignSelfValue
$cbaseline :: AlignSelfValue
Baseline
          , AlignSelfValue
AlignSelfValue -> Center AlignSelfValue
forall a. a -> Center a
center :: AlignSelfValue
$ccenter :: AlignSelfValue
Center, AlignSelfValue
AlignSelfValue -> FlexEnd AlignSelfValue
forall a. a -> FlexEnd a
flexEnd :: AlignSelfValue
$cflexEnd :: AlignSelfValue
FlexEnd, AlignSelfValue
AlignSelfValue -> FlexStart AlignSelfValue
forall a. a -> FlexStart a
flexStart :: AlignSelfValue
$cflexStart :: AlignSelfValue
FlexStart, AlignSelfValue
AlignSelfValue -> Stretch AlignSelfValue
forall a. a -> Stretch a
stretch :: AlignSelfValue
$cstretch :: AlignSelfValue
Stretch)

alignSelf :: AlignSelfValue -> Css
alignSelf :: AlignSelfValue -> Css
alignSelf = Key AlignSelfValue -> AlignSelfValue -> Css
forall a. Val a => Key a -> a -> Css
key Key AlignSelfValue
"align-self"

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

flex :: Int -> Int -> Size b -> Css
flex :: Int -> Int -> Size b -> Css
flex Int
g Int
s Size b
b = Key (Value, (Value, Value)) -> (Value, (Value, Value)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Value, (Value, Value))
"flex" (Value
gs Value -> (Value, Value) -> (Value, (Value, Value))
forall a b. a -> b -> (a, b)
! Value
ss Value -> Value -> (Value, Value)
forall a b. a -> b -> (a, b)
! Size b -> Value
forall a. Val a => a -> Value
value Size b
b)
  where gs :: Value
gs = String -> Value
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
g) :: Value
        ss :: Value
ss = String -> Value
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
s) :: Value

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

flexBasis :: Size a -> Css
flexBasis :: Size a -> Css
flexBasis = Key (Size a) -> Size a -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a)
"flex-basis"

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

newtype FlexDirection = FlexDirection Value
  deriving (FlexDirection -> Value
(FlexDirection -> Value) -> Val FlexDirection
forall a. (a -> Value) -> Val a
value :: FlexDirection -> Value
$cvalue :: FlexDirection -> Value
Val, Value -> FlexDirection
(Value -> FlexDirection) -> Other FlexDirection
forall a. (Value -> a) -> Other a
other :: Value -> FlexDirection
$cother :: Value -> FlexDirection
Other)

row, rowReverse, column, columnReverse :: FlexDirection

row :: FlexDirection
row           = Value -> FlexDirection
FlexDirection Value
"row"
rowReverse :: FlexDirection
rowReverse    = Value -> FlexDirection
FlexDirection Value
"row-reverse"
column :: FlexDirection
column        = Value -> FlexDirection
FlexDirection Value
"column"
columnReverse :: FlexDirection
columnReverse = Value -> FlexDirection
FlexDirection Value
"column-reverse"

flexDirection :: FlexDirection -> Css
flexDirection :: FlexDirection -> Css
flexDirection = Key FlexDirection -> FlexDirection -> Css
forall a. Val a => Key a -> a -> Css
key Key FlexDirection
"flex-direction"

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

flexFlow :: FlexDirection -> FlexWrap -> Css
flexFlow :: FlexDirection -> FlexWrap -> Css
flexFlow FlexDirection
d FlexWrap
w = Key (FlexDirection, FlexWrap) -> (FlexDirection, FlexWrap) -> Css
forall a. Val a => Key a -> a -> Css
key Key (FlexDirection, FlexWrap)
"flex-flow" (FlexDirection
d FlexDirection -> FlexWrap -> (FlexDirection, FlexWrap)
forall a b. a -> b -> (a, b)
! FlexWrap
w)

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

flexGrow :: Int -> Css
flexGrow :: Int -> Css
flexGrow Int
i = Key Value -> Value -> Css
forall a. Val a => Key a -> a -> Css
key Key Value
"flex-grow" (String -> Value
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) :: Value)

flexShrink :: Int  -> Css
flexShrink :: Int -> Css
flexShrink Int
i = Key Value -> Value -> Css
forall a. Val a => Key a -> a -> Css
key Key Value
"flex-shrink" (String -> Value
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) :: Value)

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

newtype FlexWrap = FlexWrap Value
  deriving (FlexWrap -> Value
(FlexWrap -> Value) -> Val FlexWrap
forall a. (a -> Value) -> Val a
value :: FlexWrap -> Value
$cvalue :: FlexWrap -> Value
Val, Value -> FlexWrap
(Value -> FlexWrap) -> Other FlexWrap
forall a. (Value -> a) -> Other a
other :: Value -> FlexWrap
$cother :: Value -> FlexWrap
Other)

nowrap, wrap, wrapReverse :: FlexWrap

nowrap :: FlexWrap
nowrap = Value -> FlexWrap
FlexWrap Value
"nowrap"
wrap :: FlexWrap
wrap = Value -> FlexWrap
FlexWrap Value
"wrap"
wrapReverse :: FlexWrap
wrapReverse = Value -> FlexWrap
FlexWrap Value
"wrap-reverse"

flexWrap :: FlexWrap -> Css
flexWrap :: FlexWrap -> Css
flexWrap = Key FlexWrap -> FlexWrap -> Css
forall a. Val a => Key a -> a -> Css
key Key FlexWrap
"flex-wrap"

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

newtype JustifyContentValue = JustifyContentValue Value
  deriving (JustifyContentValue -> Value
(JustifyContentValue -> Value) -> Val JustifyContentValue
forall a. (a -> Value) -> Val a
value :: JustifyContentValue -> Value
$cvalue :: JustifyContentValue -> Value
Val, Value -> JustifyContentValue
(Value -> JustifyContentValue) -> Other JustifyContentValue
forall a. (Value -> a) -> Other a
other :: Value -> JustifyContentValue
$cother :: Value -> JustifyContentValue
Other, JustifyContentValue
JustifyContentValue -> Inherit JustifyContentValue
forall a. a -> Inherit a
inherit :: JustifyContentValue
$cinherit :: JustifyContentValue
Inherit, JustifyContentValue
JustifyContentValue -> Center JustifyContentValue
forall a. a -> Center a
center :: JustifyContentValue
$ccenter :: JustifyContentValue
Center, JustifyContentValue
JustifyContentValue -> FlexEnd JustifyContentValue
forall a. a -> FlexEnd a
flexEnd :: JustifyContentValue
$cflexEnd :: JustifyContentValue
FlexEnd
          , JustifyContentValue
JustifyContentValue -> FlexStart JustifyContentValue
forall a. a -> FlexStart a
flexStart :: JustifyContentValue
$cflexStart :: JustifyContentValue
FlexStart, JustifyContentValue
JustifyContentValue -> SpaceAround JustifyContentValue
forall a. a -> SpaceAround a
spaceAround :: JustifyContentValue
$cspaceAround :: JustifyContentValue
SpaceAround, JustifyContentValue
JustifyContentValue -> SpaceBetween JustifyContentValue
forall a. a -> SpaceBetween a
spaceBetween :: JustifyContentValue
$cspaceBetween :: JustifyContentValue
SpaceBetween, JustifyContentValue
JustifyContentValue -> SpaceEvenly JustifyContentValue
forall a. a -> SpaceEvenly a
spaceEvenly :: JustifyContentValue
$cspaceEvenly :: JustifyContentValue
SpaceEvenly)

justifyContent :: JustifyContentValue -> Css
justifyContent :: JustifyContentValue -> Css
justifyContent = Key JustifyContentValue -> JustifyContentValue -> Css
forall a. Val a => Key a -> a -> Css
key Key JustifyContentValue
"justify-content"

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

order :: Int -> Css
order :: Int -> Css
order Int
i = Key Value -> Value -> Css
forall a. Val a => Key a -> a -> Css
key Key Value
"order" (String -> Value
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) :: Value)