git.iko.soy/typeable/servant
on master help sign in
Added support for matrix parameters.
9e5bed2Daniel Larsson
.gitignorenew file+17
compare with master
unifiedsplit
@@ -0,0 +1,17 @@
1+dist
2+cabal-dev
3+*.o
4+*.hi
5+*.chi
6+*.chs.h
7+*.dyn_o
8+*.dyn_hi
9+.virtualenv
10+.hpc
11+.hsenv
12+.cabal-sandbox/
13+cabal.sandbox.config
14+cabal.config
15+*.prof
16+*.aux
17+*.hp
servant-jquery.cabal+4−4
@@ -34,7 +34,7 @@ library
34 build-depends: base >=4.5 && <5
34 build-depends: base >=4.5 && <5
35 , charset
35 , charset
36 , lens >= 4
36 , lens >= 4
37− , servant >= 0.2.1
37+ , servant >= 0.2.2
38 , text
38 , text
39 hs-source-dirs: src
39 hs-source-dirs: src
40 default-language: Haskell2010
40 default-language: Haskell2010
@@ -54,9 +54,9 @@ executable counter
54 aeson
54 aeson
55 , base
55 , base
56 , filepath
56 , filepath
57− , servant >= 0.2.1
57+ , servant >= 0.2.2
58− , servant-server >= 0.2.1
58+ , servant-server >= 0.2.3
59− , servant-jquery >= 0.2.1
59+ , servant-jquery >= 0.2.2
60 , stm
60 , stm
61 , transformers
61 , transformers
62 , warp
62 , warp
src/Servant/JQuery/Internal.hs+81−7
@@ -24,10 +24,12 @@ import Servant.API
24
24
25type Arg = String
25type Arg = String
26
26
27−data Segment = Static String -- ^ a static path segment. like "/foo"
27+data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] }
28− | Cap Arg -- ^ a capture. like "/:userid"
29 deriving (Eq, Show)
28 deriving (Eq, Show)
30
29
30+data SegmentType = Static String -- ^ a static path segment. like "/foo"
31+ | Cap Arg -- ^ a capture. like "/:userid"
32+ deriving (Eq, Show)
31
33
32isCapture :: Segment -> Bool
34isCapture :: Segment -> Bool
33isCapture (Cap _) = True
35isCapture (Cap _) = True
@@ -113,6 +115,8 @@ toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs
113 , Set.connectorPunctuation ]
115 , Set.connectorPunctuation ]
114toValidFunctionName [] = "_"
116toValidFunctionName [] = "_"
115
117
118+type MatrixArg = QueryArg
119+
116data Url = Url
120data Url = Url
117 { _path :: Path
121 { _path :: Path
118 , _queryStr :: [QueryArg]
122 , _queryStr :: [QueryArg]
@@ -133,13 +137,52 @@ data AjaxReq = AjaxReq
133 } deriving (Eq, Show)
137 } deriving (Eq, Show)
134
138
135makeLenses ''QueryArg
139makeLenses ''QueryArg
140+makeLenses ''Segment
136makeLenses ''Url
141makeLenses ''Url
137makeLenses ''AjaxReq
142makeLenses ''AjaxReq
138
143
144+isCapture :: Segment -> Bool
145+isCapture (Segment (Cap _) _) = True
146+isCapture _ = False
147+
148+hasMatrixArgs :: Segment -> Bool
149+hasMatrixArgs (Segment _ (_:_)) = True
150+hasMatrixArgs _ = False
151+
152+hasArgs :: Segment -> Bool
153+hasArgs s = isCapture s || hasMatrixArgs s
154+
155+matrixArgs :: Segment -> [MatrixArg]
156+matrixArgs (Segment _ ms) = ms
157+
158+captureArg :: Segment -> Arg
159+captureArg (Segment (Cap s) _) = s
160+captureArg _ = error "captureArg called on non capture"
161+
162+jsSegments :: [Segment] -> String
163+jsSegments [] = ""
164+jsSegments [x] = "/" ++ segmentToStr x False
165+jsSegments (x:xs) = "/" ++ segmentToStr x True ++ jsSegments xs
166+
167+segmentToStr :: Segment -> Bool -> String
168+segmentToStr (Segment st ms) notTheEnd =
169+ segmentTypeToStr st ++ jsMParams ms ++ if notTheEnd then "" else "'"
170+
171+segmentTypeToStr :: SegmentType -> String
172+segmentTypeToStr (Static s) = s
173+segmentTypeToStr (Cap s) = "' + encodeURIComponent(" ++ s ++ ") + '"
174+
175+jsGParams :: String -> [QueryArg] -> String
176+jsGParams _ [] = ""
177+jsGParams _ [x] = paramToStr x False
178+jsGParams s (x:xs) = paramToStr x True ++ s ++ jsGParams s xs
179+
139jsParams :: [QueryArg] -> String
180jsParams :: [QueryArg] -> String
140−jsParams [] = ""
181+jsParams = jsGParams "&"
141−jsParams [x] = paramToStr x False
182+
142−jsParams (x:xs) = paramToStr x True ++ "&" ++ jsParams xs
183+jsMParams :: [MatrixArg] -> String
184+jsMParams [] = ""
185+jsMParams xs = ";" ++ jsGParams ";" xs
143
186
144paramToStr :: QueryArg -> Bool -> String
187paramToStr :: QueryArg -> Bool -> String
145paramToStr qarg notTheEnd =
188paramToStr qarg notTheEnd =
@@ -184,7 +227,7 @@ instance (KnownSymbol sym, HasJQ sublayout)
184
227
185 jqueryFor Proxy req =
228 jqueryFor Proxy req =
186 jqueryFor (Proxy :: Proxy sublayout) $
229 jqueryFor (Proxy :: Proxy sublayout) $
187− req & reqUrl.path <>~ [Cap str]
230+ req & reqUrl.path <>~ [Segment (Cap str) []]
188
231
189 where str = symbolVal (Proxy :: Proxy sym)
232 where str = symbolVal (Proxy :: Proxy sym)
190
233
@@ -256,6 +299,37 @@ instance (KnownSymbol sym, HasJQ sublayout)
256
299
257 where str = symbolVal (Proxy :: Proxy sym)
300 where str = symbolVal (Proxy :: Proxy sym)
258
301
302+instance (KnownSymbol sym, HasJQ sublayout)
303+ => HasJQ (MatrixParam sym a :> sublayout) where
304+ type JQ (MatrixParam sym a :> sublayout) = JQ sublayout
305+
306+ jqueryFor Proxy req =
307+ jqueryFor (Proxy :: Proxy sublayout) $
308+ req & reqUrl.path._last.matrix <>~ [QueryArg str Normal]
309+
310+ where str = symbolVal (Proxy :: Proxy sym)
311+ strArg = str ++ "Value"
312+
313+instance (KnownSymbol sym, HasJQ sublayout)
314+ => HasJQ (MatrixParams sym a :> sublayout) where
315+ type JQ (MatrixParams sym a :> sublayout) = JQ sublayout
316+
317+ jqueryFor Proxy req =
318+ jqueryFor (Proxy :: Proxy sublayout) $
319+ req & reqUrl.path._last.matrix <>~ [QueryArg str List]
320+
321+ where str = symbolVal (Proxy :: Proxy sym)
322+
323+instance (KnownSymbol sym, HasJQ sublayout)
324+ => HasJQ (MatrixFlag sym :> sublayout) where
325+ type JQ (MatrixFlag sym :> sublayout) = JQ sublayout
326+
327+ jqueryFor Proxy req =
328+ jqueryFor (Proxy :: Proxy sublayout) $
329+ req & reqUrl.path._last.matrix <>~ [QueryArg str Flag]
330+
331+ where str = symbolVal (Proxy :: Proxy sym)
332+
259instance HasJQ Raw where
333instance HasJQ Raw where
260 type JQ Raw = Method -> AjaxReq
334 type JQ Raw = Method -> AjaxReq
261
335
@@ -276,7 +350,7 @@ instance (KnownSymbol path, HasJQ sublayout)
276
350
277 jqueryFor Proxy req =
351 jqueryFor Proxy req =
278 jqueryFor (Proxy :: Proxy sublayout) $
352 jqueryFor (Proxy :: Proxy sublayout) $
279− req & reqUrl.path <>~ [Static str]
353+ req & reqUrl.path <>~ [Segment (Static str) []]
280 & funcName %~ (str <>)
354 & funcName %~ (str <>)
281
355
282 where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path)
356 where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path)