-- | 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 = forall a. Data a => Parser String a -> String -> Q Exp
quoteCommon forall s. Stream s Identity Char => Parser s (Expression SourcePos)
expression

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

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