Rule.hs

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
  { className :: ClassName
  , selector :: RuleSelector
  , media :: [Media]
  , properties :: [Declaration]
  }
instance Eq Rule where
  r1 == r2 = ruleSelector r1 == ruleSelector r2
instance Ord Rule where
  r1 <= r2 = ruleSelector r1 <= ruleSelector r2
instance IsString Rule where
  fromString s = fromClass (fromString s)


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


-- | An empty rule that only adds the classname
fromClass :: ClassName -> Rule
fromClass cn = Rule cn mempty mempty mempty


rule :: ClassName -> [Declaration] -> Rule
rule cn = Rule cn mempty mempty


ruleMap :: [Rule] -> Map Selector Rule
ruleMap = L.foldl' (\m r -> M.insert (ruleSelector r) r m) 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 f c =
  c
    { className = f c.className
    }


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


replaceRules :: Rule -> [Rule] -> [Rule]
replaceRules rnew 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 = ruleProperties rnew
   in filter (not . matchesRule ps) rs
 where
  matchesRule ps r =
    (hasAnyProperty ps r || rnew.className == r.className)
      && ruleClassNameF rnew.selector "" == ruleClassNameF r.selector ""
      && isNothing (ruleCustomSelector rnew)
      && isNothing (ruleCustomSelector r)


hasAnyProperty :: [Property] -> Rule -> Bool
hasAnyProperty ps r = any hasProperty ps
 where
  hasProperty :: Property -> Bool
  hasProperty p = p `elem` ruleProperties r


ruleProperties :: Rule -> [Property]
ruleProperties r =
  fmap (\(p :. _) -> p) r.properties


lookupRule :: ClassName -> [Rule] -> Maybe Rule
lookupRule c = L.find (\r -> r.className == c)


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


ruleClassNameF :: RuleSelector -> ClassName -> ClassName
ruleClassNameF rs =
  case rs of
    CustomRule _ -> id
    GeneratedRule f _ -> f


ruleSelector :: Rule -> Selector
ruleSelector r =
  ruleSelectorF r.selector $ selector $ ruleClassName r


ruleSelectorF :: RuleSelector -> Selector -> Selector
ruleSelectorF rs =
  case rs of
    CustomRule s -> const s
    GeneratedRule _ f -> f


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