@@ -2,37 +2,34 @@ module Test.Main where
2
2
3
3
import Prelude
4
4
5
- import Control.Bind
6
- import Control.Monad.Aff
7
- import Control.Monad.Aff.AVar (AVAR ())
5
+ import Control.Monad.Aff (Aff , cancel , forkAff , attempt , runAff , makeAff )
6
+ import Control.Monad.Aff.AVar (AVAR )
8
7
import Control.Monad.Aff.Console as A
9
- import Control.Monad.Eff
10
- import Control.Monad.Eff.Class
11
- import Control.Monad.Eff.Console (CONSOLE () , log , logShow )
12
- import Control.Monad.Eff.Exception
13
- import Control.Monad.Eff.Ref (REF () )
8
+ import Control.Monad.Eff ( Eff )
9
+ import Control.Monad.Eff.Class ( liftEff )
10
+ import Control.Monad.Eff.Console (CONSOLE , log , logShow )
11
+ import Control.Monad.Eff.Exception ( EXCEPTION , error , throwException )
12
+ import Control.Monad.Eff.Ref (REF )
14
13
15
- import Data.Either
16
- import Data.Foreign
17
- import Data.Maybe
14
+ import Data.Either ( Either (..))
15
+ import Data.Foreign ( Foreign , unsafeFromForeign )
16
+ import Data.Maybe ( Maybe (..))
18
17
19
- import Network.HTTP.Affjax
20
- import Network.HTTP.StatusCode
18
+ import Network.HTTP.Affjax as AX
19
+ import Network.HTTP.StatusCode ( StatusCode (..))
21
20
22
- foreign import logAny
23
- :: forall e a . a -> Eff (console :: CONSOLE | e ) Unit
21
+ foreign import logAny :: forall e a . a -> Eff (console :: CONSOLE | e ) Unit
24
22
25
23
logAny' :: forall e a . a -> Assert e Unit
26
24
logAny' = liftEff <<< logAny
27
25
28
- type Assert e a = Aff (err :: EXCEPTION , console :: CONSOLE , ajax :: AJAX | e ) a
26
+ type Assert e a = Aff (err :: EXCEPTION , console :: CONSOLE , ajax :: AX. AJAX | e ) a
29
27
30
28
assertFail :: forall e a . String -> Assert e a
31
- assertFail msg = let e = error msg
32
- in makeAff \errback _ -> errback e
29
+ assertFail msg = makeAff \errback _ -> errback (error msg)
33
30
34
31
assertMsg :: forall e . String -> Boolean -> Assert e Unit
35
- assertMsg _ true = pure unit
32
+ assertMsg _ true = pure unit
36
33
assertMsg msg false = assertFail msg
37
34
38
35
assertRight :: forall e a b . Either a b -> Assert e b
@@ -46,9 +43,8 @@ assertLeft x = case x of
46
43
Left y -> pure y
47
44
48
45
assertEq :: forall e a . (Eq a , Show a ) => a -> a -> Assert e Unit
49
- assertEq x y = if x == y
50
- then pure unit
51
- else assertFail $ " Expected " <> show x <> " , got " <> show y
46
+ assertEq x y =
47
+ when (x /= y) $ assertFail $ " Expected " <> show x <> " , got " <> show y
52
48
53
49
-- | For helping type inference
54
50
typeIs :: forall e a . a -> Assert e Unit
@@ -62,7 +58,7 @@ type MainEffects e =
62
58
| e
63
59
)
64
60
65
- main :: Eff (MainEffects (ajax :: AJAX )) Unit
61
+ main :: Eff (MainEffects (ajax :: AX. AJAX )) Unit
66
62
main = void $ runAff (\e -> logShow e >>= \_ -> throwException e) (const $ log " affjax: All good!" ) $ do
67
63
let ok200 = StatusCode 200
68
64
let notFound404 = StatusCode 404
@@ -72,52 +68,52 @@ main = void $ runAff (\e -> logShow e >>= \_ -> throwException e) (const $ log "
72
68
let mirror = prefix " /mirror"
73
69
let doesNotExist = prefix " /does-not-exist"
74
70
let notJson = prefix " /not-json"
75
- let retryPolicy = defaultRetryPolicy { timeout = Just 500 , shouldRetryWithStatusCode = \_ -> true }
71
+ let retryPolicy = AX . defaultRetryPolicy { timeout = Just 500 , shouldRetryWithStatusCode = \_ -> true }
76
72
77
73
A .log " GET /does-not-exist: should be 404 Not found after retries"
78
- (attempt $ retry retryPolicy affjax $ defaultRequest { url = doesNotExist }) >>= assertRight >>= \res -> do
79
- typeIs (res :: AffjaxResponse String )
74
+ (attempt $ AX . retry retryPolicy AX . affjax $ AX . defaultRequest { url = doesNotExist }) >>= assertRight >>= \res -> do
75
+ typeIs (res :: AX. AffjaxResponse String )
80
76
assertEq notFound404 res.status
81
77
82
78
A .log " GET /mirror: should be 200 OK"
83
- (attempt $ affjax $ defaultRequest { url = mirror }) >>= assertRight >>= \res -> do
84
- typeIs (res :: AffjaxResponse Foreign )
79
+ (attempt $ AX . affjax $ AX . defaultRequest { url = mirror }) >>= assertRight >>= \res -> do
80
+ typeIs (res :: AX. AffjaxResponse Foreign )
85
81
assertEq ok200 res.status
86
82
87
83
A .log " GET /does-not-exist: should be 404 Not found"
88
- (attempt $ affjax $ defaultRequest { url = doesNotExist }) >>= assertRight >>= \res -> do
89
- typeIs (res :: AffjaxResponse String )
84
+ (attempt $ AX . affjax $ AX . defaultRequest { url = doesNotExist }) >>= assertRight >>= \res -> do
85
+ typeIs (res :: AX. AffjaxResponse String )
90
86
assertEq notFound404 res.status
91
87
92
88
A .log " GET /not-json: invalid JSON with Foreign response should throw an error"
93
- assertLeft =<< attempt (get doesNotExist :: Affjax (MainEffects ()) Foreign )
89
+ assertLeft =<< attempt (AX . get doesNotExist :: AX. Affjax (MainEffects ()) Foreign )
94
90
95
91
A .log " GET /not-json: invalid JSON with String response should be ok"
96
- (attempt $ get notJson) >>= assertRight >>= \res -> do
97
- typeIs (res :: AffjaxResponse String )
92
+ (attempt $ AX . get notJson) >>= assertRight >>= \res -> do
93
+ typeIs (res :: AX. AffjaxResponse String )
98
94
assertEq ok200 res.status
99
95
100
96
A .log " POST /mirror: should use the POST method"
101
- (attempt $ post mirror " test" ) >>= assertRight >>= \res -> do
97
+ (attempt $ AX . post mirror " test" ) >>= assertRight >>= \res -> do
102
98
assertEq ok200 res.status
103
99
assertEq " POST" (_.method $ unsafeFromForeign res.response)
104
100
105
101
A .log " PUT with a request body"
106
102
let content = " the quick brown fox jumps over the lazy dog"
107
- (attempt $ put mirror content) >>= assertRight >>= \res -> do
108
- typeIs (res :: AffjaxResponse Foreign )
103
+ (attempt $ AX . put mirror content) >>= assertRight >>= \res -> do
104
+ typeIs (res :: AX. AffjaxResponse Foreign )
109
105
assertEq ok200 res.status
110
106
let mirroredReq = unsafeFromForeign res.response
111
107
assertEq " PUT" mirroredReq.method
112
108
assertEq content mirroredReq.body
113
109
114
110
A .log " Testing CORS, HTTPS"
115
- (attempt $ get " https://cors-test.appspot.com/test" ) >>= assertRight >>= \res -> do
116
- typeIs (res :: AffjaxResponse Foreign )
111
+ (attempt $ AX . get " https://cors-test.appspot.com/test" ) >>= assertRight >>= \res -> do
112
+ typeIs (res :: AX. AffjaxResponse Foreign )
117
113
assertEq ok200 res.status
118
114
-- assertEq (Just "test=test") (lookupHeader "Set-Cookie" res.headers)
119
115
120
116
A .log " Testing cancellation"
121
- canceler <- forkAff (post_ mirror " do it now" )
117
+ canceler <- forkAff (AX . post_ mirror " do it now" )
122
118
canceled <- canceler `cancel` error " Pull the cord!"
123
119
assertMsg " Should have been canceled" canceled
0 commit comments