git.iko.soy/roboservant
on master help sign in
WIP
commit75ec6d3b0b47b08a8178eaba3da75efb40739ce2 authorMark Wotton <mwotton@gmail.com> dateWed 30 Dec 2020, 13:03 (6 years ago) parent3deefd6
7 files changed+27−13
compare with master
unifiedsplit
package.yaml+2−1 roboservant.cabal+2−1 src/Roboservant/Direct.hs+1 src/Roboservant/Types/FlattenServer.hs+6−5 stack.yaml+3−2 stack.yaml.lock+4−4 test/Spec.hs+9
package.yaml+2−1
@@ -1,3 +1,4 @@
1+
12name: roboservant
23version: 0.1.0.2
34github: "mwotton/roboservant"
@@ -62,5 +63,5 @@ tests:
6263 dependencies:
6364 - roboservant
6465 - hspec
65− build-depends: base, markdown-unlit
66+ # build-depends: base, markdown-unlit
6667 ghc-options: -pgmL markdown-unlit
roboservant.cabal+2−1
@@ -4,7 +4,7 @@ cabal-version: 1.12
44--
55-- see: https://github.com/sol/hpack
66--
7−-- hash: 8de468df6e784f3723af9155bba9da9f43659b7d4e8e465fdac26eafcb0d4306
7+-- hash: 1a4c7ba230ea0cde1208ffe68cfb5433046265dea94f292c81d73644caa87cd6
88
99name: roboservant
1010version: 0.1.0.2
@@ -101,6 +101,7 @@ test-suite roboservant-test
101101 Breakdown
102102 Foo
103103 Headers
104+ Nested
104105 Post
105106 Product
106107 Seeded
src/Roboservant/Direct.hs+1
@@ -9,6 +9,7 @@
99{-# LANGUAGE TypeApplications #-}
1010{-# LANGUAGE TypeFamilies #-}
1111{-# LANGUAGE UndecidableInstances #-}
12+{-# LANGUAGE PolyKinds #-}
1213
1314module Roboservant.Direct
1415 ( fuzz,
src/Roboservant/Types/FlattenServer.hs+6−5
@@ -19,9 +19,9 @@ class FlattenServer api where
1919 flattenServer :: Server api -> Bundled (Endpoints api)
2020
2121instance
22− ( Endpoints (endpoint :<|> api) ~ (endpoint ': Endpoints api),
23− Server (endpoint :<|> api) ~ (Server endpoint :<|> Server api),
24− FlattenServer api
22+ ( Endpoints (endpoint :<|> api) ~ (endpoint ': Endpoints api)
23+-- , Server (endpoint :<|> api) ~ (Server endpoint :<|> Server api)
24+ , FlattenServer api
2525 ) =>
2626 FlattenServer (endpoint :<|> api)
2727 where
@@ -36,8 +36,9 @@ instance
3636 flattenServer server = server `AnEndpoint` NoEndpoints
3737
3838instance
39− ( HasServer (Verb method statusCode contentTypes responseType) '[],
40− Endpoints (Verb method statusCode contentTypes responseType) ~ '[Verb method statusCode contentTypes responseType]
39+ ( Endpoints (Verb method statusCode contentTypes responseType) ~ '[Verb method statusCode contentTypes responseType],
40+ HasServer (Verb method statusCode contentTypes responseType) '[]
41+
4142 ) =>
4243 FlattenServer (Verb method statusCode contentTypes responseType)
4344 where
stack.yaml+3−2
@@ -1,5 +1,6 @@
1−# nb: 16.8 doesn't work because the version of servant is too old to have FoldLenient', fixme.
2−resolver: lts-16.16
1+resolver: lts-16.27
2+# bit faster on ReifiedApi stuff which is unfortunately terribly slow.
3+compiler: ghc-8.10.3
34packages:
45- .
56
stack.yaml.lock+4−4
@@ -69,7 +69,7 @@ packages:
6969 hackage: servant-server-0.18.2
7070snapshots:
7171- completed:
72− size: 532380
73− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/16.yaml
74− sha256: d6b004b095fe2a0b8b14fbc30014ee97e58843b9c9362ddb9244273dda62649e
75− original: lts-16.16
72+ size: 533252
73+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/27.yaml
74+ sha256: c2aaae52beeacf6a5727c1010f50e89d03869abfab6d2c2658ade9da8ed50c73
75+ original: lts-16.27
test/Spec.hs+9
@@ -13,6 +13,7 @@ import qualified Headers
1313import qualified Post
1414import qualified Product
1515import qualified Breakdown
16+import qualified Nested
1617
1718import Test.Hspec.Core.Spec(ResultStatus(Failure,Success),resultStatus,itemExample,FailureReason(Reason),mapSpecItem_)
1819import Data.Dynamic(toDyn)
@@ -91,6 +92,14 @@ spec = do
9192 RS.fuzz @Breakdown.SumApi Breakdown.sumServer defaultConfig noCheck
9293 >>= (`shouldSatisfy` serverFailure)
9394
95+ describe "flattening" $ do
96+ -- | we don't actually do much here, this is just here to document the appropriate response
97+ -- if you get a type error with a nested api.
98+ it "can handle nested apis" $ do
99+ RS.fuzz @(Nested.FlatApi) Nested.server defaultConfig { RS.coverageThreshold = 0.99 } noCheck
100+ >>= (`shouldSatisfy` isNothing)
101+
102+
94103
95104serverFailure :: Maybe RS.Report -> Bool
96105serverFailure = \case