/
Router.purs
159 lines (137 loc) · 4.21 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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
module Pux.Router
( Match(..)
, Route
, RoutePart(..)
, router
, lit
, str
, num
, int
, bool
, parseSegment
, param
, params
, any
, end
) where
import Control.Alt (class Alt)
import Control.Applicative (class Applicative, pure)
import Control.Apply (class Apply, (<*>))
import Control.Bind (discard)
import Control.MonadPlus (guard)
import Control.Plus (class Plus)
import Data.Array as A
import Data.Boolean (otherwise)
import Data.Eq ((==))
import Data.Functor (class Functor, map, (<$>))
import Data.Function (($), (<<<))
import Data.Foldable (foldr)
import Data.Int (fromString)
import Data.List (catMaybes, List(Nil, Cons), fromFoldable, drop)
import Data.Maybe (Maybe(Just, Nothing), maybe)
import Data.Map as M
import Data.Profunctor (lmap)
import Data.String as S
import Data.Tuple (Tuple(Tuple), fst, snd)
import Data.Unit (Unit, unit)
import Global (readFloat, isNaN)
data RoutePart = Path String | Query (M.Map String String)
type Route = List RoutePart
newtype Match a = Match (Route -> Maybe (Tuple Route a))
end :: Match Unit
end = Match $ \r ->
case r of
Cons (Query m) Nil -> Just $ Tuple Nil unit
Nil -> Just $ Tuple Nil unit
_ -> Nothing
lit :: String -> Match Unit
lit part = parseSegment parse
where
parse s
| s == part = Just unit
| otherwise = Nothing
parseSegment :: forall a. (String -> Maybe a) -> Match a
parseSegment parser = Match $ \r ->
case r of
Cons (Path p) ps -> map (Tuple ps) $ parser p
_ -> Nothing
num :: Match Number
num = parseSegment parse
where
parse p = let res = readFloat p in
if isNaN res then
Nothing
else
Just res
int :: Match Int
int = parseSegment fromString
bool :: Match Boolean
bool = parseSegment parse
where
parse "true" = Just true
parse "false" = Just false
parse _ = Nothing
str :: Match String
str = parseSegment Just
param :: String -> Match String
param key = Match $ \r ->
case r of
Cons (Query map) ps ->
case M.lookup key map of
Nothing -> Nothing
Just s -> Just $ Tuple (Cons (Query <<< M.delete key $ map) ps) s
_ -> Nothing
params :: Match (M.Map String String)
params = Match $ \r ->
case r of
Cons (Query map) ps -> Just $ Tuple ps map
_ -> Nothing
any :: Match Unit
any = Match $ \r ->
case r of
Cons p ps -> Just $ Tuple ps unit
_ -> Nothing
instance matchFunctor :: Functor Match where
map f (Match r2t) = Match $ \r ->
maybe Nothing (\t -> Just $ Tuple (fst t) (f (snd t))) $ r2t r
instance matchAlt :: Alt Match where
alt (Match a) (Match b) = Match $ \r ->
-- Manual implementation to avoid unnecessary evaluation of b r in case a r is true.
case a r of
Nothing -> b r
Just x -> Just x
instance matchApply :: Apply Match where
apply (Match r2a2b) (Match r2a) = Match $ \r1 ->
case (r2a2b r1) of
Nothing -> Nothing
Just (Tuple r2 f) -> case (r2a r2) of
Nothing -> Nothing
Just (Tuple r3 b) -> Just $ Tuple r3 (f b)
instance matchPlus :: Plus Match where
empty = Match \r -> Nothing
instance matchApplicative :: Applicative Match where
pure a = Match \r -> pure $ Tuple r a
routeFromUrl :: String -> Route
routeFromUrl "/" = Nil
routeFromUrl url = case S.indexOf (S.Pattern "?") url of
Nothing -> parsePath Nil url
Just queryPos ->
let queryPart = parseQuery <<< S.drop queryPos $ url
in parsePath (Cons queryPart Nil) <<< S.take queryPos $ url
where
parsePath :: Route -> String -> Route
parsePath query = drop 1 <<< foldr prependPath query <<< S.split (S.Pattern "/")
where prependPath = lmap Path Cons
parseQuery :: String -> RoutePart
parseQuery s = Query <<< M.fromFoldable <<< catMaybes <<< map part2tuple $ parts
where
parts :: List String
parts = fromFoldable $ S.split (S.Pattern "&") $ S.drop 1 s
part2tuple :: String -> Maybe (Tuple String String)
part2tuple part = do
let param' = S.split (S.Pattern "=") part
guard $ A.length param' == 2
Tuple <$> (A.head param') <*> (param' A.!! 1)
router :: ∀ a. String -> Match a -> Maybe a
router url (Match match) = maybe Nothing (Just <<< snd) result
where result = match $ routeFromUrl url