packages feed

ghcjs-dom-jsffi 0.3.1.0 → 0.4.0.0

raw patch · 3 files changed

+31/−148 lines, 3 files

Files

ghcjs-dom-jsffi.cabal view
@@ -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
src/GHCJS/DOM.hs view
@@ -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
src/GHCJS/DOM/JSFFI/FormData.hs view
@@ -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++-- | <https://developer.mozilla.org/en-US/docs/Web/API/FormData Mozilla FormData documentation>+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 ()