{-# 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 :: Selector
star = SelectorF Selector -> Selector
forall (f :: * -> *). f (Fix f) -> Fix f
In (Refinement -> Path Selector -> SelectorF Selector
forall a. Refinement -> Path a -> SelectorF a
SelectorF ([Predicate] -> Refinement
Refinement []) Path Selector
forall f. Path f
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 :: Text -> Selector
element Text
e = SelectorF Selector -> Selector
forall (f :: * -> *). f (Fix f) -> Fix f
In (Refinement -> Path Selector -> SelectorF Selector
forall a. Refinement -> Path a -> SelectorF a
SelectorF ([Predicate] -> Refinement
Refinement []) (Text -> Path Selector
forall f. Text -> Path f
Elem Text
e))

-- | Named alias for `**`.

deep :: Selector -> Selector -> Selector
deep :: Selector -> Selector -> Selector
deep Selector
a Selector
b = SelectorF Selector -> Selector
forall (f :: * -> *). f (Fix f) -> Fix f
In (Refinement -> Path Selector -> SelectorF Selector
forall a. Refinement -> Path a -> SelectorF a
SelectorF ([Predicate] -> Refinement
Refinement []) (Selector -> Selector -> Path Selector
forall f. f -> f -> Path f
Deep Selector
a Selector
b))

-- | The deep selector composer. Maps to @sel1 sel2@ in CSS.

(**) :: Selector -> Selector -> Selector
** :: Selector -> Selector -> Selector
(**) = Selector -> Selector -> Selector
deep

-- | Named alias for `|>`.

child :: Selector -> Selector -> Selector
child :: Selector -> Selector -> Selector
child Selector
a Selector
b = SelectorF Selector -> Selector
forall (f :: * -> *). f (Fix f) -> Fix f
In (Refinement -> Path Selector -> SelectorF Selector
forall a. Refinement -> Path a -> SelectorF a
SelectorF ([Predicate] -> Refinement
Refinement []) (Selector -> Selector -> Path Selector
forall f. f -> f -> Path f
Child Selector
a Selector
b))

-- | The child selector composer. Maps to @sel1 > sel2@ in CSS.

(|>) :: Selector -> Selector -> Selector
|> :: Selector -> Selector -> Selector
(|>) = Selector -> Selector -> Selector
child

-- | The adjacent selector composer. Maps to @sel1 + sel2@ in CSS.

(|+) :: Selector -> Selector -> Selector
|+ :: Selector -> Selector -> Selector
(|+) Selector
a Selector
b = SelectorF Selector -> Selector
forall (f :: * -> *). f (Fix f) -> Fix f
In (Refinement -> Path Selector -> SelectorF Selector
forall a. Refinement -> Path a -> SelectorF a
SelectorF ([Predicate] -> Refinement
Refinement []) (Selector -> Selector -> Path Selector
forall f. f -> f -> Path f
Adjacent Selector
a Selector
b))

-- | The general sibling selector composer. Maps to @sel1 ~ sel2@ in CSS.

(|~) :: Selector -> Selector -> Selector
|~ :: Selector -> Selector -> Selector
(|~) Selector
a Selector
b = SelectorF Selector -> Selector
forall (f :: * -> *). f (Fix f) -> Fix f
In (Refinement -> Path Selector -> SelectorF Selector
forall a. Refinement -> Path a -> SelectorF a
SelectorF ([Predicate] -> Refinement
Refinement []) (Selector -> Selector -> Path Selector
forall f. f -> f -> Path f
Sibling Selector
a Selector
b))

-- | Named alias for `#`.

with :: Selector -> Refinement -> Selector
with :: Selector -> Refinement -> Selector
with (In (SelectorF (Refinement [Predicate]
fs) Path Selector
e)) (Refinement [Predicate]
ps) = SelectorF Selector -> Selector
forall (f :: * -> *). f (Fix f) -> Fix f
In (Refinement -> Path Selector -> SelectorF Selector
forall a. Refinement -> Path a -> SelectorF a
SelectorF ([Predicate] -> Refinement
Refinement ([Predicate]
fs [Predicate] -> [Predicate] -> [Predicate]
forall a. [a] -> [a] -> [a]
++ [Predicate]
ps)) Path Selector
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
# :: Selector -> Refinement -> Selector
(#) = Selector -> Refinement -> Selector
with

-- | Filter elements by id. The preferred syntax is to enable
-- @OverloadedStrings@ and use @\"#id-name\"@.

byId :: Text -> Refinement
byId :: Text -> Refinement
byId = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement)
-> (Text -> [Predicate]) -> Text -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> [Predicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Predicate -> [Predicate])
-> (Text -> Predicate) -> Text -> [Predicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Predicate
Id

-- | Filter elements by class. The preferred syntax is to enable
-- @OverloadedStrings@ and use @\".class-name\"@.

byClass :: Text -> Refinement
byClass :: Text -> Refinement
byClass = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement)
-> (Text -> [Predicate]) -> Text -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> [Predicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Predicate -> [Predicate])
-> (Text -> Predicate) -> Text -> [Predicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Predicate
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 :: Text -> Refinement
pseudo = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement)
-> (Text -> [Predicate]) -> Text -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> [Predicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Predicate -> [Predicate])
-> (Text -> Predicate) -> Text -> [Predicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Predicate
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 :: Text -> [Text] -> Refinement
func Text
f = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement)
-> ([Text] -> [Predicate]) -> [Text] -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> [Predicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Predicate -> [Predicate])
-> ([Text] -> Predicate) -> [Text] -> [Predicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Predicate
PseudoFunc Text
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 :: Text -> Refinement
attr = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement)
-> (Text -> [Predicate]) -> Text -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> [Predicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Predicate -> [Predicate])
-> (Text -> Predicate) -> Text -> [Predicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Predicate
Attr

-- | Filter elements based on the presence of a certain attribute with the
-- specified value.

(@=) :: Text -> Text -> Refinement
@= :: Text -> Text -> Refinement
(@=) Text
a = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement)
-> (Text -> [Predicate]) -> Text -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> [Predicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Predicate -> [Predicate])
-> (Text -> Predicate) -> Text -> [Predicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Predicate
AttrVal Text
a

-- | Filter elements based on the presence of a certain attribute that begins
-- with the selected value.

(^=) :: Text -> Text -> Refinement
^= :: Text -> Text -> Refinement
(^=) Text
a = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement)
-> (Text -> [Predicate]) -> Text -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> [Predicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Predicate -> [Predicate])
-> (Text -> Predicate) -> Text -> [Predicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Predicate
AttrBegins Text
a

-- | Filter elements based on the presence of a certain attribute that ends
-- with the specified value.

($=) :: Text -> Text -> Refinement
$= :: Text -> Text -> Refinement
($=) Text
a = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement)
-> (Text -> [Predicate]) -> Text -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> [Predicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Predicate -> [Predicate])
-> (Text -> Predicate) -> Text -> [Predicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Predicate
AttrEnds Text
a

-- | Filter elements based on the presence of a certain attribute that contains
-- the specified value as a substring.

(*=) :: Text -> Text -> Refinement
*= :: Text -> Text -> Refinement
(*=) Text
a = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement)
-> (Text -> [Predicate]) -> Text -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> [Predicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Predicate -> [Predicate])
-> (Text -> Predicate) -> Text -> [Predicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Predicate
AttrContains Text
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
~= :: Text -> Text -> Refinement
(~=) Text
a = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement)
-> (Text -> [Predicate]) -> Text -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> [Predicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Predicate -> [Predicate])
-> (Text -> Predicate) -> Text -> [Predicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Predicate
AttrSpace Text
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
|= :: Text -> Text -> Refinement
(|=) Text
a = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement)
-> (Text -> [Predicate]) -> Text -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> [Predicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Predicate -> [Predicate])
-> (Text -> Predicate) -> Text -> [Predicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Predicate
AttrHyph Text
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 (Predicate -> Predicate -> Bool
(Predicate -> Predicate -> Bool)
-> (Predicate -> Predicate -> Bool) -> Eq Predicate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Predicate -> Predicate -> Bool
$c/= :: Predicate -> Predicate -> Bool
== :: Predicate -> Predicate -> Bool
$c== :: Predicate -> Predicate -> Bool
Eq, Eq Predicate
Eq Predicate
-> (Predicate -> Predicate -> Ordering)
-> (Predicate -> Predicate -> Bool)
-> (Predicate -> Predicate -> Bool)
-> (Predicate -> Predicate -> Bool)
-> (Predicate -> Predicate -> Bool)
-> (Predicate -> Predicate -> Predicate)
-> (Predicate -> Predicate -> Predicate)
-> Ord Predicate
Predicate -> Predicate -> Bool
Predicate -> Predicate -> Ordering
Predicate -> Predicate -> Predicate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Predicate -> Predicate -> Predicate
$cmin :: Predicate -> Predicate -> Predicate
max :: Predicate -> Predicate -> Predicate
$cmax :: Predicate -> Predicate -> Predicate
>= :: Predicate -> Predicate -> Bool
$c>= :: Predicate -> Predicate -> Bool
> :: Predicate -> Predicate -> Bool
$c> :: Predicate -> Predicate -> Bool
<= :: Predicate -> Predicate -> Bool
$c<= :: Predicate -> Predicate -> Bool
< :: Predicate -> Predicate -> Bool
$c< :: Predicate -> Predicate -> Bool
compare :: Predicate -> Predicate -> Ordering
$ccompare :: Predicate -> Predicate -> Ordering
$cp1Ord :: Eq Predicate
Ord, Int -> Predicate -> ShowS
[Predicate] -> ShowS
Predicate -> String
(Int -> Predicate -> ShowS)
-> (Predicate -> String)
-> ([Predicate] -> ShowS)
-> Show Predicate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Predicate] -> ShowS
$cshowList :: [Predicate] -> ShowS
show :: Predicate -> String
$cshow :: Predicate -> String
showsPrec :: Int -> Predicate -> ShowS
$cshowsPrec :: Int -> Predicate -> ShowS
Show)

newtype Refinement = Refinement { Refinement -> [Predicate]
unFilter :: [Predicate] }
  deriving (Int -> Refinement -> ShowS
[Refinement] -> ShowS
Refinement -> String
(Int -> Refinement -> ShowS)
-> (Refinement -> String)
-> ([Refinement] -> ShowS)
-> Show Refinement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Refinement] -> ShowS
$cshowList :: [Refinement] -> ShowS
show :: Refinement -> String
$cshow :: Refinement -> String
showsPrec :: Int -> Refinement -> ShowS
$cshowsPrec :: Int -> Refinement -> ShowS
Show, b -> Refinement -> Refinement
NonEmpty Refinement -> Refinement
Refinement -> Refinement -> Refinement
(Refinement -> Refinement -> Refinement)
-> (NonEmpty Refinement -> Refinement)
-> (forall b. Integral b => b -> Refinement -> Refinement)
-> Semigroup Refinement
forall b. Integral b => b -> Refinement -> Refinement
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Refinement -> Refinement
$cstimes :: forall b. Integral b => b -> Refinement -> Refinement
sconcat :: NonEmpty Refinement -> Refinement
$csconcat :: NonEmpty Refinement -> Refinement
<> :: Refinement -> Refinement -> Refinement
$c<> :: Refinement -> Refinement -> Refinement
Semigroup, Semigroup Refinement
Refinement
Semigroup Refinement
-> Refinement
-> (Refinement -> Refinement -> Refinement)
-> ([Refinement] -> Refinement)
-> Monoid Refinement
[Refinement] -> Refinement
Refinement -> Refinement -> Refinement
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Refinement] -> Refinement
$cmconcat :: [Refinement] -> Refinement
mappend :: Refinement -> Refinement -> Refinement
$cmappend :: Refinement -> Refinement -> Refinement
mempty :: Refinement
$cmempty :: Refinement
$cp1Monoid :: Semigroup Refinement
Monoid)

instance IsString Refinement where
  fromString :: String -> Refinement
fromString = Text -> Refinement
refinementFromText (Text -> Refinement) -> (String -> Text) -> String -> Refinement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

refinementFromText :: Text -> Refinement
refinementFromText :: Text -> Refinement
refinementFromText Text
t = [Predicate] -> Refinement
Refinement ([Predicate] -> Refinement) -> [Predicate] -> Refinement
forall a b. (a -> b) -> a -> b
$
  case Text -> Maybe (Char, Text)
Text.uncons Text
t of
    Just (Char
'#', Text
s) -> [Text -> Predicate
Id     Text
s]
    Just (Char
'.', Text
s) -> [Text -> Predicate
Class  Text
s]
    Just (Char
':', Text
s)
      | Just (Char
':',Text
s') <- Text -> Maybe (Char, Text)
Text.uncons Text
s
                  -> [Text -> Predicate
PseudoElem Text
s']
      | Bool
otherwise -> [Text -> Predicate
Pseudo Text
s]
    Just (Char
'@', Text
s) -> [Text -> Predicate
Attr   Text
s]
    Maybe (Char, Text)
_             -> [Text -> Predicate
Attr   Text
t]

-------------------------------------------------------------------------------

data Path f
  = Star
  | Elem      Text
  | Child     f f
  | Deep      f f
  | Adjacent  f f
  | Sibling   f f
  | Combined  f f
  deriving Int -> Path f -> ShowS
[Path f] -> ShowS
Path f -> String
(Int -> Path f -> ShowS)
-> (Path f -> String) -> ([Path f] -> ShowS) -> Show (Path f)
forall f. Show f => Int -> Path f -> ShowS
forall f. Show f => [Path f] -> ShowS
forall f. Show f => Path f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path f] -> ShowS
$cshowList :: forall f. Show f => [Path f] -> ShowS
show :: Path f -> String
$cshow :: forall f. Show f => Path f -> String
showsPrec :: Int -> Path f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> Path f -> ShowS
Show

newtype Fix f = In { Fix f -> f (Fix f)
out :: f (Fix f) }

deriving instance Show (f (Fix f)) => Show (Fix f)

data SelectorF a = SelectorF Refinement (Path a)
  deriving Int -> SelectorF a -> ShowS
[SelectorF a] -> ShowS
SelectorF a -> String
(Int -> SelectorF a -> ShowS)
-> (SelectorF a -> String)
-> ([SelectorF a] -> ShowS)
-> Show (SelectorF a)
forall a. Show a => Int -> SelectorF a -> ShowS
forall a. Show a => [SelectorF a] -> ShowS
forall a. Show a => SelectorF a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectorF a] -> ShowS
$cshowList :: forall a. Show a => [SelectorF a] -> ShowS
show :: SelectorF a -> String
$cshow :: forall a. Show a => SelectorF a -> String
showsPrec :: Int -> SelectorF a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SelectorF a -> ShowS
Show

type Selector = Fix SelectorF

instance IsString (Fix SelectorF) where
  fromString :: String -> Selector
fromString = Text -> Selector
selectorFromText (Text -> Selector) -> (String -> Text) -> String -> Selector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

selectorFromText :: Text -> Selector
selectorFromText :: Text -> Selector
selectorFromText Text
t =
  case Text -> Maybe (Char, Text)
Text.uncons Text
t of
    Just (Char
c, Text
_) | Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c (String
"#.:@" :: [Char])
      -> Selector -> Refinement -> Selector
with Selector
star (Text -> Refinement
refinementFromText Text
t)
    Maybe (Char, Text)
_ -> SelectorF Selector -> Selector
forall (f :: * -> *). f (Fix f) -> Fix f
In (SelectorF Selector -> Selector) -> SelectorF Selector -> Selector
forall a b. (a -> b) -> a -> b
$ Refinement -> Path Selector -> SelectorF Selector
forall a. Refinement -> Path a -> SelectorF a
SelectorF ([Predicate] -> Refinement
Refinement []) (Text -> Path Selector
forall f. Text -> Path f
Elem Text
t)

instance Semigroup (Fix SelectorF) where
  Selector
a <> :: Selector -> Selector -> Selector
<> Selector
b = SelectorF Selector -> Selector
forall (f :: * -> *). f (Fix f) -> Fix f
In (Refinement -> Path Selector -> SelectorF Selector
forall a. Refinement -> Path a -> SelectorF a
SelectorF ([Predicate] -> Refinement
Refinement []) (Selector -> Selector -> Path Selector
forall f. f -> f -> Path f
Combined Selector
a Selector
b))

instance Monoid (Fix SelectorF) where
  mempty :: Selector
mempty  = String -> Selector
forall a. HasCallStack => String -> a
error String
"Selector is a semigroup"
  mappend :: Selector -> Selector -> Selector
mappend = Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
(<>)