@@ -0,0 +1,63 @@
1+{-# LANGUAGE DefaultSignatures #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE KindSignatures #-}
5+{-# LANGUAGE PolyKinds #-}
6+{-# LANGUAGE ScopedTypeVariables #-}
7+{-# LANGUAGE TypeOperators #-}
8+{-# LANGUAGE TypeSynonymInstances #-}
9+module Data.Swagger.Internal.Param where
10+
11+import Control.Lens
12+import Data.Aeson
13+import Data.Proxy
14+import GHC.Generics
15+
16+import Data.Swagger.Internal
17+import Data.Swagger.Internal.Schema (SchemaOptions(..), defaultSchemaOptions)
18+import Data.Swagger.Lens
19+
20+class ToParamSchema a where
21+ -- | Convert a type into a non-body parameter schema.
22+ toParamSchema :: proxy a -> ParamLocation -> ParamOtherSchema
23+ default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => proxy a -> ParamLocation -> ParamOtherSchema
24+ toParamSchema = genericToParamSchema defaultSchemaOptions
25+
26+genericToParamSchema :: forall proxy a. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> proxy a -> ParamLocation -> ParamOtherSchema
27+genericToParamSchema opts _ loc = gtoParamSchema opts (Proxy :: Proxy (Rep a)) loc mempty
28+
29+class GToParamSchema (f :: * -> *) where
30+ gtoParamSchema :: SchemaOptions -> proxy f -> ParamLocation -> ParamOtherSchema -> ParamOtherSchema
31+
32+instance GToParamSchema f => GToParamSchema (D1 d f) where
33+ gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
34+
35+instance GToParamSchema f => GToParamSchema (C1 c (S1 s f)) where
36+ gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
37+
38+instance ToParamSchema c => GToParamSchema (K1 i c) where
39+ gtoParamSchema _ _ loc _ = toParamSchema (Proxy :: Proxy c) loc
40+
41+instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) where
42+ gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
43+
44+
45+class GEnumParamSchema (f :: * -> *) where
46+ genumParamSchema :: SchemaOptions -> proxy f -> ParamLocation -> ParamOtherSchema -> ParamOtherSchema
47+
48+instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
49+ genumParamSchema opts _ loc = genumParamSchema opts (Proxy :: Proxy f) loc . genumParamSchema opts (Proxy :: Proxy g) loc
50+
51+instance Constructor c => GEnumParamSchema (C1 c U1) where
52+ genumParamSchema opts _ loc s = s
53+ & paramOtherSchemaIn .~ loc
54+ & paramOtherSchemaType .~ ParamString
55+ & schemaEnum %~ addEnumValue tag
56+ where
57+ tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
58+
59+ addEnumValue x Nothing = Just [x]
60+ addEnumValue x (Just xs) = Just (x:xs)
61+
62+data Proxy3 a b c = Proxy3
63+