@@ -1,31 +1,52 @@
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
12−
13−#if !MIN_VERSION_base(4,8,0)
14−import Control.Applicative
15−#endif
16−import Control.Lens hiding (List)
17−import Data.Char (toLower, toUpper)
1+module Servant.JS.Internal
2+ ( JavaScriptGenerator
3+ , CommonGeneratorOptions(..)
4+ , defCommonGeneratorOptions
5+ , AjaxReq
6+ , jsSegments
7+ , segmentToStr
8+ , segmentTypeToStr
9+ , jsParams
10+ , jsGParams
11+ , jsMParams
12+ , paramToStr
13+ , toValidFunctionName
14+ , toJSHeader
15+ -- re-exports
16+ , (:<|>)(..)
17+ , (:>)
18+ , defReq
19+ , reqHeaders
20+ , HasForeign(..)
21+ , HeaderArg(..)
22+ , concatCase
23+ , snakeCase
24+ , camelCase
25+ , ReqBody
26+ , JSON
27+ , FormUrlEncoded
28+ , Post
29+ , Get
30+ , Raw
31+ , Header
32+ ) where
33+
34+import Control.Lens hiding (List)
1835import qualified Data.CharSet as Set
1936import qualified Data.CharSet.Unicode.Category as Set
20−import Data.List
21−import Data.Monoid
22−import Data.Proxy
37+import Data.List
38+import Data.Monoid
2339import qualified Data.Text as T
24−import GHC.Exts (Constraint)
25−import GHC.TypeLits
26−import Servant.API
40+import Servant.Foreign
41+
42+type AjaxReq = Req
43+
44+-- A 'JavascriptGenerator' just takes the data found in the API type
45+-- for each endpoint and generates Javascript code in a String. Several
46+-- generators are available in this package.
47+type JavaScriptGenerator = [Req] -> String
2748
28−-- | this structure is used by JavaScriptGenerator implementations to let you
49+-- | This structure is used by specific implementations to let you
2950-- customize the output
3051data CommonGeneratorOptions = CommonGeneratorOptions
3152 {
@@ -33,8 +54,8 @@ data CommonGeneratorOptions = CommonGeneratorOptions
3354 , requestBody :: String -- ^ name used when a user want to send the request body (to let you redefine it)
3455 , successCallback :: String -- ^ name of the callback parameter when the request was successful
3556 , 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
57+ , moduleName :: String -- ^ namespace on which we define the foreign function (empty mean local var)
58+ , urlPrefix :: String -- ^ a prefix we should add to the Url in the codegen
3859 }
3960
4061-- | Default options.
@@ -60,87 +81,16 @@ defCommonGeneratorOptions = CommonGeneratorOptions
6081 , urlPrefix = ""
6182 }
6283
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
83−
84−-- A 'JavascriptGenerator' just takes the data found in the API type
85−-- for each endpoint and generates Javascript code in a String. Several
86−-- 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.
84+-- | Attempts to reduce the function name provided to that allowed by @'Foreign'@.
85+--
13586-- https://mathiasbynens.be/notes/javascript-identifiers
13687-- Couldn't work out how to handle zero-width characters.
88+--
13789-- @TODO: specify better default function name, or throw error?
13890toValidFunctionName :: String -> String
13991toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs
14092 where
141− setFirstChar c = if firstChar c
142− then c
143− else '_'
93+ setFirstChar c = if firstChar c then c else '_'
14494 firstChar c = prefixOK c || any (Set.member c) firstLetterOK
14595 remainder c = prefixOK c || any (Set.member c) remainderOK
14696 -- Valid prefixes
@@ -152,55 +102,29 @@ toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs
152102 , Set.modifierLetter
153103 , Set.otherLetter
154104 , Set.letterNumber ]
155− remainderOK = firstLetterOK <> [ Set.nonSpacingMark
156− , Set.spacingCombiningMark
157− , Set.decimalNumber
158− , Set.connectorPunctuation ]
105+ remainderOK = firstLetterOK
106+ <> [ Set.nonSpacingMark
107+ , Set.spacingCombiningMark
108+ , Set.decimalNumber
109+ , Set.connectorPunctuation ]
159110toValidFunctionName [] = "_"
160111
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"
112+toJSHeader :: HeaderArg -> String
113+toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n)
114+toJSHeader (ReplaceHeaderArg n p)
115+ | pn `isPrefixOf` p = pv <> " + \"" <> rp <> "\""
116+ | pn `isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
117+ | pn `isInfixOf` p = "\"" <> (replace pn ("\" + " <> pv <> " + \"") p)
118+ <> "\""
119+ | otherwise = p
120+ where
121+ pv = toValidFunctionName ("header" <> n)
122+ pn = "{" <> n <> "}"
123+ rp = replace pn "" p
124+ -- Use replace method from Data.Text
125+ replace old new = T.unpack
126+ . T.replace (T.pack old) (T.pack new)
127+ . T.pack
204128
205129jsSegments :: [Segment] -> String
206130jsSegments [] = ""
@@ -216,8 +140,8 @@ segmentTypeToStr (Static s) = s
216140segmentTypeToStr (Cap s) = "' + encodeURIComponent(" ++ s ++ ") + '"
217141
218142jsGParams :: String -> [QueryArg] -> String
219−jsGParams _ [] = ""
220−jsGParams _ [x] = paramToStr x False
143+jsGParams _ [] = ""
144+jsGParams _ [x] = paramToStr x False
221145jsGParams s (x:xs) = paramToStr x True ++ s ++ jsGParams s xs
222146
223147jsParams :: [QueryArg] -> String
@@ -234,191 +158,9 @@ paramToStr qarg notTheEnd =
234158 ++ "=' + encodeURIComponent("
235159 ++ name
236160 ++ if notTheEnd then ") + '" else ")"
237−
238161 Flag -> name ++ "="
239−
240162 List -> name
241163 ++ "[]=' + encodeURIComponent("
242164 ++ name
243165 ++ if notTheEnd then ") + '" else ")"
244−
245166 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