@@ -0,0 +1,82 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
6+{-# LANGUAGE TypeFamilies #-}
7+{-# LANGUAGE TypeOperators #-}
8+module Servant.Client.Generic
9+ ( ClientLike(..)
10+ , genericMkClient
11+ ) where
12+
13+import Generics.SOP (Generic, I(..), NP(..), NS(Z), Rep, SOP(..), to)
14+import Servant.API ((:<|>)(..))
15+import Servant.Client (ClientM)
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+-- :<|> Captre "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 -> Manager -> BaseUrl -> ClientM Int
35+-- , postBar :: Maybe Char -> Maybe String -> Manager -> BaseUrl -> ClientM [Int]
36+-- , mkNestedClient :: Int -> NestedClient
37+-- } deriving GHC.Generic
38+--
39+-- instance Generic.SOP.Generic APIClient
40+-- instance (Client API ~ client) => ClientLike client APIClient
41+--
42+-- data NestedClient = NestedClient
43+-- { getString :: Manager -> BaseUrl -> ClientM String
44+-- , postBaz :: Maybe Char -> Manager -> BaseUrl -> ClientM ()
45+-- } deriving GHC.Generic
46+--
47+-- instance Generic.SOP.Generic
48+-- instance (Client NestedAPI ~ client) => ClientLike client NestedAPI
49+--
50+-- mkAPIClient :: APIClient
51+-- mkAPIClient = mkClient (client (Proxy :: Proxy API))
52+class ClientLike client custom where
53+ mkClient :: client -> custom
54+ default mkClient :: (Generic custom, GClientLikeP client xs, SOP I '[xs] ~ Rep custom)
55+ => client -> custom
56+ mkClient = genericMkClient
57+
58+instance ClientLike client custom
59+ => ClientLike (a -> client) (a -> custom) where
60+ mkClient c = mkClient . c
61+
62+instance ClientLike (ClientM a) (ClientM a) where
63+ mkClient = id
64+
65+-- | This class is used to match client functions to the
66+-- representation of client structure type as sum of products
67+-- and basically does all the internal job to build this structure.
68+class GClientLikeP client xs where
69+ gMkClientP :: client -> NP I xs
70+
71+instance (GClientLikeP b (y ': xs), ClientLike a x)
72+ => GClientLikeP (a :<|> b) (x ': y ': xs) where
73+ gMkClientP (a :<|> b) = I (mkClient a) :* gMkClientP b
74+
75+instance ClientLike a x => GClientLikeP a '[x] where
76+ gMkClientP a = I (mkClient a) :* Nil
77+
78+-- | Generate client structure from client type.
79+genericMkClient :: (Generic custom, GClientLikeP client xs, SOP I '[xs] ~ Rep custom)
80+ => client -> custom
81+genericMkClient = to . SOP . Z . gMkClientP
82+