/
Route.purs
153 lines (129 loc) · 5.5 KB
/
Route.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
-- Syntax primitives and convenience wrappers for printing/parsing in-browser
-- routes
module Data.Intertwine.Route
( class IsRoute, routeEmpty, routeSegments, routeQueryString
, PathInfo(..)
, RoutesDef
, parseRoute
, printRoute
, empty
, literal
, value
, exactly
, query
, module SyntaxReexport
, module Data.Intertwine.Route.PathPiece
) where
import Prelude
import Control.MonadZero (guard, (<|>))
import Data.Array as Array
import Data.Intertwine.Iso (Iso(..))
import Data.Intertwine.Route.PathPiece (class PathPiece, toPathSegment, fromPathSegment)
import Data.Intertwine.Syntax (Ctor(..), (<|$|>), (<|:|>), (<|*|>), (*|>), (<|||>)) as SyntaxReexport
import Data.Intertwine.Syntax (class Syntax, atom, parse, print)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Foreign.Object as Obj
import Optic.Getter ((^.))
import Optic.Lens (lens)
import Optic.Setter ((%~), (.~))
import Optic.Types (Lens')
-- | This class abstracts the idea of the "route" data type, making it possible
-- | for the primitive in this module to work with data types from other
-- | libraries.
class IsRoute r where
routeEmpty :: r
routeSegments :: Lens' r (Array String)
routeQueryString :: Lens' r (Obj.Object String)
-- | The default representation of a route: here the route is represented as a
-- | sequence of path segments and a dictionary of querystring parameters.
data PathInfo = PathInfo (Array String) (Obj.Object String)
instance pathIsRoute :: IsRoute PathInfo where
routeEmpty = PathInfo [] Obj.empty
routeSegments = lens (\(PathInfo s _) -> s) (\(PathInfo _ q) s -> PathInfo s q)
routeQueryString = lens (\(PathInfo _ q) -> q) (\(PathInfo s _) q -> PathInfo s q)
-- | Syntax definition for a set of routes of type `a`.
type RoutesDef route a = forall syntax. Syntax syntax => syntax route a
parseRoute :: forall a route. IsRoute route => RoutesDef route a -> route -> Maybe a
parseRoute def path = do
Tuple a rt <- parse def path
guard $ Array.null $ rt^.routeSegments
pure a
printRoute :: forall a route. IsRoute route => RoutesDef route a -> a -> Maybe route
printRoute def = print def routeEmpty
-- | Empty route. During printing doesn't produce any output, during parsing
-- | makes sure that there are no URL segments remaining.
empty :: forall route. IsRoute route => RoutesDef route Unit
empty = mkAtom prnt pars
where
prnt pi _ = Just pi
pars r | Array.null (r^.routeSegments) = Just $ Tuple r unit
pars _ = Nothing
-- | Literal string. During printing outputs the given string, during parsing
-- | consumes the next URL segment and makes sure it's equal to the given
-- | string.
literal :: forall route. IsRoute route => String -> RoutesDef route Unit
literal str = mkAtom prnt pars
where
prnt pi _ =
Just $ appendSeg str pi
pars r = do
l <- Array.uncons (r^.routeSegments)
guard $ l.head == str
pure $ Tuple (r # routeSegments .~ l.tail) unit
-- | A primitive that encodes a constant value. During printing, the printer
-- | succeeds iff the value beign printed is equal to `theValue`, otherwise
-- | fails. During parsing, the parser returns `theValue` without consuming any
-- | input.
exactly :: forall a route. Eq a => a -> RoutesDef route a
exactly theValue = mkAtom prnt pars
where
prnt pi a | a == theValue = Just pi
prnt _ _ = Nothing
pars pi = Just $ Tuple pi theValue
-- | A value of the given type as URL segment. During printing, the printer
-- | outputs the value as a URL segment, using the `PathPiece` instance to
-- | convert it to a string. During parsing, the parser consumes a URL segment
-- | and tries to parse it into a value of the given type using the `PathPiece`
-- | instance.
value :: forall a route. IsRoute route => PathPiece a => RoutesDef route a
value = mkAtom prnt pars
where
prnt pi a =
Just $ appendSeg (toPathSegment a) pi
pars r = do
l <- Array.uncons (r^.routeSegments)
a <- fromPathSegment l.head
pure $ Tuple (r # routeSegments .~ l.tail) a
-- | QueryString value. During printing adds the printed value to the
-- | QueryString under given key. During parsing, looks up the value in the
-- | QueryString.
query :: forall a route. IsRoute route => PathPiece a => String -> RoutesDef route (Maybe a)
query key = mkAtom prnt \pi -> pars pi <|> fallback pi
where
prnt r Nothing =
Just r
prnt r (Just a) =
Just $ r # routeQueryString %~ Obj.insert key (toPathSegment a)
pars r = do
v <- Obj.lookup key $ r^.routeQueryString
a <- fromPathSegment v
pure $ Tuple (r # routeQueryString %~ Obj.delete key) (Just a)
fallback r =
Just $ Tuple r Nothing
--
-- Internal utilities
--
appendSeg :: forall route. IsRoute route => String -> route -> route
appendSeg seg r = r # routeSegments %~ (_ `Array.snoc` seg)
-- | Helper function for producing an Iso out of a print function and a parse
-- | function. It's here solely to shorten the code of primitives above by
-- | removing some of the `Tuple` cruft from them.
mkAtom :: forall a route
. (route -> a -> Maybe route) -- ^ Printing function
-> (route -> Maybe (Tuple route a)) -- ^ Parsing function
-> RoutesDef route a
mkAtom printA parseA = atom $ Iso {
apply: \(Tuple route a) -> printA route a <#> \newRoute -> Tuple newRoute unit,
inverse: \(Tuple route _) -> parseA route
}