-- | 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 :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter {quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
quoteJSExpr}

jsstmt :: QuasiQuoter
jsstmt :: QuasiQuoter
jsstmt = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter {quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
quoteJSStmt}

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