Add new HasClient instances to match the new HasServer instances

src/Servant/Checked/Exceptions/Internal/Servant/API.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 
 {- |
 Module      :  Servant.Checked.Exceptions.Internal.Servant.API
@@ -16,6 +18,10 @@ This module defines the 'Throws' and 'Throwing' types.
 
 module Servant.Checked.Exceptions.Internal.Servant.API where
 
+import Servant.API ((:>))
+
+import Servant.Checked.Exceptions.Internal.Util (Snoc)
+
 -- | 'Throws' is used in Servant API definitions and signifies that an API will
 -- throw the given error.
 --
@@ -28,3 +34,12 @@ data Throws (e :: *)
 
 -- | This is used internally and should not be used by end-users.
 data Throwing (e :: [*])
+
+-- | Used by the 'HasServer' and 'HasClient' instances for
+-- @'Throwing' es ':>' api ':>' apis@ to detect @'Throwing' es@ followed
+-- immediately by @'Throws' e@.
+type family ThrowingNonterminal api where
+  ThrowingNonterminal (Throwing es :> Throws e :> api) =
+    Throwing (Snoc es e) :> api
+  ThrowingNonterminal (Throwing es :> c :> api) =
+    c :> Throwing es :> api

src/Servant/Checked/Exceptions/Internal/Servant/Client.hs

@@ -27,14 +27,13 @@ This module only exports 'HasClient' instances for 'Throws' and 'Throwing'.
 module Servant.Checked.Exceptions.Internal.Servant.Client where
 
 import Data.Proxy (Proxy(Proxy))
-import Servant.API (Verb, (:>))
+import Servant.API (Verb, (:>), (:<|>))
 import Servant.Client (HasClient(clientWithRoute, Client))
 import Servant.Common.Req (Req)
 
 import Servant.Checked.Exceptions.Internal.Envelope (Envelope)
 import Servant.Checked.Exceptions.Internal.Servant.API
-       (Throws, Throwing)
-import Servant.Checked.Exceptions.Internal.Util (Snoc)
+       (Throws, Throwing, ThrowingNonterminal)
 
 -- TODO: Make sure to also account for when headers are being used.
 
@@ -63,17 +62,33 @@ instance (HasClient (Verb method status ctypes (Envelope es a))) =>
   clientWithRoute Proxy =
     clientWithRoute (Proxy :: Proxy (Verb method status ctypes (Envelope es a)))
 
+-- | When @'Throwing' es@ comes before ':<|>', push @'Throwing' es@ into each
+-- branch of the API.
+instance HasClient ((Throwing es :> api1) :<|> (Throwing es :> api2)) =>
+    HasClient (Throwing es :> (api1 :<|> api2)) where
+
+  type Client (Throwing es :> (api1 :<|> api2)) =
+    Client ((Throwing es :> api1) :<|> (Throwing es :> api2))
+
+  clientWithRoute
+    :: Proxy (Throwing es :> (api1 :<|> api2))
+    -> Req
+    -> Client ((Throwing es :> api1) :<|> (Throwing es :> api2))
+  clientWithRoute _ =
+    clientWithRoute (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))
+
 -- | When a @'Throws' e@ comes immediately after a @'Throwing' es@, 'Snoc' the
--- @e@ onto the @es@.
-instance (HasClient (Throwing (Snoc es e) :> api)) =>
-    HasClient (Throwing es :> Throws e :> api) where
+-- @e@ onto the @es@. Otherwise, if @'Throws' e@ comes before any other
+-- combinator, push it down so it is closer to the 'Verb'.
+instance HasClient (ThrowingNonterminal (Throwing es :> api :> apis)) =>
+    HasClient (Throwing es :> api :> apis) where
 
-  type Client (Throwing es :> Throws e :> api) =
-    Client (Throwing (Snoc es e) :> api)
+  type Client (Throwing es :> api :> apis) =
+    Client (ThrowingNonterminal (Throwing es :> api :> apis))
 
   clientWithRoute
-    :: Proxy (Throwing es :> Throws e :> api)
+    :: Proxy (Throwing es :> api :> apis)
     -> Req
-    -> Client (Throwing (Snoc es e) :> api)
-  clientWithRoute Proxy =
-    clientWithRoute (Proxy :: Proxy (Throwing (Snoc es e) :> api))
+    -> Client (ThrowingNonterminal (Throwing es :> api :> apis))
+  clientWithRoute _ =
+    clientWithRoute (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))

src/Servant/Checked/Exceptions/Internal/Servant/Server.hs

@@ -34,8 +34,7 @@ import Servant
 
 import Servant.Checked.Exceptions.Internal.Envelope (Envelope)
 import Servant.Checked.Exceptions.Internal.Servant.API
-       (Throws, Throwing)
-import Servant.Checked.Exceptions.Internal.Util (Snoc)
+       (Throws, Throwing, ThrowingNonterminal)
 
 -- TODO: Make sure to also account for when headers are being used.
 
@@ -83,14 +82,6 @@ instance HasServer ((Throwing es :> api1) :<|> (Throwing es :> api2)) context =>
     -> Router env
   route _ = route (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))
 
--- | Used by the 'HasServer' instance for @'Throwing' es ':>' api ':>' apis@ to
--- detect @'Throwing' es@ followed immediately by @'Throws' e@.
-type family ThrowingNonterminal api where
-  ThrowingNonterminal (Throwing es :> Throws e :> api) =
-    Throwing (Snoc es e) :> api
-  ThrowingNonterminal (Throwing es :> c :> api) =
-    c :> Throwing es :> api
-
 -- | When a @'Throws' e@ comes immediately after a @'Throwing' es@, 'Snoc' the
 -- @e@ onto the @es@. Otherwise, if @'Throws' e@ comes before any other
 -- combinator, push it down so it is closer to the 'Verb'.