{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Clay.Stylesheet where
import Control.Applicative
import Control.Arrow (second)
import Control.Monad.Writer hiding (All)
import Data.Text (Text)
import Clay.Selector hiding (Child)
import Clay.Property
import Clay.Common
newtype MediaType = MediaType Value
deriving (Val, Other, Show, All)
data NotOrOnly = Not | Only
deriving Show
data MediaQuery = MediaQuery (Maybe NotOrOnly) MediaType [Feature]
deriving Show
data Feature = Feature Text (Maybe Value)
deriving Show
data App
= Self Refinement
| Root Selector
| Pop Int
| Child Selector
| Sub Selector
deriving Show
data Keyframes = Keyframes Text [(Double, [Rule])]
deriving Show
data Rule
= Property (Key ()) Value
| Nested App [Rule]
| Query MediaQuery [Rule]
| Face [Rule]
| Keyframe Keyframes
| Import Text
deriving Show
newtype StyleM a = S (Writer [Rule] a)
deriving (Functor, Applicative, Monad)
runS :: Css -> [Rule]
runS (S a) = execWriter a
rule :: Rule -> Css
rule a = S (tell [a])
type Css = StyleM ()
instance Monoid Css where
mempty = pure ()
mappend = liftA2 mappend
key :: Val a => Key a -> a -> Css
key k v = rule $ Property (cast k) (value v)
prefixed :: Val a => Prefixed -> a -> Css
prefixed xs = key (Key xs)
infix 4 -:
(-:) :: Key Text -> Text -> Css
(-:) = key
infixr 5 <?
infixr 5 ?
infixr 5 &
(?) :: Selector -> Css -> Css
(?) sel rs = rule $ Nested (Sub sel) (runS rs)
(<?) :: Selector -> Css -> Css
(<?) sel rs = rule $ Nested (Child sel) (runS rs)
(&) :: Refinement -> Css -> Css
(&) p rs = rule $ Nested (Self p) (runS rs)
root :: Selector -> Css -> Css
root sel rs = rule $ Nested (Root sel) (runS rs)
pop :: Int -> Css -> Css
pop i rs = rule $ Nested (Pop i) (runS rs)
query :: MediaType -> [Feature] -> Css -> Css
query ty fs rs = rule $ Query (MediaQuery Nothing ty fs) (runS rs)
queryNot :: MediaType -> [Feature] -> Css -> Css
queryNot ty fs rs = rule $ Query (MediaQuery (Just Not) ty fs) (runS rs)
queryOnly :: MediaType -> [Feature] -> Css -> Css
queryOnly ty fs rs = rule $ Query (MediaQuery (Just Only) ty fs) (runS rs)
keyframes :: Text -> [(Double, Css)] -> Css
keyframes n xs = rule $ Keyframe (Keyframes n (map (second runS) xs))
keyframesFromTo :: Text -> Css -> Css -> Css
keyframesFromTo n a b = keyframes n [(0, a), (100, b)]
fontFace :: Css -> Css
fontFace rs = rule $ Face (runS rs)
importUrl :: Text -> Css
importUrl l = rule $ Import l