{-# LANGUAGE TemplateHaskellQuotes #-}

-- |
-- Module      : Css3.Selector.QuasiQuoters
-- Description : A module that defines a quasiquoter to parse a string to a css selector.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- A module that defines a quasiquoter to parse a string to a css selector.
module Css3.Selector.QuasiQuoters
  ( csssel,
    cssselFile,
    parseCss,
  )
where

import Css3.Selector.Core (SelectorGroup, toPattern)
import Css3.Selector.Lexer (alexScanTokens)
import Css3.Selector.Parser (cssselector)
import Data.Data (Data, cast)
import Data.Text (pack, unpack)
import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter, quoteDec, quoteExp, quotePat, quoteType), quoteFile)
import Language.Haskell.TH.Syntax (Exp (AppE, VarE), Q, Type (ConT), dataToExpQ, lift, reportWarning)

-- | Parse the string to a 'SelectorGroup'.
parseCss ::
  -- | The string to be parsed to a 'SelectorGroup'
  String ->
  -- | The selectorgroup that is the equivalent of the given 'String'.
  SelectorGroup
parseCss :: String -> SelectorGroup
parseCss String
st = Either String [TokenLoc] -> SelectorGroup
al (String -> Either String [TokenLoc]
alexScanTokens String
st')
  where
    st' :: String
st' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'\r' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) String
st
    al :: Either String [TokenLoc] -> SelectorGroup
al (Left String
er) = String -> SelectorGroup
forall a. HasCallStack => String -> a
error String
er
    al (Right [TokenLoc]
val) = [TokenLoc] -> SelectorGroup
cssselector [TokenLoc]
val

liftDataWithText :: Data a => a -> Q Exp
liftDataWithText :: forall a. Data a => a -> Q Exp
liftDataWithText = (forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ ((((Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'pack) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Q Exp -> Q Exp) -> (Text -> Q Exp) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift (String -> Q Exp) -> (Text -> String) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) (Text -> Q Exp) -> Maybe Text -> Maybe (Q Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Text -> Maybe (Q Exp))
-> (b -> Maybe Text) -> b -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe Text
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast)

-- | A quasiquoter that can be used to construct a 'SelectorGroup' for the given
-- css selector. In case the css selector is invalid. A compiler error will be
-- thrown (at compile time).
csssel :: QuasiQuoter
csssel :: QuasiQuoter
csssel =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = SelectorGroup -> Q Exp
forall a. Data a => a -> Q Exp
liftDataWithText (SelectorGroup -> Q Exp)
-> (String -> SelectorGroup) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SelectorGroup
parseCss,
      quotePat :: String -> Q Pat
quotePat = Pat -> Q Pat
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Q Pat) -> (String -> Pat) -> String -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectorGroup -> Pat
forall a. ToCssSelector a => a -> Pat
toPattern (SelectorGroup -> Pat)
-> (String -> SelectorGroup) -> String -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SelectorGroup
parseCss,
      quoteType :: String -> Q Type
quoteType = Q Type -> String -> Q Type
forall a b. a -> b -> a
const (String -> Q ()
reportWarning String
"The type of the quasiquoter will always use the SelectorGroup type." Q () -> Q Type -> Q Type
forall a b. Q a -> Q b -> Q b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Type
ConT ''SelectorGroup)),
      quoteDec :: String -> Q [Dec]
quoteDec = Q [Dec] -> String -> Q [Dec]
forall a b. a -> b -> a
const (String -> Q ()
reportWarning String
"The use of this quasiquoter will not make any declarations." Q () -> Q [Dec] -> Q [Dec]
forall a b. Q a -> Q b -> Q b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
    }

-- | A quasiquoter that takes the content from the file, and then runs the
-- content of that file as a 'csssel' quasiquote.
cssselFile :: QuasiQuoter
cssselFile :: QuasiQuoter
cssselFile = QuasiQuoter -> QuasiQuoter
quoteFile QuasiQuoter
csssel