{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Test.Encoding.Routes (tests, IsApi (..)) where
import qualified Data.List.NonEmpty as NonEmpty
import Data.Proxy (Proxy (Proxy))
import qualified Data.Semigroup
import qualified Data.Typeable as Typeable
import qualified Debug
import qualified Examples
import qualified Expect
import GHC.TypeLits (KnownSymbol, symbolVal)
import qualified List
import NriPrelude
import qualified Servant
import Servant.API
( Capture',
Header,
QueryFlag,
Raw,
ReqBody',
Summary,
Verb,
(:<|>),
(:>),
)
import Servant.API.Generic (ToServantApi)
import qualified Servant.Auth.Server
import Test (Test, describe, test)
import qualified Test.Encoding
import qualified Text
tests :: forall routes. IsApi (ToServantApi routes) => Proxy routes -> List Test
tests :: Proxy routes -> List Test
tests Proxy routes
_ =
let routes :: [Route]
routes = Proxy (GToServant (Rep (routes AsApi))) -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy (GToServant (Rep (routes AsApi)))
forall k (t :: k). Proxy t
Proxy :: Proxy (ToServantApi routes))
in [ HasCallStack => Text -> (() -> Expectation) -> Test
Text -> (() -> Expectation) -> Test
test Text
"route types haven't changed" ((() -> Expectation) -> Test) -> (() -> Expectation) -> Test
forall a b. (a -> b) -> a -> b
<| \() ->
[Route]
routes
[Route] -> ([Route] -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> [Route] -> Text
routesToText
Text -> (Text -> Expectation) -> Expectation
forall a b. a -> (a -> b) -> b
|> HasCallStack => Text -> Text -> Expectation
Text -> Text -> Expectation
Expect.equalToContentsOf Text
"test/golden-results/route-types.json",
Text -> List Test -> Test
describe
Text
"encodings of custom types"
( [Route]
routes
[Route]
-> ([Route] -> List (Route, Examples)) -> List (Route, Examples)
forall a b. a -> (a -> b) -> b
|> [Route] -> List (Route, Examples)
routesWithExamples
List (Route, Examples)
-> (List (Route, Examples) -> List Test) -> List Test
forall a b. a -> (a -> b) -> b
|> ((Route, Examples) -> Test) -> List (Route, Examples) -> List Test
forall a b. (a -> b) -> List a -> List b
List.map
( \(Route
route, Examples
examples) ->
Text -> Text -> Examples -> Test
Test.Encoding.examplesToTest (Text
"Examples for route `" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Route -> Text
routeName Route
route Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"`") (Route -> Text
routeToFileName Route
route) Examples
examples
)
)
]
data Route = Route
{ Route -> [Text]
path :: [Text],
Route -> Text
method :: Text,
:: [(Text, SomeType)],
Route -> Maybe SomeType
requestBody :: Maybe SomeType,
Route -> SomeType
responseBody :: SomeType
}
data SomeType where
SomeType :: (Typeable.Typeable t, Examples.HasExamples t) => Proxy t -> SomeType
routesWithExamples :: List Route -> List (Route, Examples.Examples)
routesWithExamples :: [Route] -> List (Route, Examples)
routesWithExamples [Route]
routes =
[Route]
routes
[Route]
-> ([Route] -> List (Route, Examples)) -> List (Route, Examples)
forall a b. a -> (a -> b) -> b
|> (Route -> (Route, Examples)) -> [Route] -> List (Route, Examples)
forall a b. (a -> b) -> List a -> List b
List.map
( \route :: Route
route@Route {Maybe SomeType
requestBody :: Maybe SomeType
requestBody :: Route -> Maybe SomeType
requestBody, SomeType
responseBody :: SomeType
responseBody :: Route -> SomeType
responseBody, [(Text, SomeType)]
headers :: [(Text, SomeType)]
headers :: Route -> [(Text, SomeType)]
headers} ->
( Route
route,
case (Maybe SomeType
requestBody, SomeType
responseBody) of
(Maybe SomeType
Nothing, SomeType Proxy t
t) ->
((Text, SomeType) -> Examples)
-> [(Text, SomeType)] -> List Examples
forall a b. (a -> b) -> List a -> List b
List.map (Text, SomeType) -> Examples
forall a. (a, SomeType) -> Examples
headersToExamples [(Text, SomeType)]
headers
List Examples
-> (List Examples -> NonEmpty Examples) -> NonEmpty Examples
forall a b. a -> (a -> b) -> b
|> Examples -> List Examples -> NonEmpty Examples
forall a. a -> [a] -> NonEmpty a
(NonEmpty.:|) (Proxy t -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
Examples.examples Proxy t
t)
NonEmpty Examples -> (NonEmpty Examples -> Examples) -> Examples
forall a b. a -> (a -> b) -> b
|> NonEmpty Examples -> Examples
forall a. Semigroup a => NonEmpty a -> a
Data.Semigroup.sconcat
(Just (SomeType Proxy t
s), SomeType Proxy t
t) ->
((Text, SomeType) -> Examples)
-> [(Text, SomeType)] -> List Examples
forall a b. (a -> b) -> List a -> List b
List.map (Text, SomeType) -> Examples
forall a. (a, SomeType) -> Examples
headersToExamples [(Text, SomeType)]
headers
List Examples
-> (List Examples -> NonEmpty Examples) -> NonEmpty Examples
forall a b. a -> (a -> b) -> b
|> Examples -> List Examples -> NonEmpty Examples
forall a. a -> [a] -> NonEmpty a
(NonEmpty.:|) (Proxy t -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
Examples.examples Proxy t
s Examples -> Examples -> Examples
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Proxy t -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
Examples.examples Proxy t
t)
NonEmpty Examples -> (NonEmpty Examples -> Examples) -> Examples
forall a b. a -> (a -> b) -> b
|> NonEmpty Examples -> Examples
forall a. Semigroup a => NonEmpty a -> a
Data.Semigroup.sconcat
)
)
where
headersToExamples :: (a, SomeType) -> Examples
headersToExamples (a
_, SomeType Proxy t
t) = Proxy t -> Examples
forall k (t :: k). HasExamples t => Proxy t -> Examples
Examples.examples Proxy t
t
routeName :: Route -> Text
routeName :: Route -> Text
routeName Route
route =
Text -> [Text] -> Text
Text.join Text
" " [Route -> Text
method Route
route, Text -> [Text] -> Text
Text.join Text
"/" (Route -> [Text]
path Route
route)]
routeToFileName :: Route -> Text
routeToFileName :: Route -> Text
routeToFileName Route
route =
Route -> Text
method Route
route Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"-" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text -> [Text] -> Text
Text.join Text
"-" (Route -> [Text]
path Route
route) Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
".json"
routesToText :: List Route -> Text
routesToText :: [Route] -> Text
routesToText [Route]
routes =
[Route]
routes
[Route] -> ([Route] -> List (Maybe Text)) -> List (Maybe Text)
forall a b. a -> (a -> b) -> b
|> (Route -> List (Maybe Text)) -> [Route] -> List (Maybe Text)
forall a b. (a -> List b) -> List a -> List b
List.concatMap
( \Route
route ->
[ case Route -> [(Text, SomeType)]
headers Route
route of
[] -> Maybe Text
forall a. Maybe a
Nothing
[(Text, SomeType)]
headers' ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
(Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
<| Text -> [Text] -> Text
Text.join
Text
" "
( Route -> Text
routeName Route
route Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
Text
"headers" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
((Text, SomeType) -> Text) -> [(Text, SomeType)] -> [Text]
forall a b. (a -> b) -> List a -> List b
List.map (Text, SomeType) -> Text
printHeaders [(Text, SomeType)]
headers'
),
Text -> Maybe Text
forall a. a -> Maybe a
Just
(Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
<| Text -> [Text] -> Text
Text.join
Text
" "
[ Route -> Text
routeName Route
route,
Text
"response",
SomeType -> Text
printType (Route -> SomeType
responseBody Route
route)
],
case Route -> Maybe SomeType
requestBody Route
route of
Maybe SomeType
Nothing -> Maybe Text
forall a. Maybe a
Nothing
Just SomeType
body ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
(Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
<| Text -> [Text] -> Text
Text.join
Text
" "
[ Route -> Text
routeName Route
route,
Text
"request",
SomeType -> Text
printType SomeType
body
]
]
)
List (Maybe Text) -> (List (Maybe Text) -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
|> (Maybe Text -> Maybe Text) -> List (Maybe Text) -> [Text]
forall a b. (a -> Maybe b) -> List a -> List b
List.filterMap Maybe Text -> Maybe Text
forall a. a -> a
identity
[Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
|> [Text] -> [Text]
forall a. Ord a => List a -> List a
List.sort
[Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> [Text] -> Text
Text.join Text
"\n"
printHeaders :: (Text, SomeType) -> Text
(Text
key, SomeType
val) =
Text
"(" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
", " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ SomeType -> Text
printType SomeType
val Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
")"
printType :: SomeType -> Text
printType :: SomeType -> Text
printType (SomeType Proxy t
t) =
Proxy t -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep Proxy t
t
TypeRep -> (TypeRep -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> TypeRep -> Text
forall a. Show a => a -> Text
Debug.toString
class IsApi a where
crawl :: Proxy a -> [Route]
instance (IsApi a, IsApi b) => IsApi (a :<|> b) where
crawl :: Proxy (a :<|> b) -> [Route]
crawl Proxy (a :<|> b)
_ = Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) [Route] -> [Route] -> [Route]
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Proxy b -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)
instance (KnownSymbol s, IsApi a) => IsApi (s :> a) where
crawl :: Proxy (s :> a) -> [Route]
crawl Proxy (s :> a)
_ =
Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
[Route] -> ([Route] -> [Route]) -> [Route]
forall a b. a -> (a -> b) -> b
|> (Route -> Route) -> [Route] -> [Route]
forall a b. (a -> b) -> List a -> List b
List.map
( \Route
route ->
Route
route
{ path :: [Text]
path =
List Char -> Text
Text.fromList (Proxy s -> List Char
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> List Char
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
Route -> [Text]
path Route
route
}
)
instance (KnownSymbol s, IsApi a) => IsApi (Capture' mods s paramType :> a) where
crawl :: Proxy (Capture' mods s paramType :> a) -> [Route]
crawl Proxy (Capture' mods s paramType :> a)
_ =
Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
[Route] -> ([Route] -> [Route]) -> [Route]
forall a b. a -> (a -> b) -> b
|> (Route -> Route) -> [Route] -> [Route]
forall a b. (a -> b) -> List a -> List b
List.map
( \Route
route ->
Route
route
{ path :: [Text]
path = (Text
":" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ List Char -> Text
Text.fromList (Proxy s -> List Char
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> List Char
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s))) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Route -> [Text]
path Route
route
}
)
instance
(Typeable.Typeable method, Typeable.Typeable body, Examples.HasExamples body) =>
IsApi (Verb method status encodings body)
where
crawl :: Proxy (Verb method status encodings body) -> [Route]
crawl Proxy (Verb method status encodings body)
_ =
[ Route :: [Text]
-> Text
-> [(Text, SomeType)]
-> Maybe SomeType
-> SomeType
-> Route
Route
{ path :: [Text]
path = [],
headers :: [(Text, SomeType)]
headers = [],
requestBody :: Maybe SomeType
requestBody = Maybe SomeType
forall a. Maybe a
Nothing,
method :: Text
method =
Proxy method -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
TypeRep -> (TypeRep -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> TypeRep -> Text
forall a. Show a => a -> Text
Debug.toString,
responseBody :: SomeType
responseBody = Proxy body -> SomeType
forall k (t :: k).
(Typeable t, HasExamples t) =>
Proxy t -> SomeType
SomeType (Proxy body
forall k (t :: k). Proxy t
Proxy :: Proxy body)
}
]
instance (IsApi a) => IsApi (Servant.Auth.Server.Auth types user :> a) where
crawl :: Proxy (Auth types user :> a) -> [Route]
crawl Proxy (Auth types user :> a)
_ = Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance IsApi Raw where
crawl :: Proxy Raw -> [Route]
crawl Proxy Raw
_ = []
instance (IsApi a) => IsApi (QueryFlag flag :> a) where
crawl :: Proxy (QueryFlag flag :> a) -> [Route]
crawl Proxy (QueryFlag flag :> a)
_ = Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance (Typeable.Typeable body, Examples.HasExamples body, IsApi a) => IsApi (ReqBody' x encodings body :> a) where
crawl :: Proxy (ReqBody' x encodings body :> a) -> [Route]
crawl Proxy (ReqBody' x encodings body :> a)
_ =
Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
[Route] -> ([Route] -> [Route]) -> [Route]
forall a b. a -> (a -> b) -> b
|> (Route -> Route) -> [Route] -> [Route]
forall a b. (a -> b) -> List a -> List b
List.map
( \Route
route ->
Route
route
{ requestBody :: Maybe SomeType
requestBody = SomeType -> Maybe SomeType
forall a. a -> Maybe a
Just (Proxy body -> SomeType
forall k (t :: k).
(Typeable t, HasExamples t) =>
Proxy t -> SomeType
SomeType (Proxy body
forall k (t :: k). Proxy t
Proxy :: Proxy body))
}
)
instance
( KnownSymbol key,
Typeable.Typeable val,
Examples.HasExamples val,
IsApi a
) =>
IsApi (Header key val :> a)
where
crawl :: Proxy (Header key val :> a) -> [Route]
crawl Proxy (Header key val :> a)
_ =
Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
[Route] -> ([Route] -> [Route]) -> [Route]
forall a b. a -> (a -> b) -> b
|> (Route -> Route) -> [Route] -> [Route]
forall a b. (a -> b) -> List a -> List b
List.map
( \Route
route ->
Route
route
{ headers :: [(Text, SomeType)]
headers =
( List Char -> Text
Text.fromList (Proxy key -> List Char
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> List Char
symbolVal (Proxy key
forall k (t :: k). Proxy t
Proxy :: Proxy key)),
Proxy val -> SomeType
forall k (t :: k).
(Typeable t, HasExamples t) =>
Proxy t -> SomeType
SomeType (Proxy val
forall k (t :: k). Proxy t
Proxy :: Proxy val)
) (Text, SomeType) -> [(Text, SomeType)] -> [(Text, SomeType)]
forall a. a -> [a] -> [a]
:
Route -> [(Text, SomeType)]
headers Route
route
}
)
instance (IsApi a) => IsApi (Summary x :> a) where
crawl :: Proxy (Summary x :> a) -> [Route]
crawl Proxy (Summary x :> a)
_ = Proxy a -> [Route]
forall k (a :: k). IsApi a => Proxy a -> [Route]
crawl (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance Examples.HasExamples Servant.NoContent where
examples :: Proxy NoContent -> Examples
examples Proxy NoContent
_ = Text -> () -> Examples
forall a. ToJSON a => Text -> a -> Examples
Examples.example Text
"NoContent" ()