{-# LANGUAGE UndecidableInstances #-}

-- | Json servers
module Mig.Extra.Server.Json (
  -- * Http verbs
  Get,
  Post,
  Put,
  Delete,
  Patch,
  Options,
  Head,
  Trace,

  -- * Json request body
  Body (..),

  -- * Json response
  Resp,
  RespOr,

  -- * re-exports
  module X,
)
where

import Mig.Client (FromClient (..), ToClient (..))
import Mig.Core (
  Delete,
  Get,
  Head,
  Options,
  Patch,
  Post,
  Put,
  Trace,
 )
import Mig.Core qualified as Core
import Mig.Extra.Server.Common as X

-- response

newtype Resp a = Resp (Core.Resp Json a)
  deriving newtype (MediaType
ResponseHeaders -> Resp a -> Resp a
MediaType -> Resp a -> Resp a
Status -> Resp a
Status -> RespError (Resp a) -> Resp a
Status -> Resp a -> Resp a
RespBody (Resp a) -> Resp a
Resp a -> ResponseHeaders
Resp a -> Maybe (RespError (Resp a))
Resp a -> Maybe (RespBody (Resp a))
Resp a -> Status
Resp a -> Response
forall a. ToJSON a => MediaType
forall a. ToJSON a => ResponseHeaders -> Resp a -> Resp a
forall a. ToJSON a => MediaType -> Resp a -> Resp a
forall a. ToJSON a => Status -> Resp a
forall a. ToJSON a => Status -> RespError (Resp a) -> Resp a
forall a. ToJSON a => Status -> Resp a -> Resp a
forall a. ToJSON a => RespBody (Resp a) -> Resp a
forall a. ToJSON a => Resp a -> ResponseHeaders
forall a. ToJSON a => Resp a -> Maybe (RespError (Resp a))
forall a. ToJSON a => Resp a -> Maybe (RespBody (Resp a))
forall a. ToJSON a => Resp a -> Status
forall a. ToJSON a => Resp a -> Response
forall a.
(RespBody a -> a)
-> (Status -> RespError a -> a)
-> (Status -> a)
-> (ResponseHeaders -> a -> a)
-> (a -> ResponseHeaders)
-> (Status -> a -> a)
-> (a -> Maybe (RespBody a))
-> (a -> Maybe (RespError a))
-> (a -> Status)
-> (MediaType -> a -> a)
-> MediaType
-> (a -> Response)
-> IsResp a
toResponse :: Resp a -> Response
$ctoResponse :: forall a. ToJSON a => Resp a -> Response
getMedia :: MediaType
$cgetMedia :: forall a. ToJSON a => MediaType
setMedia :: MediaType -> Resp a -> Resp a
$csetMedia :: forall a. ToJSON a => MediaType -> Resp a -> Resp a
getStatus :: Resp a -> Status
$cgetStatus :: forall a. ToJSON a => Resp a -> Status
getRespError :: Resp a -> Maybe (RespError (Resp a))
$cgetRespError :: forall a. ToJSON a => Resp a -> Maybe (RespError (Resp a))
getRespBody :: Resp a -> Maybe (RespBody (Resp a))
$cgetRespBody :: forall a. ToJSON a => Resp a -> Maybe (RespBody (Resp a))
setStatus :: Status -> Resp a -> Resp a
$csetStatus :: forall a. ToJSON a => Status -> Resp a -> Resp a
getHeaders :: Resp a -> ResponseHeaders
$cgetHeaders :: forall a. ToJSON a => Resp a -> ResponseHeaders
addHeaders :: ResponseHeaders -> Resp a -> Resp a
$caddHeaders :: forall a. ToJSON a => ResponseHeaders -> Resp a -> Resp a
noContent :: Status -> Resp a
$cnoContent :: forall a. ToJSON a => Status -> Resp a
bad :: Status -> RespError (Resp a) -> Resp a
$cbad :: forall a. ToJSON a => Status -> RespError (Resp a) -> Resp a
ok :: RespBody (Resp a) -> Resp a
$cok :: forall a. ToJSON a => RespBody (Resp a) -> Resp a
IsResp, Resp a -> Resp a -> Bool
forall a. Eq a => Resp a -> Resp a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Resp a -> Resp a -> Bool
$c/= :: forall a. Eq a => Resp a -> Resp a -> Bool
== :: Resp a -> Resp a -> Bool
$c== :: forall a. Eq a => Resp a -> Resp a -> Bool
Eq, Int -> Resp a -> ShowS
[Resp a] -> ShowS
Resp a -> String
forall a. Show a => Int -> Resp a -> ShowS
forall a. Show a => [Resp a] -> ShowS
forall a. Show a => Resp a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Resp a] -> ShowS
$cshowList :: forall a. Show a => [Resp a] -> ShowS
show :: Resp a -> String
$cshow :: forall a. Show a => Resp a -> String
showsPrec :: Int -> Resp a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Resp a -> ShowS
Show, forall a b. a -> Resp b -> Resp a
forall a b. (a -> b) -> Resp a -> Resp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Resp b -> Resp a
$c<$ :: forall a b. a -> Resp b -> Resp a
fmap :: forall a b. (a -> b) -> Resp a -> Resp b
$cfmap :: forall a b. (a -> b) -> Resp a -> Resp b
Functor)

