{-# LANGUAGE DeriveAnyClass #-}

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

Simple representation of HTTP query params
-}
module Servant.API.Routes.Param
  ( Param
  , singleParam
  , arrayElemParam
  , flagParam
  , renderParam
  )
where

import Data.Aeson
import Data.Function (on)
import qualified Data.Text as T
import Data.Typeable
import GHC.Generics
import GHC.TypeLits
import "this" Servant.API.Routes.Utils
import qualified Servant.Links as S

{- | Newtype wrapper around servant's 'S.Param' so we can define a sensible
'Eq' instance for it.
-}
newtype Param = Param
  { Param -> Param
unParam :: S.Param
  }
  deriving (Int -> Param -> ShowS
[Param] -> ShowS
Param -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Param] -> ShowS
$cshowList :: [Param] -> ShowS
show :: Param -> String
$cshow :: Param -> String
showsPrec :: Int -> Param -> ShowS
$cshowsPrec :: Int -> Param -> ShowS
Show) via S.Param

instance Eq Param where
  == :: Param -> Param -> Bool
(==) = Param -> Param -> Bool
eq forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Param -> Param
unParam
    where
      S.SingleParam String
name1 Text
rep1 eq :: Param -> Param -> Bool
`eq` S.SingleParam String
name2 Text
rep2 =
        String
name1 forall a. Eq a => a -> a -> Bool
== String
name2 Bool -> Bool -> Bool
&& Text
rep1 forall a. Eq a => a -> a -> Bool
== Text
rep2
      S.ArrayElemParam String
name1 Text
rep1 `eq` S.ArrayElemParam String
name2 Text
rep2 =
        String
name1 forall a. Eq a => a -> a -> Bool
== String
name2 Bool -> Bool -> Bool
&& Text
rep1 forall a. Eq a => a -> a -> Bool
== Text
rep2
      S.FlagParam String
name1 `eq` S.FlagParam String
name2 =
        String
name1 forall a. Eq a => a -> a -> Bool
== String
name2
      Param
_ `eq` Param
_ = Bool
False

-- | Create a 'S.SingleParam' from a 'Symbol' and a 'TypeRep' via 'Typeable'.
singleParam :: forall s a. (KnownSymbol s, Typeable a) => Param
singleParam :: forall (s :: Symbol) a. (KnownSymbol s, Typeable a) => Param
singleParam = Param -> Param
Param (String -> Text -> Param
S.SingleParam String
name Text
rep)
  where
    rep :: Text
rep = forall a. Typeable a => Text
showTypeRep @a
    name :: String
name = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @s

-- | Create an 'S.ArrayParam' from a 'Symbol' and a 'TypeRep' via 'Typeable'.
arrayElemParam :: forall s a. (KnownSymbol s, Typeable a) => Param
arrayElemParam :: forall (s :: Symbol) a. (KnownSymbol s, Typeable a) => Param
arrayElemParam = Param -> Param
Param (String -> Text -> Param
S.ArrayElemParam String
name Text
rep)
  where
    rep :: Text
rep = forall a. Typeable a => Text
showTypeRep @a
    name :: String
name = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @s

-- | Create a 'S.FlagParam' from a 'Symbol'.
flagParam :: forall s. (KnownSymbol s) => Param
flagParam :: forall (s :: Symbol). KnownSymbol s => Param
flagParam = Param -> Param
Param (String -> Param
S.FlagParam String
name)
  where
    name :: String
name = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @s

