/
Url.purs
110 lines (94 loc) · 4.18 KB
/
Url.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
module Payload.Internal.Url where
import Prelude
import Data.Array as Array
import Data.Either (Either(..))
import Data.List (List(..), (:))
import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe)
import Data.String as String
import Payload.Params (class FromParam, class FromSegments, class ToParam, fromParam, fromSegments, toParam)
import Payload.Internal.UrlParsing (class ParseUrl, UrlListProxy(..), Key, Lit, Multi, UrlCons, UrlNil, kind UrlList)
import Prim.Row as Row
import Record as Record
import Type.Equality (class TypeEquals, to)
import Type.Prelude (class IsSymbol, SProxy(..), reflectSymbol)
import Type.Proxy (Proxy(..))
class EncodeUrl (urlStr :: Symbol) params | urlStr -> params where
encodeUrl :: SProxy urlStr -> Record params -> String
instance encodeUrlRecord ::
( ParseUrl urlStr urlParts
, WriteUrl urlParts params
) => EncodeUrl urlStr params where
encodeUrl _ params = writeUrl (UrlListProxy :: _ urlParts) params
class WriteUrl (urlParts :: UrlList) params where
writeUrl :: UrlListProxy urlParts -> Record params -> String
instance writeUrlUrlNil :: WriteUrl UrlNil params where
writeUrl _ params = ""
instance writeUrlConsKey ::
( IsSymbol key
, Row.Cons key valType from params
, ToParam valType
, WriteUrl rest params
) => WriteUrl (UrlCons (Key key) rest) params where
writeUrl _ params = "/" <> encodedParam <> restOfUrl
where
encodedParam = toParam (Record.get (SProxy :: SProxy key) params)
restOfUrl = writeUrl (UrlListProxy :: _ rest) params
instance writeUrlConsLit ::
( IsSymbol lit
, WriteUrl rest params
) => WriteUrl (UrlCons (Lit lit) rest) params where
writeUrl _ params = "/" <> litStr <> restOfUrl
where
litStr = reflectSymbol (SProxy :: SProxy lit)
restOfUrl = writeUrl (UrlListProxy :: _ rest) params
instance writeUrlConsMulti ::
( IsSymbol multiKey
, Row.Cons multiKey (List String) from params
) => WriteUrl (UrlCons (Multi multiKey) UrlNil) params where
writeUrl _ params = "/" <> multiStr
where
multiStr = String.joinWith "/" (Array.fromFoldable $ Record.get (SProxy :: _ multiKey) params)
class DecodeUrl (urlStr :: Symbol) params | urlStr -> params where
decodeUrl :: SProxy urlStr -> Proxy (Record params) -> List String -> Either String (Record params)
instance decodeUrlSymbol ::
( ParseUrl urlStr urlParts
, MatchUrl urlParts params () params
) => DecodeUrl urlStr params where
decodeUrl _ paramsType path = match (UrlListProxy :: _ urlParts) paramsType {} path
class MatchUrl (urlParts :: UrlList) params from to | urlParts -> from to where
match :: UrlListProxy urlParts -> Proxy (Record params) -> Record from -> List String -> Either String (Record to)
instance matchUrlUrlNil ::
( TypeEquals (Record from) (Record to)
) => MatchUrl UrlNil params from to where
match _ _ params Nil = Right (to params)
match _ _ _ path = Left $ "Path mismatch: Ran out of params when path still had '" <> show path <> "'"
instance matchUrlMulti ::
( IsSymbol key
, Row.Cons key valType from to
, Row.Lacks key from
, FromSegments valType
) => MatchUrl (UrlCons (Multi key) UrlNil) to from to where
match _ paramsType params segments = case fromSegments segments of
Left errors -> Left $ show errors
Right decoded -> Right $ Record.insert (SProxy :: SProxy key) decoded params
instance matchUrlConsKey ::
( IsSymbol key
, MatchUrl rest params from' to
, Row.Cons key valType from from'
, Row.Cons key valType _params params
, Row.Lacks key from
, FromParam valType
) => MatchUrl (UrlCons (Key key) rest) params from to where
match _ paramsType params Nil = Left "Decoding error at key"
match _ paramsType params (segment : rest) = case fromParam segment of
Left errors -> Left $ show errors
Right decoded -> let newParams = Record.insert (SProxy :: SProxy key) decoded params in
match (UrlListProxy :: _ rest) paramsType newParams rest
instance matchUrlConsLit ::
( IsSymbol lit
, MatchUrl rest params from to
) => MatchUrl (UrlCons (Lit lit) rest) params from to where
match _ paramsType params Nil = Left "Decoding error at literal"
match _ paramsType params (segment : rest) =
match (UrlListProxy :: _ rest) paramsType params rest