mirror of
https://github.com/ilyakooo0/roboservant.git
synced 2024-09-11 08:05:47 +03:00
WIP
This commit is contained in:
parent
3deefd6139
commit
75ec6d3b0b
@ -1,3 +1,4 @@
|
||||
|
||||
name: roboservant
|
||||
version: 0.1.0.2
|
||||
github: "mwotton/roboservant"
|
||||
@ -62,5 +63,5 @@ tests:
|
||||
dependencies:
|
||||
- roboservant
|
||||
- hspec
|
||||
build-depends: base, markdown-unlit
|
||||
# build-depends: base, markdown-unlit
|
||||
ghc-options: -pgmL markdown-unlit
|
||||
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 8de468df6e784f3723af9155bba9da9f43659b7d4e8e465fdac26eafcb0d4306
|
||||
-- hash: 1a4c7ba230ea0cde1208ffe68cfb5433046265dea94f292c81d73644caa87cd6
|
||||
|
||||
name: roboservant
|
||||
version: 0.1.0.2
|
||||
@ -101,6 +101,7 @@ test-suite roboservant-test
|
||||
Breakdown
|
||||
Foo
|
||||
Headers
|
||||
Nested
|
||||
Post
|
||||
Product
|
||||
Seeded
|
||||
|
@ -9,6 +9,7 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
|
||||
module Roboservant.Direct
|
||||
( fuzz,
|
||||
|
@ -19,9 +19,9 @@ class FlattenServer api where
|
||||
flattenServer :: Server api -> Bundled (Endpoints api)
|
||||
|
||||
instance
|
||||
( Endpoints (endpoint :<|> api) ~ (endpoint ': Endpoints api),
|
||||
Server (endpoint :<|> api) ~ (Server endpoint :<|> Server api),
|
||||
FlattenServer api
|
||||
( Endpoints (endpoint :<|> api) ~ (endpoint ': Endpoints api)
|
||||
-- , Server (endpoint :<|> api) ~ (Server endpoint :<|> Server api)
|
||||
, FlattenServer api
|
||||
) =>
|
||||
FlattenServer (endpoint :<|> api)
|
||||
where
|
||||
@ -36,8 +36,9 @@ instance
|
||||
flattenServer server = server `AnEndpoint` NoEndpoints
|
||||
|
||||
instance
|
||||
( HasServer (Verb method statusCode contentTypes responseType) '[],
|
||||
Endpoints (Verb method statusCode contentTypes responseType) ~ '[Verb method statusCode contentTypes responseType]
|
||||
( Endpoints (Verb method statusCode contentTypes responseType) ~ '[Verb method statusCode contentTypes responseType],
|
||||
HasServer (Verb method statusCode contentTypes responseType) '[]
|
||||
|
||||
) =>
|
||||
FlattenServer (Verb method statusCode contentTypes responseType)
|
||||
where
|
||||
|
@ -1,5 +1,6 @@
|
||||
# nb: 16.8 doesn't work because the version of servant is too old to have FoldLenient', fixme.
|
||||
resolver: lts-16.16
|
||||
resolver: lts-16.27
|
||||
# bit faster on ReifiedApi stuff which is unfortunately terribly slow.
|
||||
compiler: ghc-8.10.3
|
||||
packages:
|
||||
- .
|
||||
|
||||
|
@ -69,7 +69,7 @@ packages:
|
||||
hackage: servant-server-0.18.2
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 532380
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/16.yaml
|
||||
sha256: d6b004b095fe2a0b8b14fbc30014ee97e58843b9c9362ddb9244273dda62649e
|
||||
original: lts-16.16
|
||||
size: 533252
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/27.yaml
|
||||
sha256: c2aaae52beeacf6a5727c1010f50e89d03869abfab6d2c2658ade9da8ed50c73
|
||||
original: lts-16.27
|
||||
|
@ -13,6 +13,7 @@ import qualified Headers
|
||||
import qualified Post
|
||||
import qualified Product
|
||||
import qualified Breakdown
|
||||
import qualified Nested
|
||||
|
||||
import Test.Hspec.Core.Spec(ResultStatus(Failure,Success),resultStatus,itemExample,FailureReason(Reason),mapSpecItem_)
|
||||
import Data.Dynamic(toDyn)
|
||||
@ -91,6 +92,14 @@ spec = do
|
||||
RS.fuzz @Breakdown.SumApi Breakdown.sumServer defaultConfig noCheck
|
||||
>>= (`shouldSatisfy` serverFailure)
|
||||
|
||||
describe "flattening" $ do
|
||||
-- | we don't actually do much here, this is just here to document the appropriate response
|
||||
-- if you get a type error with a nested api.
|
||||
it "can handle nested apis" $ do
|
||||
RS.fuzz @(Nested.FlatApi) Nested.server defaultConfig { RS.coverageThreshold = 0.99 } noCheck
|
||||
>>= (`shouldSatisfy` isNothing)
|
||||
|
||||
|
||||
|
||||
serverFailure :: Maybe RS.Report -> Bool
|
||||
serverFailure = \case
|
||||
|
Loading…
Reference in New Issue
Block a user