newtype RespOr err a = RespOr (Core.RespOr Json err a)
  deriving newtype (MediaType
ResponseHeaders -> RespOr err a -> RespOr err a
MediaType -> RespOr err a -> RespOr err a
Status -> RespOr err a
Status -> RespError (RespOr err a) -> RespOr err a
Status -> RespOr err a -> RespOr err a
RespBody (RespOr err a) -> RespOr err a
RespOr err a -> ResponseHeaders
RespOr err a -> Maybe (RespError (RespOr err a))
RespOr err a -> Maybe (RespBody (RespOr err a))
RespOr err a -> Status
RespOr err a -> Response
forall a.
(RespBody a -> a)
-> (Status -> RespError a -> a)
-> (Status -> a)
-> (ResponseHeaders -> a -> a)
-> (a -> ResponseHeaders)
-> (Status -> a -> a)
-> (a -> Maybe (RespBody a))
-> (a -> Maybe (RespError a))
-> (a -> Status)
-> (MediaType -> a -> a)
-> MediaType
-> (a -> Response)
-> IsResp a
forall err a. (ToJSON err, ToJSON a) => MediaType
forall err a.
(ToJSON err, ToJSON a) =>
ResponseHeaders -> RespOr err a -> RespOr err a
forall err a.
(ToJSON err, ToJSON a) =>
MediaType -> RespOr err a -> RespOr err a
forall err a. (ToJSON err, ToJSON a) => Status -> RespOr err a
forall err a.
(ToJSON err, ToJSON a) =>
Status -> RespError (RespOr err a) -> RespOr err a
forall err a.
(ToJSON err, ToJSON a) =>
Status -> RespOr err a -> RespOr err a
forall err a.
(ToJSON err, ToJSON a) =>
RespBody (RespOr err a) -> RespOr err a
forall err a.
(ToJSON err, ToJSON a) =>
RespOr err a -> ResponseHeaders
forall err a.
(ToJSON err, ToJSON a) =>
RespOr err a -> Maybe (RespError (RespOr err a))
forall err a.
(ToJSON err, ToJSON a) =>
RespOr err a -> Maybe (RespBody (RespOr err a))
forall err a. (ToJSON err, ToJSON a) => RespOr err a -> Status
forall err a. (ToJSON err, ToJSON a) => RespOr err a -> Response
toResponse :: RespOr err a -> Response
$ctoResponse :: forall err a. (ToJSON err, ToJSON a) => RespOr err a -> Response
getMedia :: MediaType
$cgetMedia :: forall err a. (ToJSON err, ToJSON a) => MediaType
setMedia :: MediaType -> RespOr err a -> RespOr err a
$csetMedia :: forall err a.
(ToJSON err, ToJSON a) =>
MediaType -> RespOr err a -> RespOr err a
getStatus :: RespOr err a -> Status
$cgetStatus :: forall err a. (ToJSON err, ToJSON a) => RespOr err a -> Status
getRespError :: RespOr err a -> Maybe (RespError (RespOr err a))
$cgetRespError :: forall err a.
(ToJSON err, ToJSON a) =>
RespOr err a -> Maybe (RespError (RespOr err a))
getRespBody :: RespOr err a -> Maybe (RespBody (RespOr err a))
$cgetRespBody :: forall err a.
(ToJSON err, ToJSON a) =>
RespOr err a -> Maybe (RespBody (RespOr err a))
setStatus :: Status -> RespOr err a -> RespOr err a
$csetStatus :: forall err a.
(ToJSON err, ToJSON a) =>
Status -> RespOr err a -> RespOr err a
getHeaders :: RespOr err a -> ResponseHeaders
$cgetHeaders :: forall err a.
(ToJSON err, ToJSON a) =>
RespOr err a -> ResponseHeaders
addHeaders :: ResponseHeaders -> RespOr err a -> RespOr err a
$caddHeaders :: forall err a.
(ToJSON err, ToJSON a) =>
ResponseHeaders -> RespOr err a -> RespOr err a
noContent :: Status -> RespOr err a
$cnoContent :: forall err a. (ToJSON err, ToJSON a) => Status -> RespOr err a
bad :: Status -> RespError (RespOr err a) -> RespOr err a
$cbad :: forall err a.
(ToJSON err, ToJSON a) =>
Status -> RespError (RespOr err a) -> RespOr err a
ok :: RespBody (RespOr err a) -> RespOr err a
$cok :: forall err a.
(ToJSON err, ToJSON a) =>
RespBody (RespOr err a) -> RespOr err a
IsResp, RespOr err a -> RespOr err a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall err a.
(Eq err, Eq a) =>
RespOr err a -> RespOr err a -> Bool
/= :: RespOr err a -> RespOr err a -> Bool
$c/= :: forall err a.
(Eq err, Eq a) =>
RespOr err a -> RespOr err a -> Bool
== :: RespOr err a -> RespOr err a -> Bool
$c== :: forall err a.
(Eq err, Eq a) =>
RespOr err a -> RespOr err a -> Bool
Eq, Int -> RespOr err a -> ShowS
[RespOr err a] -> ShowS
RespOr err a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall err a. (Show err, Show a) => Int -> RespOr err a -> ShowS
forall err a. (Show err, Show a) => [RespOr err a] -> ShowS
forall err a. (Show err, Show a) => RespOr err a -> String
showList :: [RespOr err a] -> ShowS
$cshowList :: forall err a. (Show err, Show a) => [RespOr err a] -> ShowS
show :: RespOr err a -> String
$cshow :: forall err a. (Show err, Show a) => RespOr err a -> String
showsPrec :: Int -> RespOr err a -> ShowS
$cshowsPrec :: forall err a. (Show err, Show a) => Int -> RespOr err a -> ShowS
Show, forall a b. a -> RespOr err b -> RespOr err a
forall a b. (a -> b) -> RespOr err a -> RespOr err b
forall err a b. a -> RespOr err b -> RespOr err a
forall err a b. (a -> b) -> RespOr err a -> RespOr err b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RespOr err b -> RespOr err a
$c<$ :: forall err a b. a -> RespOr err b -> RespOr err a
fmap :: forall a b. (a -> b) -> RespOr err a -> RespOr err b
$cfmap :: forall err a b. (a -> b) -> RespOr err a -> RespOr err b
Functor)

