📷 Add navigator.mediaDevices.getUserMedia API (#1077)

- [x] Allows camera access (implement `getUserMedia` API)
- [x] `JSVal` -> `DOMRef`
- [x] Re-export `JSVal` (convenience)
- [x] Export `previousSibling`

Author: dmjio

src/Miso.hs

@@ -77,7 +77,7 @@ module Miso
 import           Control.Monad (void)
 import           Control.Monad.IO.Class (liftIO)
 import           Data.IORef (newIORef)
-import           Language.Javascript.JSaddle (Object(Object), JSM, JSVal)
+import           Language.Javascript.JSaddle (Object(Object), JSM)
 #ifndef GHCJS_BOTH
 #ifdef WASM
 import qualified Language.Javascript.JSaddle.Wasm.TH as JSaddle.Wasm.TH
@@ -153,7 +153,7 @@ renderComponent
   -- ^ Name of the JS object that contains the drawing context
   -> Component model action
   -- ^ Component application
-  -> JSM [JSVal]
+  -> JSM [DOMRef]
   -- ^ Custom hook to perform any JSM action (e.g. render styles) before initialization.
   -> JSM ()
 renderComponent Nothing vcomp _ = startComponent vcomp
@@ -166,7 +166,7 @@ initComponent
   :: Eq model
   => Component model action
   -- ^ Component application
-  -> JSM [JSVal]
+  -> JSM [DOMRef]
   -- ^ Custom hook to perform any JSM action (e.g. render styles) before initialization.
   -> JSM (ComponentState model action)
 initComponent vcomp@Component{..} hooks = do

src/Miso/FFI.hs

@@ -47,10 +47,15 @@ module Miso.FFI
   , getComponentId
   -- ** DOM
   , nextSibling
+  , previousSibling
   -- ** Element
   , click
   , files
+  -- ** Re-exports
+  , JSVal
   ) where
 -----------------------------------------------------------------------------
 import           Miso.FFI.Internal
 -----------------------------------------------------------------------------
+import           Language.Javascript.JSaddle (JSVal)
+-----------------------------------------------------------------------------

src/Miso/FFI/Internal.hs

@@ -55,6 +55,7 @@ module Miso.FFI.Internal
    , getElementById
    , diff
    , nextSibling
+   , previousSibling
    -- * Conversions
    , integralToJSString
    , realFloatToJSString
@@ -99,6 +100,8 @@ module Miso.FFI.Internal
    -- * Element
    , files
    , click
+   -- * Media
+   , getUserMedia
    ) where
 -----------------------------------------------------------------------------
 import           Control.Concurrent (ThreadId, forkIO)
@@ -615,12 +618,18 @@ getParentComponentId domRef =
 getComponentId :: JSVal -> JSM Int
 getComponentId vtree = fromJSValUnchecked =<< vtree ! "componentId"
 -----------------------------------------------------------------------------
--- | Fetch sibling DOM node
+-- | Fetch next sibling DOM node
 --
 -- @since 1.9.0.0
 nextSibling :: JSVal -> JSM JSVal
 nextSibling domRef = domRef ! "nextSibling"
 -----------------------------------------------------------------------------
+-- | Fetch previous sibling DOM node
+--
+-- @since 1.9.0.0
+previousSibling :: JSVal -> JSM JSVal
+previousSibling domRef = domRef ! "previousSibling"
+-----------------------------------------------------------------------------
 -- | When working with /<input>/ of type="file", this is useful for
 -- extracting out the selected files.
 --
@@ -645,3 +654,28 @@ files domRef = fromJSValUnchecked =<< domRef ! "files"
 click :: () -> JSVal -> JSM ()
 click () domRef = void $ domRef # "click" $ ([] :: [MisoString])
 -----------------------------------------------------------------------------
+-- | Get Camera on user's device
+--
+-- <https://developer.mozilla.org/en-US/docs/Web/API/MediaDevices/getUserMedia>
+--
+getUserMedia
+  :: Bool
+  -- ^ video
+  -> Bool
+  -- ^ audio
+  -> (JSVal -> JSM ())
+  -- ^ successful
+  -> (JSVal -> JSM ())
+  -- ^ errorful
+  -> JSM ()
+getUserMedia video audio successful errorful = do
+  params <- create
+  set (ms "video") video params
+  set (ms "audio") audio params
+  devices <- jsg "navigator" ! "mediaDevices"
+  promise <- devices # "getUserMedia" $ [params]
+  successfulCallback <- asyncCallback1 successful
+  void $ promise # "then" $ [successfulCallback]
+  errorfulCallback <- asyncCallback1 errorful
+  void $ promise # "catch" $ [errorfulCallback]
+-----------------------------------------------------------------------------

src/Miso/Media.hs

@@ -1,4 +1,5 @@
 -----------------------------------------------------------------------------
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 -----------------------------------------------------------------------------
@@ -15,13 +16,17 @@ module Miso.Media
     Media        (..)
   , NetworkState (..)
   , ReadyState   (..)
+  , UserMedia    (..)
+  , Stream
   -- *** Constructors
   , newAudio
+  , userMedia
   -- *** Methods
   , canPlayType
   , load
   , play
   , pause
+  , getUserMedia
   -- *** Properties
   , autoplay
   , controls
@@ -52,8 +57,10 @@ import           Control.Monad
 import           Language.Javascript.JSaddle hiding (new)
 import qualified Language.Javascript.JSaddle as JS 
 -----------------------------------------------------------------------------
+import qualified Miso.FFI.Internal as FFI
 import           Miso.FFI
 import           Miso.Event
+import           Miso.Effect
 import           Miso.String
 -----------------------------------------------------------------------------
 newtype Media = Media JSVal
@@ -196,3 +203,33 @@ videoWidth (Media m) = fromJSValUnchecked =<< m ! ("videoWidth" :: MisoString)
 volume :: Media -> JSM Double
 volume (Media m) = fromJSValUnchecked =<< m ! ("volume" :: MisoString)
 -----------------------------------------------------------------------------
+-- | Type for dealing with 'navigator.mediaDevices.getUserMedia'
+data UserMedia
+  = UserMedia
+  { audio, video :: Bool
+  } deriving (Show, Eq)
+-----------------------------------------------------------------------------
+-- | Default 'UserMedia'
+userMedia :: UserMedia
+userMedia = UserMedia True True
+-----------------------------------------------------------------------------
+type Stream = JSVal
+-----------------------------------------------------------------------------
+-- | Get access to user's media devices.
+--
+-- <https://developer.mozilla.org/en-US/docs/Web/API/MediaDevices/getUserMedia>
+--
+getUserMedia
+  :: UserMedia
+  -- ^ Options
+  -> (Stream -> action)
+  -- ^ Successful callback
+  -> (JSVal -> action)
+  -- ^ Errorful callback
+  -> Effect model action
+getUserMedia UserMedia {..} successful errorful =
+  withSink $ \sink ->
+    FFI.getUserMedia audio video
+      (sink . successful)
+      (sink . errorful)
+-----------------------------------------------------------------------------