c61d486 · roboservant · git.iko.soy

git.iko.soy/roboservant

hlint

commitc61d4868cc1a7a0bb5d8f1c3996305c82da13879 authorMark Wotton <mwotton@gmail.com> dateThu 5 Aug 2021, 06:39 (5 years ago) parent5d71aaa

14 files changed+54−56

compare with master

unifiedsplit

roboservant.cabal+3−3 src/Roboservant/Client.hs+2−2 src/Roboservant/Direct.hs+11−12 src/Roboservant/Server.hs+2−2 src/Roboservant/Types/ReifiedApi/Server.hs+1−1 test/Breakdown.hs+1−1 test/Nested.hs+2−2 test/Post.hs+2−2 test/Product.hs+1−1 test/Put.hs+2−2 test/QueryParams.hs+3−3 test/Spec.hs+20−21 test/UnsafeIO.hs+3−3 test/Valid.hs+1−1

roboservant.cabal+3−3

@@ -1,10 +1,10 @@

11cabal-version: 1.12

3−-- This file has been generated from package.yaml by hpack version 0.33.0.

3+-- This file has been generated from package.yaml by hpack version 0.34.4.

44--

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

66--

7−-- hash: 76f10a967a70cffa900bcc3464a1fd973642332b3a86d22a19f5e3d1d8879f4d

7+-- hash: df9bc2d503c0e20b2f3edd45f6b63a5fa751b4b0254cfbb1b5e3209e5cf8de2c

99name: roboservant

1010version: 0.1.0.2

@@ -73,7 +73,7 @@ test-suite example

7373 other-modules:

7474 Paths_roboservant

7575 hs-source-dirs:

76− ./.

76+ ./

7777 ghc-options: -Wall -fwrite-ide-info -hiedir=.hie -pgmL markdown-unlit

7878 build-tool-depends:

7979 markdown-unlit:markdown-unlit

src/Roboservant/Client.hs+2−2

@@ -8,7 +8,7 @@

