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

-- * Media types.

  aural, braille, handheld, print, projection
, screen, tty, tv, embossed

-- * Geometrical features.

, width, minWidth, maxWidth, height, minHeight, maxHeight, deviceWidth
, minDeviceWidth, maxDeviceWidth, deviceHeight, minDeviceHeight
, maxDeviceHeight

-- * Aspect ratio features.

, aspectRatio, minAspectRatio, maxAspectRatio, deviceAspectRatio
, minDeviceAspectRatio, maxDeviceAspectRatio

-- * Color related features.

, color, monochrome, scan, grid
, minColor, maxColor, colorIndex, minColorIndex, maxColorIndex, minMonochrome
, maxMonochrome

-- * Resolution related features.

, resolution, minResolution, maxResolution

-- * Resolution value type.

, Resolution
, dpi
, dppx
)

where

import Data.Text (Text, pack)
import Data.Monoid

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

import Prelude hiding (all, print)

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

aural, braille, handheld, print, projection
  , screen, tty, tv, embossed :: MediaType

aural :: MediaType
aural      = Value -> MediaType
MediaType Value
"aural"
braille :: MediaType
braille    = Value -> MediaType
MediaType Value
"braille"
handheld :: MediaType
handheld   = Value -> MediaType
MediaType Value
"handheld"
print :: MediaType
print      = Value -> MediaType
MediaType Value
"print"
projection :: MediaType
projection = Value -> MediaType
MediaType Value
"projection"
screen :: MediaType
screen     = Value -> MediaType
MediaType Value
"screen"
tty :: MediaType
tty        = Value -> MediaType
MediaType Value
"tty"
tv :: MediaType
tv         = Value -> MediaType
MediaType Value
"tv"
embossed :: MediaType
embossed   = Value -> MediaType
MediaType Value
"embossed"

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

with :: Val a => Text -> a -> Feature
with :: Text -> a -> Feature
with Text
f a
v = Text -> Maybe Value -> Feature
Feature Text
f (Value -> Maybe Value
forall a. a -> Maybe a
Just (a -> Value
forall a. Val a => a -> Value
value a
v))

without :: Text -> Feature
without :: Text -> Feature
without Text
f = Text -> Maybe Value -> Feature
Feature Text
f Maybe Value
forall a. Maybe a
Nothing

width, minWidth, maxWidth, height, minHeight, maxHeight, deviceWidth
  , minDeviceWidth, maxDeviceWidth, deviceHeight, minDeviceHeight
  , maxDeviceHeight :: Size LengthUnit -> Feature

width :: Size LengthUnit -> Feature
width           = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"width"
minWidth :: Size LengthUnit -> Feature
minWidth        = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"min-width"
maxWidth :: Size LengthUnit -> Feature
maxWidth        = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"max-width"
height :: Size LengthUnit -> Feature
height          = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"height"
minHeight :: Size LengthUnit -> Feature
minHeight       = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"min-height"
maxHeight :: Size LengthUnit -> Feature
maxHeight       = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"max-height"
deviceWidth :: Size LengthUnit -> Feature
deviceWidth     = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"device-width"
minDeviceWidth :: Size LengthUnit -> Feature
minDeviceWidth  = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"min-device-width"
maxDeviceWidth :: Size LengthUnit -> Feature
maxDeviceWidth  = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"max-device-width"
deviceHeight :: Size LengthUnit -> Feature
deviceHeight    = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"device-height"
minDeviceHeight :: Size LengthUnit -> Feature
minDeviceHeight = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"min-device-height"
maxDeviceHeight :: Size LengthUnit -> Feature
maxDeviceHeight = Text -> Size LengthUnit -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"max-device-height"

aspectRatio, minAspectRatio, maxAspectRatio, deviceAspectRatio
  , minDeviceAspectRatio, maxDeviceAspectRatio :: (Integer, Integer) -> Feature

