git.iko.soy/typeable/servant
on master help sign in
Add access to types in servant-foreign.
commit8932cb242cfad24ca5f61059e2aef823f1f40ff5 authorMaksymilian Owsianny <Maksymilian.Owsianny@gmail.com> dateSat 28 Nov 2015, 08:13 (11 years ago) parent8bf804e
2 files changed+67−34
servant-foreign/src/Servant/Foreign.hs+2 servant-foreign/src/Servant/Foreign/Internal.hs+65−34
servant-foreign/src/Servant/Foreign.hs+2
@@ -2,6 +2,7 @@
22-- arbitrary programming languages.
33module Servant.Foreign
44 ( HasForeign(..)
5+ , HasForeignType(..)
56 , Segment(..)
67 , SegmentType(..)
78 , FunctionName
@@ -24,6 +25,7 @@ module Servant.Foreign
2425 , reqBody
2526 , reqHeaders
2627 , reqMethod
28+ , reqReturnType
2729 , segment
2830 , queryStr
2931 -- re-exports
servant-foreign/src/Servant/Foreign/Internal.hs+65−34
@@ -45,7 +45,8 @@ camelCase = camelCase' . Prelude.map (replace "-" "")
4545 capitalize "" = ""
4646 capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
4747
48−type Arg = Text
48+type ForeignType = Text
49+type Arg = (Text, ForeignType)
4950
5051newtype Segment = Segment { _segment :: SegmentType }
5152 deriving (Eq, Show)
@@ -68,10 +69,10 @@ data QueryArg = QueryArg
6869 } deriving (Eq, Show)
6970
7071data HeaderArg = HeaderArg
71− { headerArgName :: Text
72+ { headerArg :: Arg
7273 }
7374 | ReplaceHeaderArg
74− { headerArgName :: Text
75+ { headerArg :: Arg
7576 , headerPattern :: Text
7677 } deriving (Eq, Show)
7778
@@ -88,11 +89,12 @@ type FunctionName = [Text]
8889type Method = Text
8990
9091data Req = Req
91− { _reqUrl :: Url
92− , _reqMethod :: Method
93− , _reqHeaders :: [HeaderArg]
94− , _reqBody :: Bool
95− , _funcName :: FunctionName
92+ { _reqUrl :: Url
93+ , _reqMethod :: Method
94+ , _reqHeaders :: [HeaderArg]
95+ , _reqBody :: Maybe ForeignType
96+ , _reqReturnType :: ForeignType
97+ , _funcName :: FunctionName
9698 } deriving (Eq, Show)
9799
98100makeLenses ''QueryArg
@@ -109,7 +111,7 @@ captureArg (Segment (Cap s)) = s
109111captureArg _ = error "captureArg called on non capture"
110112
111113defReq :: Req
112−defReq = Req defUrl "GET" [] False []
114+defReq = Req defUrl "GET" [] Nothing "" []
113115
114116-- | To be used exclusively as a "negative" return type/constraint
115117-- by @'Elem`@ type family.
@@ -120,6 +122,9 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
120122 Elem a (a ': list) = ()
121123 Elem a (b ': list) = Elem a list
122124
125+class HasForeignType a where
126+ typeFor :: Proxy a -> ForeignType
127+
123128class HasForeign (layout :: *) where
124129 type Foreign layout :: *
125130 foreignFor :: Proxy layout -> Req -> Foreign layout
@@ -132,84 +137,107 @@ instance (HasForeign a, HasForeign b)
132137 foreignFor (Proxy :: Proxy a) req
133138 :<|> foreignFor (Proxy :: Proxy b) req
134139
135−instance (KnownSymbol sym, HasForeign sublayout)
140+instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout)
136141 => HasForeign (Capture sym a :> sublayout) where
137142 type Foreign (Capture sym a :> sublayout) = Foreign sublayout
138143
139144 foreignFor Proxy req =
140145 foreignFor (Proxy :: Proxy sublayout) $
141− req & reqUrl.path <>~ [Segment (Cap str)]
146+ req & reqUrl.path <>~ [Segment (Cap arg)]
142147 & funcName %~ (++ ["by", str])
143148
144− where str = pack . symbolVal $ (Proxy :: Proxy sym)
149+ where
150+ str = pack . symbolVal $ (Proxy :: Proxy sym)
151+ arg = (str, typeFor (Proxy :: Proxy a))
145152
146−instance Elem JSON list => HasForeign (Delete list a) where
153+instance (Elem JSON list, HasForeignType a) => HasForeign (Delete list a) where
147154 type Foreign (Delete list a) = Req
148155
149156 foreignFor Proxy req =
150− req & funcName %~ ("delete" :)
151− & reqMethod .~ "DELETE"
157+ req & funcName %~ ("delete" :)
158+ & reqMethod .~ "DELETE"
159+ & reqReturnType .~ retType
160+ where
161+ retType = typeFor (Proxy :: Proxy a)
152162
153−instance Elem JSON list => HasForeign (Get list a) where
163+instance (Elem JSON list, HasForeignType a) => HasForeign (Get list a) where
154164 type Foreign (Get list a) = Req
155165
156166 foreignFor Proxy req =
157167 req & funcName %~ ("get" :)
158168 & reqMethod .~ "GET"
169+ & reqReturnType .~ retType
170+ where
171+ retType = typeFor (Proxy :: Proxy a)
159172
160−instance (KnownSymbol sym, HasForeign sublayout)
173+instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout)
161174 => HasForeign (Header sym a :> sublayout) where
162175 type Foreign (Header sym a :> sublayout) = Foreign sublayout
163176
164177 foreignFor Proxy req =
165− foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])
178+ foreignFor subP $ req
179+ & reqHeaders <>~ [HeaderArg arg]
166180
167− where hname = pack . symbolVal $ (Proxy :: Proxy sym)
168− subP = Proxy :: Proxy sublayout
181+ where
182+ hname = pack . symbolVal $ (Proxy :: Proxy sym)
183+ arg = (hname, typeFor (Proxy :: Proxy a))
184+ subP = Proxy :: Proxy sublayout
169185
170−instance Elem JSON list => HasForeign (Post list a) where
186+instance (Elem JSON list, HasForeignType a) => HasForeign (Post list a) where
171187 type Foreign (Post list a) = Req
172188
173189 foreignFor Proxy req =
174190 req & funcName %~ ("post" :)
175191 & reqMethod .~ "POST"
192+ & reqReturnType .~ retType
193+ where
194+ retType = typeFor (Proxy :: Proxy a)
176195
177−instance Elem JSON list => HasForeign (Put list a) where
196+instance (Elem JSON list, HasForeignType a) => HasForeign (Put list a) where
178197 type Foreign (Put list a) = Req
179198
180199 foreignFor Proxy req =
181200 req & funcName %~ ("put" :)
182201 & reqMethod .~ "PUT"
202+ & reqReturnType .~ retType
203+ where
204+ retType = typeFor (Proxy :: Proxy a)
183205
184−instance (KnownSymbol sym, HasForeign sublayout)
206+instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout)
185207 => HasForeign (QueryParam sym a :> sublayout) where
186208 type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
187209
188210 foreignFor Proxy req =
189211 foreignFor (Proxy :: Proxy sublayout) $
190− req & reqUrl.queryStr <>~ [QueryArg str Normal]
212+ req & reqUrl.queryStr <>~ [QueryArg arg Normal]
191213
192− where str = pack . symbolVal $ (Proxy :: Proxy sym)
214+ where
215+ str = pack . symbolVal $ (Proxy :: Proxy sym)
216+ arg = (str, typeFor (Proxy :: Proxy a))
193217
194−instance (KnownSymbol sym, HasForeign sublayout)
218+instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout)
195219 => HasForeign (QueryParams sym a :> sublayout) where
196220 type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
197221
198222 foreignFor Proxy req =
199223 foreignFor (Proxy :: Proxy sublayout) $
200− req & reqUrl.queryStr <>~ [QueryArg str List]
224+ req & reqUrl.queryStr <>~ [QueryArg arg List]
201225
202− where str = pack . symbolVal $ (Proxy :: Proxy sym)
226+ where
227+ str = pack . symbolVal $ (Proxy :: Proxy sym)
228+ arg = (str, typeFor (Proxy :: Proxy a))
203229
204−instance (KnownSymbol sym, HasForeign sublayout)
230+instance (KnownSymbol sym, HasForeignType a, a ~ Bool, HasForeign sublayout)
205231 => HasForeign (QueryFlag sym :> sublayout) where
206232 type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
207233
208234 foreignFor Proxy req =
209235 foreignFor (Proxy :: Proxy sublayout) $
210− req & reqUrl.queryStr <>~ [QueryArg str Flag]
236+ req & reqUrl.queryStr <>~ [QueryArg arg Flag]
211237
212− where str = pack . symbolVal $ (Proxy :: Proxy sym)
238+ where
239+ str = pack . symbolVal $ (Proxy :: Proxy sym)
240+ arg = (str, typeFor (Proxy :: Proxy a))
213241
214242instance HasForeign Raw where
215243 type Foreign Raw = Method -> Req
@@ -218,12 +246,13 @@ instance HasForeign Raw where
218246 req & funcName %~ ((toLower method) :)
219247 & reqMethod .~ method
220248
221−instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where
249+instance (Elem JSON list, HasForeignType a, HasForeign sublayout)
250+ => HasForeign (ReqBody list a :> sublayout) where
222251 type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
223252
224253 foreignFor Proxy req =
225254 foreignFor (Proxy :: Proxy sublayout) $
226− req & reqBody .~ True
255+ req & reqBody .~ (Just $ typeFor (Proxy :: Proxy a))
227256
228257instance (KnownSymbol path, HasForeign sublayout)
229258 => HasForeign (path :> sublayout) where
@@ -234,7 +263,9 @@ instance (KnownSymbol path, HasForeign sublayout)
234263 req & reqUrl.path <>~ [Segment (Static str)]
235264 & funcName %~ (++ [str])
236265
237− where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)
266+ where
267+ str = Data.Text.map (\c -> if c == '.' then '_' else c)
268+ . pack . symbolVal $ (Proxy :: Proxy path)
238269
239270instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where
240271 type Foreign (RemoteHost :> sublayout) = Foreign sublayout