module Dingo.Selector
( RefinableSelector
, Selector
, SimpleSelector
, ToSelector(..)
, (.>*.)
, (.+.)
, (.>.)
, (.~.)
, anyElement
, element
, fromSelector
, with
, withId
, withClass
, withAttribute
, withAttributeValue
, withAttributeValueElement
, withAttributeValuePrefix
) where
import Data.Monoid (mconcat)
import Data.Text.Lazy (Text)
import Data.Text.Lazy.Builder (Builder, fromLazyText)
import Web.CSS.Escaping (escapeIdentifier, escapeString)
data TypeOrUniversal = SAny
| SType Text
data Qualifier = SAttributePresent Text
| SAttributeEquals Text Text
| SSpacedAttributeContains Text Text
| SHypenatedAttributeContains Text Text
| SClass Text
| SId Text
renderQualifier :: Qualifier -> Builder
renderQualifier (SAttributePresent a) =
mconcat [ "["
, fromLazyText $ escapeIdentifier a
, "]"
]
renderQualifier (SAttributeEquals a v) =
mconcat [ "["
, fromLazyText $ escapeIdentifier a
, "="
, fromLazyText $ escapeString v
, "]"
]
renderQualifier (SSpacedAttributeContains a v) =
mconcat [ "["
, fromLazyText $ escapeIdentifier a
, "~="
, fromLazyText $ escapeString v
, "]"
]
renderQualifier (SHypenatedAttributeContains a v) =
mconcat [ "["
, fromLazyText $ escapeIdentifier a
, "|="
, fromLazyText $ escapeString v
, "]"
]
renderQualifier (SClass c) =
mconcat [ "."
, fromLazyText $ escapeIdentifier c
]
renderQualifier (SId i) =
mconcat [ "#"
, fromLazyText $ escapeIdentifier i
]
newtype Discriminators = Discriminators [Qualifier]
data SimpleSelector = SimpleSelector TypeOrUniversal Discriminators
element :: Text -> SimpleSelector
element e = SimpleSelector (SType e) (Discriminators [])
anyElement :: SimpleSelector
anyElement = SimpleSelector SAny (Discriminators [])
withId :: RefinableSelector a => a -> Text -> a
withId s i = with s $ SId i
withClass :: RefinableSelector a => a -> Text -> a
withClass s c = with s $ SClass c
withAttribute :: RefinableSelector a => a -> Text -> a
withAttribute r a = with r $ SAttributePresent a
withAttributeValue :: RefinableSelector a => a -> Text -> Text -> a
withAttributeValue r a v = with r $ SAttributeEquals a v
withAttributeValueElement :: RefinableSelector a => a -> Text -> Text -> a
withAttributeValueElement r a v = with r $ SSpacedAttributeContains a v
withAttributeValuePrefix :: RefinableSelector a => a -> Text -> Text -> a
withAttributeValuePrefix r a v = with r $ SHypenatedAttributeContains a v
class RefinableSelector a where
with :: a -> Qualifier -> a
instance RefinableSelector Discriminators where
with (Discriminators a) aop = Discriminators (aop:a)
instance RefinableSelector SimpleSelector where
with (SimpleSelector tou discriminators) aop =
SimpleSelector tou (with discriminators aop)
data Selector = SSimple SimpleSelector
| SDescendant SimpleSelector Selector
| SChild SimpleSelector Selector
| SAdjacent SimpleSelector Selector
| SFollowing SimpleSelector Selector
fromTypeOrUniversal :: TypeOrUniversal -> Builder
fromTypeOrUniversal SAny = "*"
fromTypeOrUniversal (SType e) = fromLazyText $ escapeIdentifier e
fromSimpleSelector :: SimpleSelector -> Builder
fromSimpleSelector (SimpleSelector tou (Discriminators qualifiers)) =
mconcat [ fromTypeOrUniversal tou
, mconcat $ map renderQualifier qualifiers ]
fromSelector :: ToSelector a => a -> Builder
fromSelector = go . toSelector
where
go (SSimple s) = fromSimpleSelector s
go (SDescendant s r) = mconcat [fromSimpleSelector s, " ", go r]
go (SChild s r) = mconcat [fromSimpleSelector s, ">", go r]
go (SAdjacent s r) = mconcat [fromSimpleSelector s, "+", go r]
go (SFollowing s r) = mconcat [fromSimpleSelector s, "~", go r]
class ToSelector a where
toSelector :: a -> Selector
instance ToSelector Qualifier where
toSelector a = toSelector $ SimpleSelector SAny (Discriminators [a])
instance ToSelector SimpleSelector where
toSelector = SSimple
instance ToSelector Selector where
toSelector = id
class ToSimpleSelector a where
toSimpleSelector :: a -> SimpleSelector
instance ToSimpleSelector SimpleSelector where
toSimpleSelector = id
(.>*.) :: (ToSimpleSelector a, ToSelector b) => a -> b -> Selector
(.>*.) s d = SDescendant (toSimpleSelector s) (toSelector d)
infixr .>*.
(.>.) :: (ToSimpleSelector a, ToSelector b) => a -> b -> Selector
(.>.) s d = SChild (toSimpleSelector s) (toSelector d)
infixr .>.
(.+.) :: (ToSimpleSelector a, ToSelector b) => a -> b -> Selector
(.+.) s d = SAdjacent (toSimpleSelector s) (toSelector d)
infixr .+.
(.~.) :: (ToSimpleSelector a, ToSelector b) => a -> b -> Selector
(.~.) s d = SFollowing (toSimpleSelector s) (toSelector d)
infixr .~.