diff --git a/ghcjs-dom-jsffi.cabal b/ghcjs-dom-jsffi.cabal --- a/ghcjs-dom-jsffi.cabal +++ b/ghcjs-dom-jsffi.cabal @@ -1,6 +1,6 @@ name: ghcjs-dom-jsffi -version: 0.3.1.0 -cabal-version: >=1.22 +version: 0.4.0.0 +cabal-version: >=1.24 build-type: Simple license: MIT license-file: LICENSE diff --git a/src/GHCJS/DOM.hs b/src/GHCJS/DOM.hs --- a/src/GHCJS/DOM.hs +++ b/src/GHCJS/DOM.hs @@ -1,167 +1,35 @@ {-# LANGUAGE CPP, ForeignFunctionInterface, OverloadedStrings #-} -#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT) {-# LANGUAGE JavaScriptFFI #-} -#endif module GHCJS.DOM ( currentWindow , currentDocument -, WebView(..) -, webViewGetDomDocument -, runWebGUI -, enableInspector -, postGUISync -, postGUIAsync +, run +, syncPoint +, syncAfter +, catch +, bracket ) where -import qualified Data.Text as T -import Data.Monoid ((<>)) -#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT) -import GHCJS.Types (JSVal(..)) import Control.Applicative ((<$>)) -#else -import Graphics.UI.Gtk.WebKit.WebView - (webViewSetWebSettings, webViewGetWebSettings, loadStarted, - webViewLoadUri, loadFinished, webViewNew, webViewGetDomDocument, - webViewGetInspector) -import Graphics.UI.Gtk.WebKit.WebInspector - (showWindow, inspectWebView) -import Graphics.UI.Gtk - (timeoutAddFull, widgetShowAll, mainQuit, objectDestroy, - WindowPosition(..), containerAdd, scrolledWindowNew, - windowSetPosition, windowSetDefaultSize, windowNew, mainGUI, - initGUI, postGUISync, postGUIAsync) -import System.Glib.Signals (on) -import System.Glib.Attributes (get, AttrOp(..), set) -import System.Glib.FFI (maybeNull) -import System.Glib.MainLoop (priorityLow) -import Graphics.UI.Gtk.WebKit.WebSettings - (webSettingsMonospaceFontFamily, webSettingsUserAgent, - webSettingsEnableDeveloperExtras) -import Control.Monad.IO.Class (liftIO) -#endif +import Control.Exception (catch, bracket) import GHCJS.DOM.Types -import GHCJS.DOM.JSFFI.Generated.Window (getNavigator, getDocument) -import GHCJS.DOM.JSFFI.Generated.Navigator (getUserAgent) -import Foreign (ForeignPtr, nullPtr, Ptr) -import Control.Monad (unless, forever, liftM) -import Control.Concurrent - (yield, threadDelay, takeMVar, newEmptyMVar) -import System.Environment (getArgs) -import Data.List (isSuffixOf) -#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT) -postGUIAsync :: IO () -> IO () -postGUIAsync = id - -postGUISync :: IO a -> IO a -postGUISync = id - -#ifdef ghcjs_HOST_OS foreign import javascript unsafe "$r = window" ghcjs_currentWindow :: IO (Nullable Window) foreign import javascript unsafe "$r = document" ghcjs_currentDocument :: IO (Nullable Document) -#else -ghcjs_currentWindow :: IO (Nullable Window) -ghcjs_currentWindow = undefined -ghcjs_currentDocument :: IO (Nullable Document) -ghcjs_currentDocument = undefined -#endif currentWindow :: IO (Maybe Window) currentWindow = nullableToMaybe <$> ghcjs_currentWindow currentDocument :: IO (Maybe Document) currentDocument = nullableToMaybe <$> ghcjs_currentDocument -type WebView = Window -castToWebView = id - -webViewGetDomDocument :: Window -> IO (Maybe Document) -webViewGetDomDocument = getDocument -#else -foreign import ccall safe "ghcjs_currentWindow" - ghcjs_currentWindow :: IO (Ptr Window) - -currentWindow :: IO (Maybe Window) -currentWindow = maybeNull (makeNewGObject mkWindow) ghcjs_currentWindow - -foreign import ccall unsafe "ghcjs_currentDocument" - ghcjs_currentDocument :: IO (Ptr Document) - -currentDocument :: IO (Maybe Document) -currentDocument = maybeNull (makeNewGObject mkDocument) ghcjs_currentDocument -#endif - -runWebGUI :: (WebView -> IO ()) -> IO () -runWebGUI = runWebGUI' "GHCJS" - -runWebGUI' :: T.Text -> (WebView -> IO ()) -> IO () -runWebGUI' userAgentKey main = do - -- Are we in a java script inside some kind of browser - mbWindow <- currentWindow - case mbWindow of - Just window -> do - -- Check if we are running in javascript inside the the native version - Just n <- getNavigator window - agent <- getUserAgent n - unless ((" " <> userAgentKey) `T.isSuffixOf` agent) $ main (castToWebView window) - Nothing -> do - makeDefaultWebView userAgentKey main +run :: Int -> IO () -> IO () +run _ = id -makeDefaultWebView :: T.Text -> (WebView -> IO ()) -> IO () -#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT) -makeDefaultWebView _ _ = error "Unsupported makeDefaultWebView" -#else -makeDefaultWebView userAgentKey main = do - initGUI - window <- windowNew - timeoutAddFull (yield >> return True) priorityLow 10 - windowSetDefaultSize window 900 600 - windowSetPosition window WinPosCenter - scrollWin <- scrolledWindowNew Nothing Nothing - webView <- webViewNew - settings <- webViewGetWebSettings webView - userAgent <- settings `get` webSettingsUserAgent - settings `set` [webSettingsUserAgent := userAgent <> " " <> userAgentKey] - webViewSetWebSettings webView settings - window `containerAdd` scrollWin - scrollWin `containerAdd` webView - on window objectDestroy . liftIO $ mainQuit - widgetShowAll window - webView `on` loadFinished $ \frame -> do - main webView - args <- getArgs - case args of - uri:_ -> webViewLoadUri webView (T.pack uri) - [] -> do - main webView - mainGUI -#endif +syncPoint :: IO () +syncPoint = return () -enableInspector :: WebView -> IO () -#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT) -enableInspector _ = return () -#else -enableInspector webView = do - settings <- webViewGetWebSettings webView - settings `set` [webSettingsEnableDeveloperExtras := True] - webViewSetWebSettings webView settings - inspector <- webViewGetInspector webView - window <- windowNew - windowSetDefaultSize window 900 300 - scrollWin <- scrolledWindowNew Nothing Nothing - inspector `on` inspectWebView $ \view -> do - inspectorView <- webViewNew - settings <- webViewGetWebSettings inspectorView - settings `set` [webSettingsMonospaceFontFamily := ("Consolas" :: String)] - webViewSetWebSettings inspectorView settings - scrollWin `containerAdd` inspectorView - window `containerAdd` scrollWin - widgetShowAll window - return inspectorView - inspector `on` showWindow $ do - widgetShowAll window - return True - return () -#endif +syncAfter :: IO () -> IO () +syncAfter = id diff --git a/src/GHCJS/DOM/JSFFI/FormData.hs b/src/GHCJS/DOM/JSFFI/FormData.hs --- a/src/GHCJS/DOM/JSFFI/FormData.hs +++ b/src/GHCJS/DOM/JSFFI/FormData.hs @@ -1,6 +1,9 @@ {-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-} module GHCJS.DOM.JSFFI.FormData ( module Generated + , js_newFormData0 + , js_newFormData1 + , newFormData , js_append , js_append3 , append @@ -10,10 +13,22 @@ import Control.Monad.IO.Class (MonadIO(..)) import GHCJS.Types (JSVal, JSString) -import GHCJS.Marshal.Internal (PToJSVal(..)) +import GHCJS.Marshal.Pure (PToJSVal(..)) import GHCJS.DOM.Types -import GHCJS.DOM.JSFFI.Generated.FormData as Generated hiding (js_append, append) +import GHCJS.DOM.JSFFI.Generated.FormData as Generated hiding (js_append, append, newFormData) + + +foreign import javascript unsafe "new window[\"FormData\"]()" + js_newFormData0 :: IO FormData + +foreign import javascript unsafe "new window[\"FormData\"]($1)" + js_newFormData1 :: HTMLFormElement -> IO FormData + +-- | +newFormData :: (MonadIO m) => Maybe HTMLFormElement -> m FormData +newFormData = liftIO . maybe js_newFormData0 js_newFormData1 + foreign import javascript unsafe "$1[\"append\"]($2, $3)" js_append :: FormData -> JSString -> JSVal -> IO ()