19ec395 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Avoid using SOP constructors directly (#1434)

19ec395Paolo Capriotti5 years ago

servant-client/test/Servant/SuccessSpec.hs+5−7

compare with master

unifiedsplit

@@ -32,7 +32,6 @@ import Data.Foldable

32import Data.Maybe

33 (listToMaybe)

34import Data.Monoid ()

35−import Data.SOP (NS (..), I (..))

36import Data.Text

35import Data.Text

37 (Text)

36 (Text)

38import qualified Network.HTTP.Client as C

37import qualified Network.HTTP.Client as C

@@ -43,11 +42,9 @@ import Test.HUnit

43import Test.QuickCheck

42import Test.QuickCheck

45import Servant.API

44import Servant.API

46− (NoContent (NoContent), WithStatus (WithStatus), getHeaders)

45+ (NoContent (NoContent), WithStatus (WithStatus), getHeaders, Headers(..))

47import Servant.Client

46import Servant.Client

48import qualified Servant.Client.Core.Request as Req

47import qualified Servant.Client.Core.Request as Req

49−import Servant.Client.Internal.HttpClient

50− (defaultMakeClientRequest)

51import Servant.ClientTestUtils

48import Servant.ClientTestUtils

52import Servant.Test.ComprehensiveAPI

49import Servant.Test.ComprehensiveAPI

@@ -134,9 +131,10 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

134 res <- runClient getUVerbRespHeaders baseUrl

131 res <- runClient getUVerbRespHeaders baseUrl

135 case res of

132 case res of

136 Left e -> assertFailure $ show e

133 Left e -> assertFailure $ show e

137− Right (Z (I (WithStatus val))) ->

134+ Right val -> case matchUnion val of

135+ Just (WithStatus val' :: WithStatus 200 (Headers TestHeaders Bool))

138− getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]

136+ -> getHeaders val' `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]

139− Right (S _) -> assertFailure "expected first alternative of union"

137+ Nothing -> assertFailure "unexpected alternative of union"

140

138

141 it "Stores Cookie in CookieJar after a redirect" $ \(_, baseUrl) -> do

139 it "Stores Cookie in CookieJar after a redirect" $ \(_, baseUrl) -> do

142 mgr <- C.newManager C.defaultManagerSettings

140 mgr <- C.newManager C.defaultManagerSettings

servant-server/test/Servant/ServerSpec.hs+3−4

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

7{-# LANGUAGE ScopedTypeVariables #-}

8{-# LANGUAGE TypeFamilies #-}

9{-# LANGUAGE TypeOperators #-}

10+{-# LANGUAGE TypeApplications #-}

10{-# OPTIONS_GHC -freduction-depth=100 #-}

11{-# OPTIONS_GHC -freduction-depth=100 #-}

12module Servant.ServerSpec where

13module Servant.ServerSpec where

@@ -28,8 +29,6 @@ import Data.Maybe

28 (fromMaybe)

29 (fromMaybe)

29import Data.Proxy

30import Data.Proxy

30 (Proxy (Proxy))

31 (Proxy (Proxy))

31−import Data.SOP

32− (I (..), NS (..))

33import Data.String

32import Data.String

34 (fromString)

33 (fromString)

35import Data.String.Conversions

34import Data.String.Conversions

@@ -699,8 +698,8 @@ type UVerbResponseHeadersApi =

699 Capture "ok" Bool :> UVerb 'GET '[JSON] UVerbHeaderResponse

698 Capture "ok" Bool :> UVerb 'GET '[JSON] UVerbHeaderResponse

700

699

701uverbResponseHeadersServer :: Server UVerbResponseHeadersApi

700uverbResponseHeadersServer :: Server UVerbResponseHeadersApi

702−uverbResponseHeadersServer True = pure . Z . I . WithStatus $ addHeader 5 "foo"

701+uverbResponseHeadersServer True = respond . WithStatus @200 . addHeader @"H1" (5 :: Int) $ ("foo" :: String)

703−uverbResponseHeadersServer False = pure . S . Z . I . WithStatus $ "bar"

702+uverbResponseHeadersServer False = respond . WithStatus @404 $ ("bar" :: String)

704

703

705uverbResponseHeadersSpec :: Spec

704uverbResponseHeadersSpec :: Spec

706uverbResponseHeadersSpec = describe "UVerbResponseHeaders" $ do

705uverbResponseHeadersSpec = describe "UVerbResponseHeaders" $ do