/
Bootstrap.purs
62 lines (54 loc) · 1.98 KB
/
Bootstrap.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
module Elmish.Test.Bootstrap
( testComponent
, testElement
) where
import Prelude
import Control.Monad.Reader (ReaderT, runReaderT)
import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Aff.Class (class MonadAff)
import Effect.Class (liftEffect)
import Elmish (ComponentDef, ReactElement, construct)
import Elmish.React as React
import Elmish.Test.State (TestState(..))
import Web.DOM.ChildNode (remove)
import Web.DOM.Document (createElement)
import Web.DOM.Element as DOM
import Web.DOM.Node (appendChild)
import Web.HTML (window)
import Web.HTML.HTMLDocument (body, toDocument)
import Web.HTML.HTMLElement as H
import Web.HTML.Window (document)
-- | Mount the given component to a DOM element, run the given computation in
-- | the context of that element, return the computation's result.
-- |
-- | Example:
-- |
-- | describe "My component" $
-- | it "should work" $
-- | testComponent { init, view, update } do
-- | find "h1" >> text >>= shouldEqual "Hello"
-- |
testComponent :: ∀ m a msg state. MonadAff m => ComponentDef msg state -> ReaderT TestState m a -> m a
testComponent def go = do
root <- liftEffect mount
result <- runReaderT go $ TestState { root, current: root }
liftEffect $ React.unmount root
liftEffect $ remove $ DOM.toChildNode root
pure result
where
mount = do
ensureDom_
doc <- window >>= document
root <- doc # toDocument # createElement "div"
doc # body >>= traverse_ \theBody ->
appendChild (DOM.toNode root) (H.toNode theBody)
reactEl <- construct def
React.render reactEl root
pure root
-- | A convenience version of `testComponent` for "pure" components - i.e.
-- | components that consist only of `view`, no `init` or `update`.
testElement :: ∀ m a. MonadAff m => ReactElement -> ReaderT TestState m a -> m a
testElement element =
testComponent { init: pure unit, view: \_ _ -> element, update: \_ _ -> pure unit }
foreign import ensureDom_ :: Effect Unit