{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

module Language.JavaScript.Inline.Core.Class where

import Data.Binary.Get
import qualified Data.ByteString.Lazy as LBS
import Data.Proxy
import Data.String
import Language.JavaScript.Inline.Core.JSVal
import Language.JavaScript.Inline.Core.Message
import Language.JavaScript.Inline.Core.Session
import Language.JavaScript.Inline.Core.Utils

-- | UTF-8 encoded string.
newtype EncodedString = EncodedString
  { EncodedString -> ByteString
unEncodedString :: LBS.ByteString
  }
  deriving (Int -> EncodedString -> ShowS
[EncodedString] -> ShowS
EncodedString -> String
(Int -> EncodedString -> ShowS)
-> (EncodedString -> String)
-> ([EncodedString] -> ShowS)
-> Show EncodedString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncodedString] -> ShowS
$cshowList :: [EncodedString] -> ShowS
show :: EncodedString -> String
$cshow :: EncodedString -> String
showsPrec :: Int -> EncodedString -> ShowS
$cshowsPrec :: Int -> EncodedString -> ShowS
Show, String -> EncodedString
(String -> EncodedString) -> IsString EncodedString
forall a. (String -> a) -> IsString a
fromString :: String -> EncodedString
$cfromString :: String -> EncodedString
IsString)

-- | UTF-8 encoded JSON.
newtype EncodedJSON = EncodedJSON
  { EncodedJSON -> ByteString
unEncodedJSON :: LBS.ByteString
  }
  deriving (Int -> EncodedJSON -> ShowS
[EncodedJSON] -> ShowS
EncodedJSON -> String
(Int -> EncodedJSON -> ShowS)
-> (EncodedJSON -> String)
-> ([EncodedJSON] -> ShowS)
-> Show EncodedJSON
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncodedJSON] -> ShowS
$cshowList :: [EncodedJSON] -> ShowS
show :: EncodedJSON -> String
$cshow :: EncodedJSON -> String
showsPrec :: Int -> EncodedJSON -> ShowS
$cshowsPrec :: Int -> EncodedJSON -> ShowS
Show, String -> EncodedJSON
(String -> EncodedJSON) -> IsString EncodedJSON
forall a. (String -> a) -> IsString a
fromString :: String -> EncodedJSON
$cfromString :: String -> EncodedJSON
IsString)

-- | Haskell types which can be converted to JavaScript.
class ToJS a where
  -- | Encodes a Haskell value to 'JSExpr'.
  toJS :: a -> JSExpr

instance ToJS () where
  toJS :: () -> JSExpr
toJS ()
_ = JSExpr
"undefined"

instance ToJS LBS.ByteString where
  toJS :: ByteString -> JSExpr