-- request

-- | Special case for request Body with JSON.
newtype Body a = Body a

instance (ToSchema a, FromJSON a, ToRoute b) => ToRoute (Body a -> b) where
  toRouteInfo :: RouteInfo -> RouteInfo
toRouteInfo = forall a. ToRoute a => RouteInfo -> RouteInfo
toRouteInfo @(Core.Body Json a -> b)

  toRouteFun :: (Body a -> b) -> ServerFun (MonadOf (Body a -> b))
toRouteFun Body a -> b
f =
    (forall a. ToRoute a => a -> ServerFun (MonadOf a)
toRouteFun :: ((Core.Body Json a -> b) -> ServerFun (Core.MonadOf b)))
      (\(Core.Body a
a) -> Body a -> b
f (forall a. a -> Body a
Body a
a))

instance (FromJSON a, ToSchema a, ToPlugin b) => ToPlugin (Body a -> b) where
  toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall f. ToPlugin f => RouteInfo -> RouteInfo
toPluginInfo @(Core.Body Json a -> b)

  toPluginFun :: (Body a -> b)
-> ServerFun (MonadOf (Body a -> b))
-> ServerFun (MonadOf (Body a -> b))
toPluginFun Body a -> b
f =
    (forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun :: ((Core.Body Json a -> b) -> PluginFun (Core.MonadOf b)))
      (\(Core.Body a
a) -> Body a -> b
f (forall a. a -> Body a
Body a
a))

-- client instances

instance (ToJSON a, ToClient b) => ToClient (Body a -> b) where
  toClient :: forall (m :: * -> *). Server m -> Body a -> b
toClient Server m
api = (\Body Json a -> b
f -> \(Body a
b) -> Body Json a -> b
f (forall {k} (media :: k) a. a -> Body media a
Core.Body a
b)) forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). ToClient a => Server m -> a
toClient @(Core.Body Json a -> b) Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @(Core.Body Json a -> b)

instance (FromClient b) => FromClient (Body a -> b) where
  type ClientResult (Body a -> b) = ClientResult (Core.Body Json a -> b)
  fromClient :: (Body a -> b) -> ClientResult (Body a -> b)
fromClient Body a -> b
f a
arg = forall a. FromClient a => a -> ClientResult a
fromClient @(Core.Body Json a -> b) (Body a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Body a
Body forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {media :: k} {a}. Body media a -> a
fromBody) a
arg
    where
      fromBody :: Body media a -> a
fromBody (Core.Body a
a) = a
a