-
Notifications
You must be signed in to change notification settings - Fork 0
/
Router.purs
80 lines (67 loc) · 2 KB
/
Router.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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
module Grain.Router
( class Router
, parse
, useRouter
, initialRouter
, link
, navigateTo
, redirectTo
, goForward
, goBack
) where
import Prelude
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Foreign (Foreign, unsafeToForeign)
import Grain (class GlobalGrain, GProxy, Render, VNode, useUpdater)
import Grain.Markup as H
import Web.Event.Event (EventType, preventDefault)
import Web.Event.EventTarget (addEventListener, eventListener)
import Web.HTML (window)
import Web.HTML.Event.PopStateEvent.EventTypes (popstate)
import Web.HTML.History (DocumentTitle(..), URL(..), back, forward, pushState, replaceState)
import Web.HTML.Location (pathname, search)
import Web.HTML.Window (Window, history, location, toEventTarget)
class Router a where
parse :: String -> a
useRouter
:: forall a
. GlobalGrain a
=> Router a
=> GProxy a
-> Render (Effect Unit)
useRouter proxy = do
update <- useUpdater
pure do
listener <- eventListener $ const do
route <- parse <$> currentPath
update proxy $ const route
window <#> toEventTarget >>= addEventListener popstate listener false
initialRouter :: forall a. Router a => Effect a
initialRouter = parse <$> currentPath
currentPath :: Effect String
currentPath = do
l <- window >>= location
(<>) <$> pathname l <*> search l
link :: String -> VNode
link url = H.a # H.href url # H.onClick onClick
where
onClick evt = preventDefault evt *> navigateTo url
navigateTo :: String -> Effect Unit
navigateTo url = do
window >>= history >>= pushState null (DocumentTitle "") (URL url)
window >>= dispatchEvent popstate
redirectTo :: String -> Effect Unit
redirectTo url = do
window >>= history >>= replaceState null (DocumentTitle "") (URL url)
window >>= dispatchEvent popstate
goForward ::Effect Unit
goForward = window >>= history >>= forward
goBack :: Effect Unit
goBack = window >>= history >>= back
null :: Foreign
null = unsafeToForeign Nothing
foreign import dispatchEvent
:: EventType
-> Window
-> Effect Unit