-- | Types that describe route info. We use it to derive OpenApi schema or clients.
module Mig.Core.Types.Info (
  RouteInfo (..),
  RouteInput (..),
  Describe (..),
  noDescription,
  getInputType,
  RouteOutput (..),
  IsRequired (..),
  OutputSchema,
  InputSchema,
  SchemaDefs (..),
  emptySchemaDefs,
  toSchemaDefs,
  addRouteInput,
  setOutputMedia,
  setMethod,
  emptyRouteInfo,
  describeInfoInputs,

  -- * api updates
  addBodyInfo,
  addHeaderInfo,
  addOptionalHeaderInfo,
  addQueryInfo,
  addQueryFlagInfo,
  addOptionalInfo,
  addCaptureInfo,
) where

import Data.List.Extra (firstJust)
import Data.Map.Strict qualified as Map
import Data.OpenApi
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

-- | Information on route
data RouteInfo = RouteInfo
  { RouteInfo -> Maybe Method
method :: Maybe Method
  -- ^ http method
  , RouteInfo -> [Describe RouteInput]
inputs :: [Describe RouteInput]
  -- ^ route inputs
  , RouteInfo -> RouteOutput
output :: RouteOutput
  -- ^ route outputs
  , RouteInfo -> [Text]
tags :: [Text]
  -- ^ open-api tags
  , RouteInfo -> Text
description :: Text
  -- ^ open-api description
  , RouteInfo -> Text
summary :: Text
  -- ^ open-api summary
  }
  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)

-- | Values which have human-readable description.
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)

-- | no description provided
noDescription :: a -> Describe a
noDescription :: forall a. a -> Describe a
noDescription = forall a. Maybe Text -> a -> Describe a
Describe forall a. Maybe a
Nothing

{-| Appends descriptiton for the info
special name request-body is dedicated to request body input
nd raw-input is dedicated to raw input
-}
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

-- | Route inputs
data RouteInput
  = ReqBodyInput MediaType SchemaDefs
  | RawBodyInput
  | CaptureInput Text Schema
  | QueryInput IsRequired Text Schema
  | QueryFlagInput Text
  | HeaderInput 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)

-- | Get input media-type
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

-- | Input schema
type InputSchema = SchemaDefs

-- | Route output
data RouteOutput = RouteOutput
  { RouteOutput -> Status
status :: Status
  -- ^ http status
  , RouteOutput -> MediaType
media :: MediaType
  -- ^ media type
  , RouteOutput -> SchemaDefs
schema :: OutputSchema
  -- ^ open-api schema
  }
  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)

-- | Output schema
type OutputSchema = SchemaDefs

-- | Schem definition with references to the used sub-values
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)

-- | Create schema definition
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

-- | An empty schema definition
emptySchemaDefs :: SchemaDefs
emptySchemaDefs :: SchemaDefs
emptySchemaDefs = Definitions Schema -> Maybe (Referenced Schema) -> SchemaDefs
SchemaDefs forall a. Monoid a => a
mempty forall a. Maybe a
Nothing

-- | Add route input to route info list of inputs
addRouteInput :: RouteInput -> RouteInfo -> RouteInfo
addRouteInput :: RouteInput -> RouteInfo -> RouteInfo
addRouteInput RouteInput
inp = Describe RouteInput -> RouteInfo -> RouteInfo
addRouteInputWithDescriptiton (forall a. a -> Describe a
noDescription RouteInput
inp)

-- | Adds route input with description
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}

{-| Default empty route info. We update it as we construct the route with type-safe DSL.
Almost all values are derived from type signatures
-}
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
""

-- | Set http-method of the route
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
    }

-- | Set output meida-type for the route
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}

-- | Add parameter to the inputs of the route
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)))

-- | Adds required header info to API schema
addHeaderInfo :: forall sym a. (KnownSymbol sym, ToParamSchema a) => RouteInfo -> RouteInfo
addHeaderInfo :: forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addHeaderInfo = 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))

-- | Adds optional header info to API schema
addOptionalHeaderInfo :: forall sym a. (KnownSymbol sym, ToParamSchema a) => RouteInfo -> RouteInfo
addOptionalHeaderInfo :: forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addOptionalHeaderInfo = 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))

-- | Adds required query info to API schema
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))

-- | Adds optional query info to API schema
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))

-- | Adds capture info to API schema
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

-- | Adds query flag to API schema
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))

-- | Adds request body to API schema
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))

---------------------------------------------
-- utils

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))