git.iko.soy/servant
on master help sign in
Expand left-nested APIs by default
5fa99beCatherine Galkina
servant-client/src/Servant/Client/Generic.hs+40−11
compare with master
unifiedsplit
@@ -5,12 +5,14 @@
5{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeOperators #-}
8+{-# LANGUAGE UndecidableInstances #-}
8module Servant.Client.Generic
9module Servant.Client.Generic
9 ( ClientLike(..)
10 ( ClientLike(..)
10− , genericMkClient
11+ , genericMkClientL
12+ , genericMkClientP
11 ) where
13 ) where
12
14
13−import Generics.SOP (Generic, I(..), NP(..), NS(Z), Rep, SOP(..), to)
15+import Generics.SOP (Code, Generic, I(..), NP(..), NS(Z), Rep, SOP(..), to)
14import Servant.API ((:<|>)(..))
16import Servant.API ((:<|>)(..))
15import Servant.Client (ClientM)
17import Servant.Client (ClientM)
16
18
@@ -40,20 +42,20 @@ import Servant.Client (ClientM)
40-- > instance (Client API ~ client) => ClientLike client APIClient
42-- > instance (Client API ~ client) => ClientLike client APIClient
41-- >
43-- >
42-- > data NestedClient = NestedClient
44-- > data NestedClient = NestedClient
43−-- > { getString :: ClientM String
45+-- > { getString :: ClientM String
44-- > , postBaz :: Maybe Char -> ClientM ()
46-- > , postBaz :: Maybe Char -> ClientM ()
45-- > } deriving GHC.Generic
47-- > } deriving GHC.Generic
46-- >
48-- >
47−-- > instance Generic.SOP.Generic
49+-- > instance Generic.SOP.Generic NestedClient
48-- > instance (Client NestedAPI ~ client) => ClientLike client NestedClient
50-- > instance (Client NestedAPI ~ client) => ClientLike client NestedClient
49-- >
51-- >
50-- > mkAPIClient :: APIClient
52-- > mkAPIClient :: APIClient
51-- > mkAPIClient = mkClient (client (Proxy :: Proxy API))
53-- > mkAPIClient = mkClient (client (Proxy :: Proxy API))
52class ClientLike client custom where
54class ClientLike client custom where
53 mkClient :: client -> custom
55 mkClient :: client -> custom
54− default mkClient :: (Generic custom, GClientLikeP client xs, SOP I '[xs] ~ Rep custom)
56+ default mkClient :: (Generic custom, Code custom ~ '[xs], GClientList client '[], GClientLikeL (ClientList client '[]) xs)
55 => client -> custom
57 => client -> custom
56− mkClient = genericMkClient
58+ mkClient = genericMkClientL
57
59
58instance ClientLike client custom
60instance ClientLike client custom
59 => ClientLike (a -> client) (a -> custom) where
61 => ClientLike (a -> client) (a -> custom) where
@@ -62,9 +64,7 @@ instance ClientLike client custom
62instance ClientLike (ClientM a) (ClientM a) where
64instance ClientLike (ClientM a) (ClientM a) where
63 mkClient = id
65 mkClient = id
64
66
65−-- | This class is used to match client functions to the
67+-- GClientLikeP
66−-- representation of client structure type as sum of products
67−-- and basically does all the internal job to build this structure.
68class GClientLikeP client xs where
68class GClientLikeP client xs where
69 gMkClientP :: client -> NP I xs
69 gMkClientP :: client -> NP I xs
70
70
@@ -75,8 +75,37 @@ instance (GClientLikeP b (y ': xs), ClientLike a x)
75instance ClientLike a x => GClientLikeP a '[x] where
75instance ClientLike a x => GClientLikeP a '[x] where
76 gMkClientP a = I (mkClient a) :* Nil
76 gMkClientP a = I (mkClient a) :* Nil
77
77
78+-- GClientLikeL
79+class GClientLikeL (xs :: [*]) (ys :: [*]) where
80+ gMkClientL :: NP I xs -> NP I ys
81+
82+instance GClientLikeL '[] '[] where
83+ gMkClientL Nil = Nil
84+
85+instance (ClientLike x y, GClientLikeL xs ys) => GClientLikeL (x ': xs) (y ': ys) where
86+ gMkClientL (I x :* xs) = I (mkClient x) :* gMkClientL xs
87+
88+type family ClientList (client :: *) (acc :: [*]) :: [*] where
89+ ClientList (a :<|> b) acc = ClientList a (ClientList b acc)
90+ ClientList a acc = a ': acc
91+
92+class GClientList client (acc :: [*]) where
93+ gClientList :: client -> NP I acc -> NP I (ClientList client acc)
94+
95+instance (GClientList b acc, GClientList a (ClientList b acc))
96+ => GClientList (a :<|> b) acc where
97+ gClientList (a :<|> b) acc = gClientList a (gClientList b acc)
98+
99+instance {-# OVERLAPPABLE #-} (ClientList client acc ~ (client ': acc))
100+ => GClientList client acc where
101+ gClientList c acc = I c :* acc
102+
78-- | Generate client structure from client type.
103-- | Generate client structure from client type.
104+genericMkClientL :: (Generic custom, Code custom ~ '[xs], GClientList client '[], GClientLikeL (ClientList client '[]) xs)
105+ => client -> custom
106+genericMkClientL = to . SOP . Z . gMkClientL . flip gClientList Nil
107+
79−genericMkClient :: (Generic custom, GClientLikeP client xs, SOP I '[xs] ~ Rep custom)
108+genericMkClientP :: (Generic custom, Code custom ~ '[xs], GClientLikeP client xs)
80 => client -> custom
109 => client -> custom
81−genericMkClient = to . SOP . Z . gMkClientP
110+genericMkClientP = to . SOP . Z . gMkClientP
82
111