018ff13 · roboservant · git.iko.soy

git.iko.soy/roboservant

on master help sign in

Merge pull request #17 from mwotton/servant-client

018ff13Mark Wotton6 years ago

EXAMPLE.md+40−3

compare with master

unifiedsplit

@@ -13,23 +13,37 @@ Our api under test:

13{-# LANGUAGE DeriveGeneric #-}

14{-# LANGUAGE GeneralizedNewtypeDeriving #-}

15{-# LANGUAGE RecordWildCards #-}

16+{-# LANGUAGE ScopedTypeVariables #-}

17+{-# LANGUAGE TypeApplications #-}

17−import Roboservant

19+import qualified Roboservant.Server as RS

20+import qualified Roboservant.Client as RC

21+import Servant.Client(ClientEnv, baseUrlPort, parseBaseUrl, mkClientEnv)

22+import Network.HTTP.Client (newManager, defaultManagerSettings)

23+import Roboservant.Types

18import Test.Hspec

24import Test.Hspec

19import Servant

25import Servant

20import GHC.Generics

26import GHC.Generics

21import Data.Typeable

27import Data.Typeable

22import Data.Hashable

28import Data.Hashable

23import Data.Maybe(isNothing, isJust)

29import Data.Maybe(isNothing, isJust)

30+import qualified Network.Wai.Handler.Warp as Warp

31+import Data.Aeson(FromJSON,ToJSON)

25newtype A = A Int

33newtype A = A Int

26 deriving (Generic, Eq, Show, Typeable)

34 deriving (Generic, Eq, Show, Typeable)

27 deriving newtype (Hashable, FromHttpApiData, ToHttpApiData)

35 deriving newtype (Hashable, FromHttpApiData, ToHttpApiData)

37+instance FromJSON A

38+instance ToJSON A

39+

29newtype B = B Int

40newtype B = B Int

30 deriving (Generic, Eq, Show, Typeable)

41 deriving (Generic, Eq, Show, Typeable)

31 deriving newtype (Hashable, FromHttpApiData, ToHttpApiData)

42 deriving newtype (Hashable, FromHttpApiData, ToHttpApiData)

44+instance FromJSON B

45+instance ToJSON B

46+

33type Api =

47type Api =

34 "item" :> Get '[JSON] A

48 "item" :> Get '[JSON] A

35 :<|> "itemAdd" :> Capture "one" B :> Capture "two" B :> Get '[JSON] B

49 :<|> "itemAdd" :> Capture "one" B :> Capture "two" B :> Get '[JSON] B

@@ -62,13 +76,24 @@ main = hspec spec

62spec :: Spec

76spec :: Spec

63spec = describe "example" $ do

77spec = describe "example" $ do

64 it "good server should not fail" $ do

78 it "good server should not fail" $ do

65− fuzz @Api goodServer config

79+ RS.fuzz @Api goodServer config

66 >>= (`shouldSatisfy` isNothing)

80 >>= (`shouldSatisfy` isNothing)

67 it "bad server should fail" $ do

81 it "bad server should fail" $ do

68− fuzz @Api badServer config

82+ RS.fuzz @Api badServer config

69 >>= (`shouldSatisfy` isJust)

83 >>= (`shouldSatisfy` isJust)

70```

84```

86+The previous test just picked apart the server and ran functions manually: sometimes, we want to test via

87+an honest-to-goodness network port, like so:

88+

89+```haskell

90+ around (withServer (serve (Proxy :: Proxy Api) badServer)) $ do

91+ it "we should also be able to run the _client_ to an independent server (ignore server error messages)" $ \(clientEnv::ClientEnv) -> do

92+ RC.fuzz @Api clientEnv config >>= (`shouldSatisfy` isJust)

93+```

94+

95+(we use withApplication rather than testWithApplication because we don't primarily care what the server does here:

96+we want to check what a client does when presented with a faulty server.)

73We expect to be able to cover the whole api from our starting point, so let's set the coverage to 0.99.

98We expect to be able to cover the whole api from our starting point, so let's set the coverage to 0.99.

74There are other tweakable things in the config, like maximum runtime, reps,

99There are other tweakable things in the config, like maximum runtime, reps,

@@ -104,3 +129,15 @@ build it up from components.

104deriving via (Compound B) instance BuildFrom B

129deriving via (Compound B) instance BuildFrom B

105deriving via (Atom B) instance Breakdown B

130deriving via (Atom B) instance Breakdown B

106```

131```

132+

133+

134+test utilities:

135+

136+``` haskell

137+withServer :: Application -> ActionWith ClientEnv -> IO ()

138+withServer app action = Warp.withApplication (pure app) (\p -> genClientEnv p >>= action)

139+ where genClientEnv port = do

140+ baseUrl <- parseBaseUrl "http://localhost"

141+ manager <- newManager defaultManagerSettings

142+ pure $ mkClientEnv manager (baseUrl { baseUrlPort = port })

143+```

Makefile+1−1

@@ -1,4 +1,4 @@

1testwatch:

2− ghcid -T main -c 'stack repl --test --ghc-options=-fobject-code' --allow-eval --restart="stack.yaml" --restart="package.yaml" -W

2+ ghcid -T main -c 'stack repl roboservant:lib roboservant:test:roboservant-test --test --ghc-options=-fobject-code' --allow-eval --restart="stack.yaml" --restart="package.yaml" -W

3pedanticwatch:

4 ghcid -c 'stack repl --test --ghc-options=-fobject-code' --allow-eval --restart="stack.yaml" --restart="package.yaml" -W

benchmarks/genFile.sh+15−2

@@ -1,9 +1,11 @@

1n=$1

2+k=$2

3cat prelude

4cat prelude

4−echo -n "type Api = \"route1\" :> ReqBody '[JSON] Input :> Post '[JSON] Output"

5+echo -n "type SubApi = \"route1\" :> ReqBody '[JSON] Input :> Post '[JSON] Output"

5for i in $(seq 2 $n); do

6for i in $(seq 2 $n); do

7+ echo -n " :<|> \"route${i}\" :> "

6− echo " :<|> \"route${i}\" :> ReqBody '[JSON] Input :> Post '[JSON] Output"

8+ echo "ReqBody '[JSON] Input :> Post '[JSON] Output"

7done

9done

9echo -n "server = handler "

11echo -n "server = handler "

@@ -11,3 +13,14 @@ echo -n "server = handler "

11for i in $(seq 2 $n); do

13for i in $(seq 2 $n); do

12 echo -n ":<|> handler "

14 echo -n ":<|> handler "

13done

15done

16+echo

17+echo

18+

19+echo -n "type Api = Flatten ("

20+for i in $(seq 1 $k); do

21+ echo -n '"foo" :> '

22+done;

23+

24+echo "SubApi )"

25+

26+

benchmarks/prelude+7−16

@@ -12,6 +12,7 @@ import Servant

12import Data.Hashable

13import GHC.Generics

14import Data.Aeson

15+import Servant.API.Flatten

16data Input = Input1 { foo :: String }

17data Input = Input1 { foo :: String }

17 | Input2 { bar :: Int }

18 | Input2 { bar :: Int }

@@ -52,19 +53,9 @@ handler = pure . \case

52 Input1 foo -> Output1 foo

53 Input1 foo -> Output1 foo

53 Input2 bar -> Output2 bar

54 Input2 bar -> Output2 bar

56+main =

55−main = fuzz @Api server defaultConfig (pure ())

57+ -- fuzz @Api server defaultConfig

56−

58+ pure ()

57−defaultConfig :: Config

59+

58−defaultConfig = Config {

60+f = flatten (Proxy @Api)

59− -- you can pass extra values in using the seed argument. This can be useful

61+

60− -- for things that might not be produceable within the api, like auth tokens.

61− seed = [hashedDyn "blah"]

62− , maxRuntime = 0.5

63− -- if we get to 1000 interactions with the api, call it quits.

64− , maxReps = 1000

65− -- if you're using this inside quickcheck or hedgehog, you might want to set this

66− -- from their seed to make sure it stays deterministic

67− , rngSeed = 0

68− -- 0 to 100: fail tests if we hit less than this percentage of endpoints.

69− , coverageThreshold = 0

70− }

benchmarks/runTiming.sh+2−2

@@ -1,8 +1,8 @@

1lo=$1

2hi=$2

3−

3+k=$3

4for i in $(seq $lo 5 $hi); do

5− ./genFile.sh $i > main.hs;

5+ ./genFile.sh $i $k > main.hs;

6 echo "sievedn: $i,";

7 /usr/bin/time -f "%e" stack ghc main.hs 2>&1;

8# /usr/bin/time -f "%e" stack ghc -- -fomit-interface-pragmas main.hs 2>&1;

package.yaml+8−1

@@ -55,7 +55,10 @@ tests:

55 - hspec

56 - hspec-core

57 - http-api-data

58−

58+ - http-client

59+ - hspec-wai

60+ - wai

61+ - warp

59 example:

62 example:

60 main: Example.lhs

63 main: Example.lhs

61 source-dirs: .

64 source-dirs: .

@@ -63,6 +66,10 @@ tests:

63 dependencies:

66 dependencies:

64 - roboservant

67 - roboservant

65 - hspec

68 - hspec

69+ - warp

70+ - http-client

71+ - aeson

72+ - hspec-core

66 ghc-options: -pgmL markdown-unlit

73 ghc-options: -pgmL markdown-unlit

68 build-tools: markdown-unlit

75 build-tools: markdown-unlit

roboservant.cabal+13−3

@@ -4,7 +4,7 @@ cabal-version: 1.12

4--

5-- see: https://github.com/sol/hpack

6--

7−-- hash: 48773018ec618e9eba02a126e3aeb93781a1d68ce28e2c405c35e9536bf94f70

7+-- hash: 4c71b6b9460f4719791bb8e67f4a5398b807cd8d17c43dc69da806bb5ba9fb4b

9name: roboservant

10version: 0.1.0.2

@@ -28,14 +28,16 @@ source-repository head

28library

29 exposed-modules:

30 Roboservant

31+ Roboservant.Client

31 Roboservant.Direct

32 Roboservant.Direct

33+ Roboservant.Server

32 Roboservant.Types

34 Roboservant.Types

33 Roboservant.Types.Breakdown

35 Roboservant.Types.Breakdown

34 Roboservant.Types.BuildFrom

36 Roboservant.Types.BuildFrom

35 Roboservant.Types.Config

37 Roboservant.Types.Config

36− Roboservant.Types.FlattenServer

37 Roboservant.Types.Internal

38 Roboservant.Types.Internal

38 Roboservant.Types.ReifiedApi

39 Roboservant.Types.ReifiedApi

40+ Roboservant.Types.ReifiedApi.Server

39 other-modules:

41 other-modules:

40 Paths_roboservant

42 Paths_roboservant

41 hs-source-dirs:

43 hs-source-dirs:

@@ -74,13 +76,16 @@ test-suite example

74 build-tool-depends:

76 build-tool-depends:

75 markdown-unlit:markdown-unlit

77 markdown-unlit:markdown-unlit

76 build-depends:

78 build-depends:

79+ aeson

77− base >=4.7 && <5

80+ , base >=4.7 && <5

78 , bytestring

81 , bytestring

79 , containers

82 , containers

80 , dependent-map

83 , dependent-map

81 , dependent-sum

84 , dependent-sum

82 , hashable

85 , hashable

83 , hspec

86 , hspec

87+ , hspec-core

88+ , http-client

84 , lifted-base

89 , lifted-base

85 , monad-control

90 , monad-control

86 , mtl

91 , mtl

@@ -95,6 +100,7 @@ test-suite example

95 , time

100 , time

96 , unordered-containers

101 , unordered-containers

97 , vinyl

102 , vinyl

103+ , warp

98 default-language: Haskell2010

104 default-language: Haskell2010

105

100test-suite roboservant-test

106test-suite roboservant-test

@@ -124,7 +130,9 @@ test-suite roboservant-test

124 , hashable

130 , hashable

125 , hspec

131 , hspec

126 , hspec-core

132 , hspec-core

133+ , hspec-wai

127 , http-api-data

134 , http-api-data

135+ , http-client

128 , lifted-base

136 , lifted-base

129 , monad-control

137 , monad-control

130 , mtl

138 , mtl

@@ -139,4 +147,6 @@ test-suite roboservant-test

139 , time

147 , time

140 , unordered-containers

148 , unordered-containers

141 , vinyl

149 , vinyl

150+ , wai

151+ , warp

142 default-language: Haskell2010

152 default-language: Haskell2010

src/Roboservant/Client.hsnew file+119

@@ -0,0 +1,119 @@

1+{-# LANGUAGE RankNTypes #-}

2+{-# LANGUAGE TypeOperators #-}

3+{-# LANGUAGE DataKinds #-}

4+{-# LANGUAGE AllowAmbiguousTypes #-}

5+{-# LANGUAGE DataKinds #-}

6+{-# LANGUAGE GADTs #-}

7+{-# LANGUAGE PolyKinds #-}

8+{-# LANGUAGE ScopedTypeVariables #-}

9+{-# LANGUAGE TypeApplications #-}

10+{-# LANGUAGE TypeOperators #-}

11+{-# LANGUAGE UndecidableInstances #-}

12+{-# LANGUAGE TypeFamilies #-}

13+{-# LANGUAGE FlexibleContexts #-}

14+-- should all the NormalizeFunction instances be in one place?

15+{-# OPTIONS_GHC -fno-warn-orphans #-}

16+module Roboservant.Client where

17+

18+import Data.Proxy

19+import Servant.Client

20+import Roboservant.Types

21+import Roboservant(Report, fuzz')

22+import Servant

23+import Data.Bifunctor

24+import Data.List.NonEmpty (NonEmpty)

25+import Data.Dynamic (Dynamic,Typeable)

26+import qualified Data.Vinyl.Curry as V

27+import qualified Data.Text as T

28+import Control.Monad.Reader

29+import Data.Hashable

30+

31+-- fuzz :: forall api.

32+-- (FlattenServer api, ToReifiedApi (Endpoints api)) =>

33+-- Server api ->

34+-- Config ->

35+-- IO (Maybe Report)

36+-- fuzz s = fuzz' (reifyServer s)

37+-- -- todo: how do we pull reifyServer out?

38+-- where reifyServer :: (FlattenServer api, ToReifiedApi (Endpoints api))

39+-- => Server api -> ReifiedApi

40+-- reifyServer server = toReifiedApi (flattenServer @api server) (Proxy @(Endpoints api))

41+

42+fuzz :: forall api . (ToReifiedClientApi (Endpoints api), FlattenClient api, HasClient ClientM api)

43+ => ClientEnv -> Config -> IO (Maybe Report)

44+fuzz clientEnv

45+ = fuzz'

46+ (toReifiedClientApi

47+ (flattenClient @api apiClient) (Proxy @(Endpoints api)) clientEnv)

48+ where apiClient = client (Proxy @api)

49+

50+

51+

52+class ToReifiedClientApi api where

53+ toReifiedClientApi :: ClientBundled api -> Proxy api -> ClientEnv -> ReifiedApi

54+

55+data ClientBundled endpoints where

56+ AClientEndpoint :: Client ClientM endpoint -> ClientBundled endpoints -> ClientBundled (endpoint ': endpoints)

57+ NoClientEndpoints :: ClientBundled '[]

58+

59+

60+class FlattenClient api where

61+ flattenClient :: Client ClientM api -> ClientBundled (Endpoints api)

62+

63+instance

64+ ( NormalizeFunction (Client ClientM endpoint)

65+ , Normal (Client ClientM endpoint) ~ V.Curried (EndpointArgs endpoint) (ReaderT ClientEnv IO (Either InteractionError (NonEmpty (Dynamic,Int))))

66+ , ToReifiedClientApi endpoints

67+ , V.RecordCurry' (EndpointArgs endpoint)

68+ , ToReifiedEndpoint endpoint) =>

69+ ToReifiedClientApi (endpoint : endpoints) where

70+ toReifiedClientApi (endpoint `AClientEndpoint` endpoints) _ clientEnv =

71+ (0, ReifiedEndpoint

72+ { reArguments = reifiedEndpointArguments @endpoint

73+ , reEndpointFunc = foo (normalize endpoint)

74+ }

75+ )

76+ : (map . first) (+1)

77+ (toReifiedClientApi endpoints (Proxy @endpoints) clientEnv)

78+ where

79+

80+ foo :: V.Curried (EndpointArgs endpoint) (ReaderT ClientEnv IO ResultType)

81+ -> V.Curried (EndpointArgs endpoint) (IO ResultType)

82+ foo = mapCurried @(EndpointArgs endpoint) @(ReaderT ClientEnv IO ResultType) (`runReaderT` clientEnv)

83+

84+mapCurried :: forall ts a b. V.RecordCurry' ts => (a -> b) -> V.Curried ts a -> V.Curried ts b

85+mapCurried f g = V.rcurry' @ts $ f . V.runcurry' g

86+

87+type ResultType = Either InteractionError (NonEmpty (Dynamic,Int))

88+-- runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)

89+

90+

91+instance (Typeable x, Hashable x, Breakdown x) => NormalizeFunction (ClientM x) where

92+ type Normal (ClientM x) = ReaderT ClientEnv IO (Either InteractionError (NonEmpty (Dynamic,Int)))

93+ normalize c = ReaderT $

94+ fmap (bimap (InteractionError . T.pack . show) breakdown) . runClientM c

95+--

96+

97+instance ToReifiedClientApi '[] where

98+ toReifiedClientApi NoClientEndpoints _ _ = []

99+

100+

101+instance

102+ ( FlattenClient api,

103+ Endpoints endpoint ~ '[endpoint]

104+ ) =>

105+ FlattenClient (endpoint :<|> api)

106+ where

107+ flattenClient (endpoint :<|> c) = endpoint `AClientEndpoint` flattenClient @api c

108+

109+instance

110+ (

111+ Endpoints api ~ '[api]

112+ ) =>

113+ FlattenClient (x :> api)

114+ where

115+ flattenClient c = c `AClientEndpoint` NoClientEndpoints

116+

117+instance FlattenClient (Verb method statusCode contentTypes responseType)

118+ where

119+ flattenClient c = c `AClientEndpoint` NoClientEndpoints

src/Roboservant/Direct.hs+19−19

@@ -12,7 +12,7 @@

12{-# LANGUAGE UndecidableInstances #-}

14module Roboservant.Direct

15− ( fuzz,

15+ ( fuzz',

16 Config (..),

17 -- TODO come up with something smarter than exporting all this, we should

18 -- have some nice error-display functions

@@ -56,16 +56,16 @@ import GHC.Generics ((:*:) (..))

56import Roboservant.Types

57 ( ApiOffset (..),

58 Argument (..),

59− FlattenServer (..),

59+ InteractionError,

60 Provenance (..),

61+ ReifiedApi,

61 ReifiedEndpoint (..),

62 ReifiedEndpoint (..),

62 Stash (..),

63 Stash (..),

63 StashValue (..),

64 StashValue (..),

64− ToReifiedApi (..),

65 TypedF,

66 )

67import Roboservant.Types.Config

68−import Servant (Endpoints, Proxy (Proxy), Server, ServerError (..))

68+

69import System.Random (Random (randomR), StdGen, mkStdGen)

70import qualified Type.Reflection as R

@@ -105,7 +105,7 @@ data EndpointOption

105 = forall as.

106 (V.RecordToList as, V.RMap as) =>

107 EndpointOption

108− { eoCall :: V.Curried as (IO (Either ServerError (NonEmpty (Dynamic, Int)))),

108+ { eoCall :: V.Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int)))),

109 eoArgs :: V.Rec (TypedF StashValue) as

110 }

111

@@ -121,13 +121,18 @@ data Report

121 }

122 deriving (Show)

123

124+

125+

126+-- fuzzClient :: Client api -> Config -> IO (Maybe Report)

127+-- fuzzClient = undefined

128+

129+

130+

124−fuzz ::

131+fuzz' ::

125− forall api.

132+ ReifiedApi ->

126− (FlattenServer api, ToReifiedApi (Endpoints api)) =>

127− Server api ->

128 Config ->

133 Config ->

129 IO (Maybe Report)

134 IO (Maybe Report)

130−fuzz server Config {..} = handle (pure . Just . formatException) $ do

135+fuzz' reifiedApi Config {..} = handle (pure . Just . formatException) $ do

131 let path = []

136 let path = []

132 stash = addToStash seed mempty

137 stash = addToStash seed mempty

133 currentRng = mkStdGen rngSeed

138 currentRng = mkStdGen rngSeed

@@ -173,7 +178,7 @@ fuzz server Config {..} = handle (pure . Just . formatException) $ do

173 else do

178 else do

174 _ <- action

179 _ <- action

175 untilDone (n -1, deadline) action

180 untilDone (n -1, deadline) action

176− reifiedApi = toReifiedApi (flattenServer @api server) (Proxy @(Endpoints api))

181+

177 routeCount = length reifiedApi

182 routeCount = length reifiedApi

178 elementOrFail ::

183 elementOrFail ::

179 (MonadState FuzzState m, MonadIO m) =>

184 (MonadState FuzzState m, MonadIO m) =>

@@ -190,7 +195,7 @@ fuzz server Config {..} = handle (pure . Just . formatException) $ do

190 ( forall as.

195 ( forall as.

191 (V.RecordToList as, V.RMap as) =>

196 (V.RecordToList as, V.RMap as) =>

192 FuzzOp ->

197 FuzzOp ->

193− V.Curried as (IO (Either ServerError (NonEmpty (Dynamic, Int)))) ->

198+ V.Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int)))) ->

194 V.Rec (TypedF V.Identity) as ->

199 V.Rec (TypedF V.Identity) as ->

195 m r

200 m r

196 ) ->

201 ) ->

@@ -231,18 +236,13 @@ fuzz server Config {..} = handle (pure . Just . formatException) $ do

231 execute ::

236 execute ::

232 (MonadState FuzzState m, MonadIO m, V.RecordToList as, V.RMap as) =>

237 (MonadState FuzzState m, MonadIO m, V.RecordToList as, V.RMap as) =>

233 FuzzOp ->

238 FuzzOp ->

234− V.Curried as (IO (Either ServerError (NonEmpty (Dynamic, Int)))) ->

239+ V.Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int)))) ->

235 V.Rec (TypedF V.Identity) as ->

240 V.Rec (TypedF V.Identity) as ->

236 m ()

241 m ()

237 execute fuzzop func args = do

242 execute fuzzop func args = do

238 (liftIO . logInfo . show . (fuzzop,) . stash) =<< get

243 (liftIO . logInfo . show . (fuzzop,) . stash) =<< get

239 liftIO (V.runcurry' func argVals) >>= \case

244 liftIO (V.runcurry' func argVals) >>= \case

240− -- parameterise this

245+ Left (e::InteractionError) -> throw e

241− Left (serverError :: ServerError) ->

242− case errHTTPCode serverError of

243− 500 -> throw serverError

244− _ ->

245− liftIO . logInfo . show $ ("ignoring non-500 error", serverError)

246 Right (dyn :: NEL.NonEmpty (Dynamic, Int)) -> do

247 modify'

248 ( \fs@FuzzState {..} ->

src/Roboservant/Server.hsnew file+36

@@ -0,0 +1,36 @@

1+{-# LANGUAGE RankNTypes #-}

2+{-# LANGUAGE TypeApplications #-}

3+{-# LANGUAGE PolyKinds #-}

4+{-# LANGUAGE AllowAmbiguousTypes #-}

5+{-# LANGUAGE FlexibleContexts #-}

6+{-# LANGUAGE GADTs #-}

7+{-# LANGUAGE PolyKinds #-}

8+{-# LANGUAGE RankNTypes #-}

9+{-# LANGUAGE ScopedTypeVariables #-}

10+{-# LANGUAGE TypeApplications #-}

11+{-# LANGUAGE TypeFamilies #-}

12+{-# LANGUAGE UndecidableInstances #-}

13+

14+module Roboservant.Server (fuzz, module Roboservant.Types ) where

15+

16+import Roboservant.Direct(fuzz',Report)

17+import Roboservant.Types

18+ ( FlattenServer (..),

19+ ReifiedApi,

20+ )

21+import Roboservant.Types.ReifiedApi.Server(ToReifiedApi (..))

22+import Servant (Endpoints, Proxy (Proxy), Server)

23+import Roboservant.Types.Config

24+

25+fuzz :: forall api.

26+ (FlattenServer api, ToReifiedApi (Endpoints api)) =>

27+ Server api ->

28+ Config ->

29+ IO (Maybe Report)

30+fuzz s = fuzz' (reifyServer s)

31+ -- todo: how do we pull reifyServer out?

32+ where reifyServer :: (FlattenServer api, ToReifiedApi (Endpoints api))

33+ => Server api -> ReifiedApi

34+ reifyServer server = toReifiedApi (flattenServer @api server) (Proxy @(Endpoints api))

35+-- reifyServer server = toReifiedApi server (Proxy @(Endpoints api))

36+

src/Roboservant/Types.hs+2−2

@@ -10,8 +10,8 @@

10module Roboservant.Types

11 ( module Roboservant.Types.Breakdown,

12 module Roboservant.Types.BuildFrom,

13− module Roboservant.Types.FlattenServer,

14 module Roboservant.Types.ReifiedApi,

13 module Roboservant.Types.ReifiedApi,

14+ module Roboservant.Types.ReifiedApi.Server,

15 module Roboservant.Types.Internal,

16 module Roboservant.Types.Config,

17 )

@@ -20,6 +20,6 @@ where

20import Roboservant.Types.Breakdown

21import Roboservant.Types.BuildFrom

22import Roboservant.Types.Config

23−import Roboservant.Types.FlattenServer

24import Roboservant.Types.Internal

23import Roboservant.Types.Internal

25import Roboservant.Types.ReifiedApi

24import Roboservant.Types.ReifiedApi

25+import Roboservant.Types.ReifiedApi.Server

src/Roboservant/Types/BuildFrom.hs−1

@@ -12,7 +12,6 @@

13module Roboservant.Types.BuildFrom where

15−import Control.Monad (filterM)

16import qualified Data.Dependent.Map as DM

15import qualified Data.Dependent.Map as DM

17import Data.Hashable

16import Data.Hashable

18import qualified Data.IntSet as IntSet

17import qualified Data.IntSet as IntSet

src/Roboservant/Types/FlattenServer.hsdeleted−40

@@ -1,40 +0,0 @@

1−{-# LANGUAGE AllowAmbiguousTypes #-}

2−{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE GADTs #-}

4−{-# LANGUAGE PolyKinds #-}

5−{-# LANGUAGE ScopedTypeVariables #-}

6−{-# LANGUAGE TypeApplications #-}

7−{-# LANGUAGE TypeOperators #-}

8−{-# LANGUAGE UndecidableInstances #-}

9−

10−-- | terrible name, this really just pulls stuff out where we can fiddle with it.

11−module Roboservant.Types.FlattenServer where

12−

13−import Servant

14−

15−data Bundled endpoints where

16− AnEndpoint :: Server endpoint -> Bundled endpoints -> Bundled (endpoint ': endpoints)

17− NoEndpoints :: Bundled '[]

18−

19−class FlattenServer api where

20− flattenServer :: Server api -> Bundled (Endpoints api)

21−

22−instance

23− ( FlattenServer api,

24− Endpoints endpoint ~ '[endpoint]

25− ) =>

26− FlattenServer (endpoint :<|> api)

27− where

28− flattenServer (endpoint :<|> server) = endpoint `AnEndpoint` flattenServer @api server

29−

30−instance

31− (

32− Endpoints api ~ '[api]

33− ) =>

34− FlattenServer (x :> api)

35− where

36− flattenServer server = server `AnEndpoint` NoEndpoints

37−

38−instance FlattenServer (Verb method statusCode contentTypes responseType)

39− where

40− flattenServer server = server `AnEndpoint` NoEndpoints

src/Roboservant/Types/ReifiedApi.hs+17−49

@@ -1,3 +1,8 @@

1+-- | Description: ways to build a reified api from a servant description.

2+--

3+-- arguably this could be more general and be abstracted away from even relying on servant

4+-- but that's future work.

1{-# LANGUAGE AllowAmbiguousTypes #-}

6{-# LANGUAGE AllowAmbiguousTypes #-}

2{-# LANGUAGE DataKinds #-}

7{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DerivingStrategies #-}

8{-# LANGUAGE DerivingStrategies #-}

@@ -15,25 +20,22 @@

15{-# LANGUAGE CPP #-}

20{-# LANGUAGE CPP #-}

16module Roboservant.Types.ReifiedApi where

21module Roboservant.Types.ReifiedApi where

18−import Control.Monad.Except (runExceptT)

19−import Data.Bifunctor

20import Data.Dynamic (Dynamic)

23import Data.Dynamic (Dynamic)

21−import Data.Kind

24+import Control.Exception(Exception)

22import Data.List.NonEmpty (NonEmpty)

25import Data.List.NonEmpty (NonEmpty)

23import Data.Typeable (Typeable)

26import Data.Typeable (Typeable)

24import GHC.Generics ((:*:)(..))

27import GHC.Generics ((:*:)(..))

25−import GHC.TypeLits (Symbol)

26import Roboservant.Types.Internal

28import Roboservant.Types.Internal

27import Roboservant.Types.Breakdown

29import Roboservant.Types.Breakdown

28import Roboservant.Types.BuildFrom

30import Roboservant.Types.BuildFrom

29−import Roboservant.Types.FlattenServer

31+import Data.Kind

30import Servant

32import Servant

31import Servant.API.Modifiers(FoldRequired,FoldLenient)

33import Servant.API.Modifiers(FoldRequired,FoldLenient)

34+import GHC.TypeLits (Symbol)

32import qualified Data.Text as T

35import qualified Data.Text as T

33import qualified Data.Vinyl as V

36import qualified Data.Vinyl as V

34import qualified Data.Vinyl.Curry as V

37import qualified Data.Vinyl.Curry as V

35import qualified Type.Reflection as R

38import qualified Type.Reflection as R

36−import Data.Hashable(Hashable)

38newtype ApiOffset = ApiOffset Int

40newtype ApiOffset = ApiOffset Int

39 deriving (Eq, Show, Ord)

41 deriving (Eq, Show, Ord)

@@ -47,18 +49,9 @@ newtype Argument a = Argument

48data ReifiedEndpoint = forall as. (V.RecordToList as, V.RMap as) => ReifiedEndpoint

50data ReifiedEndpoint = forall as. (V.RecordToList as, V.RMap as) => ReifiedEndpoint

49 { reArguments :: V.Rec (TypedF Argument) as

51 { reArguments :: V.Rec (TypedF Argument) as

50− , reEndpointFunc :: V.Curried as (IO (Either ServerError (NonEmpty (Dynamic,Int))))

52+ , reEndpointFunc :: V.Curried as (IO (Either InteractionError (NonEmpty (Dynamic,Int))))

51 }

53 }

53−type ReifiedApi = [(ApiOffset, ReifiedEndpoint)]

54−

55−tagType :: Typeable a => f a -> TypedF f a

56−tagType = (R.typeRep :*:)

57−

58−class ToReifiedApi (endpoints ) where

59−

60− toReifiedApi :: Bundled endpoints -> Proxy endpoints -> ReifiedApi

61−

62class ( V.RecordToList (EndpointArgs endpoint)

55class ( V.RecordToList (EndpointArgs endpoint)

63 , V.RMap (EndpointArgs endpoint)

56 , V.RMap (EndpointArgs endpoint)

64 ) => ToReifiedEndpoint (endpoint :: *) where

57 ) => ToReifiedEndpoint (endpoint :: *) where

@@ -67,41 +60,16 @@ class ( V.RecordToList (EndpointArgs endpoint)

68 reifiedEndpointArguments :: V.Rec (TypedF Argument) (EndpointArgs endpoint)

61 reifiedEndpointArguments :: V.Rec (TypedF Argument) (EndpointArgs endpoint)

70−instance ToReifiedApi '[] where

71− toReifiedApi NoEndpoints _ = []

73−instance

64+tagType :: Typeable a => f a -> TypedF f a

74− ( Typeable (EndpointRes endpoint)

65+tagType = (R.typeRep :*:)

66+

67+newtype InteractionError = InteractionError T.Text

68+ deriving Show

69+instance Exception InteractionError

70+

71+

76− , NormalizeFunction (ServerT endpoint Handler)

77− , Normal (ServerT endpoint Handler) ~ V.Curried (EndpointArgs endpoint) (IO (Either ServerError (NonEmpty (Dynamic,Int))))

78− , ToReifiedEndpoint endpoint

79− , ToReifiedApi endpoints

80− ) =>

81− ToReifiedApi (endpoint : endpoints)

82− where

83− toReifiedApi (endpoint `AnEndpoint` endpoints) _ =

84− (0, ReifiedEndpoint

85− { reArguments = reifiedEndpointArguments @endpoint

86− , reEndpointFunc = normalize endpoint

87− }

88− )

89− : (map . first) (+1)

90− (toReifiedApi endpoints (Proxy @endpoints))

91−

92−class NormalizeFunction m where

93− type Normal m

94− normalize :: m -> Normal m

95−

96−instance NormalizeFunction x => NormalizeFunction (r -> x) where

97− type Normal (r -> x) = r -> Normal x

98− normalize = fmap normalize

99−

100−instance (Typeable x, Hashable x, Breakdown x) => NormalizeFunction (Handler x) where

101− type Normal (Handler x) = IO (Either ServerError (NonEmpty (Dynamic,Int)))

102− normalize handler = (runExceptT . runHandler') handler >>= \case

103− Left serverError -> pure (Left serverError)

104− Right x -> pure $ Right $ breakdown x

105

106instance

74instance

107 (Typeable responseType, Breakdown responseType) =>

75 (Typeable responseType, Breakdown responseType) =>

src/Roboservant/Types/ReifiedApi/Server.hsnew file+113

@@ -0,0 +1,113 @@

1+{-# LANGUAGE RankNTypes #-}

2+{-# LANGUAGE TypeApplications #-}

3+{-# LANGUAGE PolyKinds #-}

4+{-# LANGUAGE AllowAmbiguousTypes #-}

5+{-# LANGUAGE FlexibleContexts #-}

6+{-# LANGUAGE GADTs #-}

7+{-# LANGUAGE LambdaCase #-}

8+{-# LANGUAGE PolyKinds #-}

9+{-# LANGUAGE RankNTypes #-}

10+{-# LANGUAGE ScopedTypeVariables #-}

11+{-# LANGUAGE TypeApplications #-}

12+{-# LANGUAGE TypeFamilies #-}

13+{-# LANGUAGE UndecidableInstances #-}

14+{-# LANGUAGE CPP #-}

15+{-# LANGUAGE DataKinds #-}

16+{-# LANGUAGE TypeOperators #-}

17+{-# LANGUAGE FlexibleInstances #-}

18+{-# LANGUAGE MultiParamTypeClasses #-}

19+module Roboservant.Types.ReifiedApi.Server(module Roboservant.Types.ReifiedApi.Server) where

20+

21+import Servant

22+

23+import Control.Monad.Except (runExceptT)

24+import Data.Bifunctor

25+import Data.Dynamic (Dynamic)

26+import Data.List.NonEmpty (NonEmpty)

27+import Data.Typeable (Typeable)

28+import Roboservant.Types.Breakdown

29+import Roboservant.Types.ReifiedApi

30+

31+import qualified Data.Text as T

32+import qualified Data.Vinyl.Curry as V

33+import Data.Hashable(Hashable)

34+

35+type ReifiedApi = [(ApiOffset, ReifiedEndpoint )]

36+

37+

38+class ToReifiedApi endpoints where

39+ toReifiedApi :: Bundled endpoints -> Proxy endpoints -> ReifiedApi

40+

41+instance ToReifiedApi '[] where

42+ toReifiedApi NoEndpoints _ = []

43+

44+instance

45+ ( NormalizeFunction (ServerT endpoint Handler)

46+ , Normal (ServerT endpoint Handler) ~ V.Curried (EndpointArgs endpoint) (IO (Either InteractionError (NonEmpty (Dynamic,Int))))

47+ , ToReifiedEndpoint endpoint

48+ , ToReifiedApi endpoints

49+ ) =>

50+ ToReifiedApi (endpoint : endpoints)

51+ where

52+ toReifiedApi (endpoint `AnEndpoint` endpoints) _ =

53+ (0, ReifiedEndpoint

54+ { reArguments = reifiedEndpointArguments @endpoint

55+ , reEndpointFunc = normalize endpoint

56+ }

57+ )

58+ : (map . first) (+1)

59+ (toReifiedApi endpoints (Proxy @endpoints))

60+

61+

62+instance (Typeable x, Hashable x, Breakdown x) => NormalizeFunction (Handler x) where

63+ type Normal (Handler x) = IO (Either InteractionError (NonEmpty (Dynamic,Int)))

64+ normalize handler = (runExceptT . runHandler') handler >>= \case

65+ Left serverError -> pure (Left (renderServerError serverError))

66+ where

67+ -- | TODO improve this

68+ renderServerError :: ServerError -> InteractionError

69+ renderServerError = InteractionError . T.pack . show

70+ Right x -> pure $ Right $ breakdown x

71+

72+

73+-- case errHTTPCode serverError of

74+-- 500 -> throw serverError

75+-- _ ->

76+-- liftIO . logInfo . show $ ("ignoring non-500 error", serverError)

77+

78+

79+data Bundled endpoints where

80+ -- AnEndpoint :: Server endpoint -> Bundled endpoints -> Bundled (endpoint ': endpoints)

81+ AnEndpoint :: Server endpoint -> Bundled endpoints -> Bundled (endpoint ': endpoints)

82+ NoEndpoints :: Bundled '[]

83+

84+class FlattenServer api where

85+ flattenServer :: Server api -> Bundled (Endpoints api)

86+

87+instance

88+ ( FlattenServer api,

89+ Endpoints endpoint ~ '[endpoint]

90+ ) =>

91+ FlattenServer (endpoint :<|> api)

92+ where

93+ flattenServer (endpoint :<|> server) = endpoint `AnEndpoint` flattenServer @api server

94+

95+instance

96+ (

97+ Endpoints api ~ '[api]

98+ ) =>

99+ FlattenServer (x :> api)

100+ where

101+ flattenServer server = server `AnEndpoint` NoEndpoints

102+

103+instance FlattenServer (Verb method statusCode contentTypes responseType)

104+ where

105+ flattenServer server = server `AnEndpoint` NoEndpoints

106+

107+class NormalizeFunction m where

108+ type Normal m

109+ normalize :: m -> Normal m

110+

111+instance NormalizeFunction x => NormalizeFunction (r -> x) where

112+ type Normal (r -> x) = r -> Normal x

113+ normalize = fmap normalize

test/Spec.hs+82−56

@@ -4,7 +4,13 @@

4{-# LANGUAGE RecordWildCards #-}

5{-# LANGUAGE StandaloneDeriving #-}

6{-# LANGUAGE TypeApplications #-}

7+{-# LANGUAGE RankNTypes #-}

8+{-# LANGUAGE FlexibleContexts #-}

9+{-# LANGUAGE AllowAmbiguousTypes #-}

10+{-# LANGUAGE ScopedTypeVariables #-}

11+{-# LANGUAGE DataKinds #-}

7{-# OPTIONS_GHC -fno-warn-orphans #-}

12{-# OPTIONS_GHC -fno-warn-orphans #-}

13+{-# LANGUAGE TypeFamilies #-}

9import qualified Breakdown

15import qualified Breakdown

10import Data.Dynamic (toDyn)

16import Data.Dynamic (toDyn)

@@ -16,99 +22,119 @@ import qualified Headers

16import qualified Nested

22import qualified Nested

17import qualified Post

23import qualified Post

18import qualified Product

24import qualified Product

19−import qualified Roboservant as RS

25+import qualified Roboservant as R

26+import qualified Roboservant.Server as RS

27+import qualified Roboservant.Client as RC

20import qualified Seeded

28import qualified Seeded

21import Test.Hspec

29import Test.Hspec

22import Test.Hspec.Core.Spec (FailureReason (Reason), ResultStatus (Failure, Success), itemExample, mapSpecItem_, resultStatus)

30import Test.Hspec.Core.Spec (FailureReason (Reason), ResultStatus (Failure, Success), itemExample, mapSpecItem_, resultStatus)

23import qualified Valid

31import qualified Valid

32+import Servant ( Server, Proxy(..), serve, Endpoints, HasServer )

33+

34+import Servant.Client(ClientEnv, mkClientEnv, baseUrlPort, parseBaseUrl,HasClient,ClientM)

35+import Network.Wai(Application)

36+import qualified Network.Wai.Handler.Warp as Warp

37+import Network.HTTP.Client (newManager, defaultManagerSettings)

38+import Servant(Endpoints,HasServer)

25main :: IO ()

40main :: IO ()

26main = hspec spec

41main = hspec spec

43+fuzzBoth

44+ :: forall a .

45+ (R.ToReifiedApi (Endpoints a), HasServer a '[], RS.FlattenServer a, RC.ToReifiedClientApi (Endpoints a), RC.FlattenClient a,

46+ HasClient ClientM a)

47+ => String -> Server a -> R.Config -> (Maybe R.Report -> IO ()) -> Spec

48+fuzzBoth name server config condition = do

49+ it (name <> " via server") $ do

50+ RS.fuzz @a server config >>= condition

51+

52+ around (withServer (serve (Proxy :: Proxy a) server)) $ do

53+ it (name <> " via client") $ \(clientEnv::ClientEnv) -> do

54+ RC.fuzz @a clientEnv config >>= condition

55+

56+withServer :: Application -> ActionWith ClientEnv -> IO ()

57+withServer app action = Warp.testWithApplication (pure app) (\p -> genClientEnv p >>= action)

58+ where genClientEnv port = do

59+ baseUrl <- parseBaseUrl "http://localhost"

60+ manager <- newManager defaultManagerSettings

61+ pure $ mkClientEnv manager (baseUrl { baseUrlPort = port })

62+

28spec :: Spec

63spec :: Spec

29spec = do

64spec = do

30 describe "Basic usage" $ do

65 describe "Basic usage" $ do

31 describe "noError" $ do

66 describe "noError" $ do

32− it "finds no error in a valid app" $ do

33− RS.fuzz @Valid.Api Valid.server RS.defaultConfig

34− >>= (`shouldSatisfy` isNothing)

67+ fuzzBoth @Valid.Api "find no error in a basic app" Valid.server R.defaultConfig (`shouldSatisfy` isNothing)

35− it "finds no error in a valid generic app" $ do

68+ fuzzBoth @Valid.RoutedApi "finds no error in a valid generic app" Valid.routedServer R.defaultConfig (`shouldSatisfy` isNothing)

36− RS.fuzz @Valid.RoutedApi Valid.routedServer RS.defaultConfig

37− >>= (`shouldSatisfy` isNothing)

38− it "does fail coverage check" $ do

39− r <- RS.fuzz @Valid.Api Valid.server RS.defaultConfig {RS.coverageThreshold = 0.6}

69+ fuzzBoth @Valid.Api "fails coverage check" Valid.server R.defaultConfig {R.coverageThreshold = 0.6}

70+ (\r ->

40− fmap (RS.failureReason . RS.rsException) r

71+ fmap (R.failureReason . R.rsException) r

41− `shouldSatisfy` ( \case

72+ `shouldSatisfy` ( \case

42− Just (RS.InsufficientCoverage _) -> True

73+ Just (R.InsufficientCoverage _) -> True

43− _ -> False

74+ _ -> False

44− )

75+ ))

45 describe "posted body" $ do

76 describe "posted body" $ do

46− it "passes a coverage check using a posted body" $ do

47− RS.fuzz @Post.Api Post.server RS.defaultConfig {RS.coverageThreshold = 0.99}

77+ fuzzBoth @Post.Api "passes a coverage check using a posted body" Post.server R.defaultConfig {R.coverageThreshold = 0.99}

48− >>= (`shouldSatisfy` isNothing)

78+ (`shouldSatisfy` isNothing)

79+

49 describe "seeded" $ do

80 describe "seeded" $ do

50− shouldFail

81+ let res = Seeded.Seed 1

51− $ it "finds an error using information passed in"

82+ shouldFail $ fuzzBoth @Seeded.Api "finds an error using information passed in" Seeded.server

52− $ let res = Seeded.Seed 1

53− in RS.fuzz @Seeded.Api Seeded.server (RS.defaultConfig {RS.seed = [(toDyn res, hash res)]})

83+ (R.defaultConfig {R.seed = [(toDyn res, hash res)]})

54− >>= (`shouldSatisfy` isNothing)

84+ (`shouldSatisfy` isNothing)

85+

55 describe "Foo" $ do

86 describe "Foo" $ do

56− it "finds an error in a basic app" $

57− RS.fuzz @Foo.Api Foo.server RS.defaultConfig

58− >>= (`shouldSatisfy` serverFailure)

87+ fuzzBoth @Foo.Api "finds an error in a basic app" Foo.server R.defaultConfig (`shouldSatisfy` serverFailure)

88+

59 describe "BuildFrom" $ do

89 describe "BuildFrom" $ do

60 describe "headers (and sum types)" $ do

90 describe "headers (and sum types)" $ do

61− it "should find a failure that's dependent on using header info" $ do

91+ fuzzBoth @Headers.Api "should find a failure that's dependent on using header info" Headers.server R.defaultConfig

62− RS.fuzz @Headers.Api Headers.server RS.defaultConfig

63− >>= (`shouldSatisfy` serverFailure)

92+ (`shouldSatisfy` serverFailure)

64 describe "product types" $ do

93 describe "product types" $ do

65− it "should find a failure that's dependent on creating a product" $ do

94+ fuzzBoth @Product.Api "should find a failure that's dependent on creating a product" Product.server

66− RS.fuzz @Product.Api Product.server RS.defaultConfig {RS.seed = [RS.hashedDyn 'a', RS.hashedDyn (1 :: Int)]}

95+ R.defaultConfig {R.seed = [R.hashedDyn 'a', R.hashedDyn (1 :: Int)]}

67− >>= (`shouldSatisfy` serverFailure)

96+ (`shouldSatisfy` serverFailure)

68 describe "Breakdown" $ do

97 describe "Breakdown" $ do

69− it "handles products" $ do

70− RS.fuzz @Breakdown.ProductApi Breakdown.productServer RS.defaultConfig

98+ fuzzBoth @Breakdown.ProductApi "handles products" Breakdown.productServer R.defaultConfig

71− >>= (`shouldSatisfy` serverFailure)

99+ (`shouldSatisfy` serverFailure)

72− it "handles sums" $ do

73− RS.fuzz @Breakdown.SumApi Breakdown.sumServer RS.defaultConfig

100+ fuzzBoth @Breakdown.SumApi "handles sums" Breakdown.sumServer R.defaultConfig

74− >>= (`shouldSatisfy` serverFailure)

101+ (`shouldSatisfy` serverFailure)

75 describe "flattening" $ do

102 describe "flattening" $ do

76 -- we don't actually do much here, this is just here to document the appropriate response

103 -- we don't actually do much here, this is just here to document the appropriate response

77 -- if you get a type error with a nested api.

104 -- if you get a type error with a nested api.

78− it "can handle nested apis" $ do

79− RS.fuzz @(Nested.FlatApi) Nested.server RS.defaultConfig {RS.coverageThreshold = 0.99}

105+ fuzzBoth @Nested.FlatApi "can handle nested apis" Nested.server R.defaultConfig {R.coverageThreshold = 0.99}

80− >>= (`shouldSatisfy` isNothing)

106+ (`shouldSatisfy` isNothing)

107

82−serverFailure :: Maybe RS.Report -> Bool

108+serverFailure :: Maybe R.Report -> Bool

83serverFailure = \case

109serverFailure = \case

84− Just RS.Report {..} ->

110+ Just R.Report {..} ->

85− let RS.RoboservantException {..} = rsException

111+ let R.RoboservantException {..} = rsException

86− in failureReason /= RS.NoPossibleMoves

112+ in failureReason /= R.NoPossibleMoves

87 _ -> False

113 _ -> False

114

89−deriving via (RS.Atom Foo.Foo) instance RS.Breakdown Foo.Foo

115+deriving via (R.Atom Foo.Foo) instance R.Breakdown Foo.Foo

116

91−deriving via (RS.Atom Foo.Foo) instance RS.BuildFrom Foo.Foo

117+deriving via (R.Atom Foo.Foo) instance R.BuildFrom Foo.Foo

118

93−deriving via (RS.Atom Headers.Foo) instance RS.Breakdown Headers.Foo

119+deriving via (R.Atom Headers.Foo) instance R.Breakdown Headers.Foo

120

95−deriving via (RS.Atom Headers.Foo) instance RS.BuildFrom Headers.Foo

121+deriving via (R.Atom Headers.Foo) instance R.BuildFrom Headers.Foo

122

97−deriving via (RS.Atom Seeded.Seed) instance RS.Breakdown Seeded.Seed

123+deriving via (R.Atom Seeded.Seed) instance R.Breakdown Seeded.Seed

124

99−deriving via (RS.Atom Seeded.Seed) instance RS.BuildFrom Seeded.Seed

125+deriving via (R.Atom Seeded.Seed) instance R.BuildFrom Seeded.Seed

100

126

101−deriving via (RS.Atom Void) instance RS.BuildFrom Void

127+deriving via (R.Atom Void) instance R.BuildFrom Void

102

128

103−deriving via (RS.Atom Post.FooPost) instance RS.Breakdown Post.FooPost

129+deriving via (R.Atom Post.FooPost) instance R.Breakdown Post.FooPost

104

130

105−deriving via (RS.Atom Post.FooPost) instance RS.BuildFrom Post.FooPost

131+deriving via (R.Atom Post.FooPost) instance R.BuildFrom Post.FooPost

106

132

107−deriving via (RS.Compound Breakdown.Foo) instance RS.Breakdown Breakdown.Foo

133+deriving via (R.Compound Breakdown.Foo) instance R.Breakdown Breakdown.Foo

108

134

109−deriving via (RS.Compound Product.Foo) instance RS.BuildFrom Product.Foo

135+deriving via (R.Compound Product.Foo) instance R.BuildFrom Product.Foo

110

136

111−deriving via (RS.Compound Breakdown.SomeSum) instance RS.Breakdown Breakdown.SomeSum

137+deriving via (R.Compound Breakdown.SomeSum) instance R.Breakdown Breakdown.SomeSum

112

138

113-- | `shouldFail` allows you to assert that a given `Spec` should contain at least one failing test.

139-- | `shouldFail` allows you to assert that a given `Spec` should contain at least one failing test.

114-- this is often useful when testing tests.

140-- this is often useful when testing tests.