dd6dcd6 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Tests for placeRawElement and wrapRawElement

dd6dcd6Tom Smalley8 years ago

reflex-dom-core/test/hydration.hs+101−32

compare with develop

unifiedsplit

@@ -17,6 +17,7 @@ import Control.Monad.Fix

17import Control.Monad.IO.Class

18import Data.Foldable (traverse_)

19import Data.IORef

20+import Data.Map (Map)

20import Data.Maybe (fromMaybe)

21import Data.Maybe (fromMaybe)

21import Data.Proxy

22import Data.Proxy

22import Data.Text (Text)

23import Data.Text (Text)

@@ -42,8 +43,12 @@ import System.IO.Temp

42import System.Directory

43import System.Directory

43import qualified System.FilePath as FilePath

44import qualified System.FilePath as FilePath

46+import qualified GHCJS.DOM as DOM

47+import qualified GHCJS.DOM.Document as Document

48+import qualified GHCJS.DOM.Element as Element

45import qualified GHCJS.DOM.EventM as EventM

49import qualified GHCJS.DOM.EventM as EventM

46import qualified GHCJS.DOM.GlobalEventHandlers as Events

50import qualified GHCJS.DOM.GlobalEventHandlers as Events

51+import qualified GHCJS.DOM.Node as Node

47import qualified Data.ByteString.Lazy as LBS

52import qualified Data.ByteString.Lazy as LBS

48import qualified Data.Text as T

53import qualified Data.Text as T

49import qualified Data.Text.Encoding as TE

54import qualified Data.Text.Encoding as TE

@@ -293,9 +298,7 @@ main = hspec $ beforeAll startSeleniumServer $ do

293 readIORef valueByUIRef >>= flip shouldBe "hello"

298 readIORef valueByUIRef >>= flip shouldBe "hello"

294 readIORef valueRef >>= flip shouldBe "world"

299 readIORef valueRef >>= flip shouldBe "world"

295 testWidget (pure ()) checkValue $ do

300 testWidget (pure ()) checkValue $ do

296− (setValue, triggerSetValue) <- newTriggerEvent

301+ setValue <- triggerEventWithChan setValueChan

297− prerender (pure ()) $ liftIO $ void $ forkIO $ forever $ do

298− triggerSetValue =<< readChan setValueChan

299 e <- inputElement $ def & inputElementConfig_setValue .~ setValue

302 e <- inputElement $ def & inputElementConfig_setValue .~ setValue

300 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e

303 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e

301 performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)

304 performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)

@@ -318,9 +321,7 @@ main = hspec $ beforeAll startSeleniumServer $ do

318 readIORef checkedByUIRef >>= flip shouldBe True

321 readIORef checkedByUIRef >>= flip shouldBe True

319 readIORef checkedRef >>= flip shouldBe False

322 readIORef checkedRef >>= flip shouldBe False

320 testWidget (pure ()) checkValue $ do

323 testWidget (pure ()) checkValue $ do

321− (setChecked, triggerSetChecked) <- newTriggerEvent

324+ setChecked <- triggerEventWithChan setCheckedChan

322− prerender (pure ()) $ liftIO $ void $ forkIO $ forever $ do

323− triggerSetChecked =<< readChan setCheckedChan

324 e <- inputElement $ def

325 e <- inputElement $ def

325 & initialAttributes .~ "type" =: "checkbox"

326 & initialAttributes .~ "type" =: "checkbox"

326 & inputElementConfig_setChecked .~ setChecked

327 & inputElementConfig_setChecked .~ setChecked

@@ -384,9 +385,7 @@ main = hspec $ beforeAll startSeleniumServer $ do

384 readIORef valueByUIRef >>= flip shouldBe "hello"

385 readIORef valueByUIRef >>= flip shouldBe "hello"

385 readIORef valueRef >>= flip shouldBe "world"

386 readIORef valueRef >>= flip shouldBe "world"

386 testWidget (pure ()) checkValue $ prerender (pure ()) $ do

387 testWidget (pure ()) checkValue $ prerender (pure ()) $ do

387− (setValue, triggerSetValue) <- newTriggerEvent

388+ setValue <- triggerEventWithChan setValueChan

