module Servant.Util.Stats
( methodsCoveringAPI
) where
import Universum
import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError)
import Network.HTTP.Types.Method (Method, StdMethod)
import Servant (EmptyAPI, Raw, ReflectMethod (..), Verb, (:<|>), (:>))
type family IsElemBool (x :: StdMethod) (l :: [StdMethod]) :: Bool where
IsElemBool x (x : _) = 'True
IsElemBool x (y : xs) = IsElemBool x xs
IsElemBool x '[] = 'False
type family FailOnDissallowedMethod (method :: StdMethod) (allowed :: Bool) :: Constraint where
FailOnDissallowedMethod _ 'True = ()
FailOnDissallowedMethod m 'False = TypeError
( 'Text "Method " ':$$: 'ShowType m ':$$: 'Text " is not allowed, but appears in API"
)
type family ContainsOnlyMethods (methods :: [StdMethod]) api :: Constraint where
ContainsOnlyMethods ms ((path :: Symbol) :> sub) = ContainsOnlyMethods ms sub
ContainsOnlyMethods ms (part :> sub) = ContainsOnlyMethods ms sub
ContainsOnlyMethods ms (api1 :<|> api2) = (ContainsOnlyMethods ms api1,
ContainsOnlyMethods ms api2)
ContainsOnlyMethods ms (Verb m _ _ _) = FailOnDissallowedMethod m (IsElemBool m ms)
ContainsOnlyMethods ms Raw = ()
ContainsOnlyMethods ms EmptyAPI = ()
class ReflectMethods (methods :: [StdMethod]) where
reflectMethods :: Proxy methods -> [Method]
instance ReflectMethods '[] where
reflectMethods :: Proxy '[] -> [Method]
reflectMethods Proxy '[]
_ = []
instance (ReflectMethod m, ReflectMethods ms) => ReflectMethods (m ': ms) where
reflectMethods :: Proxy (m : ms) -> [Method]
reflectMethods Proxy (m : ms)
_ = Proxy m -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod @m Proxy m
forall k (t :: k). Proxy t
Proxy Method -> [Method] -> [Method]
forall a. a -> [a] -> [a]
: Proxy ms -> [Method]
forall (methods :: [StdMethod]).
ReflectMethods methods =>
Proxy methods -> [Method]
reflectMethods @ms Proxy ms
forall k (t :: k). Proxy t
Proxy
methodsCoveringAPI
:: forall methods api.
(ContainsOnlyMethods methods api, ReflectMethods methods)
=> [Method]
methodsCoveringAPI :: [Method]
methodsCoveringAPI = Proxy methods -> [Method]
forall (methods :: [StdMethod]).
ReflectMethods methods =>
Proxy methods -> [Method]
reflectMethods @methods Proxy methods
forall k (t :: k). Proxy t
Proxy