{-# LANGUAGE
    OverloadedStrings
  , GeneralizedNewtypeDeriving
  , FlexibleInstances
  #-}
module Clay.Font
(

-- * Generic font property.

  Font (font)
, Optional (..)
, Required (..)

-- * Color.

, fontColor
, color

-- * Font-family.

, fontFamily
, sansSerif
, serif
, monospace
, cursive
, fantasy

-- * Font-size.

, FontSize
, fontSize
, fontSizeCustom
, xxSmall, xSmall, small, medium, large, xLarge, xxLarge, smaller, larger

-- * Font-style

, FontStyle
, fontStyle
, italic, oblique

-- * Font-variant.

, FontVariant
, fontVariant
, smallCaps

-- * Font-weight

, FontWeight
, fontWeight
, bold, bolder, lighter
, weight

-- * Named fonts.

, NamedFont
, caption, icon, menu, messageBox, smallCaption, statusBar

-- * Line-height.

, lineHeight
)
where

import Control.Applicative
import Data.Text (pack, Text)
import Data.Monoid
import Prelude hiding (Left, Right)

import Clay.Color
import Clay.Common
import Clay.Property
import Clay.Stylesheet
import Clay.Size

-- | We implement the generic font property as a type class that accepts
-- multiple value types. This allows us to combine different font aspects into
-- a shorthand syntax. Fonts require a mandatory part and have a optional a
-- part.
--
-- <http://www.w3.org/TR/css3-fonts/#font-prop>

class Val a => Font a where
  font :: a -> Css
  font = Key a -> a -> Css
forall a. Val a => Key a -> a -> Css
key Key a
"font"

data Optional =
  Optional
  (Maybe FontWeight)
  (Maybe FontVariant)
  (Maybe FontStyle)

instance Val Optional where
  value :: Optional -> Value
value (Optional Maybe FontWeight
a Maybe FontVariant
b Maybe FontStyle
c) = (Maybe FontWeight, (Maybe FontVariant, Maybe FontStyle)) -> Value
forall a. Val a => a -> Value
value (Maybe FontWeight
a Maybe FontWeight
-> (Maybe FontVariant, Maybe FontStyle)
-> (Maybe FontWeight, (Maybe FontVariant, Maybe FontStyle))
forall a b. a -> b -> (a, b)
! Maybe FontVariant
b Maybe FontVariant
-> Maybe FontStyle -> (Maybe FontVariant, Maybe FontStyle)
forall a b. a -> b -> (a, b)
! Maybe FontStyle
c)

data Required a =
  Required
  (Size a)
  (Maybe (Size a))
  [Text]
  [GenericFontFamily]

instance Val (Required a) where
  value :: Required a -> Value
value (Required Size a
a Maybe (Size a)
Nothing  [Text]
c [GenericFontFamily]
d) = Size a -> Value
forall a. Val a => a -> Value
value Size a
a Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
" " Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> ([Literal] -> Value
forall a. Val a => a -> Value
value ([Literal] -> Value) -> [Literal] -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Literal
Literal (Text -> Literal) -> [Text] -> [Literal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
c) Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
sep Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [GenericFontFamily] -> Value
forall a. Val a => a -> Value
value [GenericFontFamily]
d
    where sep :: Value
sep = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
c Bool -> Bool -> Bool
|| [GenericFontFamily] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenericFontFamily]
d then Value
"" else Value
","
  value (Required Size a
a (Just Size a
b) [Text]
c [GenericFontFamily]
d) = (Value, ([Literal], [GenericFontFamily])) -> Value
forall a. Val a => a -> Value
value ((Size a -> Value
forall a. Val a => a -> Value
value Size a
a Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
"/" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Size a -> Value
forall a. Val a => a -> Value
value Size a
b) Value
-> ([Literal], [GenericFontFamily])
-> (Value, ([Literal], [GenericFontFamily]))
forall a b. a -> b -> (a, b)
! (Text -> Literal
Literal (Text -> Literal) -> [Text] -> [Literal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
c) [Literal]
-> [GenericFontFamily] -> ([Literal], [GenericFontFamily])
forall a b. a -> b -> (a, b)
! [GenericFontFamily]
d)

instance Font (          Required a)
instance Font (Optional, Required a)

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

-- | An alias for color.

fontColor :: Color -> Css
fontColor :: Color -> Css
fontColor = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"color"

color :: Color -> Css
color :: Color -> Css
color = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"color"

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

-- | The five generic font families.
--
-- <http://www.w3.org/TR/css3-fonts/#generic-font-families>.

newtype GenericFontFamily = GenericFontFamily Value
  deriving (GenericFontFamily -> Value
(GenericFontFamily -> Value) -> Val GenericFontFamily
forall a. (a -> Value) -> Val a
value :: GenericFontFamily -> Value
$cvalue :: GenericFontFamily -> Value
Val, GenericFontFamily
GenericFontFamily -> Inherit GenericFontFamily
forall a. a -> Inherit a
inherit :: GenericFontFamily
$cinherit :: GenericFontFamily
Inherit, GenericFontFamily
GenericFontFamily -> Auto GenericFontFamily
forall a. a -> Auto a
auto :: GenericFontFamily
$cauto :: GenericFontFamily
Auto, Value -> GenericFontFamily
(Value -> GenericFontFamily) -> Other GenericFontFamily
forall a. (Value -> a) -> Other a
other :: Value -> GenericFontFamily
$cother :: Value -> GenericFontFamily
Other)

sansSerif, serif, monospace, cursive, fantasy :: GenericFontFamily

sansSerif :: GenericFontFamily
sansSerif = Value -> GenericFontFamily
GenericFontFamily Value
"sans-serif"
serif :: GenericFontFamily
serif     = Value -> GenericFontFamily
GenericFontFamily Value
"serif"
monospace :: GenericFontFamily
monospace = Value -> GenericFontFamily
GenericFontFamily Value
"monospace"
cursive :: GenericFontFamily
cursive   = Value -> GenericFontFamily
GenericFontFamily Value
"cursive"
fantasy :: GenericFontFamily
fantasy   = Value -> GenericFontFamily
GenericFontFamily Value
"fantasy"

-- | The `fontFamily` style rules takes to lists of font families: zero or more
-- custom font-families and preferably one or more generic font families.

fontFamily :: [Text] -> [GenericFontFamily] -> Css
fontFamily :: [Text] -> [GenericFontFamily] -> Css
fontFamily [Text]
a [GenericFontFamily]
b = Key Value -> Value -> Css
forall a. Val a => Key a -> a -> Css
key Key Value
"font-family" (Value -> Css) -> Value -> Css
forall a b. (a -> b) -> a -> b
$
  let sep :: Value
sep = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
a Bool -> Bool -> Bool
|| [GenericFontFamily] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenericFontFamily]
b then Value
"" else Value
", "
   in [Literal] -> Value
forall a. Val a => a -> Value
value (Text -> Literal
Literal (Text -> Literal) -> [Text] -> [Literal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
a) Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
sep Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [GenericFontFamily] -> Value
forall a. Val a => a -> Value
value [GenericFontFamily]
b

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

newtype FontSize = FontSize Value
  deriving (FontSize -> Value
(FontSize -> Value) -> Val FontSize
forall a. (a -> Value) -> Val a
value :: FontSize -> Value
$cvalue :: FontSize -> Value
Val, FontSize
FontSize -> Inherit FontSize
forall a. a -> Inherit a
inherit :: FontSize
$cinherit :: FontSize
Inherit, FontSize
FontSize -> Auto FontSize
forall a. a -> Auto a
auto :: FontSize
$cauto :: FontSize
Auto, Value -> FontSize
(Value -> FontSize) -> Other FontSize
forall a. (Value -> a) -> Other a
other :: Value -> FontSize
$cother :: Value -> FontSize
Other)

xxSmall, xSmall, small, medium, large, xLarge, xxLarge, smaller, larger :: FontSize

xxSmall :: FontSize
xxSmall = Value -> FontSize
FontSize Value
"xx-small"
xSmall :: FontSize
xSmall  = Value -> FontSize
FontSize Value
"x-small"
small :: FontSize
small   = Value -> FontSize
FontSize Value
"small"
medium :: FontSize
medium  = Value -> FontSize
FontSize Value
"medium"
large :: FontSize
large   = Value -> FontSize
FontSize Value
"large"
xLarge :: FontSize
xLarge  = Value -> FontSize
FontSize Value
"x-large"
xxLarge :: FontSize
xxLarge = Value -> FontSize
FontSize Value
"xx-large"
smaller :: FontSize
smaller = Value -> FontSize
FontSize Value
"smaller"
larger :: FontSize
larger  = Value -> FontSize
FontSize Value
"larger"

fontSize :: Size a -> Css
fontSize :: Size a -> Css
fontSize = Key (Size a) -> Size a -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a)
"font-size"

fontSizeCustom :: FontSize -> Css
fontSizeCustom :: FontSize -> Css
fontSizeCustom = Key FontSize -> FontSize -> Css
forall a. Val a => Key a -> a -> Css
key Key FontSize
"font-size"

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

newtype FontStyle = FontStyle Value
  deriving (FontStyle -> Value
(FontStyle -> Value) -> Val FontStyle
forall a. (a -> Value) -> Val a
value :: FontStyle -> Value
$cvalue :: FontStyle -> Value
Val, FontStyle
FontStyle -> Inherit FontStyle
forall a. a -> Inherit a
inherit :: FontStyle
$cinherit :: FontStyle
Inherit, FontStyle
FontStyle -> Normal FontStyle
forall a. a -> Normal a
normal :: FontStyle
$cnormal :: FontStyle
Normal, Value -> FontStyle
(Value -> FontStyle) -> Other FontStyle
forall a. (Value -> a) -> Other a
other :: Value -> FontStyle
$cother :: Value -> FontStyle
Other)

italic, oblique :: FontStyle

italic :: FontStyle
italic = Value -> FontStyle
FontStyle Value
"italic"
oblique :: FontStyle
oblique = Value -> FontStyle
FontStyle Value
"oblique"

fontStyle :: FontStyle -> Css
fontStyle :: FontStyle -> Css
fontStyle = Key FontStyle -> FontStyle -> Css
forall a. Val a => Key a -> a -> Css
key Key FontStyle
"font-style"

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

newtype FontVariant = FontVariant Value
  deriving (FontVariant -> Value
(FontVariant -> Value) -> Val FontVariant
forall a. (a -> Value) -> Val a
value :: FontVariant -> Value
$cvalue :: FontVariant -> Value
Val, FontVariant
FontVariant -> Inherit FontVariant
forall a. a -> Inherit a
inherit :: FontVariant
$cinherit :: FontVariant
Inherit, FontVariant
FontVariant -> Normal FontVariant
forall a. a -> Normal a
normal :: FontVariant
$cnormal :: FontVariant
Normal, Value -> FontVariant
(Value -> FontVariant) -> Other FontVariant
forall a. (Value -> a) -> Other a
other :: Value -> FontVariant
$cother :: Value -> FontVariant
Other)

smallCaps :: FontVariant
smallCaps :: FontVariant
smallCaps = Value -> FontVariant
FontVariant Value
"small-caps"

fontVariant :: FontVariant -> Css
fontVariant :: FontVariant -> Css
fontVariant = Key FontVariant -> FontVariant -> Css
forall a. Val a => Key a -> a -> Css
key Key FontVariant
"font-variant"

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

newtype FontWeight = FontWeight Value
  deriving (FontWeight -> Value
(FontWeight -> Value) -> Val FontWeight
forall a. (a -> Value) -> Val a
value :: FontWeight -> Value
$cvalue :: FontWeight -> Value
Val, FontWeight
FontWeight -> Inherit FontWeight
forall a. a -> Inherit a
inherit :: FontWeight
$cinherit :: FontWeight
Inherit, FontWeight
FontWeight -> Normal FontWeight
forall a. a -> Normal a
normal :: FontWeight
$cnormal :: FontWeight
Normal, Value -> FontWeight
(Value -> FontWeight) -> Other FontWeight
forall a. (Value -> a) -> Other a
other :: Value -> FontWeight
$cother :: Value -> FontWeight
Other)

bold, bolder, lighter :: FontWeight

bold :: FontWeight
bold    = Value -> FontWeight
FontWeight Value
"bold"
bolder :: FontWeight
bolder  = Value -> FontWeight
FontWeight Value
"bolder"
lighter :: FontWeight
lighter = Value -> FontWeight
FontWeight Value
"lighter"

weight :: Integer -> FontWeight
weight :: Integer -> FontWeight
weight Integer
i = Value -> FontWeight
FontWeight (Text -> Value
forall a. Val a => a -> Value
value (String -> Text
pack (Integer -> String
forall a. Show a => a -> String
show Integer
i)))

fontWeight :: FontWeight -> Css
fontWeight :: FontWeight -> Css
fontWeight = Key FontWeight -> FontWeight -> Css
forall a. Val a => Key a -> a -> Css
key Key FontWeight
"font-weight"

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

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

caption, icon, menu, messageBox, smallCaption, statusBar :: NamedFont

caption :: NamedFont
caption      = Value -> NamedFont
NamedFont Value
"caption"
icon :: NamedFont
icon         = Value -> NamedFont
NamedFont Value
"icon"
menu :: NamedFont
menu         = Value -> NamedFont
NamedFont Value
"menu"
messageBox :: NamedFont
messageBox   = Value -> NamedFont
NamedFont Value
"message-box"
smallCaption :: NamedFont
smallCaption = Value -> NamedFont
NamedFont Value
"small-caption"
statusBar :: NamedFont
statusBar    = Value -> NamedFont
NamedFont Value
"status-bar"

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

lineHeight :: Size a -> Css
lineHeight :: Size a -> Css
lineHeight = Key (Size a) -> Size a -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a)
"line-height"