{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Clay.Stylesheet where
import Control.Applicative
import Control.Arrow (second)
import Control.Monad.Writer (Writer, execWriter, tell)
import Data.Maybe (isJust)
import Data.String (IsString)
import Data.Text (Text)
import Clay.Selector hiding (Child)
import Clay.Property
import Clay.Common
newtype MediaType = MediaType Value
deriving (MediaType -> Value
(MediaType -> Value) -> Val MediaType
forall a. (a -> Value) -> Val a
value :: MediaType -> Value
$cvalue :: MediaType -> Value
Val, Value -> MediaType
(Value -> MediaType) -> Other MediaType
forall a. (Value -> a) -> Other a
other :: Value -> MediaType
$cother :: Value -> MediaType
Other, Int -> MediaType -> ShowS
[MediaType] -> ShowS
MediaType -> String
(Int -> MediaType -> ShowS)
-> (MediaType -> String)
-> ([MediaType] -> ShowS)
-> Show MediaType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MediaType] -> ShowS
$cshowList :: [MediaType] -> ShowS
show :: MediaType -> String
$cshow :: MediaType -> String
showsPrec :: Int -> MediaType -> ShowS
$cshowsPrec :: Int -> MediaType -> ShowS
Show, MediaType
MediaType -> All MediaType
forall a. a -> All a
all :: MediaType
$call :: MediaType
All)
data NotOrOnly = Not | Only
deriving Int -> NotOrOnly -> ShowS
[NotOrOnly] -> ShowS
NotOrOnly -> String
(Int -> NotOrOnly -> ShowS)
-> (NotOrOnly -> String)
-> ([NotOrOnly] -> ShowS)
-> Show NotOrOnly
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotOrOnly] -> ShowS
$cshowList :: [NotOrOnly] -> ShowS
show :: NotOrOnly -> String
$cshow :: NotOrOnly -> String
showsPrec :: Int -> NotOrOnly -> ShowS
$cshowsPrec :: Int -> NotOrOnly -> ShowS
Show
data MediaQuery = MediaQuery (Maybe NotOrOnly) MediaType [Feature]
deriving Int -> MediaQuery -> ShowS
[MediaQuery] -> ShowS
MediaQuery -> String
(Int -> MediaQuery -> ShowS)
-> (MediaQuery -> String)
-> ([MediaQuery] -> ShowS)
-> Show MediaQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MediaQuery] -> ShowS
$cshowList :: [MediaQuery] -> ShowS
show :: MediaQuery -> String
$cshow :: MediaQuery -> String
showsPrec :: Int -> MediaQuery -> ShowS
$cshowsPrec :: Int -> MediaQuery -> ShowS
Show
data Feature = Feature Text (Maybe Value)
deriving Int -> Feature -> ShowS
[Feature] -> ShowS
Feature -> String
(Int -> Feature -> ShowS)
-> (Feature -> String) -> ([Feature] -> ShowS) -> Show Feature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feature] -> ShowS
$cshowList :: [Feature] -> ShowS
show :: Feature -> String
$cshow :: Feature -> String
showsPrec :: Int -> Feature -> ShowS
$cshowsPrec :: Int -> Feature -> ShowS
Show
newtype = { :: Text }
deriving (Int -> CommentText -> ShowS
[CommentText] -> ShowS
CommentText -> String
(Int -> CommentText -> ShowS)
-> (CommentText -> String)
-> ([CommentText] -> ShowS)
-> Show CommentText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentText] -> ShowS
$cshowList :: [CommentText] -> ShowS
show :: CommentText -> String
$cshow :: CommentText -> String
showsPrec :: Int -> CommentText -> ShowS
$cshowsPrec :: Int -> CommentText -> ShowS
Show, String -> CommentText
(String -> CommentText) -> IsString CommentText
forall a. (String -> a) -> IsString a
fromString :: String -> CommentText
$cfromString :: String -> CommentText
IsString, b -> CommentText -> CommentText
NonEmpty CommentText -> CommentText
CommentText -> CommentText -> CommentText
(CommentText -> CommentText -> CommentText)
-> (NonEmpty CommentText -> CommentText)
-> (forall b. Integral b => b -> CommentText -> CommentText)
-> Semigroup CommentText
forall b. Integral b => b -> CommentText -> CommentText
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> CommentText -> CommentText
$cstimes :: forall b. Integral b => b -> CommentText -> CommentText
sconcat :: NonEmpty CommentText -> CommentText
$csconcat :: NonEmpty CommentText -> CommentText
<> :: CommentText -> CommentText -> CommentText
$c<> :: CommentText -> CommentText -> CommentText
Semigroup, Semigroup CommentText
CommentText
Semigroup CommentText
-> CommentText
-> (CommentText -> CommentText -> CommentText)
-> ([CommentText] -> CommentText)
-> Monoid CommentText
[CommentText] -> CommentText
CommentText -> CommentText -> CommentText
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CommentText] -> CommentText
$cmconcat :: [CommentText] -> CommentText
mappend :: CommentText -> CommentText -> CommentText
$cmappend :: CommentText -> CommentText -> CommentText
mempty :: CommentText
$cmempty :: CommentText
$cp1Monoid :: Semigroup CommentText
Monoid)
data Modifier
= Important
| CommentText
deriving (Int -> Modifier -> ShowS
[Modifier] -> ShowS
Modifier -> String
(Int -> Modifier -> ShowS)
-> (Modifier -> String) -> ([Modifier] -> ShowS) -> Show Modifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modifier] -> ShowS
$cshowList :: [Modifier] -> ShowS
show :: Modifier -> String
$cshow :: Modifier -> String
showsPrec :: Int -> Modifier -> ShowS
$cshowsPrec :: Int -> Modifier -> ShowS
Show)
_Important :: Modifier -> Maybe Text
_Important :: Modifier -> Maybe Text
_Important Modifier
Important = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"!important"
_Important (Comment CommentText
_) = Maybe Text
forall a. Maybe a
Nothing
_Comment :: Modifier -> Maybe CommentText
(Comment CommentText
c) = CommentText -> Maybe CommentText
forall a. a -> Maybe a
Just CommentText
c
_Comment Modifier
Important = Maybe CommentText
forall a. Maybe a
Nothing
data App
= Self Refinement
| Root Selector
| Pop Int
| Child Selector
| Sub Selector
deriving Int -> App -> ShowS
[App] -> ShowS
App -> String
(Int -> App -> ShowS)
-> (App -> String) -> ([App] -> ShowS) -> Show App
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [App] -> ShowS
$cshowList :: [App] -> ShowS
show :: App -> String
$cshow :: App -> String
showsPrec :: Int -> App -> ShowS
$cshowsPrec :: Int -> App -> ShowS
Show
data Keyframes = Keyframes Text [(Double, [Rule])]
deriving Int -> Keyframes -> ShowS
[Keyframes] -> ShowS
Keyframes -> String
(Int -> Keyframes -> ShowS)
-> (Keyframes -> String)
-> ([Keyframes] -> ShowS)
-> Show Keyframes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Keyframes] -> ShowS
$cshowList :: [Keyframes] -> ShowS
show :: Keyframes -> String
$cshow :: Keyframes -> String
showsPrec :: Int -> Keyframes -> ShowS
$cshowsPrec :: Int -> Keyframes -> ShowS
Show
data Rule
= Property [Modifier] (Key ()) Value
| Nested App [Rule]
| Query MediaQuery [Rule]
| Face [Rule]
| Keyframe Keyframes
| Import Text
deriving Int -> Rule -> ShowS
[Rule] -> ShowS
Rule -> String
(Int -> Rule -> ShowS)
-> (Rule -> String) -> ([Rule] -> ShowS) -> Show Rule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rule] -> ShowS
$cshowList :: [Rule] -> ShowS
show :: Rule -> String
$cshow :: Rule -> String
showsPrec :: Int -> Rule -> ShowS
$cshowsPrec :: Int -> Rule -> ShowS
Show
newtype StyleM a = S (Writer [Rule] a)
deriving (a -> StyleM b -> StyleM a
(a -> b) -> StyleM a -> StyleM b
(forall a b. (a -> b) -> StyleM a -> StyleM b)
-> (forall a b. a -> StyleM b -> StyleM a) -> Functor StyleM
forall a b. a -> StyleM b -> StyleM a
forall a b. (a -> b) -> StyleM a -> StyleM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StyleM b -> StyleM a
$c<$ :: forall a b. a -> StyleM b -> StyleM a
fmap :: (a -> b) -> StyleM a -> StyleM b
$cfmap :: forall a b. (a -> b) -> StyleM a -> StyleM b
Functor, Functor StyleM
a -> StyleM a
Functor StyleM
-> (forall a. a -> StyleM a)
-> (forall a b. StyleM (a -> b) -> StyleM a -> StyleM b)
-> (forall a b c.
(a -> b -> c) -> StyleM a -> StyleM b -> StyleM c)
-> (forall a b. StyleM a -> StyleM b -> StyleM b)
-> (forall a b. StyleM a -> StyleM b -> StyleM a)
-> Applicative StyleM
StyleM a -> StyleM b -> StyleM b
StyleM a -> StyleM b -> StyleM a
StyleM (a -> b) -> StyleM a -> StyleM b
(a -> b -> c) -> StyleM a -> StyleM b -> StyleM c
forall a. a -> StyleM a
forall a b. StyleM a -> StyleM b -> StyleM a
forall a b. StyleM a -> StyleM b -> StyleM b
forall a b. StyleM (a -> b) -> StyleM a -> StyleM b
forall a b c. (a -> b -> c) -> StyleM a -> StyleM b -> StyleM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: StyleM a -> StyleM b -> StyleM a
$c<* :: forall a b. StyleM a -> StyleM b -> StyleM a
*> :: StyleM a -> StyleM b -> StyleM b
$c*> :: forall a b. StyleM a -> StyleM b -> StyleM b
liftA2 :: (a -> b -> c) -> StyleM a -> StyleM b -> StyleM c
$cliftA2 :: forall a b c. (a -> b -> c) -> StyleM a -> StyleM b -> StyleM c
<*> :: StyleM (a -> b) -> StyleM a -> StyleM b
$c<*> :: forall a b. StyleM (a -> b) -> StyleM a -> StyleM b
pure :: a -> StyleM a
$cpure :: forall a. a -> StyleM a
$cp1Applicative :: Functor StyleM
Applicative, Applicative StyleM
a -> StyleM a
Applicative StyleM
-> (forall a b. StyleM a -> (a -> StyleM b) -> StyleM b)
-> (forall a b. StyleM a -> StyleM b -> StyleM b)
-> (forall a. a -> StyleM a)
-> Monad StyleM
StyleM a -> (a -> StyleM b) -> StyleM b
StyleM a -> StyleM b -> StyleM b
forall a. a -> StyleM a
forall a b. StyleM a -> StyleM b -> StyleM b
forall a b. StyleM a -> (a -> StyleM b) -> StyleM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> StyleM a
$creturn :: forall a. a -> StyleM a
>> :: StyleM a -> StyleM b -> StyleM b
$c>> :: forall a b. StyleM a -> StyleM b -> StyleM b
>>= :: StyleM a -> (a -> StyleM b) -> StyleM b
$c>>= :: forall a b. StyleM a -> (a -> StyleM b) -> StyleM b
$cp1Monad :: Applicative StyleM
Monad)
runS :: Css -> [Rule]
runS :: Css -> [Rule]
runS (S Writer [Rule] ()
a) = Writer [Rule] () -> [Rule]
forall w a. Writer w a -> w
execWriter Writer [Rule] ()
a
rule :: Rule -> Css
rule :: Rule -> Css
rule Rule
a = Writer [Rule] () -> Css
forall a. Writer [Rule] a -> StyleM a
S ([Rule] -> Writer [Rule] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Rule
a])
type Css = StyleM ()
instance Semigroup Css where
<> :: Css -> Css -> Css
(<>) = (() -> () -> ()) -> Css -> Css -> Css
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 () -> () -> ()
forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid Css where
mempty :: Css
mempty = () -> Css
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
mappend :: Css -> Css -> Css
mappend = Css -> Css -> Css
forall a. Semigroup a => a -> a -> a
(<>)
key :: Val a => Key a -> a -> Css
key :: Key a -> a -> Css
key Key a
k a
v = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ [Modifier] -> Key () -> Value -> Rule
Property [] (Key a -> Key ()
forall a. Key a -> Key ()
cast Key a
k) (a -> Value
forall a. Val a => a -> Value
value a
v)
prefixed :: Val a => Prefixed -> a -> Css
prefixed :: Prefixed -> a -> Css
prefixed Prefixed
xs = Key a -> a -> Css
forall a. Val a => Key a -> a -> Css
key (Prefixed -> Key a
forall a. Prefixed -> Key a
Key Prefixed
xs)
infix 4 -:
(-:) :: Key Text -> Text -> Css
-: :: Key Text -> Text -> Css
(-:) = Key Text -> Text -> Css
forall a. Val a => Key a -> a -> Css
key
infixr 5 <?
infixr 5 ?
infixr 5 &
(?) :: Selector -> Css -> Css
? :: Selector -> Css -> Css
(?) Selector
sel Css
rs = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ App -> [Rule] -> Rule
Nested (Selector -> App
Sub Selector
sel) (Css -> [Rule]
runS Css
rs)
(<?) :: Selector -> Css -> Css
<? :: Selector -> Css -> Css
(<?) Selector
sel Css
rs = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ App -> [Rule] -> Rule
Nested (Selector -> App
Child Selector
sel) (Css -> [Rule]
runS Css
rs)
(&) :: Refinement -> Css -> Css
& :: Refinement -> Css -> Css
(&) Refinement
p Css
rs = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ App -> [Rule] -> Rule
Nested (Refinement -> App
Self Refinement
p) (Css -> [Rule]
runS Css
rs)
root :: Selector -> Css -> Css
root :: Selector -> Css -> Css
root Selector
sel Css
rs = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ App -> [Rule] -> Rule
Nested (Selector -> App
Root Selector
sel) (Css -> [Rule]
runS Css
rs)
pop :: Int -> Css -> Css
pop :: Int -> Css -> Css
pop Int
i Css
rs = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ App -> [Rule] -> Rule
Nested (Int -> App
Pop Int
i) (Css -> [Rule]
runS Css
rs)
query :: MediaType -> [Feature] -> Css -> Css
query :: MediaType -> [Feature] -> Css -> Css
query MediaType
ty [Feature]
fs Css
rs = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ MediaQuery -> [Rule] -> Rule
Query (Maybe NotOrOnly -> MediaType -> [Feature] -> MediaQuery
MediaQuery Maybe NotOrOnly
forall a. Maybe a
Nothing MediaType
ty [Feature]
fs) (Css -> [Rule]
runS Css
rs)
queryNot :: MediaType -> [Feature] -> Css -> Css
queryNot :: MediaType -> [Feature] -> Css -> Css
queryNot MediaType
ty [Feature]
fs Css
rs = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ MediaQuery -> [Rule] -> Rule
Query (Maybe NotOrOnly -> MediaType -> [Feature] -> MediaQuery
MediaQuery (NotOrOnly -> Maybe NotOrOnly
forall a. a -> Maybe a
Just NotOrOnly
Not) MediaType
ty [Feature]
fs) (Css -> [Rule]
runS Css
rs)
queryOnly :: MediaType -> [Feature] -> Css -> Css
queryOnly :: MediaType -> [Feature] -> Css -> Css
queryOnly MediaType
ty [Feature]
fs Css
rs = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ MediaQuery -> [Rule] -> Rule
Query (Maybe NotOrOnly -> MediaType -> [Feature] -> MediaQuery
MediaQuery (NotOrOnly -> Maybe NotOrOnly
forall a. a -> Maybe a
Just NotOrOnly
Only) MediaType
ty [Feature]
fs) (Css -> [Rule]
runS Css
rs)
keyframes :: Text -> [(Double, Css)] -> Css
keyframes :: Text -> [(Double, Css)] -> Css
keyframes Text
n [(Double, Css)]
xs = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ Keyframes -> Rule
Keyframe (Text -> [(Double, [Rule])] -> Keyframes
Keyframes Text
n (((Double, Css) -> (Double, [Rule]))
-> [(Double, Css)] -> [(Double, [Rule])]
forall a b. (a -> b) -> [a] -> [b]
map ((Css -> [Rule]) -> (Double, Css) -> (Double, [Rule])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Css -> [Rule]
runS) [(Double, Css)]
xs))
keyframesFromTo :: Text -> Css -> Css -> Css
keyframesFromTo :: Text -> Css -> Css -> Css
keyframesFromTo Text
n Css
a Css
b = Text -> [(Double, Css)] -> Css
keyframes Text
n [(Double
0, Css
a), (Double
100, Css
b)]
fontFace :: Css -> Css
fontFace :: Css -> Css
fontFace Css
rs = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ [Rule] -> Rule
Face (Css -> [Rule]
runS Css
rs)
importUrl :: Text -> Css
importUrl :: Text -> Css
importUrl Text
l = Rule -> Css
rule (Rule -> Css) -> Rule -> Css
forall a b. (a -> b) -> a -> b
$ Text -> Rule
Import Text
l
important :: Css -> Css
important :: Css -> Css
important = (Rule -> Css) -> [Rule] -> Css
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Rule -> Css
rule (Rule -> Css) -> (Rule -> Rule) -> Rule -> Css
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule -> Rule
addImportant) ([Rule] -> Css) -> (Css -> [Rule]) -> Css -> Css
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> [Rule]
runS
addImportant :: Rule -> Rule
addImportant :: Rule -> Rule
addImportant (Property ms :: [Modifier]
ms@((Modifier -> Bool) -> [Modifier] -> [Modifier]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> (Modifier -> Maybe Text) -> Modifier -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modifier -> Maybe Text
_Important) -> (Modifier
_:[Modifier]
_)) Key ()
k Value
v) =
[Modifier] -> Key () -> Value -> Rule
Property [Modifier]
ms Key ()
k Value
v
addImportant (Property [Modifier]
ms Key ()
k Value
v ) = [Modifier] -> Key () -> Value -> Rule
Property (Modifier
Important Modifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
: [Modifier]
ms) Key ()
k Value
v
addImportant Rule
r = Rule
r