@@ -1,206 +1,43 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE ScopedTypeVariables #-}
7−{-# LANGUAGE TemplateHaskell #-}
8−{-# LANGUAGE TypeFamilies #-}
9−{-# LANGUAGE TypeOperators #-}
10−{-# LANGUAGE UndecidableInstances #-}
11−module Servant.JS.Internal where
1+module Servant.JS.Internal
2+ ( JavaScriptGenerator
3+ , AjaxReq
4+ , jsSegments
5+ , segmentToStr
6+ , segmentTypeToStr
7+ , jsParams
8+ , jsGParams
9+ , jsMParams
10+ , paramToStr
11+ -- re-exports
12+ , (:<|>)(..)
13+ , (:>)
14+ , defReq
15+ , defCommonGeneratorOptions
16+ , reqHeaders
17+ , CommonGeneratorOptions(..)
18+ , HasForeign(..)
19+ , HeaderArg(..)
20+ , concatCase
21+ , snakeCase
22+ , camelCase
23+ , ReqBody
24+ , JSON
25+ , FormUrlEncoded
26+ , Post
27+ , Get
28+ , Raw
29+ , Header
30+ ) where
1231
13−#if !MIN_VERSION_base(4,8,0)
14−import Control.Applicative
15−#endif
1632import Control.Lens hiding (List)
17−import Data.Char (toLower, toUpper)
18−import qualified Data.CharSet as Set
19−import qualified Data.CharSet.Unicode.Category as Set
20−import Data.List
21−import Data.Monoid
22−import Data.Proxy
23−import qualified Data.Text as T
24−import GHC.Exts (Constraint)
25−import GHC.TypeLits
26−import Servant.API
33+import Servant.Foreign
2734
28−-- | this structure is used by JavaScriptGenerator implementations to let you
29−-- customize the output
30−data CommonGeneratorOptions = CommonGeneratorOptions
31− {
32− functionNameBuilder :: FunctionName -> String -- ^ function generating function names
33− , requestBody :: String -- ^ name used when a user want to send the request body (to let you redefine it)
34− , successCallback :: String -- ^ name of the callback parameter when the request was successful
35− , errorCallback :: String -- ^ name of the callback parameter when the request reported an error
36− , moduleName :: String -- ^ namespace on which we define the js function (empty mean local var)
37− , urlPrefix :: String -- ^ a prefix we should add to the Url in the JS codegen
38− }
39−
40−-- | Default options.
41−--
42−-- @
43−-- > defCommonGeneratorOptions = CommonGeneratorOptions
44−-- > { functionNameBuilder = camelCase
45−-- > , requestBody = "body"
46−-- > , successCallback = "onSuccess"
47−-- > , errorCallback = "onError"
48−-- > , moduleName = ""
49−-- > , urlPrefix = ""
50−-- > }
51−-- @
52−defCommonGeneratorOptions :: CommonGeneratorOptions
53−defCommonGeneratorOptions = CommonGeneratorOptions
54− {
55− functionNameBuilder = camelCase
56− , requestBody = "body"
57− , successCallback = "onSuccess"
58− , errorCallback = "onError"
59− , moduleName = ""
60− , urlPrefix = ""
61− }
62−
63−-- | Function name builder that simply concat each part together
64−concatCase :: FunctionName -> String
65−concatCase = concat
66−
67−-- | Function name builder using the snake_case convention.
68−-- each part is separated by a single underscore character.
69−snakeCase :: FunctionName -> String
70−snakeCase = intercalate "_"
71−
72−-- | Function name builder using the CamelCase convention.
73−-- each part begins with an upper case character.
74−camelCase :: FunctionName -> String
75−camelCase [] = ""
76−camelCase (p:ps) = concat $ p : camelCase' ps
77− where camelCase' [] = []
78− camelCase' (r:rs) = capitalize r : camelCase' rs
79− capitalize [] = []
80− capitalize (x:xs) = toUpper x : xs
81−
82−type Arg = String
35+type AjaxReq = Req
8336
8437-- A 'JavascriptGenerator' just takes the data found in the API type
8538-- for each endpoint and generates Javascript code in a String. Several
8639-- generators are available in this package.
87−type JavaScriptGenerator = [AjaxReq] -> String
88−
89−data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] }
90− deriving (Eq, Show)
91−
92−data SegmentType = Static String -- ^ a static path segment. like "/foo"
93− | Cap Arg -- ^ a capture. like "/:userid"
94− deriving (Eq, Show)
95−
96−type Path = [Segment]
97−
98−data ArgType =
99− Normal
100− | Flag
101− | List
102− deriving (Eq, Show)
103−
104−data QueryArg = QueryArg
105− { _argName :: Arg
106− , _argType :: ArgType
107− } deriving (Eq, Show)
108−
109−data HeaderArg = HeaderArg
110− { headerArgName :: String
111− }
112− | ReplaceHeaderArg
113− { headerArgName :: String
114− , headerPattern :: String
115− } deriving (Eq)
116−
117−instance Show HeaderArg where
118− show (HeaderArg n) = toValidFunctionName ("header" <> n)
119− show (ReplaceHeaderArg n p)
120− | pn `isPrefixOf` p = pv <> " + \"" <> rp <> "\""
121− | pn `isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
122− | pn `isInfixOf` p = "\"" <> (replace pn ("\" + " <> pv <> " + \"") p)
123− <> "\""
124− | otherwise = p
125− where
126− pv = toValidFunctionName ("header" <> n)
127− pn = "{" <> n <> "}"
128− rp = replace pn "" p
129− -- Use replace method from Data.Text
130− replace old new = T.unpack .
131− T.replace (T.pack old) (T.pack new) .
132− T.pack
133−
134−-- | Attempts to reduce the function name provided to that allowed by JS.
135−-- https://mathiasbynens.be/notes/javascript-identifiers
136−-- Couldn't work out how to handle zero-width characters.
137−-- @TODO: specify better default function name, or throw error?
138−toValidFunctionName :: String -> String
139−toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs
140− where
141− setFirstChar c = if firstChar c
142− then c
143− else '_'
144− firstChar c = prefixOK c || any (Set.member c) firstLetterOK
145− remainder c = prefixOK c || any (Set.member c) remainderOK
146− -- Valid prefixes
147− prefixOK c = c `elem` ['$','_']
148− -- Unicode character sets
149− firstLetterOK = [ Set.lowercaseLetter
150− , Set.uppercaseLetter
151− , Set.titlecaseLetter
152− , Set.modifierLetter
153− , Set.otherLetter
154− , Set.letterNumber ]
155− remainderOK = firstLetterOK <> [ Set.nonSpacingMark
156− , Set.spacingCombiningMark
157− , Set.decimalNumber
158− , Set.connectorPunctuation ]
159−toValidFunctionName [] = "_"
160−
161−type MatrixArg = QueryArg
162−
163−data Url = Url
164− { _path :: Path
165− , _queryStr :: [QueryArg]
166− } deriving (Eq, Show)
167−
168−defUrl :: Url
169−defUrl = Url [] []
170−
171−type FunctionName = [String]
172−type Method = String
173−
174−data AjaxReq = AjaxReq
175− { _reqUrl :: Url
176− , _reqMethod :: Method
177− , _reqHeaders :: [HeaderArg]
178− , _reqBody :: Bool
179− , _funcName :: FunctionName
180− } deriving (Eq, Show)
181−
182−makeLenses ''QueryArg
183−makeLenses ''Segment
184−makeLenses ''Url
185−makeLenses ''AjaxReq
186−
187−isCapture :: Segment -> Bool
188−isCapture (Segment (Cap _) _) = True
189−isCapture _ = False
190−
191−hasMatrixArgs :: Segment -> Bool
192−hasMatrixArgs (Segment _ (_:_)) = True
193−hasMatrixArgs _ = False
194−
195−hasArgs :: Segment -> Bool
196−hasArgs s = isCapture s || hasMatrixArgs s
197−
198−matrixArgs :: Segment -> [MatrixArg]
199−matrixArgs (Segment _ ms) = ms
200−
201−captureArg :: Segment -> Arg
202−captureArg (Segment (Cap s) _) = s
203−captureArg _ = error "captureArg called on non capture"
40+type JavaScriptGenerator = [Req] -> String
20441
20542jsSegments :: [Segment] -> String
20643jsSegments [] = ""
@@ -216,8 +53,8 @@ segmentTypeToStr (Static s) = s
21653segmentTypeToStr (Cap s) = "' + encodeURIComponent(" ++ s ++ ") + '"
21754
21855jsGParams :: String -> [QueryArg] -> String
219−jsGParams _ [] = ""
220−jsGParams _ [x] = paramToStr x False
56+jsGParams _ [] = ""
57+jsGParams _ [x] = paramToStr x False
22158jsGParams s (x:xs) = paramToStr x True ++ s ++ jsGParams s xs
22259
22360jsParams :: [QueryArg] -> String
@@ -234,191 +71,9 @@ paramToStr qarg notTheEnd =
23471 ++ "=' + encodeURIComponent("
23572 ++ name
23673 ++ if notTheEnd then ") + '" else ")"
237−
23874 Flag -> name ++ "="
239−
24075 List -> name
24176 ++ "[]=' + encodeURIComponent("
24277 ++ name
24378 ++ if notTheEnd then ") + '" else ")"
244−
24579 where name = qarg ^. argName
246−
247−defReq :: AjaxReq
248−defReq = AjaxReq defUrl "GET" [] False []
249−
250−type family Elem (a :: *) (ls::[*]) :: Constraint where
251− Elem a '[] = 'False ~ 'True
252− Elem a (a ': list) = ()
253− Elem a (b ': list) = Elem a list
254−
255−class HasJS (layout :: *) where
256− type JS layout :: *
257− javascriptFor :: Proxy layout -> AjaxReq -> JS layout
258−
259−instance (HasJS a, HasJS b)
260− => HasJS (a :<|> b) where
261− type JS (a :<|> b) = JS a :<|> JS b
262−
263− javascriptFor Proxy req =
264− javascriptFor (Proxy :: Proxy a) req
265− :<|> javascriptFor (Proxy :: Proxy b) req
266−
267−instance (KnownSymbol sym, HasJS sublayout)
268− => HasJS (Capture sym a :> sublayout) where
269− type JS (Capture sym a :> sublayout) = JS sublayout
270−
271− javascriptFor Proxy req =
272− javascriptFor (Proxy :: Proxy sublayout) $
273− req & reqUrl.path <>~ [Segment (Cap str) []]
274− & funcName %~ (++ ["by", str])
275−
276− where str = symbolVal (Proxy :: Proxy sym)
277−
278−instance Elem JSON list => HasJS (Delete list a) where
279− type JS (Delete list a) = AjaxReq
280−
281− javascriptFor Proxy req =
282− req & funcName %~ ("delete" :)
283− & reqMethod .~ "DELETE"
284−
285−instance Elem JSON list => HasJS (Get list a) where
286− type JS (Get list a) = AjaxReq
287−
288− javascriptFor Proxy req =
289− req & funcName %~ ("get" :)
290− & reqMethod .~ "GET"
291−
292−instance (KnownSymbol sym, HasJS sublayout)
293− => HasJS (Header sym a :> sublayout) where
294− type JS (Header sym a :> sublayout) = JS sublayout
295−
296− javascriptFor Proxy req =
297− javascriptFor subP (req & reqHeaders <>~ [HeaderArg hname])
298−
299− where hname = symbolVal (Proxy :: Proxy sym)
300− subP = Proxy :: Proxy sublayout
301−
302−instance Elem JSON list => HasJS (Post list a) where
303− type JS (Post list a) = AjaxReq
304−
305− javascriptFor Proxy req =
306− req & funcName %~ ("post" :)
307− & reqMethod .~ "POST"
308−
309−instance Elem JSON list => HasJS (Put list a) where
310− type JS (Put list a) = AjaxReq
311−
312− javascriptFor Proxy req =
313− req & funcName %~ ("put" :)
314− & reqMethod .~ "PUT"
315−
316−instance (KnownSymbol sym, HasJS sublayout)
317− => HasJS (QueryParam sym a :> sublayout) where
318− type JS (QueryParam sym a :> sublayout) = JS sublayout
319−
320− javascriptFor Proxy req =
321− javascriptFor (Proxy :: Proxy sublayout) $
322− req & reqUrl.queryStr <>~ [QueryArg str Normal]
323−
324− where str = symbolVal (Proxy :: Proxy sym)
325−
326−instance (KnownSymbol sym, HasJS sublayout)
327− => HasJS (QueryParams sym a :> sublayout) where
328− type JS (QueryParams sym a :> sublayout) = JS sublayout
329−
330− javascriptFor Proxy req =
331− javascriptFor (Proxy :: Proxy sublayout) $
332− req & reqUrl.queryStr <>~ [QueryArg str List]
333−
334− where str = symbolVal (Proxy :: Proxy sym)
335−
336−instance (KnownSymbol sym, HasJS sublayout)
337− => HasJS (QueryFlag sym :> sublayout) where
338− type JS (QueryFlag sym :> sublayout) = JS sublayout
339−
340− javascriptFor Proxy req =
341− javascriptFor (Proxy :: Proxy sublayout) $
342− req & reqUrl.queryStr <>~ [QueryArg str Flag]
343−
344− where str = symbolVal (Proxy :: Proxy sym)
345−
346−instance (KnownSymbol sym, HasJS sublayout)
347− => HasJS (MatrixParam sym a :> sublayout) where
348− type JS (MatrixParam sym a :> sublayout) = JS sublayout
349−
350− javascriptFor Proxy req =
351− javascriptFor (Proxy :: Proxy sublayout) $
352− req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal]
353−
354− where str = symbolVal (Proxy :: Proxy sym)
355− strArg = str ++ "Value"
356−
357−instance (KnownSymbol sym, HasJS sublayout)
358− => HasJS (MatrixParams sym a :> sublayout) where
359− type JS (MatrixParams sym a :> sublayout) = JS sublayout
360−
361− javascriptFor Proxy req =
362− javascriptFor (Proxy :: Proxy sublayout) $
363− req & reqUrl.path._last.matrix <>~ [QueryArg str List]
364−
365− where str = symbolVal (Proxy :: Proxy sym)
366−
367−instance (KnownSymbol sym, HasJS sublayout)
368− => HasJS (MatrixFlag sym :> sublayout) where
369− type JS (MatrixFlag sym :> sublayout) = JS sublayout
370−
371− javascriptFor Proxy req =
372− javascriptFor (Proxy :: Proxy sublayout) $
373− req & reqUrl.path._last.matrix <>~ [QueryArg str Flag]
374−
375− where str = symbolVal (Proxy :: Proxy sym)
376−
377−instance HasJS Raw where
378− type JS Raw = Method -> AjaxReq
379−
380− javascriptFor Proxy req method =
381− req & funcName %~ ((toLower <$> method) :)
382− & reqMethod .~ method
383−
384−instance (Elem JSON list, HasJS sublayout) => HasJS (ReqBody list a :> sublayout) where
385− type JS (ReqBody list a :> sublayout) = JS sublayout
386−
387− javascriptFor Proxy req =
388− javascriptFor (Proxy :: Proxy sublayout) $
389− req & reqBody .~ True
390−
391−instance (KnownSymbol path, HasJS sublayout)
392− => HasJS (path :> sublayout) where
393− type JS (path :> sublayout) = JS sublayout
394−
395− javascriptFor Proxy req =
396− javascriptFor (Proxy :: Proxy sublayout) $
397− req & reqUrl.path <>~ [Segment (Static str) []]
398− & funcName %~ (++ [str])
399−
400− where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path)
401−
402−instance HasJS sublayout => HasJS (RemoteHost :> sublayout) where
403− type JS (RemoteHost :> sublayout) = JS sublayout
404−
405− javascriptFor Proxy req =
406− javascriptFor (Proxy :: Proxy sublayout) req
407−
408−instance HasJS sublayout => HasJS (IsSecure :> sublayout) where
409− type JS (IsSecure :> sublayout) = JS sublayout
410−
411− javascriptFor Proxy req =
412− javascriptFor (Proxy :: Proxy sublayout) req
413−
414−instance HasJS sublayout => HasJS (Vault :> sublayout) where
415− type JS (Vault :> sublayout) = JS sublayout
416−
417− javascriptFor Proxy req =
418− javascriptFor (Proxy :: Proxy sublayout) req
419−
420−instance HasJS sublayout => HasJS (HttpVersion :> sublayout) where
421− type JS (HttpVersion :> sublayout) = JS sublayout
422−
423− javascriptFor Proxy req =
424− javascriptFor (Proxy :: Proxy sublayout) req