module Web.Atomic.Types.Rule where

import Data.List qualified as L
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M
import Data.Maybe (isNothing)
import Data.String (IsString (..))
import Web.Atomic.Types.ClassName
import Web.Atomic.Types.Selector
import Web.Atomic.Types.Style


-- Rule: CSS Utility Classes  ------------------------------------------------

data Rule = Rule
  { Rule -> ClassName
className :: ClassName
  , Rule -> RuleSelector
selector :: RuleSelector
  , Rule -> [Media]
media :: [Media]
  , Rule -> [Declaration]
properties :: [Declaration]
  }
instance Eq Rule where
  Rule
r1 == :: Rule -> Rule -> Bool
== Rule
r2 = Rule -> Selector
ruleSelector Rule
r1 Selector -> Selector -> Bool
forall a. Eq a => a -> a -> Bool
== Rule -> Selector
ruleSelector Rule
r2
instance Ord Rule where
  Rule
r1 <= :: Rule -> Rule -> Bool
<= Rule
r2 = Rule -> Selector
ruleSelector Rule
r1 Selector -> Selector -> Bool
forall a. Ord a => a -> a -> Bool
<= Rule -> Selector
ruleSelector Rule
r2
instance IsString Rule where
  fromString :: String -> Rule
fromString String
s = ClassName -> Rule
fromClass (String -> ClassName
forall a. IsString a => String -> a
fromString String
s)


data RuleSelector
  = CustomRule Selector
  | GeneratedRule (ClassName -> ClassName) (Selector -> Selector)
instance Semigroup RuleSelector where
  CustomRule Selector
s1 <> :: RuleSelector -> RuleSelector -> RuleSelector
<> CustomRule Selector
s2 = Selector -> RuleSelector
CustomRule (Selector -> RuleSelector) -> Selector -> RuleSelector
forall a b. (a -> b) -> a -> b
$ Selector
s1 Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> Selector
s2
  GeneratedRule ClassName -> ClassName
c1 Selector -> Selector
s1 <> GeneratedRule ClassName -> ClassName
c2 Selector -> Selector
s2 = (ClassName -> ClassName) -> (Selector -> Selector) -> RuleSelector
GeneratedRule (ClassName -> ClassName
c2 (ClassName -> ClassName)
-> (ClassName -> ClassName) -> ClassName -> ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassName -> ClassName
c1) (Selector -> Selector
s2 (Selector -> Selector)
-> (Selector -> Selector) -> Selector -> Selector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> Selector
s1)
  -- ignore FromClass if CustomRule is set!
  CustomRule Selector
c <> RuleSelector
_ = Selector -> RuleSelector
CustomRule Selector
c
  RuleSelector
_ <> CustomRule Selector
c = Selector -> RuleSelector
CustomRule Selector
c
instance Monoid RuleSelector where
  mempty :: RuleSelector
mempty = (ClassName -> ClassName) -> (Selector -> Selector) -> RuleSelector
GeneratedRule ClassName -> ClassName
forall a. a -> a
id Selector -> Selector
forall a. a -> a
id


-- | An empty rule that only adds the classname
fromClass :: ClassName -> Rule
fromClass :: ClassName -> Rule
fromClass ClassName
cn = ClassName -> RuleSelector -> [Media] -> [Declaration] -> Rule
Rule ClassName
cn RuleSelector
forall a. Monoid a => a
mempty [Media]
forall a. Monoid a => a
mempty [Declaration]
forall a. Monoid a => a
mempty


rule :: ClassName -> [Declaration] -> Rule
rule :: ClassName -> [Declaration] -> Rule
rule ClassName
cn = ClassName -> RuleSelector -> [Media] -> [Declaration] -> Rule
Rule ClassName
cn RuleSelector
forall a. Monoid a => a
mempty [Media]
forall a. Monoid a => a
mempty


ruleMap :: [Rule] -> Map Selector Rule
ruleMap :: [Rule] -> Map Selector Rule
ruleMap = (Map Selector Rule -> Rule -> Map Selector Rule)
-> Map Selector Rule -> [Rule] -> Map Selector Rule
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\Map Selector Rule
m Rule
r -> Selector -> Rule -> Map Selector Rule -> Map Selector Rule
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Rule -> Selector
ruleSelector Rule
r) Rule
r Map Selector Rule
m) Map Selector Rule
forall k a. Map k a
M.empty


{- | Add a property to a class
addProp :: (ToStyleValue val) => Property -> val -> Rule -> Rule
addProp p v c =
  c{properties = Declaration p (toStyleValue v) : c.properties}
-}

-- mapSelector :: (Selector -> Selector) -> Rule -> Rule
-- mapSelector f c =
--   c
--     { selector = f c.selector
--     }

mapClassName :: (ClassName -> ClassName) -> Rule -> Rule
mapClassName :: (ClassName -> ClassName) -> Rule -> Rule
mapClassName ClassName -> ClassName
f Rule
c =
  Rule
c
    { className = f c.className
    }


uniqueRules :: [Rule] -> [Rule]
uniqueRules :: [Rule] -> [Rule]
uniqueRules [] = []
uniqueRules (Rule
r : [Rule]
rs) =
  Rule
