-- | Experimental and very simple quasi-quotation of ECMAScript in
-- Haskell. Doesn't support anti-quotation as of now.

{-# LANGUAGE FlexibleContexts #-}
module Language.ECMAScript3.Syntax.QuasiQuote (js, jsexpr, jsstmt) where

import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Quote
import Text.Parsec hiding (parse)
import Control.Monad.Identity
import Data.Data (Data)

import Language.ECMAScript3.Syntax
import Language.ECMAScript3.Parser

jsexpr :: QuasiQuoter
jsexpr :: QuasiQuoter
jsexpr = QuasiQuoter {quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
quoteJSExpr}

jsstmt :: QuasiQuoter
jsstmt :: QuasiQuoter
jsstmt = QuasiQuoter {quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
quoteJSStmt}

js :: QuasiQuoter
js :: QuasiQuoter
js = QuasiQuoter {quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
quoteJS}

quoteJSExpr :: String -> TH.ExpQ
quoteJSExpr :: String -> Q Exp
quoteJSExpr = Parser String (Expression SourcePos) -> String -> Q Exp
forall a. Data a => Parser String a -> String -> Q Exp
quoteCommon Parser String (Expression SourcePos)
forall s. Stream s Identity Char => Parser s (Expression SourcePos)
expression

quoteJSStmt :: String -> TH.ExpQ
quoteJSStmt :: String -> Q Exp
quoteJSStmt = Parser String (Statement SourcePos) -> String -> Q Exp
forall a. Data a => Parser String a -> String -> Q Exp
quoteCommon Parser String (Statement SourcePos)
forall s. Stream s Identity Char => Parser s (Statement SourcePos)
statement

quoteJS :: String -> TH.ExpQ
quoteJS :: String -> Q Exp
quoteJS = Parser String (JavaScript SourcePos) -> String -> Q Exp
forall a. Data a => Parser String a -> String -> Q Exp
quoteCommon Parser String (JavaScript SourcePos)
forall s. Stream s Identity Char => Parser s (JavaScript SourcePos)
program

quoteCommon :: Data a => Parser String a -> String -> TH.ExpQ
quoteCommon :: forall a. Data a => Parser String a -> String -> Q Exp
quoteCommon Parser String a
p String
s = do loc <- Q Loc
TH.location
                     let fname = Loc -> String
TH.loc_filename Loc
loc
                     let (line, col)  = TH.loc_start loc
                     let p2 = do pos <- ParsecT String ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                                 setPosition $ (flip setSourceName) fname $
                                   (flip setSourceLine) line $
                                   (flip setSourceColumn) col $ pos
                                 r <- p
                                 eof
                                 return r
                     case parse p2 "" s of
                       Left ParseError
err -> do Bool -> String -> Q ()
TH.report Bool
True (String -> Q ()) -> String -> Q ()
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
                                      Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Maybe Exp] -> Exp
TH.UnboxedTupE []
                       Right a
x  -> (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 (Maybe (Q Exp) -> b -> Maybe (Q Exp)
forall a b. a -> b -> a
const Maybe (Q Exp)
forall a. Maybe a
Nothing) a
x