module Web.Atomic.CSS.Select where

import Web.Atomic.Types


{- | Apply when hovering over an element

> el ~ bg Primary . hover (bg PrimaryLight) $ "Hover"
-}
hover :: (Styleable h) => (CSS h -> CSS h) -> CSS h -> CSS h
hover :: forall h. Styleable h => (CSS h -> CSS h) -> CSS h -> CSS h
hover = Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
forall h.
Styleable h =>
Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
pseudo Pseudo
"hover"


-- | Apply when the mouse is pressed down on an element
active :: (Styleable h) => (CSS h -> CSS h) -> CSS h -> CSS h
active :: forall h. Styleable h => (CSS h -> CSS h) -> CSS h -> CSS h
active = Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
forall h.
Styleable h =>
Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
pseudo Pseudo
"active"


-- | Apply to even-numbered children
even :: (Styleable h) => (CSS h -> CSS h) -> CSS h -> CSS h
even :: forall h. Styleable h => (CSS h -> CSS h) -> CSS h -> CSS h
even = Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
forall h.
Styleable h =>
Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
pseudo (Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h)
-> Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
forall a b. (a -> b) -> a -> b
$ ClassName -> Selector -> Pseudo
Pseudo ClassName
"even" Selector
":nth-child(even)"


-- | Apply to odd-numbered children
odd :: (Styleable h) => (CSS h -> CSS h) -> CSS h -> CSS h
odd :: forall h. Styleable h => (CSS h -> CSS h) -> CSS h -> CSS h
odd = Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
forall h.
Styleable h =>
Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
pseudo (Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h)
-> Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
forall a b. (a -> b) -> a -> b
$ ClassName -> Selector -> Pseudo
Pseudo ClassName
"odd" Selector
":nth-child(odd)"


pseudo :: forall h. (Styleable h) => Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
pseudo :: forall h.
Styleable h =>
Pseudo -> (CSS h -> CSS h) -> CSS h -> CSS h
pseudo Pseudo
p CSS h -> CSS h
f CSS h
ss =
  (Rule -> Rule) -> CSS h -> CSS h
forall {k} (a :: k). (Rule -> Rule) -> CSS a -> CSS a
mapRules (Pseudo -> Rule -> Rule
addPseudo Pseudo
p) (CSS h -> CSS h
f CSS h
forall a. Monoid a => a
mempty) CSS h -> CSS h -> CSS h
forall a. Semigroup a => a -> a -> a
<> CSS h
ss


{- | Apply when the Media matches the current window. This allows for responsive designs

> el ~ width 100 . media (MinWidth 800) (width 400) $ do
>   "Big if window > 800"
-}
media :: (Styleable h) => Media -> (CSS h -> CSS h) -> CSS h -> CSS h
media :: forall h.
Styleable h =>
Media -> (CSS h -> CSS h) -> CSS h -> CSS h
media Media
m CSS h -> CSS h
f CSS h
ss =
  (Rule -> Rule) -> CSS h -> CSS h
forall {k} (a :: k). (Rule -> Rule) -> CSS a -> CSS a
mapRules (Media -> Rule -> Rule
addMedia Media
m) (CSS h -> CSS h
f CSS h
forall a. Monoid a => a
mempty) CSS h -> CSS h -> CSS h
forall a. Semigroup a => a -> a -> a
<> CSS h
ss


addPseudo :: Pseudo -> Rule -> Rule
addPseudo :: Pseudo -> Rule -> Rule
addPseudo Pseudo
p Rule
r = Rule
r{selector = r.selector <> GeneratedRule (addClassState p) (<> p.suffix)}


addMedia :: Media -> Rule -> Rule
addMedia :: Media -> Rule -> Rule
addMedia Media
m Rule
r =
  Rule
r
    { media = m : r.media
    , selector = r.selector <> GeneratedRule (addClassState m) id
    }


{- | Apply when this element is contained somewhere another element with the given class

> el ~ descendentOf "htmx-request" bold $ "Only bold when htmx is making a request"
-}
descendentOf :: (Styleable h) => ClassName -> (CSS h -> CSS h) -> CSS h -> CSS h
descendentOf :: forall h.
Styleable h =>
ClassName -> (CSS h -> CSS h) -> CSS h -> CSS h
descendentOf ClassName
c CSS h -> CSS h
f CSS h
ss =
  (Rule -> Rule) -> CSS h -> CSS h
forall {k} (a :: k). (Rule -> Rule) -> CSS a -> CSS a
mapRules (ClassName -> Rule -> Rule
addAncestor ClassName
c) (CSS h -> CSS h
f CSS h
forall a. Monoid a => a
mempty) CSS h -> CSS h -> CSS h
forall a. Semigroup a => a -> a -> a
<> CSS h
ss


addAncestor :: ClassName -> Rule -> Rule
addAncestor :: ClassName -> Rule -> Rule
addAncestor ClassName
cn Rule
r = Rule
r{selector = r.selector <> GeneratedRule (addClassState cn) (\Selector
s -> ClassName -> Selector
selector ClassName
cn Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> Selector
" " Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> Selector
s)}