module Graphics.UI.Threepenny.Internal.FFI (
ffi,
FFI(..), ToJS(..),
JSFunction,
showJSON,
toCode, marshalResult,
) where
import Data.Aeson as JSON
import qualified Data.Aeson.Types as JSON
import qualified Data.Aeson.Encode
import Data.ByteString (ByteString)
import Data.Data
import Data.Functor
import Data.Maybe
import Data.String (fromString)
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Builder
import Safe (atMay)
import Graphics.UI.Threepenny.Internal.Types
showJSON :: ToJSON a => a -> String
showJSON
= Data.Text.Lazy.unpack
. Data.Text.Lazy.Builder.toLazyText
. Data.Aeson.Encode.fromValue . JSON.toJSON
newtype JSCode = JSCode { unJSCode :: String }
deriving (Eq, Ord, Show, Data, Typeable)
class ToJS a where
render :: a -> JSCode
instance ToJS String where render = render . JSON.String . fromString
instance ToJS Int where render = JSCode . show
instance ToJS Bool where render b = JSCode $ if b then "false" else "true"
instance ToJS JSON.Value where render = JSCode . showJSON
instance ToJS ByteString where render = JSCode . show
instance ToJS ElementId where
render (ElementId x) = apply "elidToElement(%1)" [render x]
instance ToJS Element where render = render . unprotectedGetElementId
data JSFunction a = JSFunction
{ code :: JSCode
, marshal :: Window -> JSON.Value -> JSON.Parser a
}
toCode :: JSFunction a -> String
toCode = unJSCode . code
marshalResult
:: JSFunction a
-> Window
-> JSON.Value
-> JSON.Result a
marshalResult fun w = JSON.parse (marshal fun w)
instance Functor JSFunction where
fmap f = fmapWindow (const f)
fmapWindow :: (Window -> a -> b) -> JSFunction a -> JSFunction b
fmapWindow f (JSFunction c m) = JSFunction c (\w v -> f w <$> m w v)
fromJSCode :: JSCode -> JSFunction ()
fromJSCode c = JSFunction { code = c, marshal = \_ _ -> return () }
class FFI a where
fancy :: ([JSCode] -> JSCode) -> a
instance (ToJS a, FFI b) => FFI (a -> b) where
fancy f a = fancy $ f . (render a:)
instance FFI (JSFunction ()) where fancy f = fromJSCode $ f []
instance FFI (JSFunction String) where fancy = mkResult "%1.toString()"
instance FFI (JSFunction JSON.Value) where fancy = mkResult "%1"
instance FFI (JSFunction [ElementId]) where fancy = mkResult "elementsToElids(%1)"
mkResult :: FromJSON a => String -> ([JSCode] -> JSCode) -> JSFunction a
mkResult client f = JSFunction
{ code = apply client [f []]
, marshal = \w -> parseJSON
}
ffi :: FFI a => String -> a
ffi macro = fancy (apply macro)
testFFI :: String -> Int -> JSFunction String
testFFI = ffi "$(%1).prop('checked',%2)"
apply :: String -> [JSCode] -> JSCode
apply code args = JSCode $ go code
where
at xs i = maybe (error err) id $ atMay xs i
err = "Graphics.UI.Threepenny.FFI: Too few arguments in FFI call!"
argument i = unJSCode (args `at` i)
go [] = []
go ('%':c:cs) = argument index ++ go cs
where index = fromEnum c fromEnum '1'
go (c:cs) = c : go cs