content: -- | Renders mig-servers as OpenApi schemas
  module Mig.Core.OpenApi (
    toOpenApi,
  ) where
  
  import Control.Lens (at, (%~), (&), (.~), (?~))
  import Data.Aeson (ToJSON (..))
  import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
  import Data.HashSet.InsOrd qualified as Set
  import Data.Monoid (Endo (..))
  import Data.OpenApi hiding (Server (..))
  import Data.Proxy
  import Data.Text (Text)
  import Data.Text qualified as Text
  import Mig.Core.Api (Api)
  import Mig.Core.Api qualified as Api
  import Mig.Core.Class.Route (Route (..))
  import Mig.Core.Server (Server (..), fillCaptures)
  import Mig.Core.Types.Info (IsRequired (..), RouteInfo)
  import Mig.Core.Types.Info qualified as Info
  import Network.HTTP.Types.Method
  import Network.HTTP.Types.Status (Status (..))
  
  addCapture :: Text -> OpenApi -> OpenApi
  addCapture captureName =
    prependPath ("{" <> Text.unpack captureName <> "}")
  
  -- | Reads OpenApi schema for a server
  toOpenApi :: Server m -> OpenApi
  toOpenApi (Server x) = fromApiInfo (fmap (.info) $ fillCaptures x)
  
  fromApiInfo :: Api RouteInfo -> OpenApi
  fromApiInfo = \case
    Api.Empty -> mempty
    Api.Append a b -> fromApiInfo a <> fromApiInfo b
    Api.WithPath (Api.Path path) a -> foldr withPath (fromApiInfo a) path
    Api.HandleRoute route -> fromRoute route
  
  withPath :: Api.PathItem -> OpenApi -> OpenApi
  withPath = \case
    Api.StaticPath pathName -> prependPath (Text.unpack pathName)
    Api.CapturePath captureName -> addCapture captureName
  
  fromRoute :: RouteInfo -> OpenApi
  fromRoute routeInfo =
    appEndo
      (foldMap (Endo . fromRouteInput) routeInfo.inputs)
      (fromRouteOutput routeInfo)
  
  fromRouteOutput :: RouteInfo -> OpenApi
  fromRouteOutput routeInfo =
    mempty
      & components . schemas .~ defs
      & paths . at "/"
        ?~ ( mempty
              & method
                ?~ ( mempty
                      & at code
                        ?~ Inline
                          ( mempty
                              & content
                                .~ InsOrdHashMap.fromList
                                  [(t, mempty & schema .~ mref) | t <- responseContentTypes]
                              & headers .~ responseHeaders
                          )
                      & tags .~ Set.fromList routeInfo.tags
                      & summary .~ nonEmptyText routeInfo.summary
                      & description .~ nonEmptyText routeInfo.description
                   )
           )
    where
      method = case routeInfo.method of
        Just m | m == methodGet -> get
        Just m | m == methodPost -> post
        Just m | m == methodPut -> put
        Just m | m == methodDelete -> delete
        Just m | m == methodOptions -> options
        Just m | m == methodHead -> head_
        Just m | m == methodPatch -> patch
        Just m | m == methodTrace -> trace
        _ -> mempty
  
      code = routeInfo.output.status.statusCode
  
      responseContentTypes = [routeInfo.output.media]
  
      -- TODO: is it always empty?
      responseHeaders = Inline <$> mempty
  
      Info.SchemaDefs defs mref = routeInfo.output.schema
  
  fromRouteInput :: Info.Describe Info.RouteInput -> OpenApi -> OpenApi
  fromRouteInput descInput base = case descInput.content of
    Info.ReqBodyInput inputType bodySchema -> onRequestBody inputType bodySchema
    Info.RawBodyInput -> base
    Info.CaptureInput captureName captureSchema -> onCapture captureName captureSchema
    Info.QueryInput isRequired queryName querySchema -> onQuery isRequired queryName querySchema
    Info.QueryFlagInput queryName -> onQueryFlag queryName
    Info.HeaderInput isRequired headerName headerSchema -> onHeader isRequired headerName headerSchema
    where
      onCapture = onParam addDefaultResponse404 ParamPath (IsRequired True)
  
      onQuery = onParam addDefaultResponse400 ParamQuery
  
      onHeader = onParam addDefaultResponse400 ParamHeader
  
      onParam defResponse paramType (IsRequired isRequired) paramName paramSchema =
        base
          & addParam param
          & defResponse paramName
        where
          param =
            mempty
              & name .~ paramName
              & description .~ (nonEmptyText =<< descInput.description)
              & required ?~ isRequired
              & in_ .~ paramType
              & schema ?~ (Inline paramSchema)
  
      onRequestBody bodyInputType (Info.SchemaDefs defs ref) =
        base
          & addRequestBody reqBody
          & addDefaultResponse400 "body"
          & components . schemas %~ (<> defs)
        where
          reqBody =
            (mempty :: RequestBody)
              & description .~ (nonEmptyText =<< descInput.description)
              & content .~ InsOrdHashMap.fromList [(t, mempty & schema .~ ref) | t <- [bodyContentType]]
  
          bodyContentType = bodyInputType
  
      onQueryFlag queryName =
        base
          & addParam param
          & addDefaultResponse400 queryName
        where
          param =
            mempty
              & name .~ queryName
              & in_ .~ ParamQuery
              & allowEmptyValue ?~ True
              & schema
                ?~ ( Inline $
                      (toParamSchema (Proxy :: Proxy Bool))
                        & default_ ?~ toJSON False
                   )
  
  -------------------------------------------------------------------------------------
  -- openapi utils
  
  nonEmptyText :: Text -> Maybe Text
  nonEmptyText txt
    | Text.null txt = Nothing
    | otherwise = Just txt
  
  -- | Add RequestBody to every operations in the spec.
  addRequestBody :: RequestBody -> OpenApi -> OpenApi
  addRequestBody rb = allOperations . requestBody ?~ Inline rb
  
  -- | Add parameter to every operation in the spec.
  addParam :: Param -> OpenApi -> OpenApi
  addParam param = allOperations . parameters %~ (Inline param :)
  
  addDefaultResponse404 :: ParamName -> OpenApi -> OpenApi
  addDefaultResponse404 pname = setResponseWith (\old _new -> alter404 old) 404 (return response404)
    where
      sname = markdownCode pname
      description404 = sname <> " not found"
      alter404 = description %~ ((sname <> " or ") <>)
      response404 = mempty & description .~ description404
  
  addDefaultResponse400 :: ParamName -> OpenApi -> OpenApi
  addDefaultResponse400 pname = setResponseWith (\old _new -> alter400 old) 400 (return response400)
    where
      sname = markdownCode pname
      description400 = "Invalid " <> sname
      alter400 = description %~ (<> (" or " <> sname))
      response400 = mempty & description .~ description400
  
  -- | Format given text as inline code in Markdown.
  markdownCode :: Text -> Text
  markdownCode s = "`" <> s <> "`"
  