@@ -2,24 +2,396 @@ module Test.Main where
22
33import Prelude
44
5+import Control.Monad.Error.Class as MonadThrow
6+import Control.Monad.Reader.Class (asks)
7+import Data.Array (intercalate)
8+import Data.Either (Either(..))
9+import Data.Maybe (Maybe(..))
10+import Data.Monoid (power)
11+import Data.Time.Duration (Milliseconds(..), Seconds(..))
12+import Data.Variant (match)
513import Effect (Effect)
6−import Effect.Aff (launchAff_)
14+import Effect.Aff (Aff, launchAff_)
15+import Effect.Aff as Aff
716import Effect.Aff.Class (liftAff)
17+import Effect.Aff.Retry (RetryStatus(..), limitRetries, constantDelay)
818import Effect.Class (liftEffect)
19+import Effect.Class.Console as Console
20+import Effect.Exception as Exn
921import Effect.Ref as Ref
10−import Effect.Aff.Retry (RetryStatus(..), limitRetries, constantDelay)
11−import Data.Either (Either(..))
12−import Data.Time.Duration (Milliseconds(..))
13−import Data.Variant (match)
1422import Test.Spec (describe, it)
1523import Test.Spec.Assertions (shouldEqual)
1624import Test.Spec.Reporter (consoleReporter)
1725import Test.Spec.Runner (runSpec)
26+import Yoga.Om (Om)
1827import Yoga.Om as Om
1928import Yoga.Om.Retry (recovering, repeating)
2029
2130main :: Effect Unit
2231main = launchAff_ $ runSpec [ consoleReporter ] do
32+
33+ describe "Yoga.Om - basics" do
34+
35+ it "pure values pass through" do
36+ result <- pure true
37+ # Om.runOm {} { exception: \_ -> pure false }
38+ # liftAff
39+ result `shouldEqual` true
40+
41+ it "launches safely" do
42+ let launch = Console.log "Hello from Om" # Om.launchOm_ {} { exception: \_ -> pure unit }
43+ liftEffect launch
44+
45+ it "reads context with ask" do
46+ result <- do
47+ ctx <- Om.ask
48+ pure ctx.name
49+ # Om.runOm { name: "Alice" } { exception: \_ -> pure "" }
50+ # liftAff
51+ result `shouldEqual` "Alice"
52+
53+ it "lifts Aff with fromAff" do
54+ ref <- Ref.new 0 # liftEffect
55+ result <- Om.fromAff (Ref.modify (_ + 1) ref # liftEffect)
56+ # Om.runOm {} { exception: \_ -> pure 0 }
57+ # liftAff
58+ result `shouldEqual` 1
59+
60+ describe "Yoga.Om - exception safety" do
61+
62+ it "fatal throws a string into the exception channel" do
63+ result <- do
64+ _ <- Om.fatal "something went wrong"
65+ pure "unreachable"
66+ # Om.runOm {} { exception: \e -> pure (Exn.message e) }
67+ # liftAff
68+ result `shouldEqual` "something went wrong"
69+
70+ it "catches Aff exceptions" do
71+ result <- do
72+ _ <- Om.fromAff (Aff.throwError (Exn.error "boom"))
73+ pure "ok"
74+ # Om.runOm {} { exception: \_ -> pure "caught" }
75+ # liftAff
76+ result `shouldEqual` "caught"
77+
78+ it "catches Effect exceptions" do
79+ result <- do
80+ liftEffect throwingEffect $> "never reached"
81+ # Om.runOm {} { exception: \_ -> pure "caught" }
82+ # liftAff
83+ result `shouldEqual` "caught"
84+
85+ describe "Yoga.Om - context composition" do
86+
87+ it "combines Oms with different contexts" do
88+ let askText = Om.ask <#> _.text
89+ let askHowOften = Om.asks _.howOften
90+ result <- do
91+ text <- askText
92+ times <- askHowOften
93+ pure (power text times)
94+ # Om.runOm { text: "!", howOften: 3 } { exception: \_ -> pure "" }
95+ # liftAff
96+ result `shouldEqual` "!!!"
97+
98+ it "expandCtx widens a closed context" do
99+ let appM1 = (asks _.x) :: Om { x :: String } () String
100+ let appM2 = (asks _.y) :: Om { y :: String } () String
101+ result <- do
102+ r1 <- Om.expandCtx appM1
103+ r2 <- Om.expandCtx appM2
104+ pure (r1 <> " " <> r2)
105+ # Om.runOm { x: "good", y: "food" } { exception: \_ -> pure "" }
106+ # liftAff
107+ result `shouldEqual` "good food"
108+
109+ it "expand widens both context and errors" do
110+ let appM1 = (asks _.x) :: Om { x :: String } (bad :: String) String
111+ let appM2 = (asks _.y) :: Om { y :: String } (realBad :: String) String
112+ result <- do
113+ r1 <- Om.expand appM1
114+ r2 <- Om.expand appM2
115+ pure (r1 <> " " <> r2)
116+ # Om.runOm { x: "good", y: "food" } { exception: \_ -> pure "", bad: pure, realBad: pure }
117+ # liftAff
118+ result `shouldEqual` "good food"
119+
120+ describe "Yoga.Om - errors" do
121+
122+ it "throw delivers error to handler" do
123+ result <- Om.throw { notFound: "missing" }
124+ # Om.runOm {} { exception: \_ -> pure "", notFound: \msg -> pure msg }
125+ # liftAff
126+ result `shouldEqual` "missing"
127+
128+ it "throw with error helper" do
129+ result <- (MonadThrow.throwError $ Om.error { badError: "bad" })
130+ # runExampleOm
131+ # liftAff
132+ result `shouldEqual` "bad"
133+
134+ it "expandErr widens closed error rows" do
135+ let appM1 = pure "good" :: Om {} (goodError :: Int) String
136+ let appM2 = Om.throw { badError: "bad" } :: Om {} (badError :: String) String
137+ result <- do
138+ _ <- Om.expandErr appM1
139+ Om.expandErr appM2
140+ # Om.runOm {} { exception: \_ -> pure "", goodError: pure <<< show, badError: pure }
141+ # liftAff
142+ result `shouldEqual` "bad"
143+
144+ it "handleErrors catches and recovers" do
145+ result <- Om.handleErrors { notFound: \_ -> pure "recovered" } do
146+ Om.throw { notFound: "oops" }
147+ # Om.runOm {} { exception: \_ -> pure "" }
148+ # liftAff
149+ result `shouldEqual` "recovered"
150+
151+ it "handleErrors eliminates handled error from row" do
152+ let
153+ getFromCache = do
154+ _ <- Om.throw { cacheError: "not found" }
155+ _ <- Om.throw { benignError: "harmless" }
156+ Om.throw { badError: "bad" }
157+ let
158+ appM :: Om {} (badError :: String) String
159+ appM = do
160+ _ <- getFromCache # Om.handleErrors
161+ { cacheError: \_ -> pure "cached"
162+ , benignError: \_ -> pure "ok"
163+ }
164+ pure "done"
165+ result <- appM # runExampleOm # liftAff
166+ result `shouldEqual` "done"
167+
168+ it "handleErrors can transform errors" do
169+ let
170+ getFromCache = do
171+ _ <- Om.throw { cacheError: "not found" }
172+ Om.throw { fatal: "horrible" }
173+ let
174+ appM :: Om {} (badError :: String) String
175+ appM = do
176+ _ <- getFromCache # Om.handleErrors
177+ { cacheError: \_ -> Om.throw { badError: "bad" }
178+ , fatal: \_ -> pure "fine"
179+ }
180+ pure "done"
181+ result <- appM # runExampleOm # liftAff
182+ result `shouldEqual` "bad"
183+
184+ it "mapError transforms error type" do
185+ result <- Om.mapError @"notFound" @"apiError" (\msg -> "mapped: " <> msg)
186+ (Om.throw { notFound: "gone" })
187+ # Om.runOm {} { exception: \_ -> pure "", apiError: \msg -> pure msg }
188+ # liftAff
189+ result `shouldEqual` "mapped: gone"
190+
191+ it "onError runs side effect then re-throws" do
192+ ref <- Ref.new "" # liftEffect
193+ result <- Om.onError @"notFound"
194+ (\msg -> do
195+ Ref.write ("saw: " <> msg) ref # liftEffect
196+ Om.throw { notFound: msg }
197+ )
198+ (Om.throw { notFound: "404" })
199+ # Om.runOm {} { exception: \_ -> pure "", notFound: \msg -> pure msg }
200+ # liftAff
201+ result `shouldEqual` "404"
202+ logged <- Ref.read ref # liftEffect
203+ logged `shouldEqual` "saw: 404"
204+
205+ it "combines Oms with different errors" do
206+ let readFromDisk = Om.throw { ioError: { reason: "Disk Exploded", code: -3 } }
207+ let readFromDB = Om.throw { dbError: "DB Dead" }
208+ result <- do
209+ _ <- readFromDisk
210+ _ <- readFromDB
211+ pure "unreachable"
212+ # Om.runOm {}
213+ { exception: \_ -> pure ""
214+ , dbError: pure
215+ , ioError: \err -> pure (err.reason <> " " <> show err.code)
216+ }
217+ # liftAff
218+ result `shouldEqual` "Disk Exploded -3"
219+
220+ describe "Yoga.Om - helpers" do
221+
222+ it "note converts Just to pure" do
223+ result <- Om.note { missing: unit } (Just 42)
224+ # Om.runOm {} { exception: \_ -> pure 0, missing: \(_ :: Unit) -> pure 0 }
225+ # liftAff
226+ result `shouldEqual` 42
227+
228+ it "note converts Nothing to throw" do
229+ result <- Om.note { missing: unit } (Nothing :: Maybe Int)
230+ # Om.runOm {} { exception: \_ -> pure 0, missing: \(_ :: Unit) -> pure 99 }
231+ # liftAff
232+ result `shouldEqual` 99
233+
234+ it "throwLeftAs converts Left to error" do
235+ result <- Left "bad" # Om.throwLeftAs (\badError -> Om.error { badError })
236+ # runExampleOm
237+ # liftAff
238+ result `shouldEqual` "bad"
239+
240+ it "noteM throws when Nothing with monadic error" do
241+ result <- (Nothing # Om.noteM do
242+ _ <- Om.throw { badError: "bad" }
243+ pure $ Om.error { badError: "unreachable" })
244+ # runExampleOm
245+ # liftAff
246+ result `shouldEqual` "bad"
247+
248+ it "throwLeftAsM converts Left with monadic transform" do
249+ result <- (Left "bad" # Om.throwLeftAsM \badError -> do
250+ _ <- Om.throw { badError }
251+ pure $ Om.error { badError: "unreachable" })
252+ # runExampleOm
253+ # liftAff
254+ result `shouldEqual` "bad"
255+
256+ it "tap runs side effect and returns value" do
257+ ref <- Ref.new "" # liftEffect
258+ result <- Om.tap (\s -> Ref.write s ref # liftEffect) "hello"
259+ # Om.runOm {} { exception: \_ -> pure "" }
260+ # liftAff
261+ result `shouldEqual` "hello"
262+ written <- Ref.read ref # liftEffect
263+ written `shouldEqual` "hello"
264+
265+ it "tapM runs side effect on monadic result" do
266+ ref <- Ref.new 0 # liftEffect
267+ result <- Om.tapM (\n -> Ref.write n ref # liftEffect) (pure 42)
268+ # Om.runOm {} { exception: \_ -> pure 0 }
269+ # liftAff
270+ result `shouldEqual` 42
271+ written <- Ref.read ref # liftEffect
272+ written `shouldEqual` 42
273+
274+ describe "Yoga.Om - parallel" do
275+
276+ it "race returns fastest result" do
277+ result <- Om.race
278+ [ Om.delay (1.0 # Seconds) *> pure "slow"
279+ , pure "fast"
280+ ]
281+ # runExampleOm
282+ # liftAff
283+ result `shouldEqual` "fast"
284+
285+ it "race prefers success over fast failure" do
286+ result <- Om.race
287+ [ Om.throw { badError: "fast but broken" }
288+ , Om.delay (8.0 # Milliseconds) *> pure "slow but works"
289+ ]
290+ # runExampleOm
291+ # liftAff
292+ result `shouldEqual` "slow but works"
293+
294+ it "inParallel collects all results" do
295+ result <- do
296+ strings <- Om.inParallel
297+ [ Om.delay (9.0 # Milliseconds) *> pure "1"
298+ , Om.delay (1.0 # Milliseconds) *> pure "2"
299+ ]
300+ pure $ intercalate "|" strings
301+ # runExampleOm
302+ # liftAff
303+ result `shouldEqual` "1|2"
304+
305+ it "inParallel fails fast" do
306+ result <- do
307+ strings <- Om.inParallel
308+ [ Om.throw { badError: "fast but broken" }
309+ , Om.delay (8.0 # Milliseconds) *> pure "slow but works"
310+ ]
311+ pure $ intercalate "|" strings
312+ # runExampleOm
313+ # liftAff
314+ result `shouldEqual` "fast but broken"
315+
316+ describe "Yoga.Om - runOmRecord" do
317+
318+ it "sequences a record of Oms and runs to Aff" do
319+ result <- Om.runOmRecord { greeting: "hi" }
320+ { exception: \_ -> pure { a: "", b: 0 } }
321+ { a: (Om.ask :: Om.Om { greeting :: String } () { greeting :: String }) <#> _.greeting
322+ , b: pure 42 :: Om.Om {} () Int
323+ }
324+ # liftAff
325+ result.a `shouldEqual` "hi"
326+ result.b `shouldEqual` 42
327+
328+ describe "Yoga.Om - sequenceOmRecord" do
329+
330+ it "sequences a record of Oms into one Om" do
331+ result <- Om.sequenceOmRecord
332+ { a: (Om.ask :: Om.Om { x :: Int } () { x :: Int }) <#> _.x
333+ , b: (Om.ask :: Om.Om { y :: String } () { y :: String }) <#> _.y
334+ }
335+ # Om.runOm { x: 1, y: "two" } { exception: \_ -> pure { a: 0, b: "" } }
336+ # liftAff
337+ result.a `shouldEqual` 1
338+ result.b `shouldEqual` "two"
339+
340+ describe "Yoga.Om - runOms" do
341+
342+ it "maps a record of Oms to a record of Affs" do
343+ let
344+ affs = Om.runOms { greeting: "hello" }
345+ { exception: \_ -> pure unit }
346+ { name: (Om.ask :: Om.Om { greeting :: String } () { greeting :: String }) <#> _.greeting
347+ , number: pure 42 :: Om.Om {} () Int
348+ }
349+ name <- affs.name # liftAff
350+ number <- affs.number # liftAff
351+ name `shouldEqual` "hello"
352+ number `shouldEqual` 42
353+
354+ it "runs each Aff independently" do
355+ ref <- Ref.new 0 # liftEffect
356+ let
357+ affs = Om.runOms {}
358+ { exception: \_ -> pure unit }
359+ { inc: Ref.modify (_ + 1) ref # liftEffect :: Om.Om {} () Int
360+ }
361+ _ <- affs.inc # liftAff
362+ _ <- affs.inc # liftAff
363+ _ <- affs.inc # liftAff
364+ result <- Ref.read ref # liftEffect
365+ result `shouldEqual` 3
366+
367+ it "expands different context rows to a shared context" do
368+ let
369+ affs = Om.runOms { foo: 1, bar: "hi" }
370+ { exception: \_ -> pure unit }
371+ { fromFoo: (Om.ask :: Om.Om { foo :: Int } () { foo :: Int }) <#> _.foo
372+ , fromBar: (Om.ask :: Om.Om { bar :: String } () { bar :: String }) <#> _.bar
373+ }
374+ foo <- affs.fromFoo # liftAff
375+ bar <- affs.fromBar # liftAff
376+ foo `shouldEqual` 1
377+ bar `shouldEqual` "hi"
378+
379+ describe "Yoga.Om - runOmsInOm" do
380+
381+ it "runs Oms using context from ask" do
382+ affs <- Om.runOmsInOm
383+ { exception: \_ -> pure unit }
384+ { name: (Om.ask :: Om.Om { greeting :: String } () { greeting :: String }) <#> _.greeting
385+ , number: pure 42 :: Om.Om {} () Int
386+ }
387+ # Om.runOm { greeting: "world" }
388+ { exception: \_ -> pure { name: pure "", number: pure 0 } }
389+ # liftAff
390+ name <- affs.name # liftAff
391+ number <- affs.number # liftAff
392+ name `shouldEqual` "world"
393+ number `shouldEqual` 42
394+
23395 describe "Yoga.Om.Retry - recovering" do
24396
25397 it "retries on matching errors up to the limit" do
@@ -190,3 +562,8 @@ main = launchAff_ $ runSpec [ consoleReporter ] do
190562 # Om.runOm {} { exception: \_ -> pure "" }
191563 # liftAff
192564 result `shouldEqual` "attempt-2"
565+
566+foreign import throwingEffect :: Effect Unit
567+
568+runExampleOm :: Om {} (badError :: String) String -> Aff String
569+runExampleOm = Om.runOm {} { exception: \_ -> pure "exception", badError: pure }