@@ -1,155 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE TypeFamilies #-}
7−{-# LANGUAGE TypeOperators #-}
8−{-# LANGUAGE UndecidableInstances #-}
9−
10−module Servant.Client.Core.Internal.Generic where
11−
12−import Generics.SOP
13− (Code, Generic, I (..), NP (..), NS (Z), SOP (..), to)
14−import Servant.API
15− ((:<|>) (..))
16−
17−-- | This class allows us to match client structure with client functions
18−-- produced with 'client' without explicit pattern-matching.
19−--
20−-- The client structure needs a 'Generics.SOP.Generic' instance.
21−--
22−-- Example:
23−--
24−-- > type API
25−-- > = "foo" :> Capture "x" Int :> Get '[JSON] Int
26−-- > :<|> "bar" :> QueryParam "a" Char :> QueryParam "b" String :> Post '[JSON] [Int]
27−-- > :<|> Capture "nested" Int :> NestedAPI
28−-- >
29−-- > type NestedAPI
30−-- > = Get '[JSON] String
31−-- > :<|> "baz" :> QueryParam "c" Char :> Post '[JSON] ()
32−-- >
33−-- > data APIClient = APIClient
34−-- > { getFoo :: Int -> ClientM Int
35−-- > , postBar :: Maybe Char -> Maybe String -> ClientM [Int]
36−-- > , mkNestedClient :: Int -> NestedClient
37−-- > } deriving GHC.Generic
38−-- >
39−-- > instance Generics.SOP.Generic APIClient
40−-- > instance (Client API ~ client) => ClientLike client APIClient
41−-- >
42−-- > data NestedClient = NestedClient
43−-- > { getString :: ClientM String
44−-- > , postBaz :: Maybe Char -> ClientM ()
45−-- > } deriving GHC.Generic
46−-- >
47−-- > instance Generics.SOP.Generic NestedClient
48−-- > instance (Client NestedAPI ~ client) => ClientLike client NestedClient
49−-- >
50−-- > mkAPIClient :: APIClient
51−-- > mkAPIClient = mkClient (client (Proxy :: Proxy API))
52−--
53−-- By default, left-nested alternatives are expanded:
54−--
55−-- > type API1
56−-- > = "foo" :> Capture "x" Int :> Get '[JSON] Int
57−-- > :<|> "bar" :> QueryParam "a" Char :> Post '[JSON] String
58−-- >
59−-- > type API2
60−-- > = "baz" :> QueryParam "c" Char :> Post '[JSON] ()
61−-- >
62−-- > type API = API1 :<|> API2
63−-- >
64−-- > data APIClient = APIClient
65−-- > { getFoo :: Int -> ClientM Int
66−-- > , postBar :: Maybe Char -> ClientM String
67−-- > , postBaz :: Maybe Char -> ClientM ()
68−-- > } deriving GHC.Generic
69−-- >
70−-- > instance Generics.SOP.Generic APIClient
71−-- > instance (Client API ~ client) => ClientLike client APIClient
72−-- >
73−-- > mkAPIClient :: APIClient
74−-- > mkAPIClient = mkClient (client (Proxy :: Proxy API))
75−--
76−-- If you want to define client for @API1@ as a separate data structure,
77−-- you can use 'genericMkClientP':
78−--
79−-- > data APIClient1 = APIClient1
80−-- > { getFoo :: Int -> ClientM Int
81−-- > , postBar :: Maybe Char -> ClientM String
82−-- > } deriving GHC.Generic
83−-- >
84−-- > instance Generics.SOP.Generic APIClient1
85−-- > instance (Client API1 ~ client) => ClientLike client APIClient1
86−-- >
87−-- > data APIClient = APIClient
88−-- > { mkAPIClient1 :: APIClient1
89−-- > , postBaz :: Maybe Char -> ClientM ()
90−-- > } deriving GHC.Generic
91−-- >
92−-- > instance Generics.SOP.Generic APIClient
93−-- > instance (Client API ~ client) => ClientLike client APIClient where
94−-- > mkClient = genericMkClientP
95−-- >
96−-- > mkAPIClient :: APIClient
97−-- > mkAPIClient = mkClient (client (Proxy :: Proxy API))
98−class ClientLike client custom where
99− mkClient :: client -> custom
100− default mkClient :: (Generic custom, Code custom ~ '[xs], GClientList client '[], GClientLikeL (ClientList client '[]) xs)
101− => client -> custom
102− mkClient = genericMkClientL
103−
104−instance ClientLike client custom
105− => ClientLike (a -> client) (a -> custom) where
106− mkClient c = mkClient . c
107−
108−-- | Match client structure with client functions, regarding left-nested API clients
109−-- as separate data structures.
110−class GClientLikeP client xs where
111− gMkClientP :: client -> NP I xs
112−
113−instance (GClientLikeP b (y ': xs), ClientLike a x)
114− => GClientLikeP (a :<|> b) (x ': y ': xs) where
115− gMkClientP (a :<|> b) = I (mkClient a) :* gMkClientP b
116−
117−instance ClientLike a x => GClientLikeP a '[x] where
118− gMkClientP a = I (mkClient a) :* Nil
119−
120−-- | Match client structure with client functions, expanding left-nested API clients
121−-- in the same structure.
122−class GClientLikeL (xs :: [*]) (ys :: [*]) where
123− gMkClientL :: NP I xs -> NP I ys
124−
125−instance GClientLikeL '[] '[] where
126− gMkClientL Nil = Nil
127−
128−instance (ClientLike x y, GClientLikeL xs ys) => GClientLikeL (x ': xs) (y ': ys) where
129− gMkClientL (I x :* xs) = I (mkClient x) :* gMkClientL xs
130−
131−type family ClientList (client :: *) (acc :: [*]) :: [*] where
132− ClientList (a :<|> b) acc = ClientList a (ClientList b acc)
133− ClientList a acc = a ': acc
134−
135−class GClientList client (acc :: [*]) where
136− gClientList :: client -> NP I acc -> NP I (ClientList client acc)
137−
138−instance (GClientList b acc, GClientList a (ClientList b acc))
139− => GClientList (a :<|> b) acc where
140− gClientList (a :<|> b) acc = gClientList a (gClientList b acc)
141−
142−instance {-# OVERLAPPABLE #-} (ClientList client acc ~ (client ': acc))
143− => GClientList client acc where
144− gClientList c acc = I c :* acc
145−
146−-- | Generate client structure from client type, expanding left-nested API (done by default).
147−genericMkClientL :: (Generic custom, Code custom ~ '[xs], GClientList client '[], GClientLikeL (ClientList client '[]) xs)
148− => client -> custom
149−genericMkClientL = to . SOP . Z . gMkClientL . flip gClientList Nil
150−
151−-- | Generate client structure from client type, regarding left-nested API clients as separate data structures.
152−genericMkClientP :: (Generic custom, Code custom ~ '[xs], GClientLikeP client xs)
153− => client -> custom
154−genericMkClientP = to . SOP . Z . gMkClientP
155−