r Rule -> [Rule] -> [Rule]
forall a. a -> [a] -> [a]
: Rule -> [Rule] -> [Rule]
replaceRules Rule
r ([Rule] -> [Rule]
uniqueRules [Rule]
rs)


replaceRules :: Rule -> [Rule] -> [Rule]
replaceRules :: Rule -> [Rule] -> [Rule]
replaceRules Rule
rnew [Rule]
rs =
  -- OVERRIDE RULES
  -- 1. if ANY property is set again, delete entire previous rule
  -- 2. if "manual" mode is set, pass it through!
  -- 3. if pseudo, media, etc, changes when these rules apply
  let ps :: [Property]
ps = Rule -> [Property]
ruleProperties Rule
rnew
   in (Rule -> Bool) -> [Rule] -> [Rule]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Rule -> Bool) -> Rule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Property] -> Rule -> Bool
matchesRule [Property]
ps) [Rule]
rs
 where
  matchesRule :: [Property] -> Rule -> Bool
matchesRule [Property]
ps Rule
r =
    ([Property] -> Rule -> Bool
hasAnyProperty [Property]
ps Rule
r Bool -> Bool -> Bool
|| Rule
rnew.className ClassName -> ClassName -> Bool
forall a. Eq a => a -> a -> Bool
== Rule
r.className)
      Bool -> Bool -> Bool
&& RuleSelector -> ClassName -> ClassName
ruleClassNameF Rule
rnew.selector ClassName
"" ClassName -> ClassName -> Bool
forall a. Eq a => a -> a -> Bool
== RuleSelector -> ClassName -> ClassName
ruleClassNameF Rule
r.selector ClassName
""
      Bool -> Bool -> Bool
&& Maybe Selector -> Bool
forall a. Maybe a -> Bool
isNothing (Rule -> Maybe Selector
ruleCustomSelector Rule
rnew)
      Bool -> Bool -> Bool
&& Maybe Selector -> Bool
forall a. Maybe a -> Bool
isNothing (Rule -> Maybe Selector
ruleCustomSelector Rule
r)


hasAnyProperty :: [Property] -> Rule -> Bool
hasAnyProperty :: [Property] -> Rule -> Bool
hasAnyProperty [Property]
ps Rule
r = (Property -> Bool) -> [Property] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Property -> Bool
hasProperty [Property]
ps
 where
  hasProperty :: Property -> Bool
  hasProperty :: Property -> Bool
hasProperty Property
p = Property
p Property -> [Property] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Rule -> [Property]
ruleProperties Rule
r


ruleProperties :: Rule -> [Property]
ruleProperties :: Rule -> [Property]
ruleProperties Rule
r =
  (Declaration -> Property) -> [Declaration] -> [Property]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Property
p :. Style
_) -> Property
p) Rule
r.properties


lookupRule :: ClassName -> [Rule] -> Maybe Rule
lookupRule :: ClassName -> [Rule] -> Maybe Rule
lookupRule ClassName
c = (Rule -> Bool) -> [Rule] -> Maybe Rule
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\Rule
r -> Rule
r.className ClassName -> ClassName -> Bool
forall a. Eq a => a -> a -> Bool
== ClassName
c)


ruleClassName :: Rule -> ClassName
ruleClassName :: Rule -> ClassName
ruleClassName Rule
r =
  RuleSelector -> ClassName -> ClassName
ruleClassNameF Rule
r.selector Rule
r.className


ruleClassNameF :: RuleSelector -> ClassName -> ClassName
ruleClassNameF :: RuleSelector -> ClassName -> ClassName
ruleClassNameF RuleSelector
rs =
  case RuleSelector
rs of
    CustomRule Selector
_ -> ClassName -> ClassName
forall a. a -> a
id
    GeneratedRule ClassName -> ClassName
f Selector -> Selector
_ -> ClassName -> ClassName
f


ruleSelector :: Rule -> Selector
ruleSelector :: Rule -> Selector
ruleSelector Rule
r =
  RuleSelector -> Selector -> Selector
ruleSelectorF Rule
r.selector (Selector -> Selector) -> Selector -> Selector
forall a b. (a -> b) -> a -> b
$ ClassName -> Selector
selector (ClassName -> Selector) -> ClassName -> Selector
forall a b. (a -> b) -> a -> b
$ Rule -> ClassName
ruleClassName Rule
r


ruleSelectorF :: RuleSelector -> Selector -> Selector
ruleSelectorF :: RuleSelector -> Selector -> Selector
ruleSelectorF RuleSelector
rs =
  case RuleSelector
rs of
    CustomRule Selector
s -> Selector -> Selector -> Selector
forall a b. a -> b -> a
const Selector
s
    GeneratedRule ClassName -> ClassName
_ Selector -> Selector
f -> Selector -> Selector
f


ruleCustomSelector :: Rule -> Maybe Selector
ruleCustomSelector :: Rule -> Maybe Selector
ruleCustomSelector Rule
r =
  case Rule
r.selector of
    CustomRule Selector
s -> Selector -> Maybe Selector
forall a. a -> Maybe a
Just Selector
s
    RuleSelector
_ -> Maybe Selector
forall a. Maybe a
Nothing