module Reflex.Dom.TH.Parser
( TElement(..),
parseTemplate
)
where
import Data.Char
import Data.List
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
import Data.Void
import Control.Monad
import Language.Haskell.TH.Syntax
type Parser = Parsec Void String
type TTag = String
type Attribute = (String, String)
type Ref = Int
data TElement = TElement { TElement -> TTag
tTag :: TTag
, TElement -> Maybe Ref
tRef :: Maybe Ref
, TElement -> [Attribute]
tAttrs :: [Attribute]
, TElement -> Maybe TTag
tDynAttrs :: Maybe String
, TElement -> [TElement]
tChilds :: [TElement] }
| TText String
| String
| TWidget String (Maybe Ref)
deriving Ref -> TElement -> ShowS
[TElement] -> ShowS
TElement -> TTag
(Ref -> TElement -> ShowS)
-> (TElement -> TTag) -> ([TElement] -> ShowS) -> Show TElement
forall a.
(Ref -> a -> ShowS) -> (a -> TTag) -> ([a] -> ShowS) -> Show a
showList :: [TElement] -> ShowS
$cshowList :: [TElement] -> ShowS
show :: TElement -> TTag
$cshow :: TElement -> TTag
showsPrec :: Ref -> TElement -> ShowS
$cshowsPrec :: Ref -> TElement -> ShowS
Show
refOpt :: Parser (Maybe Int)
refOpt :: Parser (Maybe Ref)
refOpt = ParsecT Void TTag Identity Ref -> Parser (Maybe Ref)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void TTag Identity Ref -> Parser (Maybe Ref))
-> (ParsecT Void TTag Identity Ref
-> ParsecT Void TTag Identity Ref)
-> ParsecT Void TTag Identity Ref
-> Parser (Maybe Ref)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void TTag Identity Ref -> ParsecT Void TTag Identity Ref
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void TTag Identity Ref -> Parser (Maybe Ref))
-> ParsecT Void TTag Identity Ref -> Parser (Maybe Ref)
forall a b. (a -> b) -> a -> b
$ do
ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1
ParsecT Void TTag Identity Char -> ParsecT Void TTag Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void TTag Identity Char -> ParsecT Void TTag Identity ())
-> ParsecT Void TTag Identity Char -> ParsecT Void TTag Identity ()
forall a b. (a -> b) -> a -> b
$ Token TTag -> ParsecT Void TTag Identity (Token TTag)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token TTag
'#'
ParsecT Void TTag Identity Ref
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal ParsecT Void TTag Identity Ref
-> ParsecT Void TTag Identity () -> ParsecT Void TTag Identity Ref
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
openTag :: Parser (String, [TElement] -> TElement)
openTag :: Parser (TTag, [TElement] -> TElement)
openTag =
ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity Char
-> Parser (TTag, [TElement] -> TElement)
-> Parser (TTag, [TElement] -> TElement)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token TTag -> ParsecT Void TTag Identity (Token TTag)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token TTag
'<') (Token TTag -> ParsecT Void TTag Identity (Token TTag)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token TTag
'>') (Parser (TTag, [TElement] -> TElement)
-> Parser (TTag, [TElement] -> TElement))
-> Parser (TTag, [TElement] -> TElement)
-> Parser (TTag, [TElement] -> TElement)
forall a b. (a -> b) -> a -> b
$ do
TTag
tag <- ParsecT Void TTag Identity Char -> ParsecT Void TTag Identity TTag
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void TTag Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token TTag -> ParsecT Void TTag Identity (Token TTag)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token TTag
'-')
Maybe Ref
ref <- Parser (Maybe Ref)
refOpt
ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
[Attribute]
attrs <- Parser [Attribute]
attributes
ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
Maybe TTag
dynAttr <- ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity (Maybe TTag)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void TTag Identity TTag
varRef
(TTag, [TElement] -> TElement)
-> Parser (TTag, [TElement] -> TElement)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TTag, [TElement] -> TElement)
-> Parser (TTag, [TElement] -> TElement))
-> (TTag, [TElement] -> TElement)
-> Parser (TTag, [TElement] -> TElement)
forall a b. (a -> b) -> a -> b
$ (TTag
tag, TTag
-> Maybe Ref -> [Attribute] -> Maybe TTag -> [TElement] -> TElement
TElement TTag
tag Maybe Ref
ref [Attribute]
attrs Maybe TTag
dynAttr)
closeTag :: String -> Parser ()
closeTag :: TTag -> ParsecT Void TTag Identity ()
closeTag TTag
tag = ParsecT Void TTag Identity () -> ParsecT Void TTag Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void TTag Identity () -> ParsecT Void TTag Identity ())
-> ParsecT Void TTag Identity () -> ParsecT Void TTag Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void TTag Identity ()
-> ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity ()
-> ParsecT Void TTag Identity ()
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens TTag -> ParsecT Void TTag Identity (Tokens TTag)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens TTag
"</" ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity () -> ParsecT Void TTag Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token TTag -> ParsecT Void TTag Identity (Token TTag)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token TTag
'>') (Tokens TTag -> ParsecT Void TTag Identity (Tokens TTag)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string TTag
Tokens TTag
tag ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity () -> ParsecT Void TTag Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space)
comment :: Parser TElement
= TTag -> TElement
TComment (TTag -> TElement)
-> ParsecT Void TTag Identity TTag -> Parser TElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Tokens TTag -> ParsecT Void TTag Identity (Tokens TTag)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens TTag
"<!--") ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity TTag
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity TTag
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void TTag Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (Tokens TTag -> ParsecT Void TTag Identity (Tokens TTag)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens TTag
"-->")))
stringLiteral :: Parser String
stringLiteral :: ParsecT Void TTag Identity TTag
stringLiteral = Token TTag -> ParsecT Void TTag Identity (Token TTag)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token TTag
'\"' ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity TTag
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity TTag
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void TTag Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (Token TTag -> ParsecT Void TTag Identity (Token TTag)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token TTag
'\"')
attribute :: Parser Attribute
attribute :: Parser Attribute
attribute = (,) (TTag -> TTag -> Attribute)
-> ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity (TTag -> Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void TTag Identity Char -> ParsecT Void TTag Identity TTag
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void TTag Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token TTag -> ParsecT Void TTag Identity (Token TTag)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token TTag
'-') ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity TTag
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token TTag -> ParsecT Void TTag Identity (Token TTag)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token TTag
'=') ParsecT Void TTag Identity (TTag -> Attribute)
-> ParsecT Void TTag Identity TTag -> Parser Attribute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void TTag Identity TTag
stringLiteral
attributes :: Parser [Attribute]
attributes :: Parser [Attribute]
attributes = Parser Attribute
-> ParsecT Void TTag Identity () -> Parser [Attribute]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepEndBy Parser Attribute
attribute ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 Parser [Attribute]
-> ParsecT Void TTag Identity () -> Parser [Attribute]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
node :: Parser TElement
node :: Parser TElement
node = do
(TTag
tag, [TElement] -> TElement
mkElem) <- Parser (TTag, [TElement] -> TElement)
openTag
ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
[TElement]
childs <- Parser TElement
-> ParsecT Void TTag Identity ()
-> ParsecT Void TTag Identity [TElement]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill Parser TElement
element (TTag -> ParsecT Void TTag Identity ()
closeTag TTag
tag)
TElement -> Parser TElement
forall (m :: * -> *) a. Monad m => a -> m a
return (TElement -> Parser TElement) -> TElement -> Parser TElement
forall a b. (a -> b) -> a -> b
$ [TElement] -> TElement
mkElem [TElement]
childs
varName :: Parser String
varName :: ParsecT Void TTag Identity TTag
varName = (:) (Char -> ShowS)
-> ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void TTag Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar ParsecT Void TTag Identity ShowS
-> ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity TTag
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void TTag Identity Char -> ParsecT Void TTag Identity TTag
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void TTag Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
varRef :: Parser String
varRef :: ParsecT Void TTag Identity TTag
varRef = Tokens TTag -> ParsecT Void TTag Identity (Tokens TTag)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens TTag
"{{" ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity () -> ParsecT Void TTag Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void TTag Identity ()
-> ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity TTag
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void TTag Identity TTag
varName ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity TTag
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens TTag -> ParsecT Void TTag Identity (Tokens TTag)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens TTag
"}}" ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity () -> ParsecT Void TTag Identity TTag
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
widget :: Parser TElement
widget :: Parser TElement
widget = TTag -> Maybe Ref -> TElement
TWidget (TTag -> Maybe Ref -> TElement)
-> ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity (Maybe Ref -> TElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens TTag -> ParsecT Void TTag Identity (Tokens TTag)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens TTag
"{{" ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity () -> ParsecT Void TTag Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void TTag Identity ()
-> ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity TTag
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void TTag Identity TTag
varName) ParsecT Void TTag Identity (Maybe Ref -> TElement)
-> Parser (Maybe Ref) -> Parser TElement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser (Maybe Ref)
refOpt Parser (Maybe Ref)
-> ParsecT Void TTag Identity TTag -> Parser (Maybe Ref)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Tokens TTag -> ParsecT Void TTag Identity (Tokens TTag)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens TTag
"}}"))
text :: Parser TElement
text :: Parser TElement
text = TTag -> TElement
TText (TTag -> TElement) -> ShowS -> TTag -> TElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace (TTag -> TElement)
-> ParsecT Void TTag Identity TTag -> Parser TElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity () -> ParsecT Void TTag Identity TTag
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
someTill ParsecT Void TTag Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (ParsecT Void TTag Identity () -> ParsecT Void TTag Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Token TTag -> ParsecT Void TTag Identity (Token TTag)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token TTag
'<' ParsecT Void TTag Identity Char
-> ParsecT Void TTag Identity () -> ParsecT Void TTag Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> ParsecT Void TTag Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ParsecT Void TTag Identity ()
-> ParsecT Void TTag Identity () -> ParsecT Void TTag Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens TTag -> ParsecT Void TTag Identity (Tokens TTag)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens TTag
"{{" ParsecT Void TTag Identity TTag
-> ParsecT Void TTag Identity () -> ParsecT Void TTag Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> ParsecT Void TTag Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ))
element :: Parser TElement
element :: Parser TElement
element = (Parser TElement
comment Parser TElement -> Parser TElement -> Parser TElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TElement
node Parser TElement -> Parser TElement -> Parser TElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TElement
widget Parser TElement -> Parser TElement -> Parser TElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TElement
text) Parser TElement -> ParsecT Void TTag Identity () -> Parser TElement
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
template :: Parser [TElement]
template :: ParsecT Void TTag Identity [TElement]
template = do
ParsecT Void TTag Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
[TElement]
result <- Parser TElement -> ParsecT Void TTag Identity [TElement]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser TElement
element
ParsecT Void TTag Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
[TElement] -> ParsecT Void TTag Identity [TElement]
forall (m :: * -> *) a. Monad m => a -> m a
return [TElement]
result
parseTemplate :: FilePath -> String -> Either (ParseErrorBundle String Void) [TElement]
parseTemplate :: TTag -> TTag -> Either (ParseErrorBundle TTag Void) [TElement]
parseTemplate TTag
fn = ParsecT Void TTag Identity [TElement]
-> TTag -> TTag -> Either (ParseErrorBundle TTag Void) [TElement]
forall e s a.
Parsec e s a -> TTag -> s -> Either (ParseErrorBundle s e) a
runParser ParsecT Void TTag Identity [TElement]
template TTag
fn