Rule.hs

module CssParser.Rule where

import CssParser.At.Container ( ContainerQueryMap )
import CssParser.At.CustomMedia ( CustomMediaQuery )
import CssParser.At.FontFeatureValues ( FontFeatureValues )
import CssParser.At.FontPaletteValues ( FontPaletteValues )
import CssParser.At.Function ( Function )
import CssParser.At.Import ( Import )
import CssParser.At.Keyframe ( KeyframeSet, PropEntry )
import CssParser.At.MediaQuery ( MediaQueryList )
import CssParser.At.Page ( PageMargin, PageSelectorList )
import CssParser.At.Supports qualified as S
import CssParser.Descriptor (Descriptor)
import CssParser.Ident
import CssParser.MonoPair ( MonoPair )
import CssParser.Parser.Monad ( P(Failed) )
import CssParser.Prelude
import CssParser.Rule.Pseudo
    ( AtomicPseudoClass(UnknownPc),
      BrowserSpecificIdent(BrowserSpecificIdent),
      PseudoElement,
      Language )
import CssParser.Rule.Value
    ( CommaSeparatedList,
      PropVals,
      PropValsList,
      Source,
      Unsigned,
      NthFormula )
import CssParser.Show ( toCssStr, CslNe, Embraced, SslNe )


type SelectorList = NonEmpty Selector
type FeatureQuery = S.FeatureQuery SelectorList

data CssRule
  = CssRule SelectorList [CssRuleBodyItem]
  | AtRule BrowserPrefix AtRule
  deriving (Show, Ord, Eq, Generic)

data AtRule
  = CharsetStmt Charset
  | ColorProfile PropertyName [CssRuleBodyItem]
  | Container ContainerQueryMap [CssRuleBodyItem]
  | CounterStyle Ident [CssRuleBodyItem]
  | CustomMedia Var CustomMediaQuery
  | FontFaceBlock [CssRuleBodyItem]
  | FontFeatureValuesBlock FontFeatureValues
  | FontPaletteValuesBlock FontPaletteValues
  | FunctionBlock CssFunction
  | ImportStmt (Import SelectorList)
  | Keyframes KeyframeSet
  | LayerBlock (Maybe LayerName) [CssRuleBodyItem]
  | LayerStmt (NonEmpty LayerName)
  | MediaRule MediaQueryList [CssRuleBodyItem]
  | Mixin Ident
  | CustomSelector CustomSelectorName SelectorList
  | DefineMixin Ident [CssRuleBodyItem]
  | Namespace (Maybe Ident) Source
  | Page PageSelectorList [CssRuleBodyItem]
  | PageMarginBlock PageMargin [CssRuleBodyItem]
  | PositionTry Var [PropEntry]
  | Property Var [CssRuleBodyItem]
  | ScopeBlock (MonoPair SelectorList) [CssRuleBodyItem]
  | StartingStyle [CssRuleBodyItem]
  | Supports FeatureQuery [CssRuleBodyItem]
  | UnknownGramma Ident (Maybe CommaSeparatedList) [CssRuleBodyItem]
  | ViewTransition [CssRuleBodyItem]
  deriving (Show, Ord, Eq, Generic)

type CssFunction = Function CssRule

data Selector
  = Selector (Maybe TagRelation) TagSelector [(TagRelation, TagSelector)]
  | PeSelector (Maybe TagRelation) TagSelector [(TagRelation, TagSelector)] PseudeTagSelector
  | PeSelectorOnly PseudeTagSelector
  deriving (Eq, Ord, Show, Generic)

instance GEnum Selector where
  genum = []

data PseudeTagSelector
  = PseudeTagSelector
  { ptagName :: CompositePe
  , ptagSubs :: [TagSubSelector]
  } deriving (Eq, Ord, Show, Generic)

data CompositePe
  = AtomicPe PseudoElement
  | Highlight (Embraced Ident)
  | Part (Embraced (SslNe Ident))
  | Picker (Embraced Ident)
  | ScrollButton (Embraced TagName)
  | Slotted (Embraced SelectorList)
  | ViewTransitionGroup (Embraced SelectorList)
  | ViewTransitionImagePair (Embraced SelectorList)
  | ViewTransitionNew (Embraced SelectorList)
  | ViewTransitionOld (Embraced SelectorList)
  deriving (Eq, Ord, Show, Generic)

data TagRelation
  = Descendant
  | Child
  | NextSibling
  | GeneralSibling
  deriving (Bounded, Enum, Eq, Ord, Show, Generic)

data TagSelector
  = TagSelector
  { tagNs :: Namespace
  , tagName :: TagName
  , tagSubSelectors :: [ TagSubSelector ]
  } deriving (Show, Ord, Eq, Generic)

mkUnknownPseudoF :: AtomicPseudoClass -> SelectorList -> P TagSubSelector
mkUnknownPseudoF pc sel =
  case pc of
    UnknownPc (BrowserSpecificIdent i) ->
      pure $ UnknownPseudoF i sel
    o -> Failed $ "Expected unknown pseudo class but got " <> toCssStr o

data TagSubSelector
  = AtomicClass { unClass :: Ident }
  | AtomicPseudoClass AtomicPseudoClass
  | UnknownPseudoF Ident SelectorList
  | NotClass SelectorList
  | Lang Language
  | Global SelectorList
  | Where SelectorList
  | Has SelectorList
  | Is SelectorList
  | NthChild NthFormula (Maybe TagSelector)
  | NthLastChild NthFormula (Maybe TagSelector)
  | NthLastOfType NthFormula
  | NthOfType NthFormula
  | ActiveViewTransitionType (Embraced (CslNe Ident))
  | Dir (Embraced Ident)
  | Heading (Embraced (CslNe Unsigned))
  | Host (Embraced SelectorList)
  | State (Embraced Ident)
  | HasAttr AttrName
  | Attr AttrName AttrOp (Maybe AtrPat)
  | Hash Ident
  deriving (Eq, Ord, Show, Generic)

data CssRuleBodyItem
  = CssLeafRule Descriptor PropVals
  | CssEnumLeaf Descriptor PropValsList
  | CssNestedRule CssRule
  deriving (Show, Ord, Eq, Generic)

data AtrPat
  = StrAtrPat Text (Maybe CaseSensetivity)
  | IdtAtrPat Ident (Maybe CaseSensetivity)
  deriving (Show, Eq, Ord, Generic)

data AttrOp =
      Exact -- ^ exactly the value of the value, denoted with @=@
    | Include -- ^ whitespace separated list of items, one of these items is the value, denoted with @~=@
    | DashMatch -- ^ hyphen separated list of items, the first item is the value, denoted with @|=@
    | PrefixMatch -- ^ prefix of the value in the attribute, denoted with @^=@
    | SuffixMatch -- ^ suffix of the value in the attribute, denoted with @$=@
    | SubstringMatch -- ^ substring of the value in the attribute, denoted with @*=@
    deriving (Bounded, Enum, Eq, Ord, Show, Generic)