{-# OPTIONS_HADDOCK not-home #-}

{- |
Module      : Servant.API.Routes.Internal.Header
Copyright   : (c) Frederick Pringle, 2025
License     : BSD-3-Clause
Maintainer  : frederick.pringle@fpringle.com

Internal module, subject to change.
-}
module Servant.API.Routes.Internal.Header
  ( HeaderRep (..)
  , mkHeaderRep
  , GetHeaderReps (..)
  )
where

import Data.Aeson
import Data.Kind (Type)
import Data.Text
import Data.Typeable
import GHC.TypeLits
import Servant.API
import "this" Servant.API.Routes.Utils

-- | Convenience function to construct a 'HeaderRep' from @sym :: 'Symbol'@ and @a :: Type'@.
mkHeaderRep ::
  forall sym a.
  (KnownSymbol sym, Typeable a) =>
  HeaderRep
mkHeaderRep :: forall (sym :: Symbol) a.
(KnownSymbol sym, Typeable a) =>
HeaderRep
mkHeaderRep =
  HeaderRep
    { _hName :: Text
_hName = forall (name :: Symbol). KnownSymbol name => Text
knownSymbolT @sym
    , _hType :: TypeRep
_hType = forall a. Typeable a => TypeRep
typeRepOf @a
    }

{- | Simple term-level representation of a 'Servant.API.Header.Header'.

A type-level @'Servant.API.Header.Header' (sym :: 'GHC.TypeLits.Symbol') typ@ should correspond to
@'HeaderRep' { _hName = str, _hType =  typRep }@, where @str@ is the term-level equivalent
of @sym@ and @typRep@ is the term-level representation of @typ@.
-}
data HeaderRep = HeaderRep
  { HeaderRep -> Text
_hName :: Text
  , HeaderRep -> TypeRep
_hType :: TypeRep
  }
  deriving (Int -> HeaderRep -> ShowS
[HeaderRep] -> ShowS
HeaderRep -> String
(Int -> HeaderRep -> ShowS)
-> (HeaderRep -> String)
-> ([HeaderRep] -> ShowS)
-> Show HeaderRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeaderRep -> ShowS
showsPrec :: Int -> HeaderRep -> ShowS
$cshow :: HeaderRep -> String
show :: HeaderRep -> String
$cshowList :: [HeaderRep] -> ShowS
showList :: [HeaderRep] -> ShowS
Show, HeaderRep -> HeaderRep -> Bool
(HeaderRep -> HeaderRep -> Bool)
-> (HeaderRep -> HeaderRep -> Bool) -> Eq HeaderRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeaderRep -> HeaderRep -> Bool
== :: HeaderRep -> HeaderRep -> Bool
$c/= :: HeaderRep -> HeaderRep -> Bool
/= :: HeaderRep -> HeaderRep -> Bool
Eq, Eq HeaderRep
Eq HeaderRep =>
(HeaderRep -> HeaderRep -> Ordering)
-> (HeaderRep -> HeaderRep -> Bool)
-> (HeaderRep -> HeaderRep -> Bool)
-> (HeaderRep -> HeaderRep -> Bool)
-> (HeaderRep -> HeaderRep -> Bool)
-> (HeaderRep -> HeaderRep -> HeaderRep)
-> (HeaderRep -> HeaderRep -> HeaderRep)
-> Ord HeaderRep
HeaderRep -> HeaderRep -> Bool
HeaderRep -> HeaderRep -> Ordering
HeaderRep -> HeaderRep -> HeaderRep
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HeaderRep -> HeaderRep -> Ordering
compare :: HeaderRep -> HeaderRep -> Ordering
$c< :: HeaderRep -> HeaderRep -> Bool
< :: HeaderRep -> HeaderRep -> Bool
$c<= :: HeaderRep -> HeaderRep -> Bool
<= :: HeaderRep -> HeaderRep -> Bool
$c> :: HeaderRep -> HeaderRep -> Bool
> :: HeaderRep -> HeaderRep -> Bool
$c>= :: HeaderRep -> HeaderRep -> Bool
>= :: HeaderRep -> HeaderRep -> Bool
$cmax :: HeaderRep -> HeaderRep -> HeaderRep
max :: HeaderRep -> HeaderRep -> HeaderRep
$cmin :: HeaderRep -> HeaderRep -> HeaderRep
min :: HeaderRep -> HeaderRep -> HeaderRep
Ord)

instance ToJSON HeaderRep where
  toJSON :: HeaderRep -> Value
toJSON HeaderRep {TypeRep
Text
_hName :: HeaderRep -> Text
_hType :: HeaderRep -> TypeRep
_hName :: Text
_hType :: TypeRep
..} =
    [Pair] -> Value
object
      [ Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
_hName
      , Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TypeRep -> Value
typeRepToJSON TypeRep
_hType
      ]

{- | Utility class to let us get a value-level list of 'HeaderRep's from a
type-level list of 'Servant.API.Header.Header's. See the implementation of
@'Servant.API.Route.HasRoutes' ('Verb' method status ctypes ('Headers' hs a))@ for an example.
-}
class GetHeaderReps (hs :: [Type]) where
  getHeaderReps :: [HeaderRep]

instance GetHeaderReps '[] where
  getHeaderReps :: [HeaderRep]
getHeaderReps = []

instance
  (GetHeaderReps rest, KnownSymbol h, Typeable v) =>
  GetHeaderReps (Header h v ': rest)
  where
  getHeaderReps :: [HeaderRep]
getHeaderReps = HeaderRep
header HeaderRep -> [HeaderRep] -> [HeaderRep]
forall a. a -> [a] -> [a]
: forall (hs :: [*]). GetHeaderReps hs => [HeaderRep]
getHeaderReps @rest
    where
      header :: HeaderRep
header = forall (sym :: Symbol) a.
(KnownSymbol sym, Typeable a) =>
HeaderRep
mkHeaderRep @h @v