@@ -10,6 +10,7 @@
10{-# LANGUAGE TypeFamilies #-}
10{-# LANGUAGE TypeFamilies #-}
12import Control.Concurrent
12import Control.Concurrent
13+import Control.Lens ((^.))
13import Control.Monad
14import Control.Monad
14import Control.Monad.Catch
15import Control.Monad.Catch
15import Control.Monad.Fix
16import Control.Monad.Fix
@@ -19,7 +20,7 @@ import Data.IORef
19import Data.Maybe (fromMaybe)
20import Data.Maybe (fromMaybe)
20import Data.Proxy
21import Data.Proxy
21import Data.Text (Text)
22import Data.Text (Text)
22−import Language.Javascript.JSaddle (JSException(..), syncPoint, liftJSM)
23+import Language.Javascript.JSaddle (JSException(..), syncPoint, liftJSM, jsg, js1)
23import Language.Javascript.JSaddle.Warp
24import Language.Javascript.JSaddle.Warp
24import Network.HTTP.Types (status200)
25import Network.HTTP.Types (status200)
25import Network.Wai
26import Network.Wai
@@ -31,7 +32,7 @@ import System.Timeout
31import Test.Hspec
32import Test.Hspec
32import Test.HUnit
33import Test.HUnit
33import Test.WebDriver (WD)
34import Test.WebDriver (WD)
34−import qualified GHCJS.DOM.Types as DOM (File)
35+import qualified GHCJS.DOM.Types as DOM
35import qualified GHCJS.DOM.File as File
36import qualified GHCJS.DOM.File as File
37--import System.IO.Silently
38--import System.IO.Silently
@@ -39,6 +40,8 @@ import System.IO.Temp
39import System.Directory
40import System.Directory
40import qualified System.FilePath as FilePath
41import qualified System.FilePath as FilePath
43+import qualified GHCJS.DOM.EventM as EventM
44+import qualified GHCJS.DOM.GlobalEventHandlers as Events
42import qualified Data.ByteString.Lazy as LBS
45import qualified Data.ByteString.Lazy as LBS
43import qualified Data.Text as T
46import qualified Data.Text as T
44import qualified Data.Text.Encoding as TE
47import qualified Data.Text.Encoding as TE
@@ -199,6 +202,23 @@ main = hspec $ parallel $ do
200 testWidget' checkSSRAttr (\e -> assertAttr e "ssr" Nothing) $ el "div" $ text "hello world"
203 testWidget' checkSSRAttr (\e -> assertAttr e "ssr" Nothing) $ el "div" $ text "hello world"
205+ it "can't misuse raw elements" $ do
206+ clicked <- newIORef False
208+ e <- WD.findElem $ WD.ByTag "div"
209+ liftIO $ readIORef clicked >>= flip shouldBe True
213+ readIORef clicked >>= flip shouldBe False
214+ testWidget (pure ()) check $ do
215+ (e, _) <- el' "div" $ text "hello"
216+ prerender (pure ()) $ do
217+ let e' = DOM.uncheckedCastTo DOM.HTMLElement (_element_raw e)
218+ liftJSM $ e' `EventM.on` Events.click $ do
219+ liftIO $ writeIORef clicked True
202 describe "inputElement" $ parallel $ do
222 describe "inputElement" $ parallel $ do
203 it "doesn't wipe user input when switching over" $ do
223 it "doesn't wipe user input when switching over" $ do
204 inputRef <- newIORef ""
224 inputRef <- newIORef ""
@@ -240,6 +260,30 @@ main = hspec $ parallel $ do
240 testWidget (pure ()) checkValue $ do
260 testWidget (pure ()) checkValue $ do
241 e <- inputElement def
261 e <- inputElement def
242 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
262 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
263+ it "sets value appropriately" $ do
264+ valueByUIRef <- newIORef ""
265+ valueRef <- newIORef ""
266+ setValueChan :: Chan Text <- newChan
268+ liftIO $ readIORef valueByUIRef >>= flip shouldBe ""
269+ liftIO $ readIORef valueRef >>= flip shouldBe ""
270+ e <- WD.findElem $ WD.ByTag "input"
271+ WD.sendKeys "hello" e
274+ readIORef valueByUIRef >>= flip shouldBe "hello"
275+ readIORef valueRef >>= flip shouldBe "hello"
276+ writeChan setValueChan "world"
278+ readIORef valueByUIRef >>= flip shouldBe "hello"
279+ readIORef valueRef >>= flip shouldBe "world"
280+ testWidget (pure ()) checkValue $ do
281+ (setValue, triggerSetValue) <- newTriggerEvent
282+ prerender (pure ()) $ liftIO $ void $ forkIO $ forever $ do
283+ triggerSetValue =<< readChan setValueChan
284+ e <- inputElement $ def & inputElementConfig_setValue .~ setValue
285+ performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e
286+ performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
243 it "sets checked appropriately" $ do
287 it "sets checked appropriately" $ do
244 checkedByUIRef <- newIORef False
288 checkedByUIRef <- newIORef False
245 checkedRef <- newIORef False
289 checkedRef <- newIORef False