module Web.Atomic.Types.Styleable where

import Web.Atomic.Types.ClassName
import Web.Atomic.Types.Rule as Rule
import Web.Atomic.Types.Selector
import Web.Atomic.Types.Style


class Styleable h where
  -- | Apply a CSS utility to some html
  --
  -- > el ~ bold . border 1 $ "styled"
  -- > el "styled" ~ bold . border 1
  -- > el "not styled"
  (~) :: h -> (CSS h -> CSS h) -> h
  h
h ~ CSS h -> CSS h
f =
    (([Rule] -> [Rule]) -> h -> h) -> h -> ([Rule] -> [Rule]) -> h
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Rule] -> [Rule]) -> h -> h
forall h. Styleable h => ([Rule] -> [Rule]) -> h -> h
modCSS h
h (([Rule] -> [Rule]) -> h) -> ([Rule] -> [Rule]) -> h
forall a b. (a -> b) -> a -> b
$ \[Rule]
rs ->
      let CSS [Rule]
new = CSS h -> CSS h
f (CSS h -> CSS h) -> CSS h -> CSS h
forall a b. (a -> b) -> a -> b
$ [Rule] -> CSS h
forall {k} (h :: k). [Rule] -> CSS h
CSS [Rule]
rs
       in [Rule] -> [Rule]
uniqueRules [Rule]
new


  modCSS :: ([Rule] -> [Rule]) -> h -> h


infixl 5 ~


