/
Internal.purs
47 lines (40 loc) · 1.76 KB
/
Internal.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
module Pha.App.Internal where
import Prelude
import Effect (Effect)
import Data.Maybe (Maybe(..))
import Pha (VDom, Event, EventHandler, Sub)
import Pha.Update (Update, GetState(..), SetState(..))
import Run (VariantF, onMatch, runCont)
type Interpreter effs = VariantF effs (Effect Unit) → Effect Unit
type AppPrimitives msg state =
{ getS ∷ Effect state
, setS ∷ state → Effect Unit
, renderVDom ∷ VDom msg → Effect Unit
}
type App msg state =
{ render ∷ state → Effect Unit
, dispatch ∷ msg → Effect Unit
, dispatchEvent ∷ Event → (EventHandler msg) → Effect Unit
, subscriptions ∷ state → Array (Sub msg)
, init ∷ Effect Unit
}
type AppBuilder msg state = AppPrimitives msg state → App msg state
foreign import app ∷ ∀msg state. AppBuilder msg state → String → Effect Unit
getDispatchers ∷ ∀msg state effs. Effect state → (state → Effect Unit) → (msg → Update state effs) → Interpreter effs →
{ runAction ∷ Update state effs → Effect Unit
, dispatch ∷ msg → Effect Unit
, dispatchEvent ∷ Event → (EventHandler msg) → Effect Unit
}
getDispatchers getS setS update interpreter = {runAction, dispatch, dispatchEvent} where
runAction = runCont handleState (const (pure unit)) where
handleState = onMatch {
getState: \(GetState next) → getS >>= next
, setState: \(SetState f next) → (getS <#> f >>= setS) *> next
} interpreter
dispatch = runAction <<< update
dispatchEvent ev handler = do
let {effect, msg} = handler ev
effect
case msg of
Nothing → pure unit
Just m → dispatch m