module Mig.Core.Types.Info (
RouteInfo (..),
RouteInput (..),
Describe (..),
noDescription,
getInputType,
RouteOutput (..),
IsRequired (..),
OutputSchema,
InputSchema,
SchemaDefs (..),
emptySchemaDefs,
toSchemaDefs,
addRouteInput,
setOutputMedia,
setMethod,
emptyRouteInfo,
describeInfoInputs,
addBodyInfo,
addHeaderInfo,
addOptionalHeaderInfo,
addQueryInfo,
addQueryFlagInfo,
addOptionalInfo,
addCaptureInfo,
routeHasQuery,
routeHasOptionalQuery,
routeHasQueryFlag,
routeHasCapture,
) where
import Data.List.Extra (firstJust)
import Data.Map.Strict qualified as Map
import Data.OpenApi (Definitions, Referenced, Schema, ToParamSchema (..), ToSchema (..), declareSchemaRef)
import Data.OpenApi.Declare (runDeclare)
import Data.Proxy
import Data.String
import Data.Text (Text)
import GHC.TypeLits
import Mig.Core.Class.MediaType
import Network.HTTP.Types.Method
import Network.HTTP.Types.Status
data RouteInfo = RouteInfo
{ RouteInfo -> Maybe Method
method :: Maybe Method
, RouteInfo -> [Describe RouteInput]
inputs :: [Describe RouteInput]
, RouteInfo -> RouteOutput
output :: RouteOutput
, RouteInfo -> [Text]
tags :: [Text]
, RouteInfo -> Text
description :: Text
, RouteInfo -> Text
summary :: Text
}
deriving (Int -> RouteInfo -> ShowS
[RouteInfo] -> ShowS
RouteInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RouteInfo] -> ShowS
$cshowList :: [RouteInfo] -> ShowS
show :: RouteInfo -> String
$cshow :: RouteInfo -> String
showsPrec :: Int -> RouteInfo -> ShowS
$cshowsPrec :: Int -> RouteInfo -> ShowS
Show, RouteInfo -> RouteInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RouteInfo -> RouteInfo -> Bool
$c/= :: RouteInfo -> RouteInfo -> Bool
== :: RouteInfo -> RouteInfo -> Bool
$c== :: RouteInfo -> RouteInfo -> Bool
Eq)
newtype IsRequired = IsRequired Bool
deriving newtype (Int -> IsRequired -> ShowS
[IsRequired] -> ShowS
IsRequired -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsRequired] -> ShowS
$cshowList :: [IsRequired] -> ShowS
show :: IsRequired -> String
$cshow :: IsRequired -> String
showsPrec :: Int -> IsRequired -> ShowS
$cshowsPrec :: Int -> IsRequired -> ShowS
Show, IsRequired -> IsRequired -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsRequired -> IsRequired -> Bool
$c/= :: IsRequired -> IsRequired -> Bool
== :: IsRequired -> IsRequired -> Bool
$c== :: IsRequired -> IsRequired -> Bool
Eq)
data Describe a = Describe
{ forall a. Describe a -> Maybe Text
description :: Maybe Text
, forall a. Describe a -> a
content :: a
}
deriving (Int -> Describe a -> ShowS
forall a. Show a => Int -> Describe a -> ShowS
forall a. Show a => [Describe a] -> ShowS
forall a. Show a => Describe a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Describe a] -> ShowS
$cshowList :: forall a. Show a => [Describe a] -> ShowS
show :: Describe a -> String
$cshow :: forall a. Show a => Describe a -> String
showsPrec :: Int -> Describe a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Describe a -> ShowS
Show, Describe a -> Describe a -> Bool
forall a. Eq a => Describe a -> Describe a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Describe a -> Describe a -> Bool
$c/= :: forall a. Eq a => Describe a -> Describe a -> Bool
== :: Describe a -> Describe a -> Bool
$c== :: forall a. Eq a => Describe a -> Describe a -> Bool
Eq)
noDescription :: a -> Describe a
noDescription :: forall a. a -> Describe a
noDescription = forall a. Maybe Text -> a -> Describe a
Describe forall a. Maybe a
Nothing
describeInfoInputs :: [(Text, Text)] -> RouteInfo -> RouteInfo
describeInfoInputs :: [(Text, Text)] -> RouteInfo -> RouteInfo
describeInfoInputs [(Text, Text)]
descs RouteInfo
routeInfo = RouteInfo
routeInfo{$sel:inputs:RouteInfo :: [Describe RouteInput]
inputs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Describe RouteInput -> Describe RouteInput
addDesc RouteInfo
routeInfo.inputs}
where
addDesc :: Describe RouteInput -> Describe RouteInput
addDesc Describe RouteInput
inp =
forall a. Maybe Text -> a -> Describe a
Describe (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall {r}. HasField "content" r RouteInput => r -> Text
getInputName Describe RouteInput
inp) Map Text Text
descMap) Describe RouteInput
inp.content
getInputName :: r -> Text
getInputName r
inp =
case r
inp.content of
ReqBodyInput MediaType
_ SchemaDefs
_ -> Text
"request-body"
RouteInput
RawBodyInput -> Text
"raw-input"
CaptureInput Text
captureName Schema
_ -> Text
captureName
QueryInput IsRequired
_ Text
queryName Schema
_ -> Text
queryName
QueryFlagInput Text
queryName -> Text
queryName
HeaderInput IsRequired
_ Text
headerName Schema
_ -> Text
headerName
descMap :: Map Text Text
descMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
descs
data RouteInput
= ReqBodyInput MediaType SchemaDefs
| RawBodyInput
| CaptureInput Text Schema
| QueryInput IsRequired Text Schema
| QueryFlagInput Text
| IsRequired Text Schema
deriving (Int -> RouteInput -> ShowS
[RouteInput] -> ShowS
RouteInput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RouteInput] -> ShowS
$cshowList :: [RouteInput] -> ShowS
show :: RouteInput -> String
$cshow :: RouteInput -> String
showsPrec :: Int -> RouteInput -> ShowS
$cshowsPrec :: Int -> RouteInput -> ShowS
Show, RouteInput -> RouteInput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RouteInput -> RouteInput -> Bool
$c/= :: RouteInput -> RouteInput -> Bool
== :: RouteInput -> RouteInput -> Bool
$c== :: RouteInput -> RouteInput -> Bool
Eq)
getInputType :: RouteInfo -> Maybe MediaType
getInputType :: RouteInfo -> Maybe MediaType
getInputType RouteInfo
route = forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust (RouteInput -> Maybe MediaType
fromInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.content)) RouteInfo
route.inputs
where
fromInput :: RouteInput -> Maybe MediaType
fromInput = \case
ReqBodyInput MediaType
ty SchemaDefs
_ -> forall a. a -> Maybe a
Just MediaType
ty
RouteInput
_ -> forall a. Maybe a
Nothing
type InputSchema = SchemaDefs
data RouteOutput = RouteOutput
{ RouteOutput -> Status
status :: Status
, RouteOutput -> MediaType
media :: MediaType
, RouteOutput -> SchemaDefs
schema :: OutputSchema
}
deriving (Int -> RouteOutput -> ShowS
[RouteOutput] -> ShowS
RouteOutput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RouteOutput] -> ShowS
$cshowList :: [RouteOutput] -> ShowS
show :: RouteOutput -> String
$cshow :: RouteOutput -> String
showsPrec :: Int -> RouteOutput -> ShowS
$cshowsPrec :: Int -> RouteOutput -> ShowS
Show, RouteOutput -> RouteOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RouteOutput -> RouteOutput -> Bool
$c/= :: RouteOutput -> RouteOutput -> Bool
== :: RouteOutput -> RouteOutput -> Bool
$c== :: RouteOutput -> RouteOutput -> Bool
Eq)
type OutputSchema = SchemaDefs
data SchemaDefs = SchemaDefs
{ SchemaDefs -> Definitions Schema
defs :: Definitions Schema
, SchemaDefs -> Maybe (Referenced Schema)
ref :: Maybe (Referenced Schema)
}
deriving (Int -> SchemaDefs -> ShowS
[SchemaDefs] -> ShowS
SchemaDefs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaDefs] -> ShowS
$cshowList :: [SchemaDefs] -> ShowS
show :: SchemaDefs -> String
$cshow :: SchemaDefs -> String
showsPrec :: Int -> SchemaDefs -> ShowS
$cshowsPrec :: Int -> SchemaDefs -> ShowS
Show, SchemaDefs -> SchemaDefs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaDefs -> SchemaDefs -> Bool
$c/= :: SchemaDefs -> SchemaDefs -> Bool
== :: SchemaDefs -> SchemaDefs -> Bool
$c== :: SchemaDefs -> SchemaDefs -> Bool
Eq)
toSchemaDefs :: forall a. (ToSchema a) => SchemaDefs
toSchemaDefs :: forall a. ToSchema a => SchemaDefs
toSchemaDefs =
Definitions Schema -> Maybe (Referenced Schema) -> SchemaDefs
SchemaDefs Definitions Schema
defs (forall a. a -> Maybe a
Just Referenced Schema
ref)
where
(Definitions Schema
defs, Referenced Schema
ref) = forall d a. Declare d a -> d -> (d, a)
runDeclare (forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall {k} (t :: k). Proxy t
Proxy @a)) forall a. Monoid a => a
mempty
emptySchemaDefs :: SchemaDefs
emptySchemaDefs :: SchemaDefs
emptySchemaDefs = Definitions Schema -> Maybe (Referenced Schema) -> SchemaDefs
SchemaDefs forall a. Monoid a => a
mempty forall a. Maybe a
Nothing
addRouteInput :: RouteInput -> RouteInfo -> RouteInfo
addRouteInput :: RouteInput -> RouteInfo -> RouteInfo
addRouteInput RouteInput
inp = Describe RouteInput -> RouteInfo -> RouteInfo
addRouteInputWithDescriptiton (forall a. a -> Describe a
noDescription RouteInput
inp)
addRouteInputWithDescriptiton :: Describe RouteInput -> RouteInfo -> RouteInfo
addRouteInputWithDescriptiton :: Describe RouteInput -> RouteInfo -> RouteInfo
addRouteInputWithDescriptiton Describe RouteInput
inp RouteInfo
routeInfo =
RouteInfo
routeInfo{$sel:inputs:RouteInfo :: [Describe RouteInput]
inputs = Describe RouteInput
inp forall a. a -> [a] -> [a]
: RouteInfo
routeInfo.inputs}
emptyRouteInfo :: RouteInfo
emptyRouteInfo :: RouteInfo
emptyRouteInfo =
Maybe Method
-> [Describe RouteInput]
-> RouteOutput
-> [Text]
-> Text
-> Text
-> RouteInfo
RouteInfo forall a. Maybe a
Nothing [] (Status -> MediaType -> SchemaDefs -> RouteOutput
RouteOutput Status
ok200 MediaType
"*/*" SchemaDefs
emptySchemaDefs) [] Text
"" Text
""
setMethod :: Method -> MediaType -> RouteInfo -> RouteInfo
setMethod :: Method -> MediaType -> RouteInfo -> RouteInfo
setMethod Method
method MediaType
mediaType RouteInfo
routeInfo =
RouteInfo
routeInfo
{ $sel:method:RouteInfo :: Maybe Method
method = forall a. a -> Maybe a
Just Method
method
, $sel:output:RouteInfo :: RouteOutput
output = Status -> MediaType -> SchemaDefs -> RouteOutput
RouteOutput RouteInfo
routeInfo.output.status MediaType
mediaType SchemaDefs
emptySchemaDefs
}
setOutputMedia :: MediaType -> RouteInfo -> RouteInfo
setOutputMedia :: MediaType -> RouteInfo -> RouteInfo
setOutputMedia MediaType
mediaType RouteInfo
routeInfo =
RouteInfo
routeInfo{$sel:output:RouteInfo :: RouteOutput
output = RouteOutput -> RouteOutput
setMedia RouteInfo
routeInfo.output}
where
setMedia :: RouteOutput -> RouteOutput
setMedia RouteOutput
outp = RouteOutput
outp{$sel:media:RouteOutput :: MediaType
media = MediaType
mediaType}
addParamInfoBy :: forall sym a. (KnownSymbol sym, ToParamSchema a) => (Text -> Schema -> RouteInput) -> RouteInfo -> RouteInfo
addParamInfoBy :: forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
(Text -> Schema -> RouteInput) -> RouteInfo -> RouteInfo
addParamInfoBy Text -> Schema -> RouteInput
cons = RouteInput -> RouteInfo -> RouteInfo
addRouteInput (Text -> Schema -> RouteInput
cons (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall {k} (t :: k). Proxy t
Proxy @a)))
addHeaderInfo :: forall sym a. (KnownSymbol sym, ToParamSchema a) => RouteInfo -> RouteInfo
= forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
(Text -> Schema -> RouteInput) -> RouteInfo -> RouteInfo
addParamInfoBy @sym @a (IsRequired -> Text -> Schema -> RouteInput
HeaderInput (Bool -> IsRequired
IsRequired Bool
True))
addOptionalHeaderInfo :: forall sym a. (KnownSymbol sym, ToParamSchema a) => RouteInfo -> RouteInfo
= forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
(Text -> Schema -> RouteInput) -> RouteInfo -> RouteInfo
addParamInfoBy @sym @a (IsRequired -> Text -> Schema -> RouteInput
HeaderInput (Bool -> IsRequired
IsRequired Bool
False))
addQueryInfo :: forall sym a. (KnownSymbol sym, ToParamSchema a) => RouteInfo -> RouteInfo
addQueryInfo :: forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addQueryInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
(Text -> Schema -> RouteInput) -> RouteInfo -> RouteInfo
addParamInfoBy @sym @a (IsRequired -> Text -> Schema -> RouteInput
QueryInput (Bool -> IsRequired
IsRequired Bool
True))
addOptionalInfo :: forall sym a. (KnownSymbol sym, ToParamSchema a) => RouteInfo -> RouteInfo
addOptionalInfo :: forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addOptionalInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
(Text -> Schema -> RouteInput) -> RouteInfo -> RouteInfo
addParamInfoBy @sym @a (IsRequired -> Text -> Schema -> RouteInput
QueryInput (Bool -> IsRequired
IsRequired Bool
False))
addCaptureInfo :: forall sym a. (KnownSymbol sym, ToParamSchema a) => RouteInfo -> RouteInfo
addCaptureInfo :: forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addCaptureInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
(Text -> Schema -> RouteInput) -> RouteInfo -> RouteInfo
addParamInfoBy @sym @a Text -> Schema -> RouteInput
CaptureInput
addQueryFlagInfo :: forall sym. (KnownSymbol sym) => RouteInfo -> RouteInfo
addQueryFlagInfo :: forall (sym :: Symbol). KnownSymbol sym => RouteInfo -> RouteInfo
addQueryFlagInfo = RouteInput -> RouteInfo -> RouteInfo
addRouteInput (Text -> RouteInput
QueryFlagInput (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym))
addBodyInfo :: forall ty a. (ToMediaType ty, ToSchema a) => RouteInfo -> RouteInfo
addBodyInfo :: forall {k} (ty :: k) a.
(ToMediaType ty, ToSchema a) =>
RouteInfo -> RouteInfo
addBodyInfo = RouteInput -> RouteInfo -> RouteInfo
addRouteInput (MediaType -> SchemaDefs -> RouteInput
ReqBodyInput (forall {k} (a :: k). ToMediaType a => MediaType
toMediaType @ty) (forall a. ToSchema a => SchemaDefs
toSchemaDefs @a))
routeHasQuery :: Text -> RouteInfo -> Bool
routeHasQuery :: Text -> RouteInfo -> Bool
routeHasQuery Text
expectedName = (RouteInput -> Bool) -> RouteInfo -> Bool
routeHasInput RouteInput -> Bool
isQuery
where
isQuery :: RouteInput -> Bool
isQuery = \case
QueryInput (IsRequired Bool
True) Text
name Schema
_ -> Text
expectedName forall a. Eq a => a -> a -> Bool
== Text
name
RouteInput
_ -> Bool
False
routeHasOptionalQuery :: Text -> RouteInfo -> Bool
routeHasOptionalQuery :: Text -> RouteInfo -> Bool
routeHasOptionalQuery Text
expectedName = (RouteInput -> Bool) -> RouteInfo -> Bool
routeHasInput RouteInput -> Bool
isOptionalQuery
where
isOptionalQuery :: RouteInput -> Bool
isOptionalQuery = \case
QueryInput (IsRequired Bool
False) Text
name Schema
_ -> Text
expectedName forall a. Eq a => a -> a -> Bool
== Text
name
RouteInput
_ -> Bool
False
routeHasQueryFlag :: Text -> RouteInfo -> Bool
routeHasQueryFlag :: Text -> RouteInfo -> Bool
routeHasQueryFlag Text
expectedName = (RouteInput -> Bool) -> RouteInfo -> Bool
routeHasInput RouteInput -> Bool
isQueryFlag
where
isQueryFlag :: RouteInput -> Bool
isQueryFlag = \case
QueryFlagInput Text
name -> Text
expectedName forall a. Eq a => a -> a -> Bool
== Text
name
RouteInput
_ -> Bool
False
routeHasCapture :: Text -> RouteInfo -> Bool
routeHasCapture :: Text -> RouteInfo -> Bool
routeHasCapture Text
expectedName = (RouteInput -> Bool) -> RouteInfo -> Bool
routeHasInput RouteInput -> Bool
isCapture
where
isCapture :: RouteInput -> Bool
isCapture = \case
CaptureInput Text
name Schema
_ -> Text
expectedName forall a. Eq a => a -> a -> Bool
== Text
name
RouteInput
_ -> Bool
False
routeHasInput :: (RouteInput -> Bool) -> RouteInfo -> Bool
routeHasInput :: (RouteInput -> Bool) -> RouteInfo -> Bool
routeHasInput RouteInput -> Bool
check RouteInfo
info = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (RouteInput -> Bool
check forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.content)) RouteInfo
info.inputs
getName :: forall sym a. (KnownSymbol sym, IsString a) => a
getName :: forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName = forall a. IsString a => String -> a
fromString (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @sym))