{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}

module Okapi.HTTP.Responses
    ( Responses
    , getResponses
    , Cases
    , cases
    , parseResponses
    , printResponses
    , traverseResponses
    ) where

import Data.Functor.Identity (Identity (..))
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as NE
import Data.Maybe (mapMaybe)
import GHC.Generics
import GHC.TypeLits (ErrorMessage (..), TypeError)
import Network.Wai qualified as Wai
import Okapi.Record.Tree qualified as Tree
import Okapi.Record.Error    qualified as Error
import Okapi.Record.Result   qualified as Result
import Okapi.Record.Data    qualified as Data
import Okapi.HTTP.Response qualified as Res

newtype Responses
    (f         :: Type -> Type -> Type -> Type)
    (responses :: (Type -> Type -> Type -> Type) -> Type)
    = Responses (NonEmpty (responses f))

getResponses :: Responses f responses -> NonEmpty (responses f)
getResponses :: forall (f :: * -> * -> * -> *)
       (responses :: (* -> * -> * -> *) -> *).
Responses f responses -> NonEmpty (responses f)
getResponses (Responses NonEmpty (responses f)
xs) = NonEmpty (responses f)
xs

type family GArgs
    (f   :: Type -> Type -> Type -> Type)
    (rep :: Type -> Type)
    (res :: Type)
    :: Type where
    GArgs f (D1 meta fi)                              res = GArgs f fi res
    GArgs f (C1 meta fi)                              res = GArgs f fi res
    GArgs f (S1 meta (Rec0 (f status headers body))) res = f status headers body -> res
    GArgs f (fi :+: gi)                              res = GArgs f fi (GArgs f gi res)

class GTraverse
    (f  :: Type -> Type -> Type -> Type)
    (g  :: Type -> Type -> Type -> Type)
    (fi :: Type -> Type)
    (fg :: Type -> Type) where
    gtraverse ::
        Functor t =>
        (forall status headers body. f status headers body -> t (g status headers body)) ->
        fi () -> t (fg ())

instance GTraverse f g fi fg => GTraverse f g (D1 meta fi) (D1 meta fg) where
    gtraverse :: forall (t :: * -> *).
Functor t =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> D1 meta fi () -> t (D1 meta fg ())
gtraverse forall status headers body.
f status headers body -> t (g status headers body)
k (M1 fi ()
x) = fg () -> D1 meta fg ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (fg () -> D1 meta fg ()) -> t (fg ()) -> t (D1 meta fg ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall status headers body.
 f status headers body -> t (g status headers body))
-> fi () -> t (fg ())
forall (t :: * -> *).
Functor t =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> fi () -> t (fg ())
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (fi :: * -> *) (fg :: * -> *) (t :: * -> *).
(GTraverse f g fi fg, Functor t) =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> fi () -> t (fg ())
gtraverse f status headers body -> t (g status headers body)
forall status headers body.
f status headers body -> t (g status headers body)
k fi ()
x

instance GTraverse f g fi fg => GTraverse f g (C1 meta fi) (C1 meta fg) where
    gtraverse :: forall (t :: * -> *).
Functor t =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> C1 meta fi () -> t (C1 meta fg ())
gtraverse forall status headers body.
f status headers body -> t (g status headers body)
k (M1 fi ()
x) = fg () -> C1 meta fg ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (fg () -> C1 meta fg ()) -> t (fg ()) -> t (C1 meta fg ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall status headers body.
 f status headers body -> t (g status headers body))
-> fi () -> t (fg ())
forall (t :: * -> *).
Functor t =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> fi () -> t (fg ())
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (fi :: * -> *) (fg :: * -> *) (t :: * -> *).
(GTraverse f g fi fg, Functor t) =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> fi () -> t (fg ())
gtraverse f status headers body -> t (g status headers body)
forall status headers body.
f status headers body -> t (g status headers body)
k fi ()
x

instance GTraverse f g
    (S1 meta (Rec0 (f status headers body)))
    (S1 meta (Rec0 (g status headers body))) where
    gtraverse :: forall (t :: * -> *).
Functor t =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> S1 meta (Rec0 (f status headers body)) ()
-> t (S1 meta (Rec0 (g status headers body)) ())
gtraverse forall status headers body.
f status headers body -> t (g status headers body)
k (M1 (K1 f status headers body
resp)) = Rec0 (g status headers body) ()
-> S1 meta (Rec0 (g status headers body)) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Rec0 (g status headers body) ()
 -> S1 meta (Rec0 (g status headers body)) ())
