content: {-# LANGUAGE
      OverloadedStrings
    , FlexibleInstances
    , GeneralizedNewtypeDeriving
    , StandaloneDeriving
    , UndecidableInstances
    , ViewPatterns
    , PatternGuards
    #-}
  module Clay.Selector where
  
  import Data.String
  import Data.Text (Text)
  
  import qualified Data.Text as Text
  
  -- | The star selector applies to all elements. Maps to @*@ in CSS.
  
  star :: Selector
  star = In (SelectorF (Refinement []) Star)
  
  -- | Select elements by name. The preferred syntax is to enable
  -- @OverloadedStrings@ and actually just use @\"element-name\"@ or use one of
  -- the predefined elements from "Clay.Elements".
  
  element :: Text -> Selector
  element e = In (SelectorF (Refinement []) (Elem e))
  
  -- | Named alias for `**`.
  
  deep :: Selector -> Selector -> Selector
  deep a b = In (SelectorF (Refinement []) (Deep a b))
  
  -- | The deep selector composer. Maps to @sel1 sel2@ in CSS.
  
  (**) :: Selector -> Selector -> Selector
  (**) = deep
  
  -- | Named alias for `|>`.
  
  child :: Selector -> Selector -> Selector
  child a b = In (SelectorF (Refinement []) (Child a b))
  
  -- | The child selector composer. Maps to @sel1 > sel2@ in CSS.
  
  (|>) :: Selector -> Selector -> Selector
  (|>) = child
  
  -- | The adjacent selector composer. Maps to @sel1 + sel2@ in CSS.
  
  (|+) :: Selector -> Selector -> Selector
  (|+) a b = In (SelectorF (Refinement []) (Adjacent a b))
  
  -- | The general sibling selector composer. Maps to @sel1 ~ sel2@ in CSS.
  
  (|~) :: Selector -> Selector -> Selector
  (|~) a b = In (SelectorF (Refinement []) (Sibling a b))
  
  -- | Named alias for `#`.
  
  with :: Selector -> Refinement -> Selector
  with (In (SelectorF (Refinement fs) e)) (Refinement ps) = In (SelectorF (Refinement (fs ++ ps)) e)
  
  -- | The filter selector composer, adds a filter to a selector. Maps to
  -- something like @sel#filter@ or @sel.filter@ in CSS, depending on the filter.
  
  (#) :: Selector -> Refinement -> Selector
  (#) = with
  
  -- | Filter elements by id. The preferred syntax is to enable
  -- @OverloadedStrings@ and use @\"#id-name\"@.
  
  byId :: Text -> Refinement
  byId = Refinement . pure . Id
  
  -- | Filter elements by class. The preferred syntax is to enable
  -- @OverloadedStrings@ and use @\".class-name\"@.
  
  byClass :: Text -> Refinement
  byClass = Refinement . pure . Class
  
  -- | Filter elements by pseudo selector or pseudo class. The preferred syntax
  -- is to enable @OverloadedStrings@ and use @\":pseudo-selector\"@ or use one
  -- of the predefined ones from "Clay.Pseudo".
  
  pseudo :: Text -> Refinement
  pseudo = Refinement . pure . Pseudo
  
  -- | Filter elements by pseudo selector functions. The preferred way is to use
  -- one of the predefined functions from "Clay.Pseudo".
  
  func :: Text -> [Text] -> Refinement
  func f = Refinement . pure . PseudoFunc f
  
  -- | Filter elements based on the presence of a certain attribute. The
  -- preferred syntax is to enable @OverloadedStrings@ and use
  -- @\"\@attr\"@ or use one of the predefined ones from "Clay.Attributes".
  
  attr :: Text -> Refinement
  attr = Refinement . pure . Attr
  
  -- | Filter elements based on the presence of a certain attribute with the
  -- specified value.
  
  (@=) :: Text -> Text -> Refinement
  (@=) a = Refinement . pure . AttrVal a
  
  -- | Filter elements based on the presence of a certain attribute that begins
  -- with the selected value.
  
  (^=) :: Text -> Text -> Refinement
  (^=) a = Refinement . pure . AttrBegins a
  
  -- | Filter elements based on the presence of a certain attribute that ends
  -- with the specified value.
  
  ($=) :: Text -> Text -> Refinement
  ($=) a = Refinement . pure . AttrEnds a
  
  -- | Filter elements based on the presence of a certain attribute that contains
  -- the specified value as a substring.
  
  (*=) :: Text -> Text -> Refinement
  (*=) a = Refinement . pure . AttrContains a
  
  -- | Filter elements based on the presence of a certain attribute that have the
  -- specified value contained in a space separated list.
  
  (~=) :: Text -> Text -> Refinement
  (~=) a = Refinement . pure . AttrSpace a
  
  -- | Filter elements based on the presence of a certain attribute that have the
  -- specified value contained in a hyphen separated list.
  
  (|=) :: Text -> Text -> Refinement
  (|=) a = Refinement . pure . AttrHyph a
  
  
  -------------------------------------------------------------------------------
  
  data Predicate
    = Id           Text
    | Class        Text
    | Attr         Text
    | AttrVal      Text Text
    | AttrBegins   Text Text
    | AttrEnds     Text Text
    | AttrContains Text Text
    | AttrSpace    Text Text
    | AttrHyph     Text Text
    | Pseudo       Text
    | PseudoFunc   Text [Text]
    | PseudoElem   Text
    deriving (Eq, Ord, Show)
  
  newtype Refinement = Refinement { unFilter :: [Predicate] }
    deriving (Show, Semigroup, Monoid)
  
  instance IsString Refinement where
    fromString = refinementFromText . fromString
  
  refinementFromText :: Text -> Refinement
  refinementFromText t = Refinement $
    case Text.uncons t of
      Just ('#', s) -> [Id     s]
      Just ('.', s) -> [Class  s]
      Just (':', s)
        | Just (':',s') <- Text.uncons s
                    -> [PseudoElem s']
        | otherwise -> [Pseudo s]
      Just ('@', s) -> [Attr   s]
      _             -> [Attr   t]
  
  -------------------------------------------------------------------------------
  
  data Path f
    = Star
    | Elem      Text
    | Child     f f
    | Deep      f f
    | Adjacent  f f
    | Sibling   f f
    | Combined  f f
    deriving Show
  
  newtype Fix f = In { out :: f (Fix f) }
  
  deriving instance Show (f (Fix f)) => Show (Fix f)
  
  data SelectorF a = SelectorF Refinement (Path a)
    deriving Show
  
  type Selector = Fix SelectorF
  
  instance IsString (Fix SelectorF) where
    fromString = selectorFromText . fromString
  
  selectorFromText :: Text -> Selector
  selectorFromText t =
    case Text.uncons t of
      Just (c, _) | elem c ("#.:@" :: [Char])
        -> with star (refinementFromText t)
      _ -> In $ SelectorF (Refinement []) (Elem t)
  
  instance Semigroup (Fix SelectorF) where
    a <> b = In (SelectorF (Refinement []) (Combined a b))
  
  instance Monoid (Fix SelectorF) where
    mempty  = error "Selector is a semigroup"
    mappend = (<>)
  