{-# LANGUAGE TemplateHaskell #-}
module Language.JavaScript.Inline.TH (js) where
import Data.List
import Data.String
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Language.JavaScript.Inline.Core
import Language.JavaScript.Inline.JSParse
js :: QuasiQuoter
js :: QuasiQuoter
js = (String -> Q Exp) -> QuasiQuoter
fromQuoteExp String -> Q Exp
inlineJS
fromQuoteExp :: (String -> Q Exp) -> QuasiQuoter
fromQuoteExp :: (String -> Q Exp) -> QuasiQuoter
fromQuoteExp String -> Q Exp
q =
QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
q,
quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"Language.JavaScript.Inline.TH: quotePat",
quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"Language.JavaScript.Inline.TH: quoteType",
quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"Language.JavaScript.Inline.TH: quoteDec"
}
inlineJS :: String -> Q Exp
inlineJS :: String -> Q Exp
inlineJS String
js_code =
do
(Bool
is_sync, Bool
is_expr, [String]
hs_vars) <- IO (Bool, Bool, [String]) -> Q (Bool, Bool, [String])
forall a. IO a -> Q a
runIO (IO (Bool, Bool, [String]) -> Q (Bool, Bool, [String]))
-> IO (Bool, Bool, [String]) -> Q (Bool, Bool, [String])
forall a b. (a -> b) -> a -> b
$ String -> IO (Bool, Bool, [String])
jsParse String
js_code
[|
mconcat
$( listE
( [ [|
fromString
$( litE
( stringL
( ( if is_sync
then "(("
else "(async ("
)
<> intercalate
","
['$' : v | v <- hs_vars]
<> ") => {"
<> ( if is_expr
then
"return "
<> js_code
<> ";"
else js_code
)
<> "})("
)
)
)
|]
]
<> intersperse
[|fromString ","|]
[ [|toJS $(varE (mkName v))|]
| v <- hs_vars
]
<> [[|fromString ")"|]]
)
)
|]