toJS = [JSExprSegment] -> JSExpr
JSExpr ([JSExprSegment] -> JSExpr)
-> (ByteString -> [JSExprSegment]) -> ByteString -> JSExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSExprSegment -> [JSExprSegment]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSExprSegment -> [JSExprSegment])
-> (ByteString -> JSExprSegment) -> ByteString -> [JSExprSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> JSExprSegment
BufferLiteral

instance ToJS EncodedString where
  toJS :: EncodedString -> JSExpr
toJS = [JSExprSegment] -> JSExpr
JSExpr ([JSExprSegment] -> JSExpr)
-> (EncodedString -> [JSExprSegment]) -> EncodedString -> JSExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSExprSegment -> [JSExprSegment]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSExprSegment -> [JSExprSegment])
-> (EncodedString -> JSExprSegment)
-> EncodedString
-> [JSExprSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> JSExprSegment
StringLiteral (ByteString -> JSExprSegment)
-> (EncodedString -> ByteString) -> EncodedString -> JSExprSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodedString -> ByteString
unEncodedString

instance ToJS EncodedJSON where
  toJS :: EncodedJSON -> JSExpr
toJS = [JSExprSegment] -> JSExpr
JSExpr ([JSExprSegment] -> JSExpr)
-> (EncodedJSON -> [JSExprSegment]) -> EncodedJSON -> JSExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSExprSegment -> [JSExprSegment]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSExprSegment -> [JSExprSegment])
-> (EncodedJSON -> JSExprSegment) -> EncodedJSON -> [JSExprSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> JSExprSegment
JSONLiteral (ByteString -> JSExprSegment)
-> (EncodedJSON -> ByteString) -> EncodedJSON -> JSExprSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodedJSON -> ByteString
unEncodedJSON

instance ToJS JSVal where
  toJS :: JSVal -> JSExpr
toJS = [JSExprSegment] -> JSExpr
JSExpr ([JSExprSegment] -> JSExpr)
-> (JSVal -> [JSExprSegment]) -> JSVal -> JSExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSExprSegment -> [JSExprSegment]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSExprSegment -> [JSExprSegment])
-> (JSVal -> JSExprSegment) -> JSVal -> [JSExprSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSExprSegment
JSValLiteral

-- | Haskell types which can be converted from JavaScript.
class FromJS a where
  -- | The JavaScript value's 'RawJSType'.
  rawJSType :: Proxy a -> RawJSType

  -- | A synchronous JavaScript function which encodes a value to its
  -- 'RawJSType'.
  toRawJSType :: Proxy a -> JSExpr

  -- | A Haskell function which decodes the Haskell value from the serialized
  -- 'RawJSType'.
  fromJS :: Session -> LBS.ByteString -> IO a

instance FromJS () where
  rawJSType :: Proxy () -> RawJSType
rawJSType Proxy ()
_ = RawJSType
RawNone
  toRawJSType :: Proxy () -> JSExpr
toRawJSType Proxy ()
_ = JSExpr
"() => undefined"
  fromJS :: Session -> ByteString -> IO ()
fromJS Session
_ ByteString
_ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance FromJS LBS.ByteString where
  rawJSType :: Proxy ByteString -> RawJSType
rawJSType Proxy ByteString
_ = RawJSType
RawBuffer
  toRawJSType :: Proxy ByteString -> JSExpr
toRawJSType Proxy ByteString
_ = JSExpr
"a => a"
  fromJS :: Session -> ByteString -> IO ByteString
fromJS Session
_ = ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance FromJS EncodedString where
  rawJSType :: Proxy EncodedString -> RawJSType
rawJSType Proxy EncodedString
_ = RawJSType
RawBuffer
  toRawJSType :: Proxy EncodedString -> JSExpr
toRawJSType Proxy EncodedString
_ = JSExpr
"a => a"
  fromJS :: Session -> ByteString -> IO EncodedString
fromJS Session
_ = EncodedString -> IO EncodedString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncodedString -> IO EncodedString)
-> (ByteString -> EncodedString) -> ByteString -> IO EncodedString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> EncodedString
EncodedString

instance FromJS EncodedJSON where
  rawJSType :: Proxy EncodedJSON -> RawJSType
rawJSType Proxy EncodedJSON
_ = RawJSType
RawJSON
  toRawJSType :: Proxy EncodedJSON -> JSExpr
toRawJSType Proxy EncodedJSON
_ = JSExpr
"a => a"
  fromJS :: Session -> ByteString -> IO EncodedJSON
fromJS Session
_ = EncodedJSON -> IO EncodedJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncodedJSON -> IO EncodedJSON)
-> (ByteString -> EncodedJSON) -> ByteString -> IO EncodedJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> EncodedJSON
EncodedJSON

instance FromJS JSVal where
  rawJSType :: Proxy JSVal -> RawJSType
rawJSType Proxy JSVal
_ = RawJSType
RawJSVal
  toRawJSType :: Proxy JSVal -> JSExpr
toRawJSType Proxy JSVal
_ = JSExpr
"a => a"
  fromJS :: Session -> ByteString -> IO JSVal
fromJS Session
_session ByteString
_jsval_id_buf = do
    Word64
_jsval_id <- Get Word64 -> ByteString -> IO Word64
forall a. Typeable a => Get a -> ByteString -> IO a
runGetExact Get Word64
getWord64host ByteString
_jsval_id_buf
    Bool -> Word64 -> IO () -> IO JSVal
newJSVal Bool
True Word64
_jsval_id (Session -> MessageHS -> IO ()
sessionSend Session
_session (MessageHS -> IO ()) -> MessageHS -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64 -> MessageHS
JSValFree Word64
_jsval_id)