My implementation of generic servant clients

Test.hs

{-# LANGUAGE DataKinds, TypeOperators, DeriveGeneric #-}
{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures, MultiParamTypeClasses #-}
module Test where

import Data.Proxy
import qualified GHC.Generics as GHC
import Generics.SOP
import Servant.API
import Servant.Client

type API =
       "foo" :> Capture "x" Int :> Get '[JSON] Int
  :<|> "bar" :> QueryParam "a" Char :> QueryParam "b" String :> Post '[JSON] [Int]
  :<|> Capture "nested" Int :> NestedAPI

type NestedAPI =
       Get '[JSON] String
  :<|> "baz" :> QueryParam "c" Char :> Post '[JSON] ()

-- Client API =
--
--        Int -> ClientM Int
--   :<|> (Maybe Char -> Maybe [Char] -> ClientM [Int])
--   :<|> (Int -> (ClientM [Char] :<|> (Maybe Char -> ClientM ())))


-- Generic client machinery

-- | From a client type, to an original type.
class Convertible (a :: *) (c :: *) where
  convert :: c -> a
  default convert :: (Generic a, Code a ~ '[ xs ], GetComponents c '[], ConvertibleL xs (Components c '[])) => c -> a
  convert = gconvert

instance (a ~ c) => Convertible (ClientM a) (ClientM c) where
  convert = id

instance (x ~ y, Convertible a c) => Convertible (x -> a) (y -> c) where
  convert yc = convert . yc

gconvert :: (Generic a, Code a ~ '[ xs ], GetComponents c '[], ConvertibleL xs (Components c '[])) => c -> a
gconvert = to . SOP . Z . convertL . flip getComponents Nil

class ConvertibleL (as :: [*]) (cs :: [*]) where
  convertL :: NP I cs -> NP I as

instance ConvertibleL '[] '[] where
  convertL Nil = Nil

instance (Convertible a c, ConvertibleL as cs) => ConvertibleL (a ': as) (c ': cs) where
  convertL (I c :* cs) = I (convert c) :* convertL cs

class GetComponents (a :: *) (k :: [*]) where
  getComponents :: a -> NP I k -> NP I (Components a k)

instance (GetComponents b k, GetComponents a (Components b k)) => GetComponents (a :<|> b) k where
  getComponents (a :<|> b) k = getComponents a (getComponents b k)

instance {-# OVERLAPPABLE #-} (Components a k ~ (a ': k)) =>  GetComponents a k where
  getComponents a k = I a :* k

type family Components (a :: *) (k :: [*]) :: [*] where
  Components (a :<|> b) k = Components a (Components b k)
  Components a          k = a ': k

-- Applying to the example

data APIClient = APIClient
  { getFoo         :: Int -> ClientM Int
  , postBar        :: Maybe Char -> Maybe String -> ClientM [Int]
  , mkNestedClient :: Int -> NestedClient
  }
  deriving GHC.Generic

data NestedClient = NestedClient
  { getString :: ClientM String
  , postBaz   :: Maybe Char -> ClientM ()
  }
  deriving GHC.Generic

instance Generic APIClient
instance Generic NestedClient

instance (c ~ Client API) => Convertible APIClient c
instance (c ~ Client NestedAPI) => Convertible NestedClient c

test :: APIClient
test = convert (client (Proxy :: Proxy API))

-- Trying left-associative nesting of ':<|>'

type AnotherAPI =
       "foo" :> Capture "x" Int :> Get '[JSON] Int

type API' = NestedAPI :<|> AnotherAPI

data APIClient' = APIClient'
  { getString' :: ClientM String
  , postBaz'   :: Maybe Char -> ClientM ()
  , getFoo'    :: Int -> ClientM Int
  }
  deriving GHC.Generic

instance Generic APIClient'

instance (c ~ Client API') => Convertible APIClient' c

test' :: APIClient'
test' = convert (client (Proxy :: Proxy API'))