88{-# LANGUAGE PolyKinds #-}

99{-# LANGUAGE ScopedTypeVariables #-}

1010{-# LANGUAGE TypeApplications #-}

11−{-# LANGUAGE TypeOperators #-}

11+

1212{-# LANGUAGE UndecidableInstances #-}

1313{-# LANGUAGE TypeFamilies #-}

1414{-# LANGUAGE FlexibleContexts #-}

@@ -97,7 +97,7 @@ instance (Typeable x, Hashable x, Breakdown x) => NormalizeFunction (ClientM x)

9797 where

9898 renderClientError :: ClientError -> InteractionError

9999 renderClientError err = case err of

100− FailureResponse _ (Response{responseStatusCode}) -> InteractionError textual (responseStatusCode == status500)

100+ FailureResponse _ Response{responseStatusCode} -> InteractionError textual (responseStatusCode == status500)

101101 _ -> InteractionError textual True

102102

103103 where textual = T.pack $ show err

src/Roboservant/Direct.hs+11−12

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

77{-# LANGUAGE RecordWildCards #-}

88{-# LANGUAGE ScopedTypeVariables #-}

99{-# LANGUAGE TupleSections #-}

10−{-# LANGUAGE TypeApplications #-}

10+

1111{-# LANGUAGE TypeFamilies #-}

1212{-# LANGUAGE UndecidableInstances #-}

1313

@@ -150,12 +150,12 @@ fuzz' reifiedApi Config {..} = handle (pure . Just . formatException) $ do

150150 Report

151151 (unlines [show failureType, show exception])

152152 r

153− displayDiagnostics FuzzState {..} = liftIO $ do

153+ displayDiagnostics FuzzState {..} = liftIO $

154154 logInfo $ unlines $

155− ["api endpoints covered"]

156− <> (map show . Set.toList . Set.fromList $ map apiOffset path)

157− <> ["", "types in stash"]

158− <> DM.foldrWithKey (\_ v r -> (show . NEL.length . getStashValue $ v) : r) [] (getStash stash)

155+ ["api endpoints covered"]

156+ <> (map show . Set.toList . Set.fromList $ map apiOffset path)

157+ <> ["", "types in stash"]

158+ <> DM.foldrWithKey (\_ v r -> (show . NEL.length . getStashValue $ v) : r) [] (getStash stash)

159159 -- <> (map (show . NEL.length . getStashValue ) $ DM.assocs (getStash stash))

160160 -- $ \_k v ->

161161 -- (show . NEL.length $ getStashValue v))

@@ -246,11 +246,11 @@ fuzz' reifiedApi Config {..} = handle (pure . Just . formatException) $ do

246246 if fatalError e

247247 then throw e

248248 else pure ()

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

249+ Right (dyn :: NEL.NonEmpty (Dynamic, Int)) ->

250250 modify'

251− ( \fs@FuzzState {..} ->

252− fs {stash = addToStash (NEL.toList dyn) stash}

253− )

251+ ( \fs@FuzzState {..} ->

252+ fs {stash = addToStash (NEL.toList dyn) stash}

253+ )

254254 where

255255 argVals = V.rmap (\(_ :*: V.Identity x) -> V.Identity x) args

256256 -- argTypes = recordToList' (\(tr :*: _) -> R.SomeTypeRep tr) args

@@ -262,8 +262,7 @@ fuzz' reifiedApi Config {..} = handle (pure . Just . formatException) $ do

262262 (execute op func args)

263263 [ Handler (\(e :: SomeAsyncException) -> throw e),

264264 Handler

265− ( \(e :: SomeException) -> do

266− -- displayDiagnostics =<< get

265+ ( \(e :: SomeException) ->

267266 throw . RoboservantException ServerCrashed (Just e) =<< get

268267 )

269268 ]

src/Roboservant/Server.hs+2−2

@@ -5,7 +5,7 @@

55{-# LANGUAGE FlexibleContexts #-}

66{-# LANGUAGE GADTs #-}

77{-# LANGUAGE PolyKinds #-}

8−{-# LANGUAGE RankNTypes #-}

99{-# LANGUAGE ScopedTypeVariables #-}

1010{-# LANGUAGE TypeApplications #-}

1111{-# LANGUAGE TypeFamilies #-}

@@ -27,7 +27,7 @@ fuzz :: forall api.

2727 Server api ->

2828 Config ->

2929 IO (Maybe Report)

30−fuzz s = fuzz' (reifyServer s)

30+fuzz s = fuzz' (reifyServer s)

3131 -- todo: how do we pull reifyServer out?

3232 where reifyServer :: (FlattenServer api, ToReifiedApi (Endpoints api))

3333 => Server api -> ReifiedApi

src/Roboservant/Types/ReifiedApi/Server.hs+1−1

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

66{-# LANGUAGE GADTs #-}

77{-# LANGUAGE LambdaCase #-}

88{-# LANGUAGE PolyKinds #-}

9−{-# LANGUAGE RankNTypes #-}

1010{-# LANGUAGE ScopedTypeVariables #-}

1111{-# LANGUAGE TypeApplications #-}

1212{-# LANGUAGE TypeFamilies #-}

test/Breakdown.hs+1−1

@@ -1,7 +1,7 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

55{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE TypeOperators #-}

test/Nested.hs+2−2

@@ -1,7 +1,7 @@

11{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

55{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE TypeOperators #-}

test/Post.hs+2−2

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

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5−{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE TypeOperators #-}

88module Post where

test/Product.hs+1−1

@@ -1,7 +1,7 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

55{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE TypeOperators #-}

test/Put.hs+2−2

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

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5−{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE TypeOperators #-}

88module Put where

test/QueryParams.hs+3−3

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

11{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5−{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE TypeOperators #-}

88module QueryParams where

test/Spec.hs+20−21

@@ -37,6 +37,7 @@ import Servant.Client(ClientEnv, mkClientEnv, baseUrlPort, parseBaseUrl,HasClien

3737import Network.Wai(Application)

3838import qualified Network.Wai.Handler.Warp as Warp

3939import Network.HTTP.Client (newManager, defaultManagerSettings)

40+import Control.Monad((>=>))

4041

4142main :: IO ()

4243main = hspec spec

@@ -47,15 +48,15 @@ fuzzBoth

4748 HasClient ClientM a)

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

4950fuzzBoth name server config condition = do

50− it (name <> " via server") $ do

51+ it (name <> " via server") $

5152 RS.fuzz @a server config >>= condition

5253

53− around (withServer (serve (Proxy :: Proxy a) server)) $ do

54+ around (withServer (serve (Proxy :: Proxy a) server)) $

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

55− RC.fuzz @a clientEnv config >>= condition

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

5657

5758withServer :: Application -> ActionWith ClientEnv -> IO ()

58−withServer app action = Warp.testWithApplication (pure app) (\p -> genClientEnv p >>= action)

59+withServer app action = Warp.testWithApplication (pure app) (genClientEnv >=> action)

5960 where genClientEnv port = do

6061 baseUrl <- parseBaseUrl "http://localhost"

6162 manager <- newManager defaultManagerSettings

@@ -74,14 +75,14 @@ spec = do

7475 Just (R.InsufficientCoverage _) -> True

7576 _ -> False

7677 ))

77− describe "posted body" $ do

78+ describe "posted body" $

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

79− (`shouldSatisfy` isNothing)

80+ (`shouldSatisfy` isNothing)

8081

8182

82− describe "PUTted body" $ do

83+ describe "PUTted body" $

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

84− (`shouldSatisfy` isNothing)

85+ (`shouldSatisfy` isNothing)

8586

8687

8788 describe "seeded" $ do

@@ -90,31 +91,29 @@ spec = do

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

9192 (`shouldSatisfy` isNothing)

9293

93− describe "Foo" $ do

94+ describe "Foo" $

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

9596

96− describe "QueryParams" $ do

97+ describe "QueryParams" $

9798 fuzzBoth @QueryParams.Api "can handle query params" QueryParams.server R.defaultConfig { R.seed = [R.hashedDyn (12::Int)] }

98− (`shouldSatisfy` isNothing)

99+ (`shouldSatisfy` isNothing)

99100

100101 describe "BuildFrom" $ do

101− describe "headers (and sum types)" $ do

102+ describe "headers (and sum types)" $

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

103− (`shouldSatisfy` serverFailure)

104− describe "product types" $ do

104+ (`shouldSatisfy` serverFailure)

105+ describe "product types" $

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

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

107− (`shouldSatisfy` serverFailure)

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

108+ (`shouldSatisfy` serverFailure)

108109 describe "Breakdown" $ do

109110 fuzzBoth @Breakdown.ProductApi "handles products" Breakdown.productServer R.defaultConfig

110111 (`shouldSatisfy` serverFailure)

111112 fuzzBoth @Breakdown.SumApi "handles sums" Breakdown.sumServer R.defaultConfig

112113 (`shouldSatisfy` serverFailure)

113− describe "flattening" $ do

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

115− -- if you get a type error with a nested api.

114+ describe "flattening" $

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

117− (`shouldSatisfy` isNothing)

116+ (`shouldSatisfy` isNothing)

118117

119118serverFailure :: Maybe R.Report -> Bool

120119serverFailure = \case

@@ -159,7 +158,7 @@ shouldFail =

159158 ( \i ->

160159 i

161160 { itemExample = \p a cb -> do

162− r <- (itemExample i) p a cb

161+ r <- itemExample i p a cb

163162 pure

164163 r

165164 { resultStatus = case resultStatus r of

test/UnsafeIO.hs+3−3

@@ -1,7 +1,7 @@

11{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

55{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE TypeOperators #-}

@@ -22,7 +22,7 @@ healthcheck ref = do

2222 t <- liftIO $ readIORef ref

2323 case t of

2424 0 -> pure ()

25− n -> throwError $ err500 {errBody = "observed inconsistency: " <> (BL8.pack $ show n)}

25+ n -> throwError $ err500 {errBody = "observed inconsistency: " <> BL8.pack (show n)}

2626

2727makeServer :: IO (Server UnsafeApi)

2828makeServer = do

test/Valid.hs+1−1

@@ -1,7 +1,7 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

55{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE TypeOperators #-}