{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK not-home #-}

{- |
Module      : Servant.API.Routes.Internal.Request
Copyright   : (c) Frederick Pringle, 2025
License     : BSD-3-Clause
Maintainer  : freddyjepringle@gmail.com

Internal module, subject to change.
-}
module Servant.API.Routes.Internal.Request
  ( Request (..)
  , unRequest
  , AllTypeable (..)
  )
where

import Data.Aeson
import Data.Function (on)
import Data.Kind (Type)
import Data.List (nub, sort)
import Data.Typeable
import Lens.Micro.TH
import "this" Servant.API.Routes.Internal.Some as S
import "this" Servant.API.Routes.Utils

{- | A representation of the request /body/(s) that a Servant endpoint expects.

Under the hood, 'Request' is a @'Some' 'TypeRep'@.
This allows for the possibility that an endpoint might expect the request body
to parse as several different types (multiple 'Servant.API.ReqBody''s).

Note that this type doesn't include any information about the headers that an
endpoint expects, since those are independent of the request body.
-}
newtype Request = Request {Request -> Some TypeRep
_unRequest :: Some TypeRep}
  deriving (Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show) via Some TypeRep

makeLenses ''Request

instance ToJSON Request where
  toJSON :: Request -> Value
toJSON = forall a. (a -> Value) -> Text -> Some a -> Value
someToJSONAs TypeRep -> Value
typeRepToJSON Text
"all_of" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Some TypeRep
_unRequest

instance Eq Request where
  == :: Request -> Request -> Bool
(==) = forall a. Eq a => ([a] -> [a] -> Bool) -> Some a -> Some a -> Bool
eqSome (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub)) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Request -> Some TypeRep
_unRequest

instance Semigroup Request where
  Request Some TypeRep
b1 <> :: Request -> Request -> Request
<> Request Some TypeRep
b2 = Some TypeRep -> Request
Request (forall a.
(a -> [a] -> [a])
-> ([a] -> a -> [a]) -> Some a -> Some a -> Some a
appendSome (:) (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) Some TypeRep
b1 Some TypeRep
b2)

instance Monoid Request where
  mempty :: Request
mempty = Some TypeRep -> Request
Request forall a. Some a
S.None

{- | This class does 2 things:

- It lets us get a term-level list of 'TypeRep's from a type-level list of types, all of
  which have 'Typeable' instances.
- More impressively, its instances enforce that 'typeReps' will only type-check for type-level
  lists of length 2 or more. This is because 'AllTypeable' will only ever be used by
  'Servant.API.Routes.Request.allOfRequests', which is the only way to construct a
  'Many' @'Request' and thus lets us enforce the invariant that its list arguments will always
  have more than 1 element. This lets us make sure that there's only ever one way to represent a list of
  'TypeRep's using 'Request'.

  Of course, someone might import this Internal module and define a @'Typeable' a => 'AllTypeable' '[a]@
  instance. Don't do that.
-}
class AllTypeable (as :: [Type]) where
  typeReps :: [TypeRep]

instance (Typeable a, Typeable b) => AllTypeable '[a, b] where
  typeReps :: [TypeRep]
typeReps = [forall a. Typeable a => TypeRep
typeRepOf @a, forall a. Typeable a => TypeRep
typeRepOf @b]

instance (Typeable a, AllTypeable (b ': c ': as)) => AllTypeable (a ': b ': c ': as) where
  typeReps :: [TypeRep]
typeReps = forall a. Typeable a => TypeRep
typeRepOf @a forall a. a -> [a] -> [a]
: forall (as :: [*]). AllTypeable as => [TypeRep]
typeReps @(b ': c ': as)