react-flux-1.0.2: test/spec/TestClientSpec.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module TestClientSpec (spec) where
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.List
import Data.Time
import qualified Data.Text as T
import System.Directory (getCurrentDirectory)
import Test.Hspec.WebDriver
loadLog :: WD [String]
loadLog = executeJS [] "var old = window.test_client_output; window.test_client_output = []; return old;"
shouldBeEvent :: String -> (String, Bool, Int) -> WD ()
shouldBeEvent evt (expectedType, evtBandC, evtPhase) = do
let prefix = concat
[ "Event {evtType = \"" ++ expectedType ++ "\", "
, "evtBubbles = " ++ show evtBandC ++ ", "
, "evtCancelable = " ++ show evtBandC ++ ", "
, "evtCurrentTarget = EventTarget, evtDefaultPrevented = False, "
, "evtPhase = " ++ show evtPhase ++ ", "
, "evtIsTrusted = True, evtTarget = EventTarget, evtTimestamp = "
]
unless (prefix `isPrefixOf` evt) $
error $ "Expecting " ++ prefix ++ " but got " ++ evt
let suffix = dropWhile (/= ' ') $ drop (length prefix) evt
suffix `shouldBe` " evtHandlerArg = HandlerArg}"
lifecyclePropsAndStateAre :: String -> Int -> WD ()
lifecyclePropsAndStateAre props st = do
stE <- findElem (ById "hello")
getText stE `shouldReturn` (T.pack $ show st)
p <- findElem (ById "world")
getText p `shouldReturn` (T.pack $ "Current props: " ++ props)
scuShouldBe :: [(Int, String)] -> WD ()
scuShouldBe items = do
d <- findElem $ ById "should-component-update"
lis <- findElemsFrom d $ ByTag "li"
length lis `shouldBe` length items
forM_ (zip lis items) $ \(li,(i, s)) ->
getText li `shouldReturn` (T.pack $ show i ++ s)
intlSpanShouldBe :: String -> String -> WD ()
intlSpanShouldBe ident txt = do
e <- findElem (ById $ T.pack ident)
getText e `shouldReturn` T.pack txt
intlPlaceholderShouldBe :: String -> String -> WD ()
intlPlaceholderShouldBe ident txt = do
e <- findElem (ById $ T.pack ident)
input <- findElemFrom e $ ByTag "input"
(input `attr` "placeholder") `shouldReturn` Just (T.pack txt)
-- | Only up to 999,999 since this is just used for the number of days since 1969
showWithComma :: Integer -> String
showWithComma i = show x ++ "," ++ show y
where
(x, y) = divMod i 1000
spec :: Spec
spec = do
describe "React 0.13" $ testClientSpec "test-client13.html"
describe "React 0.14" $ do
testClientSpec "test-client14.html"
intlSpec "test-client14.html"
testClientSpec :: String -> Spec
testClientSpec filename = session " for the test client" $ using Chrome $ do
it "opens the page" $ runWD $ do
dir <- liftIO $ getCurrentDirectory
openPage $ "file://" ++ dir ++ "/../client/" ++ filename
loadLog `shouldReturn`
[ "will mount"
, "Current props and state: Hello, 12"
, "did mount"
, "Current props and state: Hello, 100"
, "this id = lifecycle-p"
, "refStr id = hello"
, "refProps id = world"
]
lifecyclePropsAndStateAre "Hello" 100
it "processes a focus event" $ runWD $ do
findElem (ById "keyinput") >>= click
[focus, evt] <- loadLog
focus `shouldBe` "focus"
evt `shouldBeEvent` ("focus", False, 1)
it "processes a keydown event" $ runWD $ do
findElem (ById "keyinput") >>= sendKeys "x"
[keydown, evt, keyEvt, modState, target, curTarget] <- loadLog
keydown `shouldBe` "keydown"
evt `shouldBeEvent` ("keydown", True, 3)
keyEvt `shouldBe` "(False,0,False,\"Unidentified\",88,\"\",0,False,False,False,88)"
modState `shouldBe` "alt modifier: False"
target `shouldBe` "keyinput"
curTarget `shouldBe` "keyinput"
it "processes a keydown with alt" $ runWD $ do
findElem (ById "keyinput") >>= sendKeys "\xE00Ar" -- send Alt-r
-- generates two events, one for alt, one for r
[_, _, keyEvt, modState, _, _, _, _, keyEvt2, modState2, _, _] <- loadLog
keyEvt `shouldBe` "(True,0,False,\"Alt\",18,\"\",0,False,False,False,18)"
modState `shouldBe` "alt modifier: True"
keyEvt2 `shouldBe` "(True,0,False,\"Unidentified\",82,\"\",0,False,False,False,82)"
modState2 `shouldBe` "alt modifier: True"
it "processes a click event" $ runWD $ do
findElem (ById "clickinput") >>= click
[clickName, evt, mouseEvt, modState] <- loadLog
clickName `shouldBe` "click"
evt `shouldBeEvent` ("click", True, 3)
mouseEvt `shouldBe` "(False,0,0,37,54,False,False,37,54,EventTarget,37,54,False)"
modState `shouldBe` "alt modifier: False"
{- touch events can't be tested at the moment, chrome doesn't support them
it "processes a touchinput event" $ runWD $ do
t <- findElem $ ById "touchinput"
touchClick t
-}
it "stops the default browser action" $ runWD $ do
findElem (ById "some-link") >>= click
[x] <- loadLog
x `shouldBe` "Click some-link"
url <- getCurrentURL
unless ("file:" `isPrefixOf` url) $ error "Default browser action was not prevented"
it "stops propagating an event in the bubbling phase" $ runWD $ do
findElem (ById "inner-span") >>= moveToCenter
clickWith LeftButton
[inner] <- loadLog
inner `shouldBe` "Click inner span"
it "stops propagating an event during the capture phase" $ runWD $ do
findElem (ById "inner-span") >>= moveToCenter
doubleClick
[inner, outer] <- loadLog
inner `shouldBe` "Click inner span"
outer `shouldBe` "Double click outer div"
it "has rendered the raw show view" $ runWD $
(findElem (ById "raw-show-view") >>= getText)
`shouldReturn` "42"
describe "lifecycle events" $ do
it "properly updates the state" $ runWD $ do
findElem (ById "increment-state") >>= click
loadLog `shouldReturn`
[ "will update"
, "Current props and state: Hello, 100"
, "New props: Hello"
, "New state: 101"
, "did update"
, "Current props and state: Hello, 101"
, "Old props: Hello"
, "Old state: 100"
]
lifecyclePropsAndStateAre "Hello" 101
it "properly updates the properties" $ runWD $ do
findElem (ById "add-app-str") >>= click
loadLog `shouldReturn`
[ "will recv props"
, "Current props and state: Hello, 101"
, "New props: Helloo"
, "will update"
, "Current props and state: Hello, 101"
, "New props: Helloo"
, "New state: 101"
, "did update"
, "Current props and state: Helloo, 101"
, "Old props: Hello"
, "Old state: 101"
]
lifecyclePropsAndStateAre "Helloo" 101
it "unmounts" $ runWD $ do
findElem (ById "clear-app-str") >>= click
loadLog `shouldReturn`
[ "will unmount"
, "Current props and state: Helloo, 101"
]
describe "children passed to view" $ do
it "does not display null children" $ runWD $ do
s <- findElem $ ById "empty-children"
s `attr` "class" `shouldReturn` Just "display-children"
findElemsFrom s (ByCSS "*") `shouldReturn` []
getText s `shouldReturn` ""
it "displays a single child" $ runWD $ do
s <- findElem $ ById "single-child-wrapper"
s `attr` "class" `shouldReturn` Just "display-children"
s' <- findElemFrom s $ ByCSS "span#single-child"
getText s' `shouldReturn` "Single Child!!"
it "displays a child list" $ runWD $ do
s <- findElem $ ById "multi-child"
s `attr` "class" `shouldReturn` Just "display-children"
c1 <- findElemFrom s $ ByCSS "span#child1"
getText c1 `shouldReturn` "Child 1"
c2 <- findElemFrom s $ ByCSS "span#child2"
getText c2 `shouldReturn` "Child 2"
it "displays the elements inside the transition" $ runWD $ do
d <- findElem $ ById "css-transitions"
[a, b] <- findElemsFrom d $ ByCSS "span.css-transition-entry"
getText a `shouldReturn` "A"
getText b `shouldReturn` "B"
describe "bootstrap" $ do
it "displays and closes alert" $ runWD $ do
alert <- findElem $ ByCSS "div#bootstrap div.alert"
(findElemFrom alert (ByTag "p") >>= getText)
`shouldReturn` "Hello, World!"
findElemFrom alert (ByTag "button") >>= click
loadLog `shouldReturn` ["Closing alert"]
it "switchs nav items" $ runWD $ do
navUl <- findElem $ ByCSS "div#bootstrap nav > ul"
i1 <- findElemFrom navUl $ ByCSS "li:first-child a"
i2 <- findElemFrom navUl $ ByCSS "li:nth-child(2) a"
i3 <- findElemFrom navUl $ ByCSS "li:nth-child(3) a"
click i2
loadLog `shouldReturn` ["Switched to 2"]
click i3
loadLog `shouldReturn` ["Switched to 3"]
click i1
loadLog `shouldReturn` ["Switched to 1"]
describe "should component update" $ do
it "has the initial data" $ runWD $
scuShouldBe [(1, "Hello"), (2, "World"), (3, "!!!")]
it "increments just the first entry without re-rendering all entries" $ runWD $ do
findElem (ById "increment-first-scu") >>= click
scuShouldBe [(2, "Hello"), (2, "World"), (3, "!!!")]
loadLog `shouldReturn`
[ "Component will update"
, "current props: 1 Hello"
, "new props: 2 Hello"
]
it "does not update when no change to data" $ runWD $ do
findElem (ById "no-change-scu") >>= click
scuShouldBe [(2, "Hello"), (2, "World"), (3, "!!!")]
loadLog `shouldReturn` []
it "increments all entries" $ runWD $ do
findElem (ById "change-all-scu") >>= click
scuShouldBe [(3, "Hello"), (3, "World"), (4, "!!!")]
loadLog `shouldReturn`
[ "Component will update"
, "current props: 2 Hello"
, "new props: 3 Hello"
, "Component will update"
, "current props: 2 World"
, "new props: 3 World"
, "Component will update"
, "current props: 3 !!!"
, "new props: 4 !!!"
]
{-
it "inspects the session" $ runWD $ do
loadLog >>= \x -> liftIO $ putStrLn $ show x
inspectSession
-}
intlSpec :: String -> Spec
intlSpec filename = session " for the i18n test client" $ using Chrome $ do
it "opens the page" $ runWD $ do
dir <- liftIO $ getCurrentDirectory
openPage $ "file://" ++ dir ++ "/../client/" ++ filename
it "displays the intl formatted data" $ runWD $ do
"f-number" `intlSpanShouldBe` "90.0%"
"f-int" `intlSpanShouldBe` "100,000"
"f-double" `intlSpanShouldBe` "40,000.2"
"f-shortday" `intlSpanShouldBe` "Jul 20, 1969"
"f-fullday" `intlSpanShouldBe` "Sunday, July 20, 69 AD"
"f-date" `intlSpanShouldBe` "Sun, Jul 20, 69"
-- f-shorttime and f-fulltime cannot be (easily) tested since they rely on the current timezone
"f-time" `intlSpanShouldBe` "Jul 19, 69, 4:56:00 PM GMT-10"
"f-plural" `intlSpanShouldBe` "plural other"
today <- liftIO (utctDay <$> getCurrentTime)
let moon = fromGregorian 1969 7 20
daysAgo = diffDays today moon
yearsAgo :: Int = round $ realToFrac daysAgo / (365 :: Double) -- is close enough
"f-relative" `intlSpanShouldBe` (show yearsAgo ++ " years ago")
"f-relative-days" `intlSpanShouldBe` (showWithComma daysAgo ++ " days ago")
it "displays messages" $ runWD $ do
msg <- findElem $ ById "f-msg"
getText msg `shouldReturn` "Neil Armstrong took 100 photos years ago."
takenAgoSpan <- findElemFrom msg $ ById "takenAgoSpan"
getText takenAgoSpan `shouldReturn` "years ago"
msg' <- findElem $ ById "f-msg-with-descr"
getText msg' `shouldReturn` "Neil Armstrong took no photos."
"f-msg-with-trans" `intlSpanShouldBe` "message from translation xxx"
htmlMsg <- findElem $ ById "f-html-msg"
getText htmlMsg `shouldReturn` "42 is the answer to life, the universe, and everything"
(findElemFrom htmlMsg (ByTag "b") >>= getText)
`shouldReturn` "42"
htmlMsg' <- findElem $ ById "f-html-msg-with-descr"
getText htmlMsg' `shouldReturn` "42 is the answer to life, the universe, and everything"
(findElemFrom htmlMsg' (ByTag "b") >>= getText)
`shouldReturn` "answer"
it "displays formatted properties" $ runWD $ do
"f-number-prop" `intlPlaceholderShouldBe` "123,456"
"f-date-prop" `intlPlaceholderShouldBe` "7/20/1969"
"f-time-prop" `intlPlaceholderShouldBe` "Jul 19, 69, 4 PM"
"f-plural-prop" `intlPlaceholderShouldBe` "other"
"f-msg-prop" `intlPlaceholderShouldBe` "Neil Armstrong took 100 photos"
"f-msg-prop-with-descr" `intlPlaceholderShouldBe` "Neil Armstrong took 0 photos"