388− prerender (pure ()) $ liftIO $ void $ forkIO $ forever $ do

389− triggerSetValue =<< readChan setValueChan

390 e <- inputElement $ def & inputElementConfig_setValue .~ setValue

389 e <- inputElement $ def & inputElementConfig_setValue .~ setValue

391 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e

390 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e

392 performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)

391 performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)

@@ -409,9 +408,7 @@ main = hspec $ beforeAll startSeleniumServer $ do

409 readIORef checkedByUIRef >>= flip shouldBe True

408 readIORef checkedByUIRef >>= flip shouldBe True

410 readIORef checkedRef >>= flip shouldBe False

409 readIORef checkedRef >>= flip shouldBe False

411 testWidget (pure ()) checkValue $ prerender (pure ()) $ do

410 testWidget (pure ()) checkValue $ prerender (pure ()) $ do

412− (setChecked, triggerSetChecked) <- newTriggerEvent

411+ setChecked <- triggerEventWithChan setCheckedChan

413− prerender (pure ()) $ liftIO $ void $ forkIO $ forever $ do

414− triggerSetChecked =<< readChan setCheckedChan

415 e <- inputElement $ def

412 e <- inputElement $ def

416 & initialAttributes .~ "type" =: "checkbox"

413 & initialAttributes .~ "type" =: "checkbox"

417 & inputElementConfig_setChecked .~ setChecked

414 & inputElementConfig_setChecked .~ setChecked

@@ -506,9 +503,7 @@ main = hspec $ beforeAll startSeleniumServer $ do

506 readIORef valueByUIRef >>= flip shouldBe "hello"

503 readIORef valueByUIRef >>= flip shouldBe "hello"

507 readIORef valueRef >>= flip shouldBe "world"

504 readIORef valueRef >>= flip shouldBe "world"

508 testWidget (pure ()) checkValue $ do

505 testWidget (pure ()) checkValue $ do

509− (setValue', triggerSetValue) <- newTriggerEvent

506+ setValue' <- triggerEventWithChan setValueChan

510− prerender (pure ()) $ liftIO $ void $ forkIO $ forever $ do

511− triggerSetValue =<< readChan setValueChan

512 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }

507 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }

513 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _textAreaElement_input e

508 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _textAreaElement_input e

514 performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)

509 performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)

@@ -554,9 +549,7 @@ main = hspec $ beforeAll startSeleniumServer $ do

554 readIORef valueByUIRef >>= flip shouldBe "hello"

549 readIORef valueByUIRef >>= flip shouldBe "hello"

555 readIORef valueRef >>= flip shouldBe "world"

550 readIORef valueRef >>= flip shouldBe "world"

556 testWidget (pure ()) checkValue $ prerender (pure ()) $ do

551 testWidget (pure ()) checkValue $ prerender (pure ()) $ do

557− (setValue', triggerSetValue) <- newTriggerEvent

552+ setValue' <- triggerEventWithChan setValueChan

558− prerender (pure ()) $ liftIO $ void $ forkIO $ forever $ do

559− triggerSetValue =<< readChan setValueChan

560 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }

553 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }

561 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _textAreaElement_input e

554 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _textAreaElement_input e

562 performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)

555 performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)

@@ -642,9 +635,7 @@ main = hspec $ beforeAll startSeleniumServer $ do

642 readIORef valueByUIRef >>= flip shouldBe "two"

635 readIORef valueByUIRef >>= flip shouldBe "two"

643 readIORef valueRef >>= flip shouldBe "three"

636 readIORef valueRef >>= flip shouldBe "three"

644 testWidget (pure ()) checkValue $ do

637 testWidget (pure ()) checkValue $ do

