module Serv.Api.Analysis where
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Singletons
import Data.Singletons.Prelude.List
import Data.Singletons.Prelude.Tuple
import Network.HTTP.Kinder.Header (HeaderName, SomeHeaderName (..))
import Network.HTTP.Kinder.Verb (Verb)
import Serv.Api
data EndpointAnalysis
= EndpointAnalysis
{ verbsHandled :: Set Verb
, headersExpected :: Set SomeHeaderName
, headersEmitted :: Set SomeHeaderName
}
instance Monoid EndpointAnalysis where
mempty = EndpointAnalysis mempty mempty mempty
mappend ea eb =
EndpointAnalysis
{ verbsHandled = verbsHandled ea <> verbsHandled eb
, headersExpected = headersExpected ea <> headersExpected eb
, headersEmitted = headersEmitted ea <> headersEmitted eb
}
inspectEndpoint :: forall (hs :: [Handler *]) . Sing hs -> EndpointAnalysis
inspectEndpoint s =
case s of
SNil -> mempty
SCons sHandler sRest -> inspectHandler sHandler <> inspectEndpoint sRest
inspectHandler :: forall (h :: Handler *) . Sing h -> EndpointAnalysis
inspectHandler s =
case s of
SCaptureQuery _ sNext -> inspectHandler sNext
SCaptureBody _ _ sNext -> inspectHandler sNext
SMethod sVerb sResponses ->
case sResponses of
SNil -> mempty
SCons (STuple2 _sCode (SRespond sHdrs _sBody)) sRest ->
EndpointAnalysis
{ verbsHandled = Set.singleton (fromSing sVerb)
, headersEmitted = headerNames sHdrs
, headersExpected = Set.empty
} <> inspectHandler (SMethod sVerb sRest)
SCaptureHeaders sHdrs sNext ->
EndpointAnalysis
{ verbsHandled = Set.empty
, headersEmitted = Set.empty
, headersExpected = headerNames sHdrs
}
<> inspectHandler sNext
headerNames :: forall (hts :: [(HeaderName, k)]) . Sing hts -> Set SomeHeaderName
headerNames s =
case s of
SNil -> Set.empty
SCons (STuple2 sHt _sTy) sRest ->
Set.insert (SomeHeaderName sHt) (headerNames sRest)
inspectVerbs :: forall (hs :: [Handler *]) . Sing hs -> Set Verb
inspectVerbs = verbsHandled . inspectEndpoint
headersExpectedOf :: forall (hs :: [Handler *]) . Sing hs -> Set SomeHeaderName
headersExpectedOf = headersExpected . inspectEndpoint