{-# LANGUAGE TemplateHaskellQuotes #-}
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, quoteExp, quotePat, quoteType, quoteDec), quoteFile)
import Language.Haskell.TH.Syntax(Exp(AppE, VarE), Q, Type(ConT), dataToExpQ, lift, reportWarning)
parseCss :: String
-> SelectorGroup
parseCss :: String -> SelectorGroup
parseCss = [TokenLoc] -> SelectorGroup
cssselector ([TokenLoc] -> SelectorGroup)
-> (String -> [TokenLoc]) -> String -> SelectorGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [TokenLoc]
alexScanTokens (String -> [TokenLoc])
-> (String -> String) -> String -> [TokenLoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'\r' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=)
liftDataWithText :: Data a => a -> Q Exp
liftDataWithText :: a -> Q Exp
liftDataWithText = (forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q 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. Lift t => t -> Q 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)
csssel :: QuasiQuoter
csssel :: QuasiQuoter
csssel = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> Q Type
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
}
cssselFile :: QuasiQuoter
cssselFile :: QuasiQuoter
cssselFile = QuasiQuoter -> QuasiQuoter
quoteFile QuasiQuoter
csssel