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