1
1
mirror of https://github.com/aelve/guide.git synced 2024-12-10 23:19:47 +03:00
guide/tests/WebSpec.hs

601 lines
23 KiB
Haskell
Raw Normal View History

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE IncoherentInstances #-}
2016-08-21 14:32:52 +03:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
2016-08-21 14:32:52 +03:00
module WebSpec (tests) where
import BasePrelude hiding (catch, bracket)
-- Monads
import Control.Monad.IO.Class
2016-08-24 18:05:27 +03:00
import Control.Monad.Loops
2016-08-21 14:32:52 +03:00
-- Concurrency
import qualified SlaveThread as Slave
-- Text
import Data.Text.All (Text)
2016-08-23 16:03:54 +03:00
import qualified Data.Text.All as T
2016-08-21 14:32:52 +03:00
-- Files
import System.Directory
-- URLs
import Network.URI
-- Exceptions
import Control.Monad.Catch
-- Testing
import Selenium
2016-08-21 14:32:52 +03:00
-- Site
import qualified Guide
import Config (Config(..))
-----------------------------------------------------------------------------
-- Tests
-----------------------------------------------------------------------------
tests :: IO ()
tests = run $ do
mainPageTests
categoryTests
2016-09-01 22:49:35 +03:00
itemTests
2016-08-22 17:10:29 +03:00
markdownTests
2016-08-21 14:32:52 +03:00
mainPageTests :: Spec
mainPageTests = session "main page" $ using Firefox $ do
openGuide "/"
wd "is initially empty" $ do
2016-08-22 16:11:14 +03:00
checkPresent "#categories"
checkNotPresent "#categories > *"
2016-08-21 14:32:52 +03:00
wd "has a google-token" $ do
2016-09-01 01:25:46 +03:00
"meta[name=google-site-verification]" `shouldHaveAttr`
("content", "some-google-token")
2016-08-21 14:32:52 +03:00
wd "has a title" $ do
2016-09-01 01:25:46 +03:00
"h1" `shouldHaveText` "Aelve Guide: Haskell"
describe "subtitle" $ do
wd "is present" $ do
2016-09-01 01:25:46 +03:00
sub <- select ".subtitle"
fs <- fontSize sub; fs `shouldBeInRange` (15,17)
wd "has a discuss link" $ do
checkPresent ".subtitle a[href='http://discuss.link']"
describe "footer" $ do
2016-08-21 14:32:52 +03:00
wd "is present" $ do
2016-08-22 16:11:14 +03:00
checkPresent "#footer"
2016-08-21 14:32:52 +03:00
wd "isn't overflowing" $ do
setWindowSize (900, 500) -- the footer is about 800px wide
2016-09-01 01:25:46 +03:00
footer <- select "#footer"
(width, height) <- elemSize footer
2016-08-23 16:03:54 +03:00
width `shouldBeInRange` (750, 850)
height `shouldBeInRange` (60, 70)
2016-08-21 14:32:52 +03:00
-- and now it shall be overflowing
setWindowSize (700, 500)
waitUntil wait_delay (expect . inRange (90, 140) . snd =<< elemSize footer)
`catch` \(_::ExpectFailed) -> return ()
2016-09-01 01:25:46 +03:00
height2 <- snd <$> elemSize footer
height2 `shouldBeInRange` (90, 140)
2016-08-21 14:32:52 +03:00
categoryTests :: Spec
categoryTests = session "categories" $ using Firefox $ do
openGuide "/"
wd "add a new category" $ do
2016-08-22 18:09:46 +03:00
createCategory "Some category"
2016-08-22 16:11:14 +03:00
checkPresent ".category"
2016-08-21 14:32:52 +03:00
url <- getCurrentRelativeURL
2016-08-24 22:17:54 +03:00
(slug, _) <- parseCategoryURL (uriPath url)
slug `shouldBe` "some-category"
2016-08-21 14:32:52 +03:00
describe "created category" $ do
wd "has a link to the main page" $ do
2016-09-01 01:25:46 +03:00
titleLink <- select "h1 > a"
titleLink `shouldHaveText` "Aelve Guide: Haskell"
2016-09-03 21:49:55 +03:00
titleLink `shouldLinkToRelative` "/haskell"
2016-08-21 14:32:52 +03:00
wd "has a subtitle" $ do
2016-08-22 16:11:14 +03:00
checkPresent ".subtitle"
2016-08-21 14:32:52 +03:00
wd "doesn't have an add-category field" $ do
2016-08-22 16:11:14 +03:00
checkNotPresent ".add-category"
2016-08-24 22:17:54 +03:00
wd "is present on the main page" $ do
2016-09-03 21:49:55 +03:00
getBackAfterwards $ do
catURL <- getCurrentURL
openGuidePage "/"
ByLinkText "Some category" `shouldLinkTo` catURL
wd "is initially empty" $ do
checkPresent ".items"
checkNotPresent (".items" :// Not ".dummy")
2016-08-22 21:15:40 +03:00
describe "category properties" $ do
describe "title" $ do
wd "is present" $ do
2016-08-24 01:00:19 +03:00
e <- select categoryTitle; e `shouldHaveText` "Some category"
fs <- fontSize e; fs `shouldBeInRange` (20, 26)
2016-08-22 21:15:40 +03:00
wd "can be changed" $ do
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
enterInput "Cat 1" (form :// ByName "title")
2016-09-01 01:25:46 +03:00
categoryTitle `shouldHaveText` "Cat 1"
2016-08-24 22:17:54 +03:00
wd "changes page slug when changed" $ do
changesURL $ refresh
do (slug, _) <- parseCategoryURL . uriPath =<< getCurrentRelativeURL
slug `shouldBe` "cat-1"
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
enterInput "Cat 2" (form :// ByName "title")
2016-08-24 22:17:54 +03:00
changesURL $ refresh
do (slug, _) <- parseCategoryURL . uriPath =<< getCurrentRelativeURL
slug `shouldBe` "cat-2"
wd "is changed on the front page too" $ do
(_, id1) <- parseCategoryURL . uriPath =<< getCurrentRelativeURL
openGuidePage "/"
checkNotPresent (ByLinkText "Some category")
checkNotPresent (ByLinkText "Cat 1")
2016-09-01 01:25:46 +03:00
changesURL $ click (ByLinkText "Cat 2")
2016-08-24 22:17:54 +03:00
(slug2, id2) <- parseCategoryURL . uriPath =<< getCurrentRelativeURL
id1 `shouldBe` id2; slug2 `shouldBe` "cat-2"
2016-08-22 21:15:40 +03:00
describe "group" $ do
wd "is present" $ do
2016-09-01 01:25:46 +03:00
group_ <- select categoryGroup
group_ `shouldHaveText` "Miscellaneous"
fs <- fontSize group_; fs `shouldBeInRange` (12, 15)
2016-08-22 21:15:40 +03:00
wd "can be changed" $ do
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
enterInput "Basics" (form :// ByName "group")
2016-09-01 01:25:46 +03:00
categoryGroup `shouldHaveText` "Basics"
2016-08-24 22:17:54 +03:00
wd "is changed on the front page too" $ do
2016-08-28 15:00:35 +03:00
onAnotherPage "/" $ do
2016-08-24 22:17:54 +03:00
catLink <- select (ByLinkText "Cat 2")
groupHeader <- select ((".category-group" :<// catLink) :// "h2")
groupHeader `shouldHaveText` "Basics"
2016-08-28 15:00:35 +03:00
describe "status" $ do
wd "is “stub” by default" $ do
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
chosenOption <- select (form :// ByName "status" :// "option:checked")
2016-09-01 01:25:46 +03:00
chosenOption `shouldHaveText` "Stub"
2016-08-28 15:00:35 +03:00
onAnotherPage "/" $ do
2016-09-01 01:25:46 +03:00
ByLinkText "Cat 2" `shouldHaveAttr` ("class", "status-stub")
2016-08-28 15:00:35 +03:00
wd "can be changed" $ do
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
sel <- select (form :// ByName "status")
2016-08-28 15:00:35 +03:00
opt <- select (sel :// HasText "Complete")
selectDropdown sel opt
2016-09-01 01:25:46 +03:00
click (form :// ".save")
2016-08-28 15:00:35 +03:00
onAnotherPage "/" $ do
2016-09-01 01:25:46 +03:00
ByLinkText "Cat 2" `shouldHaveAttr` ("class", "status-finished")
2016-08-30 16:55:06 +03:00
wd "create two items for further tests" $ do
createItem "some item"
createItem "another item"
describe "pros/cons enabled" $ do
wd "checkbox enabled by default" $ do
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
checkbox <- select (form :// ByName "pros-cons-enabled")
2016-09-01 01:25:46 +03:00
shouldBeSelected checkbox
click (form :// ".cancel")
wd "section is shown in an item" $ do
mapM_ shouldBeDisplayed =<< selectAll ".item-traits"
wd "section isn't shown after unchecking the checkbox" $ do
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
click (form :// ByName "pros-cons-enabled")
2016-09-01 01:25:46 +03:00
click (form :// ".save")
waitUntil wait_delay $
expect . not =<< anyM isDisplayed =<< selectAll ".item-traits"
wd "section is shown again after checking the checkbox" $ do
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
click (form :// ByName "pros-cons-enabled")
2016-09-01 01:25:46 +03:00
click (form :// ".save")
waitUntil wait_delay $
expect =<< allM isDisplayed =<< selectAll ".item-traits"
2016-08-30 16:55:06 +03:00
describe "ecosystem enabled" $ do
wd "checkbox enabled by default" $ do
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
checkbox <- select (form :// ByName "ecosystem-enabled")
2016-09-01 01:25:46 +03:00
shouldBeSelected checkbox
click (form :// ".cancel")
2016-08-30 16:55:06 +03:00
wd "section is shown in an item" $ do
mapM_ shouldBeDisplayed =<< selectAll ".item-ecosystem"
wd "section isn't shown after unchecking the checkbox" $ do
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
click (form :// ByName "ecosystem-enabled")
2016-09-01 01:25:46 +03:00
click (form :// ".save")
waitUntil wait_delay $
2016-08-30 16:55:06 +03:00
expect . not =<< anyM isDisplayed =<< selectAll ".item-ecosystem"
wd "section is shown again after checking the checkbox" $ do
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
click (form :// ByName "ecosystem-enabled")
2016-09-01 01:25:46 +03:00
click (form :// ".save")
waitUntil wait_delay $
2016-08-30 16:55:06 +03:00
expect =<< allM isDisplayed =<< selectAll ".item-ecosystem"
2016-09-09 20:06:17 +03:00
describe "feed" $ do
-- TODO: actually test the generated feed
wd "exists" $ do
getBackAfterwards $ do
2016-08-30 18:06:06 +03:00
url <- getCurrentRelativeURL
2016-09-09 20:06:17 +03:00
(_, catId) <- parseCategoryURL (uriPath url)
".category-feed" `shouldLinkToRelative`
("/haskell/feed/category/" <> catId)
click ".category-feed"
checkPresent (".item-name" :& HasText "some item")
checkPresent (".item-name" :& HasText "another item")
2016-09-11 21:56:52 +03:00
describe "notes" $ do
wd "has a default template" $ do
2016-09-11 21:56:52 +03:00
form <- openCategoryNotesEditForm
contents <- T.lines <$> getValue (form :// "textarea")
contents `shouldSatisfy`
2016-09-10 00:17:50 +03:00
("have “# Recommendations”", ("# Recommendations" `elem`))
2016-09-11 21:56:52 +03:00
click (form :// ".cancel")
wd "can be edited" $ do
form <- openCategoryNotesEditForm
2016-09-13 00:23:54 +03:00
setInput "Blah blah" (form :// "textarea")
2016-09-11 21:56:52 +03:00
click (form :// ".save")
".category-notes .notes-like" `shouldHaveText` "Blah blah"
2016-09-09 20:06:17 +03:00
describe "deleting a category" $ do
wd "dismissing the alert doesn't do anything" $ do
click (".category h2" :// ByLinkText "delete")
dismissAlert
getBackAfterwards $ do
catURL <- getCurrentURL
openGuidePage "/"
ByLinkText "Cat 2" `shouldLinkTo` catURL
wd "accepting the alert deletes the category" $ do
catURL <- getCurrentURL
changesURL $ do
click (".category h2" :// ByLinkText "delete")
acceptAlert
url <- getCurrentRelativeURL
uriPath url `shouldBe` "/haskell"
checkNotPresent (ByLinkText "Cat 2")
openPage catURL
"body" `shouldHaveText` "Something went wrong"
2016-08-22 16:11:14 +03:00
2016-09-01 22:49:35 +03:00
itemTests :: Spec
itemTests = session "items" $ using Firefox $ do
openGuide "/"
wd "create a test category" $ do
createCategory "Item test category"
wd "add a new item" $ do
createItem "An item"
let item1 = Index 0 ".item"
2016-09-16 02:12:32 +03:00
2016-09-01 22:49:35 +03:00
describe "item properties" $ do
2016-09-03 01:24:37 +03:00
describe "name" $ do
2016-09-01 22:49:35 +03:00
wd "is present" $ do
2016-09-06 13:06:19 +03:00
itemName item1 `shouldHaveText` "An item"
fs <- fontSize (itemName item1); fs `shouldBeInRange` (20,26)
2016-09-03 21:49:55 +03:00
wd "doesn't link to Hackage" $ do
2016-09-06 13:06:19 +03:00
doesNotChangeURL $ click (itemName item1)
2016-09-03 21:49:55 +03:00
-- TODO: find a better test for this (maybe by checking all hrefs)
checkNotPresent (item1 :// ByLinkText "Hackage")
2016-09-03 01:24:37 +03:00
wd "can be changed" $ do
2016-09-03 21:49:55 +03:00
form <- openItemEditForm item1
2016-09-06 13:06:19 +03:00
enterInput "New item" (form :// ByName "name")
itemName item1 `shouldHaveText` "New item"
2016-09-03 21:49:55 +03:00
wd "doesn't link to Hackage if changed to something without spaces" $ do
form <- openItemEditForm item1
2016-09-06 13:06:19 +03:00
enterInput "item1" (form :// ByName "name")
itemName item1 `shouldHaveText` "item1"
doesNotChangeURL $ click (itemName item1)
2016-09-03 21:49:55 +03:00
checkNotPresent (item1 :// ByLinkText "Hackage")
wd "links to Hackage if the name is originally a package name" $ do
item2 <- createItem "foo-bar-2"
2016-09-06 13:06:19 +03:00
itemName item2 `shouldHaveText` "foo-bar-2"
2016-09-03 21:49:55 +03:00
(item2 :// ByLinkText "Hackage")
`shouldLinkTo` "https://hackage.haskell.org/package/foo-bar-2"
describe "group" $ do
wd "is present and “other” by default" $ do
2016-09-06 13:06:19 +03:00
itemGroup item1 `shouldHaveText` "other"
fs <- fontSize (itemGroup item1); fs `shouldBeInRange` (15,17)
2016-09-06 14:19:18 +03:00
form <- openItemEditForm item1
(form :// ByName "group" :// ":checked") `shouldHaveText` "-"
click (form :// ".cancel")
wd "custom group input is hidden but then shows" $ do
2016-09-03 21:49:55 +03:00
form <- openItemEditForm item1
2016-09-06 13:06:19 +03:00
sel <- select (form :// ByName "group")
2016-09-06 14:19:18 +03:00
opt <- select (sel :// HasText "New group...")
2016-09-06 13:06:19 +03:00
shouldBeHidden (form :// ByName "custom-group")
2016-09-03 21:49:55 +03:00
selectDropdown sel opt
2016-09-06 13:06:19 +03:00
shouldBeDisplayed (form :// ByName "custom-group")
2016-09-06 14:19:18 +03:00
click (form :// ".cancel")
wd "can be changed to a custom group" $ do
setItemCustomGroup "some group" item1
2016-09-03 21:49:55 +03:00
-- TODO: check that it works with 2 groups etc
2016-09-08 23:57:10 +03:00
wd "is automatically put into all items' choosers" $ do
-- TODO: make a combinator for this
items <- selectAll ".item"
waitUntil wait_delay $ expect (length items >= 2)
for_ items $ \item -> do
form <- openItemEditForm item
checkPresent $
form :// ByName "group" :// "option" :& HasText "some group"
click (form :// ".cancel")
2016-09-03 21:49:55 +03:00
wd "is present in the chooser after a refresh" $ do
refresh
form <- openItemEditForm item1
2016-09-06 13:06:19 +03:00
sel <- select (form :// ByName "group")
2016-09-05 23:42:58 +03:00
(sel :// ":checked") `shouldHaveText` "some group"
click (form :// ".cancel")
-- TODO: more convoluted change scenarious
2016-09-06 14:19:18 +03:00
-- TODO: setting custom group to something that already exists
-- doesn't result in two equal groups
wd "changing it changes the color" $ do
2016-09-06 14:29:06 +03:00
[itemA, itemB, itemC] <- replicateM 3 (createItem "blah")
2016-09-06 14:19:18 +03:00
setItemCustomGroup "one" itemA
setItemGroup "one" itemB
setItemCustomGroup "two" itemC
let getColors = for [itemA, itemB, itemC] $ \item ->
(,) <$> cssProp (item :// ".item-info") "background-color"
<*> cssProp (item :// ".item-body") "background-color"
-- A=1,B=1,C=2; check that A=B, A≠C
do [aCol, bCol, cCol] <- getColors
aCol `shouldBe` bCol; aCol `shouldNotBe` cCol
-- A:=2; now A=2,B=1,C=2; check that A≠B, A=C
setItemCustomGroup "two" itemA
do [aCol, bCol, cCol] <- getColors
aCol `shouldNotBe` bCol; aCol `shouldBe` cCol
-- C:=1; now A=2,B=1,C=1; check that A≠C, B=C
setItemGroup "one" itemC
do [aCol, bCol, cCol] <- getColors
aCol `shouldNotBe` cCol; bCol `shouldBe` cCol
-- TODO: kind
-- TODO: site
2016-09-16 02:12:32 +03:00
describe "item sections" $ do
describe "description/summary" $ do
wd "default state" $ do
(item1 :// ".item-description .notes-like p") `shouldHaveText`
"write something here!"
form <- openItemDescriptionEditForm item1
val <- getValue (form :// "textarea")
val `shouldBe` ""
click (form :// ".cancel")
wd "can be changed" $ do
do form <- openItemDescriptionEditForm item1
2016-09-17 01:07:07 +03:00
setInput "foo *bar*\n\n# Blah" (form :// "textarea")
2016-09-16 02:12:32 +03:00
click (form :// ".save")
2016-09-17 01:07:07 +03:00
section <- select (item1 :// ".item-description .notes-like")
(section :// "p") `shouldHaveText` "foo bar"
(section :// "h1") `shouldHaveText` "Blah"
2016-09-16 02:12:32 +03:00
do form <- openItemDescriptionEditForm item1
val <- getValue (form :// "textarea")
2016-09-17 01:07:07 +03:00
val `shouldBe` "foo *bar*\n\n# Blah"
2016-09-16 02:12:32 +03:00
click (form :// ".cancel")
-- TODO: check that edit and then cancel discards the edit
-- TODO: pros/cons
2016-09-17 01:07:07 +03:00
describe "ecosystem" $ do
wd "default state" $ do
(item1 :// ".item-ecosystem .notes-like") `shouldHaveText` ""
form <- openItemEcosystemEditForm item1
val <- getValue (form :// "textarea")
val `shouldBe` ""
click (form :// ".cancel")
wd "can be changed" $ do
do form <- openItemEcosystemEditForm item1
setInput "foo *bar*\n\n# Blah" (form :// "textarea")
click (form :// ".save")
section <- select (item1 :// ".item-ecosystem .notes-like")
(section :// "p") `shouldHaveText` "foo bar"
(section :// "h1") `shouldHaveText` "Blah"
do form <- openItemEcosystemEditForm item1
val <- getValue (form :// "textarea")
val `shouldBe` "foo *bar*\n\n# Blah"
click (form :// ".cancel")
2016-09-16 02:12:32 +03:00
-- TODO: notes
describe "items with the same name" $ do
wd "can be present" $ do
createItem "item1"
waitUntil wait_delay $
expect . (== 2) . length =<< selectAll
2016-09-06 13:06:19 +03:00
(itemName ".item" :& HasText "item1")
wd "can be changed separately" $ do
item2 <- select $
Index 1 (".item" :<// (".item-name" :& HasText "item1"))
form <- openItemEditForm item2
2016-09-06 13:06:19 +03:00
enterInput "Blah" (form :// ByName "name")
itemName item1 `shouldHaveText` "item1"
itemName item2 `shouldHaveText` "Blah"
2016-09-06 14:19:18 +03:00
-- TODO: moving item up/down
-- TODO: item's self-link in the header
2016-09-16 02:12:32 +03:00
-- TODO: deleting an item
-- TODO: merge tests
2016-09-01 22:49:35 +03:00
2016-08-22 17:10:29 +03:00
markdownTests :: Spec
markdownTests = session "markdown" $ using Firefox $ do
openGuide "/"
describe "Markdown isn't allowed in category names" $ do
wd "when creating a category" $ do
2016-08-22 18:09:46 +03:00
createCategory "*foo*"
2016-09-01 01:25:46 +03:00
categoryTitle `shouldHaveText` "*foo*"
2016-08-22 17:10:29 +03:00
wd "when changing existing category's name" $ do
form <- openCategoryEditForm
2016-09-06 13:06:19 +03:00
enterInput "foo `bar`" (form :// ByName "title")
2016-09-01 01:25:46 +03:00
categoryTitle `shouldHaveText` "foo `bar`"
2016-09-13 00:23:54 +03:00
wd "Markdown in category notes" $ do
form <- openCategoryNotesEditForm
setInput "# Test\n*foo*" (form :// "textarea")
click (form :// ".save")
".category-notes .notes-like h1" `shouldHaveText` "Test"
".category-notes .notes-like p em" `shouldHaveText` "foo"
2016-09-14 22:57:20 +03:00
describe "Markdown in item descriptions" $ do
let item = Index 0 ".item"
wd "works" $ do
createItem "test"
form <- openItemDescriptionEditForm item
setInput "# Blah\n*bar*" (form :// "textarea")
click (form :// ".save")
(item :// ".item-description .notes-like h1") `shouldHaveText` "Blah"
(item :// ".item-description .notes-like p em") `shouldHaveText` "bar"
wd "@hk links are parsed as Hackage links" $ do
form <- openItemDescriptionEditForm item
setInput "[foo-bar](@hk)" (form :// "textarea")
click (form :// ".save")
(item :// ".item-description .notes-like a") `shouldHaveText` "foo-bar"
(item :// ".item-description .notes-like a") `shouldLinkTo`
"https://hackage.haskell.org/package/foo-bar"
-- TODO: check that headers in notes Markdown are rendered as headers but
-- still have smaller font size
2016-08-21 14:32:52 +03:00
-----------------------------------------------------------------------------
2016-08-22 18:09:46 +03:00
-- Helpers dealing with guide specifically
-----------------------------------------------------------------------------
2016-08-24 22:17:54 +03:00
parseCategoryURL :: String -> WD (String, String)
parseCategoryURL url = do
case T.stripPrefix "/haskell/" (T.toStrict url) of
Nothing -> expectationFailure $
printf "%s doesn't start with /haskell/" (show url)
Just u -> do
let (slug, catId) = T.breakOnEnd "-" u
slug `shouldSatisfy` ("not null", not . T.null)
T.last slug `shouldBe` '-'
return (T.toString (T.init slug), T.toString catId)
2016-08-22 18:09:46 +03:00
openGuide :: String -> SpecWith (WdTestSession ())
2016-08-24 18:05:27 +03:00
openGuide s = wd ("load " ++ s) (openGuidePage s)
openGuidePage :: String -> WD ()
2016-08-24 22:17:54 +03:00
openGuidePage s = changesURL $ openPage ("http://localhost:8080/haskell" ++ s)
2016-08-22 18:09:46 +03:00
2016-08-28 15:00:35 +03:00
onAnotherPage :: String -> WD a -> WD a
onAnotherPage s x = getBackAfterwards $ do
openGuidePage s
x
2016-08-22 18:09:46 +03:00
-- Assumes that the main page is open
createCategory :: Text -> WD ()
createCategory t =
2016-09-13 00:23:54 +03:00
changesURL $ enterInput t ".add-category"
2016-08-22 18:09:46 +03:00
-- Assumes that the category page is open
createItem :: Text -> WD Element
createItem t = do
let selectItems = selectAll ".item"
items <- selectItems
2016-09-13 00:23:54 +03:00
sendKeys (t <> _enter) ".add-item"
waitUntil wait_delay (expect . (\xs -> length xs > length items) =<< selectItems)
items2 <- selectItems
case items2 \\ items of
[] -> expectationFailure "an item wasn't created"
[x] -> return x
_ -> expectationFailure "more than one item was created"
2016-09-06 13:06:19 +03:00
itemName :: CanSelect s => s -> ComplexSelector
itemName item = item :// ".item-name"
itemGroup :: CanSelect s => s -> ComplexSelector
itemGroup item = item :// ".item-group"
2016-09-06 14:19:18 +03:00
setItemGroup :: CanSelect s => Text -> s -> WD ()
setItemGroup g item = do
form <- openItemEditForm item
sel <- select (form :// ByName "group")
opt <- select (sel :// HasText g)
selectDropdown sel opt
click (form :// ".save")
itemGroup item `shouldHaveText` g
setItemCustomGroup :: CanSelect s => Text -> s -> WD ()
setItemCustomGroup g item = do
form <- openItemEditForm item
sel <- select (form :// ByName "group")
opt <- select (sel :// HasText "New group...")
selectDropdown sel opt
enterInput g (form :// ByName "custom-group")
itemGroup item `shouldHaveText` g
categoryTitle :: Selector
categoryTitle = ByCSS ".category-title"
2016-08-23 16:03:54 +03:00
categoryGroup :: Selector
categoryGroup = ByCSS ".category .group"
openCategoryEditForm :: WD Element
openCategoryEditForm = do
2016-09-01 01:25:46 +03:00
click (".category h2" :// ByLinkText "edit")
select ".category-info form"
2016-09-11 21:56:52 +03:00
openCategoryNotesEditForm :: WD Element
openCategoryNotesEditForm = do
click (".category-notes" :// ByLinkText "edit description")
select ".category-notes .editing"
2016-09-03 01:24:37 +03:00
openItemEditForm :: CanSelect s => s -> WD Element
openItemEditForm item = do
click (item :// ".edit-item-info")
select (item :// ".item-info form")
2016-09-14 01:02:32 +03:00
openItemDescriptionEditForm :: CanSelect s => s -> WD Element
openItemDescriptionEditForm item = do
click (item :// ".item-description .normal .edit-item-description")
select (item :// ".item-description .editing")
2016-09-17 01:07:07 +03:00
openItemEcosystemEditForm :: CanSelect s => s -> WD Element
openItemEcosystemEditForm item = do
click (item :// ".item-ecosystem .normal .edit-item-ecosystem")
select (item :// ".item-ecosystem .editing")
2016-08-22 18:09:46 +03:00
-----------------------------------------------------------------------------
-- Utilities for webdriver
2016-08-21 14:32:52 +03:00
-----------------------------------------------------------------------------
_TODO :: MonadIO m => m ()
_TODO = error "test not implemented"
2016-08-22 17:10:29 +03:00
_pause :: WD ()
_pause = do
liftIO $ putStr "press Enter to continue testing, or “q” to quit: "
x <- liftIO $ getLine
when (x == "q") $
expectationFailure "quit"
2016-08-21 14:32:52 +03:00
getCurrentRelativeURL :: WD URI
getCurrentRelativeURL = do
url <- getCurrentURL
case parseURI url of
Nothing -> error ("couldn't parse as URL: " ++ url)
Just u -> do
maybe "" uriRegName (uriAuthority u) `shouldBe` "localhost"
return u
run :: Spec -> IO ()
run ts = do
let prepare = do
exold <- doesDirectoryExist "state-old"
when exold $ error "state-old exists"
ex <- doesDirectoryExist "state"
when ex $ renameDirectory "state" "state-old"
-- Start the server
--
-- Using 'Slave.fork' in 'Guide.mainWith' ensures that threads started
-- inside of 'mainWith' will be killed too when the thread dies.
tid <- Slave.fork $ Guide.mainWith Config {
_baseUrl = "/",
_googleToken = "some-google-token",
_adminPassword = "123",
_prerender = False,
_discussLink = Just "http://discuss.link" }
2016-08-21 14:32:52 +03:00
-- Using a delay so that “Spock is running on port 8080” would be
-- printed before the first test.
threadDelay 100000
return tid
let finalise tid = do
killThread tid
ex <- doesDirectoryExist "state"
when ex $ removeDirectoryRecursive "state"
exold <- doesDirectoryExist "state-old"
when exold $ renameDirectory "state-old" "state"
bracket prepare finalise $ \_ -> do
hspec ts
_site :: IO ()
_site = run $ do
session "_" $ using Firefox $ do
wd "_" $ do
openGuidePage "/"
_pause
shouldLinkToRelative :: CanSelect a => a -> String -> WD ()
s `shouldLinkToRelative` url2 = do
-- TODO: would be nice if it checked relative to the current page
url <- getLink s
case parseURI url of
Nothing -> error ("couldn't parse as URL: " ++ url)
Just u -> do
maybe "" uriRegName (uriAuthority u) `shouldBe` "localhost"
uriPath u `shouldBe` url2