/
Router.purs
119 lines (97 loc) · 3.33 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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
module Router
( Context
, Router
, Route
, makeRouter
, makeRoute
, route
) where
import Prelude
import Data.Array (all, any, zip, (!!))
import Data.FoldableWithIndex (foldrWithIndex)
import Data.List as List
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
import Data.String (Pattern(..))
import Data.String as String
import Data.String.CodeUnits (charAt)
import Data.Tuple (Tuple(..))
import Record.Unsafe.Union (unsafeUnion)
import Router.Method (Method)
newtype Route
= Route
{ methods :: Array Method
, path :: String
, paramIndexes :: Map String Int
}
derive instance eqRoute :: Eq Route
derive instance ordRoute :: Ord Route
emptyRoute :: Route
emptyRoute = Route { methods: [], path: "", paramIndexes: Map.empty }
newtype Router context request response
= Router
{ routes :: Map Route (request -> Context context -> response)
, fallbackResponse :: response
, requestToPath :: request -> String
, requestToMethod :: request -> Method
, requestToContext :: request -> Record context
}
type Context r
= { path :: String
, params :: Map String String
| r
}
makeRoute :: { path :: String, methods :: Array Method } -> Route
makeRoute { path, methods } =
let
pattern = Pattern "/"
params = String.split pattern path
paramIndexes = foldrWithIndex (\i new acc -> if charAt 0 new == Just ':' then Map.insert (String.drop 1 new) i acc else acc) Map.empty params
in
Route { path, methods, paramIndexes }
makeRouter ::
forall context request response.
{ routes :: Map Route (request -> Context context -> response)
, fallbackResponse :: response
, requestToPath :: request -> String
, requestToMethod :: request -> Method
, requestToContext :: request -> Record context
} ->
Router context request response
makeRouter { routes, fallbackResponse, requestToPath, requestToMethod, requestToContext } =
Router
{ routes, fallbackResponse, requestToPath, requestToMethod, requestToContext
}
route :: forall context request response. Router context request response -> request -> response
route (Router { routes, requestToPath, requestToContext, requestToMethod, fallbackResponse }) request =
let
path = requestToPath request
partialContext = requestToContext request
fallbackRoute = Tuple emptyRoute (\_req _ctx -> fallbackResponse)
Tuple matched handler =
fromMaybe fallbackRoute
$ List.head
$ Map.toUnfoldable
$ Map.filterKeys routeMatch routes
params = buildParams matched
context = unsafeUnion partialContext { path, params }
in
handler request context
where
buildParams :: Route -> Map String String
buildParams (Route { paramIndexes }) =
let
splitPath = String.split (Pattern "/") (requestToPath request)
in
Map.mapMaybe (\v -> splitPath !! v) paramIndexes
routeMatch :: Route -> Boolean
routeMatch (Route routeToMatch) =
let
splitter = Pattern "/"
splitPattern = String.split splitter (String.toLower routeToMatch.path)
splitRequestUrl = String.split splitter (String.toLower (requestToPath request))
zipped = zip splitPattern splitRequestUrl
methodMatch = any (\method -> method == requestToMethod request) routeToMatch.methods
in
methodMatch && all (\(Tuple p r) -> if charAt 0 p == Just ':' then true else p == r) zipped