{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TypeApplications #-}

module Language.JavaScript.Inline.Core.Import where

import Language.JavaScript.Inline.Core.Class
import Language.JavaScript.Inline.Core.Session
import Language.JavaScript.Inline.Core.JSVal
import Language.JavaScript.Inline.Core.Message
import Language.JavaScript.Inline.Core.Instruction
import Data.List

-- | The class of Haskell functions which can be imported from JavaScript
-- function 'JSVal's. The Haskell function type should be @a -> b -> .. -> IO
-- r@, where the arguments @a@, @b@, etc are 'ToJS' instances, and the result
-- @r@ is 'FromJS' instance.
class Import f where
  importMonomorphize :: Session -> JSVal -> [JSExpr] -> f

instance FromJS r => Import (IO r) where
  importMonomorphize :: Session -> JSVal -> [JSExpr] -> IO r
importMonomorphize Session
s JSVal
v [JSExpr]
xs = Session -> JSExpr -> IO r
forall a. FromJS a => Session -> JSExpr -> IO a
eval Session
s (JSExpr -> IO r) -> JSExpr -> IO r
forall a b. (a -> b) -> a -> b
$ JSVal -> JSExpr
forall a. ToJS a => a -> JSExpr
toJS JSVal
v JSExpr -> JSExpr -> JSExpr
forall a. Semigroup a => a -> a -> a
<> JSExpr
"(...[" JSExpr -> JSExpr -> JSExpr
forall a. Semigroup a => a -> a -> a
<> [JSExpr] -> JSExpr
forall a. Monoid a => [a] -> a
mconcat (JSExpr -> [JSExpr] -> [JSExpr]
forall a. a -> [a] -> [a]
intersperse JSExpr
"," [JSExpr]
xs) JSExpr -> JSExpr -> JSExpr
forall a. Semigroup a => a -> a -> a
<> JSExpr
"])"

instance (ToJS a, Import b) => Import (a -> b) where
  importMonomorphize :: Session -> JSVal -> [JSExpr] -> a -> b
importMonomorphize Session
s JSVal
v [JSExpr]
xs = \a
a -> Session -> JSVal -> [JSExpr] -> b
forall f. Import f => Session -> JSVal -> [JSExpr] -> f
importMonomorphize @b Session
s JSVal
v (a -> JSExpr
forall a. ToJS a => a -> JSExpr
toJS a
aJSExpr -> [JSExpr] -> [JSExpr]
forall a. a -> [a] -> [a]
:[JSExpr]
xs)

-- | Import a JavaScript function to a Haskell function.
importJSFunc :: Import f => Session -> JSVal -> f
importJSFunc :: Session -> JSVal -> f
importJSFunc Session
s JSVal
v = Session -> JSVal -> [JSExpr] -> f
forall f. Import f => Session -> JSVal -> [JSExpr] -> f
importMonomorphize Session
s JSVal
v []