WIP

package.yaml

@@ -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

roboservant.cabal

@@ -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

src/Roboservant/Direct.hs

@@ -9,6 +9,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE PolyKinds #-}
 
 module Roboservant.Direct
   ( fuzz,

src/Roboservant/Types/FlattenServer.hs

@@ -19,9 +19,9 @@ class FlattenServer api where
   flattenServer :: Server api -> Bundled (Endpoints api)
 
 instance
-  ( Endpoints (endpoint :<|> api) ~ (endpoint ': Endpoints api),
+  ( Endpoints (endpoint :<|> api) ~ (endpoint ': Endpoints api)
-    Server (endpoint :<|> api) ~ (Server endpoint :<|> Server api),
+--  , Server (endpoint :<|> api) ~ (Server endpoint :<|> Server api)
-    FlattenServer 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

stack.yaml

@@ -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.27
-resolver: lts-16.16
+# bit faster on ReifiedApi stuff which is unfortunately terribly slow.
+compiler: ghc-8.10.3
 packages:
 - .
 

stack.yaml.lock

@@ -69,7 +69,7 @@ packages:
     hackage: servant-server-0.18.2
 snapshots:
 - completed:
-    size: 532380
+    size: 533252
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/16.yaml
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/27.yaml
-    sha256: d6b004b095fe2a0b8b14fbc30014ee97e58843b9c9362ddb9244273dda62649e
+    sha256: c2aaae52beeacf6a5727c1010f50e89d03869abfab6d2c2658ade9da8ed50c73
-  original: lts-16.16
+  original: lts-16.27

test/Spec.hs

@@ -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