data ParamType
  = SingleParam
  | ArrayElemParam
  | FlagParam
  deriving (Int -> ParamType -> ShowS
[ParamType] -> ShowS
ParamType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamType] -> ShowS
$cshowList :: [ParamType] -> ShowS
show :: ParamType -> String
$cshow :: ParamType -> String
showsPrec :: Int -> ParamType -> ShowS
$cshowsPrec :: Int -> ParamType -> ShowS
Show, ParamType -> ParamType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamType -> ParamType -> Bool
$c/= :: ParamType -> ParamType -> Bool
== :: ParamType -> ParamType -> Bool
$c== :: ParamType -> ParamType -> Bool
Eq, Int -> ParamType
ParamType -> Int
ParamType -> [ParamType]
ParamType -> ParamType
ParamType -> ParamType -> [ParamType]
ParamType -> ParamType -> ParamType -> [ParamType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ParamType -> ParamType -> ParamType -> [ParamType]
$cenumFromThenTo :: ParamType -> ParamType -> ParamType -> [ParamType]
enumFromTo :: ParamType -> ParamType -> [ParamType]
$cenumFromTo :: ParamType -> ParamType -> [ParamType]
enumFromThen :: ParamType -> ParamType -> [ParamType]
$cenumFromThen :: ParamType -> ParamType -> [ParamType]
enumFrom :: ParamType -> [ParamType]
$cenumFrom :: ParamType -> [ParamType]
fromEnum :: ParamType -> Int
$cfromEnum :: ParamType -> Int
toEnum :: Int -> ParamType
$ctoEnum :: Int -> ParamType
pred :: ParamType -> ParamType
$cpred :: ParamType -> ParamType
succ :: ParamType -> ParamType
$csucc :: ParamType -> ParamType
Enum, ParamType
forall a. a -> a -> Bounded a
maxBound :: ParamType
$cmaxBound :: ParamType
minBound :: ParamType
$cminBound :: ParamType
Bounded, forall x. Rep ParamType x -> ParamType
forall x. ParamType -> Rep ParamType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParamType x -> ParamType
$cfrom :: forall x. ParamType -> Rep ParamType x
Generic)
  deriving ([ParamType] -> Encoding
[ParamType] -> Value
ParamType -> Encoding
ParamType -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ParamType] -> Encoding
$ctoEncodingList :: [ParamType] -> Encoding
toJSONList :: [ParamType] -> Value
$ctoJSONList :: [ParamType] -> Value
toEncoding :: ParamType -> Encoding
$ctoEncoding :: ParamType -> Encoding
toJSON :: ParamType -> Value
$ctoJSON :: ParamType -> Value
ToJSON)

instance ToJSON Param where
  toJSON :: Param -> Value
toJSON (Param Param
p) =
    [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ case Param
p of
      S.SingleParam String
name Text
rep ->
        forall {a} {v}. (KeyValue a, ToJSON v) => v -> [a] -> [a]
withType ParamType
SingleParam [Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
name, Key
"param_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
rep]
      S.ArrayElemParam String
name Text
rep ->
        forall {a} {v}. (KeyValue a, ToJSON v) => v -> [a] -> [a]
withType ParamType
ArrayElemParam [Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
name, Key
"param_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
rep]
      S.FlagParam String
name ->
        forall {a} {v}. (KeyValue a, ToJSON v) => v -> [a] -> [a]
withType ParamType
FlagParam [Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
name]
    where
      withType :: v -> [a] -> [a]
withType v
t [a]
ps = (Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
t) forall a. a -> [a] -> [a]
: [a]
ps

-- | Pretty-print a 'Param'. Used by 'Servant.API.Routes.showRoute'.
renderParam :: Param -> T.Text
renderParam :: Param -> Text
renderParam (Param Param
param) = case Param
param of
  S.SingleParam String
var Text
typ -> String -> Text
T.pack String
var forall a. Semigroup a => a -> a -> a
<> Text
"=<" forall a. Semigroup a => a -> a -> a
<> Text
typ forall a. Semigroup a => a -> a -> a
<> Text
">"
  S.ArrayElemParam String
var Text
typ -> String -> Text
T.pack String
var forall a. Semigroup a => a -> a -> a
<> Text
"=<[" forall a. Semigroup a => a -> a -> a
<> Text
typ forall a. Semigroup a => a -> a -> a
<> Text
"]>"
  S.FlagParam String
var -> String -> Text
T.pack String
var