|
1 | 1 | module Test.UI where
|
2 | 2 |
|
3 |
| -import Prelude |
| 3 | +-- import Prelude |
4 | 4 |
|
5 |
| -import Data.Array as Array |
6 |
| -import Data.Foldable (for_) |
7 |
| -import Data.Newtype (unwrap) |
8 |
| -import Effect (Effect) |
9 |
| -import Effect.Aff (Aff, launchAff_) |
10 |
| -import Effect.Class (liftEffect) |
11 |
| -import Effect.Console as Console |
12 |
| -import Foreign (Foreign) |
13 |
| -import Foreign as Foreign |
14 |
| -import Node.FS.Sync (realpath) |
15 |
| -import Test.Unit.Assert as Assert |
16 |
| -import Toppokki as T |
| 5 | +-- import Data.Array as Array |
| 6 | +-- import Data.Foldable (for_) |
| 7 | +-- import Data.Newtype (unwrap) |
| 8 | +-- import Effect (Effect) |
| 9 | +-- import Effect.Aff (Aff, launchAff_) |
| 10 | +-- import Effect.Class (liftEffect) |
| 11 | +-- import Effect.Console as Console |
| 12 | +-- import Foreign (Foreign) |
| 13 | +-- import Foreign as Foreign |
| 14 | +-- import Node.FS.Sync (realpath) |
| 15 | +-- import Test.Spec.Assertions (shouldSatisfy) |
| 16 | +-- -- import Toppokki as T |
| 17 | +-- -- import Playwright as P |
17 | 18 |
|
| 19 | +-- main :: Effect Unit |
| 20 | +-- main = launchAff_ do |
| 21 | +-- pure unit |
| 22 | +-- path <- liftEffect $ realpath "." |
18 | 23 |
|
19 |
| -main :: Effect Unit |
20 |
| -main = launchAff_ do |
21 |
| - path <- liftEffect $ realpath "." |
| 24 | +-- let indexHTML = T.URL $ "file://" <> path <> "/generated-docs/html/index.html" |
| 25 | +-- prim = T.URL $ "file://" <> path <> "/generated-docs/html/Prim.html" |
| 26 | +-- docsSearch = T.URL $ "file://" <> path <> "/generated-docs/html/Docs.Search.App.html" |
22 | 27 |
|
23 |
| - let indexHTML = T.URL $ "file://" <> path <> "/generated-docs/html/index.html" |
24 |
| - prim = T.URL $ "file://" <> path <> "/generated-docs/html/Prim.html" |
25 |
| - docsSearch = T.URL $ "file://" <> path <> "/generated-docs/html/Docs.Search.App.html" |
| 28 | +-- for_ [ indexHTML, prim, docsSearch ] \url -> do |
| 29 | +-- withPage url \page -> do |
| 30 | +-- void $ T.pageWaitForSelector (T.Selector "#group-modules__label") { timeout: 10000 } page |
| 31 | +-- log $ "has module grouping: " <> unwrap url |
26 | 32 |
|
27 |
| - for_ [ indexHTML, prim, docsSearch ] \url -> do |
28 |
| - withPage url \page -> do |
29 |
| - void $ T.pageWaitForSelector (T.Selector "#group-modules__label") { timeout: 10000 } page |
30 |
| - log $ "has module grouping: " <> unwrap url |
| 33 | +-- withPage url \page -> do |
| 34 | +-- T.keyboardPress (T.KeyboardKey "s") {} page |
| 35 | +-- void $ T.keyboardType "slice" {} page |
| 36 | +-- T.keyboardPress (T.KeyboardKey "Enter") {} page |
| 37 | +-- void $ T.pageWaitForSelector (T.Selector ".result__actions__item") { timeout: 10000 } page |
| 38 | +-- log $ "has working search field: " <> unwrap url |
31 | 39 |
|
32 |
| - withPage url \page -> do |
33 |
| - T.keyboardPress (T.KeyboardKey "s") {} page |
34 |
| - void $ T.keyboardType "slice" {} page |
35 |
| - T.keyboardPress (T.KeyboardKey "Enter") {} page |
36 |
| - void $ T.pageWaitForSelector (T.Selector ".result__actions__item") { timeout: 10000 } page |
37 |
| - log $ "has working search field: " <> unwrap url |
| 40 | +-- withPage url \page -> do |
| 41 | +-- T.keyboardPress (T.KeyboardKey "s") {} page |
| 42 | +-- void $ T.keyboardType "a -> b" {} page |
| 43 | +-- T.keyboardPress (T.KeyboardKey "Enter") {} page |
| 44 | +-- void $ T.pageWaitForSelector (T.Selector ".result__actions__item") { timeout: 10000 } page |
| 45 | +-- arr <- readStringArray <$> T.unsafeEvaluateStringFunction getResultTitlesCode page |
| 46 | +-- arr `shouldSatisfy` (Array.elem "unsafeCoerce") |
| 47 | +-- log $ "is able to find unsafeCoerce by type: " <> unwrap url |
38 | 48 |
|
39 |
| - withPage url \page -> do |
40 |
| - T.keyboardPress (T.KeyboardKey "s") {} page |
41 |
| - void $ T.keyboardType "a -> b" {} page |
42 |
| - T.keyboardPress (T.KeyboardKey "Enter") {} page |
43 |
| - void $ T.pageWaitForSelector (T.Selector ".result__actions__item") { timeout: 10000 } page |
44 |
| - arr <- readStringArray <$> T.unsafeEvaluateStringFunction getResultTitlesCode page |
45 |
| - Assert.assert "resulting array contains unsafeCoerce" (Array.elem "unsafeCoerce" arr) |
46 |
| - log $ "is able to find unsafeCoerce by type: " <> unwrap url |
| 49 | +-- withPage (T.URL $ unwrap url <> "#search:unsafeCoerce") \page -> do |
| 50 | +-- void $ T.pageWaitForSelector (T.Selector ".result__actions__item") { timeout: 10000 } page |
| 51 | +-- arr <- readStringArray <$> T.unsafeEvaluateStringFunction getResultTitlesCode page |
| 52 | +-- arr `shouldSatisfy` (Array.elem "unsafeCoerce") |
| 53 | +-- log $ "can read URI hash: " <> unwrap url |
47 | 54 |
|
48 |
| - withPage (T.URL $ unwrap url <> "#search:unsafeCoerce") \page -> do |
49 |
| - void $ T.pageWaitForSelector (T.Selector ".result__actions__item") { timeout: 10000 } page |
50 |
| - arr <- readStringArray <$> T.unsafeEvaluateStringFunction getResultTitlesCode page |
51 |
| - Assert.assert "resulting array contains unsafeCoerce" (Array.elem "unsafeCoerce" arr) |
52 |
| - log $ "can read URI hash: " <> unwrap url |
| 55 | +-- where |
| 56 | +-- log = liftEffect <<< Console.log |
| 57 | +-- getResultTitlesCode = "[].map.call(document.querySelectorAll('.result__title'), el => el.textContent)" |
| 58 | +-- readStringArray :: Foreign -> Array String |
| 59 | +-- readStringArray = Foreign.unsafeFromForeign |
53 | 60 |
|
54 |
| - where |
55 |
| - log = liftEffect <<< Console.log |
56 |
| - getResultTitlesCode = "[].map.call(document.querySelectorAll('.result__title'), el => el.textContent)" |
57 |
| - readStringArray :: Foreign -> Array String |
58 |
| - readStringArray = Foreign.unsafeFromForeign |
59 | 61 |
|
60 |
| - |
61 |
| -withPage :: forall a. T.URL -> (T.Page -> Aff a) -> Aff Unit |
62 |
| -withPage url f = do |
63 |
| - browser <- T.launch {} |
64 |
| - page <- T.newPage browser |
65 |
| - T.goto url page |
66 |
| - void $ f page |
67 |
| - T.close browser |
| 62 | +-- withPage :: forall a. T.URL -> (T.Page -> Aff a) -> Aff Unit |
| 63 | +-- withPage url f = do |
| 64 | +-- browser <- T.launch {} |
| 65 | +-- page <- T.newPage browser |
| 66 | +-- T.goto url page |
| 67 | +-- void $ f page |
| 68 | +-- T.close browser |
0 commit comments