aspectRatio :: (Integer, Integer) -> Feature
aspectRatio          (Integer
x, Integer
y) = Text -> Value -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"aspect-ratio"            (Integer -> Value
forall a. Val a => a -> Value
value Integer
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
"/" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Integer -> Value
forall a. Val a => a -> Value
value Integer
y)
minAspectRatio :: (Integer, Integer) -> Feature
minAspectRatio       (Integer
x, Integer
y) = Text -> Value -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"min-aspect-ratio"        (Integer -> Value
forall a. Val a => a -> Value
value Integer
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
"/" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Integer -> Value
forall a. Val a => a -> Value
value Integer
y)
maxAspectRatio :: (Integer, Integer) -> Feature
maxAspectRatio       (Integer
x, Integer
y) = Text -> Value -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"max-aspect-ratio"        (Integer -> Value
forall a. Val a => a -> Value
value Integer
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
"/" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Integer -> Value
forall a. Val a => a -> Value
value Integer
y)
deviceAspectRatio :: (Integer, Integer) -> Feature
deviceAspectRatio    (Integer
x, Integer
y) = Text -> Value -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"device-aspect-ratio"     (Integer -> Value
forall a. Val a => a -> Value
value Integer
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
"/" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Integer -> Value
forall a. Val a => a -> Value
value Integer
y)
minDeviceAspectRatio :: (Integer, Integer) -> Feature
minDeviceAspectRatio (Integer
x, Integer
y) = Text -> Value -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"min-device-aspect-ratio" (Integer -> Value
forall a. Val a => a -> Value
value Integer
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
"/" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Integer -> Value
forall a. Val a => a -> Value
value Integer
y)
maxDeviceAspectRatio :: (Integer, Integer) -> Feature
maxDeviceAspectRatio (Integer
x, Integer
y) = Text -> Value -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"max-device-aspect-ratio" (Integer -> Value
forall a. Val a => a -> Value
value Integer
x Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
"/" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Integer -> Value
forall a. Val a => a -> Value
value Integer
y)

color, monochrome, scan, grid :: Feature

color :: Feature
color      = Text -> Feature
without Text
"color"
monochrome :: Feature
monochrome = Text -> Feature
without Text
"monochrome"
scan :: Feature
scan       = Text -> Feature
without Text
"scan"
grid :: Feature
grid       = Text -> Feature
without Text
"grid"

minColor, maxColor, colorIndex, minColorIndex, maxColorIndex, minMonochrome
  , maxMonochrome :: Integer -> Feature

minColor :: Integer -> Feature
minColor      = Text -> Integer -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"min-color"
maxColor :: Integer -> Feature
maxColor      = Text -> Integer -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"max-color"
colorIndex :: Integer -> Feature
colorIndex    = Text -> Integer -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"color-index"
minColorIndex :: Integer -> Feature
minColorIndex = Text -> Integer -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"min-color-index"
maxColorIndex :: Integer -> Feature
maxColorIndex = Text -> Integer -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"max-color-index"
minMonochrome :: Integer -> Feature
minMonochrome = Text -> Integer -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"min-monochrome"
maxMonochrome :: Integer -> Feature
maxMonochrome = Text -> Integer -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"max-monochrome"

resolution, minResolution, maxResolution :: Val a => a -> Feature

resolution :: a -> Feature
resolution    = Text -> a -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"resolution"
minResolution :: a -> Feature
minResolution = Text -> a -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"min-resolution"
maxResolution :: a -> Feature
maxResolution = Text -> a -> Feature
forall a. Val a => Text -> a -> Feature
with Text
"max-resolution"

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

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

dpi :: Integer -> Resolution
dpi :: Integer -> Resolution
dpi Integer
i = Value -> Resolution
Resolution (Text -> Value
forall a. Val a => a -> Value
value (String -> Text
pack (Integer -> String
forall a. Show a => a -> String
show Integer
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"dpi"))

dppx :: Integer -> Resolution
dppx :: Integer -> Resolution
dppx Integer
i = Value -> Resolution
Resolution (Text -> Value
forall a. Val a => a -> Value
value (String -> Text
pack (Integer -> String
forall a. Show a => a -> String
show Integer
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"dppx"))