-> (g status headers body -> Rec0 (g status headers body) ())
-> g status headers body
-> S1 meta (Rec0 (g status headers body)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g status headers body -> Rec0 (g status headers body) ()
forall k i c (p :: k). c -> K1 i c p
K1 (g status headers body
 -> S1 meta (Rec0 (g status headers body)) ())
-> t (g status headers body)
-> t (S1 meta (Rec0 (g status headers body)) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f status headers body -> t (g status headers body)
forall status headers body.
f status headers body -> t (g status headers body)
k f status headers body
resp

instance (GTraverse f g fil fgl, GTraverse f g fir fgr)
    => GTraverse f g (fil :+: fir) (fgl :+: fgr) where
    gtraverse :: forall (t :: * -> *).
Functor t =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> (:+:) fil fir () -> t ((:+:) fgl fgr ())
gtraverse forall status headers body.
f status headers body -> t (g status headers body)
k (L1 fil ()
x) = fgl () -> (:+:) fgl fgr ()
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (fgl () -> (:+:) fgl fgr ()) -> t (fgl ()) -> t ((:+:) fgl fgr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall status headers body.
 f status headers body -> t (g status headers body))
-> fil () -> t (fgl ())
forall (t :: * -> *).
Functor t =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> fil () -> t (fgl ())
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (fi :: * -> *) (fg :: * -> *) (t :: * -> *).
(GTraverse f g fi fg, Functor t) =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> fi () -> t (fg ())
gtraverse f status headers body -> t (g status headers body)
forall status headers body.
f status headers body -> t (g status headers body)
k fil ()
x
    gtraverse forall status headers body.
f status headers body -> t (g status headers body)
k (R1 fir ()
x) = fgr () -> (:+:) fgl fgr ()
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (fgr () -> (:+:) fgl fgr ()) -> t (fgr ()) -> t ((:+:) fgl fgr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall status headers body.
 f status headers body -> t (g status headers body))
-> fir () -> t (fgr ())
forall (t :: * -> *).
Functor t =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> fir () -> t (fgr ())
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (fi :: * -> *) (fg :: * -> *) (t :: * -> *).
(GTraverse f g fi fg, Functor t) =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> fi () -> t (fg ())
gtraverse f status headers body -> t (g status headers body)
forall status headers body.
f status headers body -> t (g status headers body)
k fir ()
x

instance {-# OVERLAPPABLE #-}
    TypeError
        ( 'Text "Cannot traverse this `responses` type — its shape isn't supported."
        ':$$: 'Text "Every constructor must hold exactly one field of type `f status headers body`."
        ':$$: 'Text "Example: data MyResponses f = Ok (f S200 () Body) | NotFound (f S404 () ())"
        )
    => GTraverse f g fi fg where
    gtraverse :: forall (t :: * -> *).
Functor t =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> fi () -> t (fg ())
gtraverse forall status headers body.
f status headers body -> t (g status headers body)
_ = [Char] -> fi () -> t (fg ())
forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable: resolved via TypeError instance"

traverseResponses ::
    forall f g responses t.
    ( Generic (responses f)
    , Generic (responses g)
    , GTraverse f g (Rep (responses f)) (Rep (responses g))
    , Functor t
    ) =>
    (forall status headers body. f status headers body -> t (g status headers body)) ->
    responses f -> t (responses g)
traverseResponses :: forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (responses :: (* -> * -> * -> *) -> *) (t :: * -> *).
(Generic (responses f), Generic (responses g),
 GTraverse f g (Rep (responses f)) (Rep (responses g)),
 Functor t) =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> responses f -> t (responses g)
traverseResponses forall status headers body.
f status headers body -> t (g status headers body)
k = (Rep (responses g) () -> responses g)
-> t (Rep (responses g) ()) -> t (responses g)
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep (responses g) () -> responses g
forall a x. Generic a => Rep a x -> a
forall x. Rep (responses g) x -> responses g
to (t (Rep (responses g) ()) -> t (responses g))
-> (responses f -> t (Rep (responses g) ()))
-> responses f
-> t (responses g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall status headers body.
 f status headers body -> t (g status headers body))
-> Rep (responses f) () -> t (Rep (responses g) ())
forall (t :: * -> *).
Functor t =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> Rep (responses f) () -> t (Rep (responses g) ())
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (fi :: * -> *) (fg :: * -> *) (t :: * -> *).
(GTraverse f g fi fg, Functor t) =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> fi () -> t (fg ())
gtraverse f status headers body -> t (g status headers body)
forall status headers body.
f status headers body -> t (g status headers body)
k (Rep (responses f) () -> t (Rep (responses g) ()))
-> (responses f -> Rep (responses f) ())
-> responses f
-> t (Rep (responses g) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. responses f -> Rep (responses f) ()
forall x. responses f -> Rep (responses f) x
forall a x. Generic a => a -> Rep a x
from

class GZip
    (f  :: Type -> Type -> Type -> Type)
    (g  :: Type -> Type -> Type -> Type)
    (fi :: Type -> Type)
    (fg :: Type -> Type) where
    gzip ::
        (forall status headers body. f status headers body -> g status headers body -> c) ->
        fi () -> fg () -> Maybe c

instance GZip f g fi fg => GZip f g (D1 meta fi) (D1 meta fg) where
    gzip :: forall c.
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> D1 meta fi () -> D1 meta fg () -> Maybe c
gzip forall status headers body.
f status headers body -> g status headers body -> c
k (M1 fi ()
a) (M1 fg ()
b) = (forall status headers body.
 f status headers body -> g status headers body -> c)
-> fi () -> fg () -> Maybe c
forall c.
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> fi () -> fg () -> Maybe c
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (fi :: * -> *) (fg :: * -> *) c.
GZip f g fi fg =>
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> fi () -> fg () -> Maybe c
gzip f status headers body -> g status headers body -> c
forall status headers body.
f status headers body -> g status headers body -> c
k fi ()
a fg ()
b

instance GZip f g fi fg => GZip f g (C1 meta fi) (C1 meta fg) where
    gzip :: forall c.
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> C1 meta fi () -> C1 meta fg () -> Maybe c
gzip forall status headers body.
f status headers body -> g status headers body -> c
k (M1 fi ()
a) (M1 fg ()
b) = (forall status headers body.
 f status headers body -> g status headers body -> c)
-> fi () -> fg () -> Maybe c
forall c.
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> fi () -> fg () -> Maybe c
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (fi :: * -> *) (fg :: * -> *) c.
GZip f g fi fg =>
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> fi () -> fg () -> Maybe c
gzip f status headers body -> g status headers body -> c
forall status headers body.
f status headers body -> g status headers body -> c
k fi ()
a fg ()
b

instance GZip f g
    (S1 meta (Rec0 (f status headers body)))
    (S1 meta (Rec0 (g status headers body))) where
    gzip :: forall c.
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> S1 meta (Rec0 (f status headers body)) ()
-> S1 meta (Rec0 (g status headers body)) ()
-> Maybe c
gzip forall status headers body.
f status headers body -> g status headers body -> c
k (M1 (K1 f status headers body
a)) (M1 (K1 g status headers body
b)) = c -> Maybe c
forall a. a -> Maybe a
Just (f status headers body -> g status headers body -> c
forall status headers body.
f status headers body -> g status headers body -> c
k f status headers body
a g status headers body
b)

instance (GZip f g fil fgl, GZip f g fir fgr)
    => GZip f g (fil :+: fir) (fgl :+: fgr) where
    gzip :: forall c.
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> (:+:) fil fir () -> (:+:) fgl fgr () -> Maybe c
gzip forall status headers body.
f status headers body -> g status headers body -> c
k (L1 fil ()
a) (L1 fgl ()
b) = (forall status headers body.
 f status headers body -> g status headers body -> c)
-> fil () -> fgl () -> Maybe c
forall c.
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> fil () -> fgl () -> Maybe c
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (fi :: * -> *) (fg :: * -> *) c.
GZip f g fi fg =>
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> fi () -> fg () -> Maybe c
gzip f status headers body -> g status headers body -> c
forall status headers body.
f status headers body -> g status headers body -> c
k fil ()
a fgl ()
b
    gzip forall status headers body.
f status headers body -> g status headers body -> c
k (R1 fir ()
a) (R1 fgr ()
b) = (forall status headers body.
 f status headers body -> g status headers body -> c)
-> fir () -> fgr () -> Maybe c
forall c.
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> fir () -> fgr () -> Maybe c
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (fi :: * -> *) (fg :: * -> *) c.
GZip f g fi fg =>
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> fi () -> fg () -> Maybe c
gzip f status headers body -> g status headers body -> c
forall status headers body.
f status headers body -> g status headers body -> c
k fir ()
a fgr ()
b
    gzip forall status headers body.
f status headers body -> g status headers body -> c
_ (:+:) fil fir ()
_      (:+:) fgl fgr ()
_      = Maybe c
forall a. Maybe a
Nothing

instance {-# OVERLAPPABLE #-}
    TypeError
        ( 'Text "Cannot zip this `responses` type — its shape isn't supported."
        ':$$: 'Text "Every constructor must hold exactly one field of type `f status headers body`."
        ':$$: 'Text "Example: data MyResponses f = Ok (f S200 () Body) | NotFound (f S404 () ())"
        )
    => GZip f g fi fg where
    gzip :: forall c.
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> fi () -> fg () -> Maybe c
gzip forall status headers body.
f status headers body -> g status headers body -> c
_ = [Char] -> fi () -> fg () -> Maybe c
forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable: resolved via TypeError instance"

zipResponses ::
    forall f g responses c.
    ( Generic (responses f)
    , Generic (responses g)
    , GZip f g (Rep (responses f)) (Rep (responses g))
    ) =>
    (forall status headers body. f status headers body -> g status headers body -> c) ->
    responses f -> responses g -> Maybe c
zipResponses :: forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (responses :: (* -> * -> * -> *) -> *) c.
(Generic (responses f), Generic (responses g),
 GZip f g (Rep (responses f)) (Rep (responses g))) =>
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> responses f -> responses g -> Maybe c
zipResponses forall status headers body.
f status headers body -> g status headers body -> c
k responses f
a responses g
b = (forall status headers body.
 f status headers body -> g status headers body -> c)
-> Rep (responses f) () -> Rep (responses g) () -> Maybe c
forall c.
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> Rep (responses f) () -> Rep (responses g) () -> Maybe c
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (fi :: * -> *) (fg :: * -> *) c.
GZip f g fi fg =>
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> fi () -> fg () -> Maybe c
gzip f status headers body -> g status headers body -> c
forall status headers body.
f status headers body -> g status headers body -> c
k (responses f -> Rep (responses f) ()
forall x. responses f -> Rep (responses f) x
forall a x. Generic a => a -> Rep a x
from responses f
a) (responses g -> Rep (responses g) ()
forall x. responses g -> Rep (responses g) x
forall a x. Generic a => a -> Rep a x
from responses g
b)

class GConstruct (rep :: Type -> Type) where
    gConstruct ::
        forall (responses :: (Type -> Type -> Type -> Type) -> Type) res.
        Generic (responses Tree.Response) =>
        (rep () -> Rep (responses Tree.Response) ()) ->
        (NonEmpty (responses Tree.Response) -> res) ->
        GArgs Tree.Response rep res

instance GConstruct fi => GConstruct (D1 meta fi) where
    gConstruct :: forall (responses :: (* -> * -> * -> *) -> *) res.
Generic (responses Response) =>
(D1 meta fi () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res)
-> GArgs Response (D1 meta fi) res
gConstruct D1 meta fi () -> Rep (responses Response) ()
inject NonEmpty (responses Response) -> res
cont = (fi () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response fi res
forall (rep :: * -> *) (responses :: (* -> * -> * -> *) -> *) res.
(GConstruct rep, Generic (responses Response)) =>
(rep () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response rep res
forall (responses :: (* -> * -> * -> *) -> *) res.
Generic (responses Response) =>
(fi () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response fi res
gConstruct (D1 meta fi () -> Rep (responses Response) ()
inject (D1 meta fi () -> Rep (responses Response) ())
-> (fi () -> D1 meta fi ()) -> fi () -> Rep (responses Response) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fi () -> D1 meta fi ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) NonEmpty (responses Response) -> res
cont

instance GConstruct fi => GConstruct (C1 meta fi) where
    gConstruct :: forall (responses :: (* -> * -> * -> *) -> *) res.
Generic (responses Response) =>
(C1 meta fi () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res)
-> GArgs Response (C1 meta fi) res
gConstruct C1 meta fi () -> Rep (responses Response) ()
inject NonEmpty (responses Response) -> res
cont = (fi () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response fi res
forall (rep :: * -> *) (responses :: (* -> * -> * -> *) -> *) res.
(GConstruct rep, Generic (responses Response)) =>
(rep () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response rep res
forall (responses :: (* -> * -> * -> *) -> *) res.
Generic (responses Response) =>
(fi () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response fi res
gConstruct (C1 meta fi () -> Rep (responses Response) ()
inject (C1 meta fi () -> Rep (responses Response) ())
-> (fi () -> C1 meta fi ()) -> fi () -> Rep (responses Response) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fi () -> C1 meta fi ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) NonEmpty (responses Response) -> res
cont

instance GConstruct (S1 meta (Rec0 (Tree.Response status headers body))) where
    gConstruct :: forall (responses :: (* -> * -> * -> *) -> *) res.
Generic (responses Response) =>
(S1 meta (Rec0 (Response status headers body)) ()
 -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res)
-> GArgs
     Response (S1 meta (Rec0 (Response status headers body))) res
gConstruct S1 meta (Rec0 (Response status headers body)) ()
-> Rep (responses Response) ()
inject NonEmpty (responses Response) -> res
cont Response status headers body
codec = NonEmpty (responses Response) -> res
cont (Rep (responses Response) () -> responses Response
forall a x. Generic a => Rep a x -> a
forall x. Rep (responses Response) x -> responses Response
to (S1 meta (Rec0 (Response status headers body)) ()
-> Rep (responses Response) ()
inject (Rec0 (Response status headers body) ()
-> S1 meta (Rec0 (Response status headers body)) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Response status headers body
-> Rec0 (Response status headers body) ()
forall k i c (p :: k). c -> K1 i c p
K1 Response status headers body
codec))) responses Response
-> [responses Response] -> NonEmpty (responses Response)
forall a. a -> [a] -> NonEmpty a
:| [])

instance (GConstruct fil, GConstruct fir) => GConstruct (fil :+: fir) where
    gConstruct :: forall (responses :: (* -> * -> * -> *) -> *) res.
Generic (responses Response) =>
((:+:) fil fir () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res)
-> GArgs Response (fil :+: fir) res
gConstruct (:+:) fil fir () -> Rep (responses Response) ()
inject NonEmpty (responses Response) -> res
cont =
        (fil () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> GArgs Response fir res)
-> GArgs Response fil (GArgs Response fir res)
forall (rep :: * -> *) (responses :: (* -> * -> * -> *) -> *) res.
(GConstruct rep, Generic (responses Response)) =>
(rep () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response rep res
forall (responses :: (* -> * -> * -> *) -> *) res.
Generic (responses Response) =>
(fil () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response fil res
gConstruct ((:+:) fil fir () -> Rep (responses Response) ()
inject ((:+:) fil fir () -> Rep (responses Response) ())
-> (fil () -> (:+:) fil fir ())
-> fil ()
-> Rep (responses Response) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fil () -> (:+:) fil fir ()
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) ((NonEmpty (responses Response) -> GArgs Response fir res)
 -> GArgs Response fil (GArgs Response fir res))
-> (NonEmpty (responses Response) -> GArgs Response fir res)
-> GArgs Response fil (GArgs Response fir res)
forall a b. (a -> b) -> a -> b
$ \NonEmpty (responses Response)
ls ->
        (fir () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response fir res
forall (rep :: * -> *) (responses :: (* -> * -> * -> *) -> *) res.
(GConstruct rep, Generic (responses Response)) =>
(rep () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response rep res
forall (responses :: (* -> * -> * -> *) -> *) res.
Generic (responses Response) =>
(fir () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response fir res
gConstruct ((:+:) fil fir () -> Rep (responses Response) ()
inject ((:+:) fil fir () -> Rep (responses Response) ())
-> (fir () -> (:+:) fil fir ())
-> fir ()
-> Rep (responses Response) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fir () -> (:+:) fil fir ()
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1) ((NonEmpty (responses Response) -> res) -> GArgs Response fir res)
-> (NonEmpty (responses Response) -> res) -> GArgs Response fir res
forall a b. (a -> b) -> a -> b
$ \NonEmpty (responses Response)
rs ->
        NonEmpty (responses Response) -> res
cont (NonEmpty (responses Response)
ls NonEmpty (responses Response)
-> NonEmpty (responses Response) -> NonEmpty (responses Response)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (responses Response)
rs)

instance {-# OVERLAPPABLE #-}
    TypeError
        ( 'Text "Cannot build `cases` for this `responses` type — its shape isn't supported."
        ':$$: 'Text "Every constructor must hold exactly one field of type `f status headers body`."
        ':$$: 'Text "Example: data MyResponses f = Ok (f S200 () Body) | NotFound (f S404 () ())"
        )
    => GConstruct rep where
    gConstruct :: forall (responses :: (* -> * -> * -> *) -> *) res.
Generic (responses Response) =>
(rep () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response rep res
gConstruct = [Char]
-> (rep () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res)
-> GArgs Response rep res
forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable: resolved via TypeError instance"

class
    ( Generic (responses Tree.Response)
    , Generic (responses Result.Response)
    , Generic (responses Data.Response)
    , Generic (responses Error.Response)
    , GConstruct (Rep (responses Tree.Response))
    , GTraverse Tree.Response Result.Response
        (Rep (responses Tree.Response)) (Rep (responses Result.Response))
    , GTraverse Result.Response   Data.Response
        (Rep (responses Result.Response))   (Rep (responses Data.Response))
    , GTraverse Result.Response   Error.Response
        (Rep (responses Result.Response))   (Rep (responses Error.Response))
    , GTraverse Tree.Response Tree.Response
        (Rep (responses Tree.Response)) (Rep (responses Tree.Response))
    , GZip Tree.Response Data.Response
        (Rep (responses Tree.Response)) (Rep (responses Data.Response))
    ) =>
    Cases (responses :: (Type -> Type -> Type -> Type) -> Type)

cases ::
    forall (responses :: (Type -> Type -> Type -> Type) -> Type).
    Cases responses =>
    GArgs
        Tree.Response
        (Rep (responses Tree.Response))
        (Responses Tree.Response responses)
cases :: forall (responses :: (* -> * -> * -> *) -> *).
Cases responses =>
GArgs
  Response (Rep (responses Response)) (Responses Response responses)
cases =
    (Rep (responses Response) () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> Responses Response responses)
-> GArgs
     Response (Rep (responses Response)) (Responses Response responses)
forall (rep :: * -> *) (responses :: (* -> * -> * -> *) -> *) res.
(GConstruct rep, Generic (responses Response)) =>
(rep () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res) -> GArgs Response rep res
forall (responses :: (* -> * -> * -> *) -> *) res.
Generic (responses Response) =>
(Rep (responses Response) () -> Rep (responses Response) ())
-> (NonEmpty (responses Response) -> res)
-> GArgs Response (Rep (responses Response)) res
gConstruct
        (Rep (responses Response) () -> Rep (responses Response) ()
forall a. a -> a
id :: Rep (responses Tree.Response) () -> Rep (responses Tree.Response) ())
        (forall (f :: * -> * -> * -> *)
       (responses :: (* -> * -> * -> *) -> *).
NonEmpty (responses f) -> Responses f responses
Responses @Tree.Response @responses)

parseResponses ::
    forall responses.
    Cases responses =>
    Responses Tree.Response responses ->
    Wai.Response ->
    IO (Either (Responses Error.Response responses) (responses Data.Response))
parseResponses :: forall (responses :: (* -> * -> * -> *) -> *).
Cases responses =>
Responses Response responses
-> Response
-> IO (Either (Responses Response responses) (responses Response))
parseResponses (Responses NonEmpty (responses Response)
cs) Response
waiRes = do
    rs <- (responses Response -> IO (responses Response))
-> NonEmpty (responses Response)
-> IO (NonEmpty (responses Response))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse responses Response -> IO (responses Response)
parseBranch NonEmpty (responses Response)
cs
    pure $ case mapMaybe toValue (NE.toList rs) of
        (responses Response
v : [responses Response]
_) -> responses Response
-> Either (Responses Response responses) (responses Response)
forall a b. b -> Either a b
Right responses Response
v
        []      -> Responses Response responses
-> Either (Responses Response responses) (responses Response)
forall a b. a -> Either a b
Left (NonEmpty (responses Response) -> Responses Response responses
forall (f :: * -> * -> * -> *)
       (responses :: (* -> * -> * -> *) -> *).
NonEmpty (responses f) -> Responses f responses
Responses ((responses Response -> responses Response)
-> NonEmpty (responses Response) -> NonEmpty (responses Response)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap responses Response -> responses Response
toErrors NonEmpty (responses Response)
rs))
  where
    parseBranch :: responses Tree.Response -> IO (responses Result.Response)
    parseBranch :: responses Response -> IO (responses Response)
parseBranch = (forall status headers body.
 Response status headers body -> IO (Response status headers body))
-> responses Response -> IO (responses Response)
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (responses :: (* -> * -> * -> *) -> *) (t :: * -> *).
(Generic (responses f), Generic (responses g),
 GTraverse f g (Rep (responses f)) (Rep (responses g)),
 Functor t) =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> responses f -> t (responses g)
traverseResponses (\Response status headers body
codec -> Response status headers body
-> Response -> IO (Response status headers body)
forall status headers body.
Response status headers body
-> Response -> IO (Response status headers body)
Res.parseResponseResult Response status headers body
codec Response
waiRes)
    toValue :: responses Result.Response -> Maybe (responses Data.Response)
    toValue :: responses Response -> Maybe (responses Response)
toValue = (forall status headers body.
 Response status headers body
 -> Maybe (Response status headers body))
-> responses Response -> Maybe (responses Response)
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (responses :: (* -> * -> * -> *) -> *) (t :: * -> *).
(Generic (responses f), Generic (responses g),
 GTraverse f g (Rep (responses f)) (Rep (responses g)),
 Functor t) =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> responses f -> t (responses g)
traverseResponses Response status headers body
-> Maybe (Response status headers body)
forall status headers body.
Response status headers body
-> Maybe (Response status headers body)
Res.resultToValue
    toErrors :: responses Result.Response -> responses Error.Response
    toErrors :: responses Response -> responses Response
toErrors = Identity (responses Response) -> responses Response
forall a. Identity a -> a
runIdentity (Identity (responses Response) -> responses Response)
-> (responses Response -> Identity (responses Response))
-> responses Response
-> responses Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall status headers body.
 Response status headers body
 -> Identity (Response status headers body))
-> responses Response -> Identity (responses Response)
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (responses :: (* -> * -> * -> *) -> *) (t :: * -> *).
(Generic (responses f), Generic (responses g),
 GTraverse f g (Rep (responses f)) (Rep (responses g)),
 Functor t) =>
(forall status headers body.
 f status headers body -> t (g status headers body))
-> responses f -> t (responses g)
traverseResponses (Response status headers body
-> Identity (Response status headers body)
forall a. a -> Identity a
Identity (Response status headers body
 -> Identity (Response status headers body))
-> (Response status headers body -> Response status headers body)
-> Response status headers body
-> Identity (Response status headers body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response status headers body -> Response status headers body
forall status headers body.
Response status headers body -> Response status headers body
Res.resultToError)

printResponses ::
    forall responses.
    Cases responses =>
    Responses Tree.Response responses ->
    responses Data.Response ->
    IO Wai.Response
printResponses :: forall (responses :: (* -> * -> * -> *) -> *).
Cases responses =>
Responses Response responses -> responses Response -> IO Response
printResponses (Responses NonEmpty (responses Response)
cs) responses Response
rv =
    case [IO Response
io | responses Response
c <- NonEmpty (responses Response) -> [responses Response]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (responses Response)
cs, Just IO Response
io <- [(forall status headers body.
 Response status headers body
 -> Response status headers body -> IO Response)
-> responses Response -> responses Response -> Maybe (IO Response)
forall (f :: * -> * -> * -> *) (g :: * -> * -> * -> *)
       (responses :: (* -> * -> * -> *) -> *) c.
(Generic (responses f), Generic (responses g),
 GZip f g (Rep (responses f)) (Rep (responses g))) =>
(forall status headers body.
 f status headers body -> g status headers body -> c)
-> responses f -> responses g -> Maybe c
zipResponses Response status headers body
-> Response status headers body -> IO Response
forall status headers body.
Response status headers body
-> Response status headers body -> IO Response
Res.printResponse responses Response
c responses Response
rv]] of
        (IO Response
io : [IO Response]
_) -> IO Response
io
        []       -> [Char] -> IO Response
forall a. HasCallStack => [Char] -> a
error [Char]
"printResponses: no matching response constructor"