@@ -0,0 +1,60 @@
1+
2+{-# LANGUAGE KindSignatures #-}
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE TypeFamilies #-}
5+{-# LANGUAGE TypeOperators #-}
6+{-# LANGUAGE UndecidableInstances #-}
7+
8+
9+module Data.Swagger.Internal.TypeShape where
10+
11+
12+import Data.Proxy
13+import GHC.Generics
14+import GHC.TypeLits
15+
16+data TypeShape = EnumShape
17+ | NestedShape
18+ | IlegalShape
19+
20+
21+type family ProdCombine (a :: TypeShape ) (b :: TypeShape) :: TypeShape where
22+
23+ ProdCombine IlegalShape b = IlegalShape
24+ ProdCombine a IlegalShape = IlegalShape
25+ ProdCombine a b = NestedShape
26+
27+
28+type family SumCombine (a :: TypeShape ) (b :: TypeShape) :: TypeShape where
29+
30+ SumCombine EnumShape EnumShape = EnumShape
31+ SumCombine NestedShape NestedShape = NestedShape
32+ SumCombine a b = IlegalShape
33+
34+
35+
36+
37+class LegalShape (a :: TypeShape) where
38+
39+instance LegalShape EnumShape
40+instance LegalShape NestedShape
41+
42+instance TypeError
43+ ( Text "Cannot auto derive swagger class, for that to be possible, make sure that any constructor "
44+ :$$: Text "for this type, only holds 0 arguments if there are no other contructors with more than 0 arguments,"
45+ :$$: Text "otherwise, every constructor have to hold at least 1 argument"
46+ ) => LegalShape IlegalShape
47+
48+
49+
50+type family GenericShape ( g :: * -> * ) :: TypeShape
51+
52+
53+type instance GenericShape (f :*: g) = ProdCombine (GenericShape f) (GenericShape g)
54+type instance GenericShape (f :+: g) = SumCombine (GenericShape f) (GenericShape g)
55+type instance GenericShape (D1 d f) = GenericShape f
56+type instance GenericShape (C1 c U1) = EnumShape
57+type instance GenericShape (C1 c (S1 s f)) = NestedShape
58+type instance GenericShape (C1 c (f :*: g)) = NestedShape
59+
60+