instance {-# OVERLAPPABLE #-} (Styleable a, Styleable b) => Styleable (a -> b) where
  (~) :: (a -> b) -> (CSS (a -> b) -> CSS (a -> b)) -> (a -> b)
  a -> b
hh ~ :: (a -> b) -> (CSS (a -> b) -> CSS (a -> b)) -> a -> b
~ CSS (a -> b) -> CSS (a -> b)
f = \a
content ->
    a -> b
hh a
content b -> (CSS b -> CSS b) -> b
forall h. Styleable h => h -> (CSS h -> CSS h) -> h
~ \(CSS [Rule]
m) ->
      let CSS [Rule]
m2 = CSS (a -> b) -> CSS (a -> b)
f (CSS (a -> b) -> CSS (a -> b)) -> CSS (a -> b) -> CSS (a -> b)
forall a b. (a -> b) -> a -> b
$ [Rule] -> CSS (a -> b)
forall {k} (h :: k). [Rule] -> CSS h
CSS [Rule]
m
       in [Rule] -> CSS b
forall {k} (h :: k). [Rule] -> CSS h
CSS [Rule]
m2


  modCSS :: ([Rule] -> [Rule]) -> (a -> b) -> a -> b
modCSS [Rule] -> [Rule]
r a -> b
hh a
content =
    ([Rule] -> [Rule]) -> b -> b
forall h. Styleable h => ([Rule] -> [Rule]) -> h -> h
modCSS [Rule] -> [Rule]
r (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ a -> b
hh a
content


instance Styleable [Rule] where
  modCSS :: ([Rule] -> [Rule]) -> [Rule] -> [Rule]
modCSS [Rule] -> [Rule]
f = [Rule] -> [Rule]
f


instance Styleable (CSS h) where
  modCSS :: ([Rule] -> [Rule]) -> CSS h -> CSS h
modCSS [Rule] -> [Rule]
f (CSS [Rule]
rs) = [Rule] -> CSS h
forall {k} (h :: k). [Rule] -> CSS h
CSS ([Rule] -> CSS h) -> [Rule] -> CSS h
forall a b. (a -> b) -> a -> b
$ [Rule] -> [Rule]
f [Rule]
rs


newtype CSS h = CSS {forall {k} (h :: k). CSS h -> [Rule]
rules :: [Rule]}
  deriving newtype (Semigroup (CSS h)
CSS h
Semigroup (CSS h) =>
CSS h
-> (CSS h -> CSS h -> CSS h)
-> ([CSS h] -> CSS h)
-> Monoid (CSS h)
[CSS h] -> CSS h
CSS h -> CSS h -> CSS h
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall k (h :: k). Semigroup (CSS h)
forall k (h :: k). CSS h
forall k (h :: k). [CSS h] -> CSS h
forall k (h :: k). CSS h -> CSS h -> CSS h
$cmempty :: forall k (h :: k). CSS h
mempty :: CSS h
$cmappend :: forall k (h :: k). CSS h -> CSS h -> CSS h
mappend :: CSS h -> CSS h -> CSS h
$cmconcat :: forall k (h :: k). [CSS h] -> CSS h
mconcat :: [CSS h] -> CSS h
Monoid, NonEmpty (CSS h) -> CSS h
CSS h -> CSS h -> CSS h
(CSS h -> CSS h -> CSS h)
-> (NonEmpty (CSS h) -> CSS h)
-> (forall b. Integral b => b -> CSS h -> CSS h)
-> Semigroup (CSS h)
forall b. Integral b => b -> CSS h -> CSS h
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall k (h :: k). NonEmpty (CSS h) -> CSS h
forall k (h :: k). CSS h -> CSS h -> CSS h
forall k (h :: k) b. Integral b => b -> CSS h -> CSS h
$c<> :: forall k (h :: k). CSS h -> CSS h -> CSS h
<> :: CSS h -> CSS h -> CSS h
$csconcat :: forall k (h :: k). NonEmpty (CSS h) -> CSS h
sconcat :: NonEmpty (CSS h) -> CSS h
$cstimes :: forall k (h :: k) b. Integral b => b -> CSS h -> CSS h
stimes :: forall b. Integral b => b -> CSS h -> CSS h
Semigroup)


mapRules :: (Rule -> Rule) -> CSS a -> CSS a
mapRules :: forall {k} (a :: k). (Rule -> Rule) -> CSS a -> CSS a
mapRules Rule -> Rule
f (CSS [Rule]
rs) = [Rule] -> CSS a
forall {k} (h :: k). [Rule] -> CSS h
CSS ([Rule] -> CSS a) -> [Rule] -> CSS a
forall a b. (a -> b) -> a -> b
$ (Rule -> Rule) -> [Rule] -> [Rule]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rule -> Rule
f [Rule]
rs


{- | Create an atomic CSS utility. These are classes that set a single property, allowing you to compose styles like functions

@
bold :: 'Styleable' h => 'CSS' h -> 'CSS' h
bold = utility "bold" ["font-weight" :. "bold"]

pad :: 'Styleable' h => 'PxRem' -> 'CSS' h -> 'CSS' h
pad px = utility ("pad" -. px) ["padding" :. 'style' px]

example = el ~ bold . pad 10 $ "Padded and bold"
@
-}
utility :: (Styleable h) => ClassName -> [Declaration] -> CSS h -> CSS h
utility :: forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility ClassName
cn [Declaration]
ds (CSS [Rule]
rs) =
  [Rule] -> CSS h
forall {k} (h :: k). [Rule] -> CSS h
CSS ([Rule] -> CSS h) -> [Rule] -> CSS h
forall a b. (a -> b) -> a -> b
$ ClassName -> [Declaration] -> Rule
rule ClassName
cn [Declaration]
ds Rule -> [Rule] -> [Rule]
forall a. a -> [a] -> [a]
: [Rule]
rs


{- | Apply a class name with no styles. Useful for external CSS

> el ~ cls "parent" $ do
>   el ~ cls "item" $ "one"
>   el ~ cls "item" $ "two"
-}
cls :: (Styleable h) => ClassName -> CSS h -> CSS h
cls :: forall h. Styleable h => ClassName -> CSS h -> CSS h
cls ClassName
cn (CSS [Rule]
rs) =
  [Rule] -> CSS h
forall {k} (h :: k). [Rule] -> CSS h
CSS ([Rule] -> CSS h) -> [Rule] -> CSS h
forall a b. (a -> b) -> a -> b
$ ClassName -> Rule
Rule.fromClass ClassName
cn Rule -> [Rule] -> [Rule]
forall a. a -> [a] -> [a]
: [Rule]
rs


{- | Embed CSS with a custom selector and apply it to an element. Modifiers like 'hover' will ignore this

> listItems =
>   css
>     "list"
>     ".list > .item"
>     [ "display" :. "list-item"
>     , "list-style" :. "square"
>     ]
>
> example = do
>   el ~ listItems $ do
>     el ~ cls "item" $ "one"
>     el ~ cls "item" $ "two"
>     el ~ cls "item" $ "three"
-}
css :: (Styleable h) => ClassName -> Selector -> [Declaration] -> CSS h -> CSS h
css :: forall h.
Styleable h =>
ClassName -> Selector -> [Declaration] -> CSS h -> CSS h
css ClassName
cn Selector
sel [Declaration]
ds (CSS [Rule]
rs) =
  [Rule] -> CSS h
forall {k} (h :: k). [Rule] -> CSS h
CSS ([Rule] -> CSS h) -> [Rule] -> CSS h
forall a b. (a -> b) -> a -> b
$ ClassName -> RuleSelector -> [Media] -> [Declaration] -> Rule
Rule ClassName
cn (Selector -> RuleSelector
CustomRule Selector
sel) [Media]
forall a. Monoid a => a
mempty [Declaration]
ds Rule -> [Rule] -> [Rule]
forall a. a -> [a] -> [a]
: [Rule]
rs


-- | Get all the rules for combined utilities
rules :: (CSS [Rule] -> CSS [Rule]) -> [Rule]
rules :: (CSS [Rule] -> CSS [Rule]) -> [Rule]
rules CSS [Rule] -> CSS [Rule]
f =
  let CSS [Rule]
rs = CSS [Rule] -> CSS [Rule]
f CSS [Rule]
forall a. Monoid a => a
mempty
   in [Rule]
rs


-- | Get all the declarations for a utility or combination of them
declarations :: (CSS [Rule] -> CSS [Rule]) -> [Declaration]
declarations :: (CSS [Rule] -> CSS [Rule]) -> [Declaration]
declarations CSS [Rule] -> CSS [Rule]
f =
  [[Declaration]] -> [Declaration]
forall a. Monoid a => [a] -> a
mconcat ([[Declaration]] -> [Declaration])
-> [[Declaration]] -> [Declaration]
forall a b. (a -> b) -> a -> b
$ (Rule -> [Declaration]) -> [Rule] -> [[Declaration]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.properties) ((CSS [Rule] -> CSS [Rule]) -> [Rule]
rules CSS [Rule] -> CSS [Rule]
f)