{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- | Everything in this module belongs in JSaddle, GHCJS-DOM, or similar
module React.JSaddle where

import Prelude hiding ((!!))

import Data.Text (Text)
import qualified Data.Text as T
import Data.Map (Map)
import qualified Data.Map as Map
import Control.Monad
import Data.String

import React.Misc

#ifdef ghcjs_HOST_OS
import Data.Coerce (coerce)
import GHCJS.Foreign.Callback
import qualified JavaScript.Array as Array (toListIO)
import Language.Javascript.JSaddle
#else
import GHCJS.Prim.Internal (primToJSVal)
import Language.Javascript.JSaddle hiding (Ref)
#endif

#ifndef ghcjs_HOST_OS
instance PToJSVal Text where
  pToJSVal :: Text -> JSVal
pToJSVal Text
s = Val -> JSVal
primToJSVal (Val -> JSVal) -> Val -> JSVal
forall a b. (a -> b) -> a -> b
$ Text -> Val
forall a. Text -> PrimVal a
PrimVal_String Text
s

instance PToJSVal Int where
  pToJSVal :: Int -> JSVal
pToJSVal Int
i = Val -> JSVal
primToJSVal (Val -> JSVal) -> Val -> JSVal
forall a b. (a -> b) -> a -> b
$ Double -> Val
forall a. Double -> PrimVal a
PrimVal_Number (Double -> Val) -> Double -> Val
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
#endif

instance PToJSVal Function where
  pToJSVal :: Function -> JSVal
pToJSVal (Function CallbackId
_ Object
o) = Object -> JSVal
forall a. PToJSVal a => a -> JSVal
pToJSVal Object
o

instance PToJSVal Object where
  pToJSVal :: Object -> JSVal
pToJSVal (Object JSVal
v) = JSVal
v

instance IsString JSVal where
  fromString :: String -> JSVal
fromString = Text -> JSVal
forall a. PToJSVal a => a -> JSVal
pToJSVal (Text -> JSVal) -> (String -> Text) -> String -> JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance ToJSVal v => ToJSVal (Map Text v) where
  toJSVal :: Map Text v -> JSM JSVal
toJSVal Map Text v
m = do
    o :: Object
o@(Object JSVal
oVal) <- JSM Object
obj
    [(Text, v)] -> ((Text, v) -> JSM ()) -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Text v -> [(Text, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text v
m) (((Text, v) -> JSM ()) -> JSM ())
-> ((Text, v) -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \(Text
k, v
v) -> do
      (Object
o Object -> Text -> JSVal -> JSM ()
forall this name val.
(MakeObject this, ToJSString name, ToJSVal val) =>
this -> name -> val -> JSM ()
<# Text
k) (JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< v -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal v
v
    JSVal -> JSM JSVal
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
oVal

consoleLog :: ToJSVal a => a -> JSM JSVal
consoleLog :: a -> JSM JSVal
consoleLog a
x = (Object
global Object -> Text -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! Text -> Text
t Text
"console") JSM JSVal -> Text -> [a] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# Text -> Text
t Text
"log" ([a] -> JSM JSVal) -> [a] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [a
x]

type JSCallAsFunction' = JSVal      -- ^ Function object
                     -> JSVal      -- ^ this
                     -> [JSVal]    -- ^ Function arguments
                     -> JSM JSVal  -- ^ Return value

function' :: JSCallAsFunction' -- ^ Haskell function to call
         -> JSM Function'     -- ^ Returns a JavaScript function object that will
                             --   call the Haskell one when it is called
#ifdef ghcjs_HOST_OS
function' f = do
    callback <- syncCallback2' $ \this args -> do
        rargs <- Array.toListIO (coerce args)
        f this this rargs -- TODO pass function object through
    Function' callback <$> makeFunctionWithCallback' callback
#else
function' :: JSCallAsFunction' -> JSM Function'
function' JSCallAsFunction'
f = do
    (CallbackId
cb, JSVal
f') <- JSCallAsFunction' -> JSM (CallbackId, JSVal)
newSyncCallback'' JSCallAsFunction'
f --TODO: "ContinueAsync" behavior
    Function' -> JSM Function'
forall (m :: * -> *) a. Monad m => a -> m a
return (Function' -> JSM Function') -> Function' -> JSM Function'
forall a b. (a -> b) -> a -> b
$ CallbackId -> Object -> Function'
Function' CallbackId
cb (Object -> Function') -> Object -> Function'
forall a b. (a -> b) -> a -> b
$ JSVal -> Object
Object JSVal
f'
#endif

#ifdef ghcjs_HOST_OS
data Function' = Function' {functionCallback' :: Callback (JSVal -> JSVal -> IO JSVal), functionObject' :: Object}
#else
data Function' = Function' {Function' -> CallbackId
functionCallback' :: CallbackId, Function' -> Object
functionObject' :: Object}
#endif

#ifdef ghcjs_HOST_OS
foreign import javascript unsafe "$r = function () { return $1(this, arguments); }"
    makeFunctionWithCallback' :: Callback (JSVal -> JSVal -> IO JSVal) -> IO Object
#endif

instance ToJSVal Function' where
    toJSVal :: Function' -> JSM JSVal
toJSVal = Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal (Object -> JSM JSVal)
-> (Function' -> Object) -> Function' -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function' -> Object
functionObject'

instance PToJSVal Function' where
  pToJSVal :: Function' -> JSVal
pToJSVal (Function' CallbackId
_ Object
o) = Object -> JSVal
forall a. PToJSVal a => a -> JSVal
pToJSVal Object
o