645− (setValue', triggerSetValue) <- newTriggerEvent

638+ setValue' <- triggerEventWithChan setValueChan

646− prerender (pure ()) $ liftIO $ void $ forkIO $ forever $ do

647− triggerSetValue =<< readChan setValueChan

648 (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options

639 (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options

649 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _selectElement_change e

640 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _selectElement_change e

650 performEvent_ $ liftIO . writeIORef valueRef <$> updated (_selectElement_value e)

641 performEvent_ $ liftIO . writeIORef valueRef <$> updated (_selectElement_value e)

@@ -688,13 +679,89 @@ main = hspec $ beforeAll startSeleniumServer $ do

688 readIORef valueByUIRef >>= flip shouldBe "two"

679 readIORef valueByUIRef >>= flip shouldBe "two"

689 readIORef valueRef >>= flip shouldBe "three"

680 readIORef valueRef >>= flip shouldBe "three"

690 testWidget (pure ()) checkValue $ prerender (pure ()) $ do

681 testWidget (pure ()) checkValue $ prerender (pure ()) $ do

691− (setValue', triggerSetValue) <- newTriggerEvent

682+ setValue' <- triggerEventWithChan setValueChan

692− prerender (pure ()) $ liftIO $ void $ forkIO $ forever $ do

693− triggerSetValue =<< readChan setValueChan

694 (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options

683 (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options

695 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _selectElement_change e

684 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _selectElement_change e

696 performEvent_ $ liftIO . writeIORef valueRef <$> updated (_selectElement_value e)

685 performEvent_ $ liftIO . writeIORef valueRef <$> updated (_selectElement_value e)

697

686

687+ let createRawElement :: DOM.MonadJSM m => m DOM.Element

688+ createRawElement = do

689+ doc <- DOM.currentDocumentUnchecked

690+ div <- Document.createElement doc ("div" :: Text)

691+ Element.setAttribute div ("id" :: Text) ("raw" :: Text)

692+ text <- Document.createTextNode doc ("two" :: Text)

693+ Node.appendChild div text

694+ pure div

695+ describe "placeRawElement" $ do

696+ it "is placed correctly in the DOM at switchover" $ do

697+ let check = do

698+ shouldContainText "two" <=< WD.findElem $ WD.ByTag "div"

699+ shouldContainText "one\ntwo\nthree" <=< WD.findElem $ WD.ByTag "body"

700+ testWidget (pure ()) check $ do

701+ text "one"

702+ prerender (pure ()) $ placeRawElement =<< createRawElement

703+ text "three"

704+ it "is placed correctly in the DOM in immediate mode" $ do

705+ let check = do

706+ shouldContainText "two" <=< WD.findElem $ WD.ByTag "div"

707+ shouldContainText "one\ntwo\nthree" <=< WD.findElem $ WD.ByTag "body"

708+ testWidget (pure ()) check $ prerender (pure ()) $ do

709+ text "one"

710+ placeRawElement =<< createRawElement

711+ text "three"

712+ it "can be clicked" $ do

713+ clickedRef <- newIORef False

714+ let check = WD.click <=< WD.findElem $ WD.ByTag "div"

715+ testWidget (pure ()) check $ prerender (pure ()) $ do

716+ raw <- createRawElement

717+ placeRawElement raw

718+ let htmlElement = DOM.uncheckedCastTo DOM.HTMLElement raw

719+ liftJSM $ htmlElement `EventM.on` Events.click $ do

720+ liftIO $ writeIORef clickedRef True

721+ return ()

722+ clicked <- readIORef clickedRef

723+ assertEqual "Not clicked" True clicked

724+

725+ describe "wrapRawElement" $ do

726+ it "modifies attributes" $ do

727+ modifyAttrsChan :: Chan (Map AttributeName (Maybe Text)) <- newChan

728+ let check = do

729+ div <- WD.findElem $ WD.ByTag "div"

730+ assertAttr div "test" Nothing

731+ liftIO $ writeChan modifyAttrsChan ("test" =: Just "test")

732+ assertAttr div "test" (Just "test")

733+ testWidget (pure ()) check $ prerender (pure ()) $ do

734+ modifyAttrs <- triggerEventWithChan modifyAttrsChan

735+ raw <- createRawElement

736+ placeRawElement raw

737+ wrapRawElement raw $ RawElementConfig

738+ { _rawElementConfig_modifyAttributes = Just modifyAttrs

739+ , _rawElementConfig_eventSpec = (def :: EventSpec GhcjsDomSpace EventResult)

740+ }

741+ return ()

742+ it "works with eventFlags" $ do

743+ clickedRef <- newIORef False

744+ let clickBoth = do

745+ liftIO $ readIORef clickedRef >>= flip shouldBe False

746+ WD.findElem (WD.ById "normal") >>= WD.click

747+ liftIO $ do

748+ readIORef clickedRef >>= flip shouldBe True

749+ writeIORef clickedRef False

750+ WD.findElem (WD.ById "raw") >>= WD.click

751+ liftIO $ do

752+ threadDelay 100000

753+ readIORef clickedRef >>= flip shouldBe False

754+ testWidget (pure ()) clickBoth $ prerender (pure ()) $ do

755+ (e, _) <- el' "div" $ do

756+ raw <- createRawElement

757+ placeRawElement raw

758+ wrapRawElement raw $ RawElementConfig

759+ { _rawElementConfig_modifyAttributes = Nothing

760+ , _rawElementConfig_eventSpec = addEventSpecFlags (Proxy :: Proxy GhcjsDomSpace) Click (\_ -> stopPropagation) (def :: EventSpec GhcjsDomSpace EventResult)

761+ }

762+ elAttr "div" ("id" =: "normal") $ text "normal"

763+ performEvent_ $ liftIO (writeIORef clickedRef True) <$ domEvent Click e

764+

698 describe "prerender" $ do

765 describe "prerender" $ do

699 it "works in simple case" $ do

766 it "works in simple case" $ do

700 testWidget (checkBodyText "One") (checkBodyText "Two") $ do

767 testWidget (checkBodyText "One") (checkBodyText "Two") $ do

@@ -736,6 +803,12 @@ startSeleniumServer = do

736 _ <- forkIO $ print =<< waitForProcess ph

803 _ <- forkIO $ print =<< waitForProcess ph

737 threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on

804 threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on

738

805

806+triggerEventWithChan :: (TriggerEvent t m, Prerender js m) => Chan a -> m (Event t a)

807+triggerEventWithChan chan = do

808+ (e, trigger) <- newTriggerEvent

809+ prerender (pure ()) $ void $ liftIO $ forkIO $ forever $ trigger =<< readChan chan

810+ pure e

811+

739assertAttr :: WD.Element -> Text -> Maybe Text -> WD ()

812assertAttr :: WD.Element -> Text -> Maybe Text -> WD ()

740assertAttr e k v = liftIO . assertEqual "Incorrect attribute value" v =<< WD.attr e k

813assertAttr e k v = liftIO . assertEqual "Incorrect attribute value" v =<< WD.attr e k

741

814

@@ -746,21 +819,17 @@ elementShouldBeRemoved e = do

746 Left e -> throwM e

819 Left e -> throwM e

747 Right !_ -> liftIO $ assertFailure "Expected element to be removed, but it still exists"

820 Right !_ -> liftIO $ assertFailure "Expected element to be removed, but it still exists"

748

821

749−shouldContainText :: WD.Element -> Text -> WD ()

822+shouldContainText :: Text -> WD.Element -> WD ()

750−shouldContainText e t = liftIO . flip shouldBe t =<< WD.getText e

823+shouldContainText t = liftIO . flip shouldBe t <=< WD.getText

751

824

752checkBodyText :: Text -> WD ()

825checkBodyText :: Text -> WD ()

753checkBodyText = checkTextInTag "body"

826checkBodyText = checkTextInTag "body"

754

827

755checkTextInTag :: Text -> Text -> WD ()

828checkTextInTag :: Text -> Text -> WD ()

756−checkTextInTag tag expected = do

829+checkTextInTag tag expected = WD.findElem (WD.ByTag tag) >>= shouldContainText expected

757− body <- WD.findElem $ WD.ByTag tag

758− body `shouldContainText` expected

759

830

760checkTextInId :: Text -> Text -> WD ()

831checkTextInId :: Text -> Text -> WD ()

761−checkTextInId i expected = do

762− e <- WD.findElem $ WD.ById i

763− e `shouldContainText` expected

832+checkTextInId i expected = WD.findElem (WD.ById i) >>= shouldContainText expected

764

833

765divId :: DomBuilder t m => Text -> m a -> m a

834divId :: DomBuilder t m => Text -> m a -> m a

766divId i = elAttr "div" ("id" =: i)

835divId i = elAttr "div" ("id" =: i)