consumer_effect_depth.tri (3614B)
1 !import "prelude" !Local 2 !import "io" !Local 3 !import "consumers.structural" S 4 !import "consumers.lexical-worker" L 5 !import "consumers.unit-compile" U 6 !import "consumers.effect-compose" E 7 8 reference rows = map (row : pair (fst row) (fst (snd (snd row)))) rows 9 lexical rows = map (row : pair (fst row) (S.makeConsumer t (L.lWorker t (fst (snd row))))) rows 10 record value = bind get (trace : put (pair value trace)) 11 echo value = bind (record value) (_ : pure (ok value t)) 12 failLast value = (bind (record value) (_ : lazyBool 13 (_ : pure (err (pair "stopped" value) [91])) (_ : pure (ok value t)) (equal? value 0))) 14 badLast value = (bind (record value) (_ : lazyBool 15 (_ : pure t) (_ : pure (ok value t)) (equal? value 0))) 16 run step scope handler input = (bind (put t) (_ : 17 bind (E.runWithFault (diagnostic : pure (pair E.faultTag diagnostic)) 18 step [(pair "Echo" handler)] scope input t) (result : 19 bind get (trace : pure (pair result (reverse trace)))))) 20 checkBackend step receivers callers input = (lazyResult 21 (_ _ : pure (pair t false)) 22 (dependency _ : E.prepareWithFault (diagnostic : pure (pair E.faultTag diagnostic)) 23 (E.makePackage "entry" callers [(pair "relay" dependency)]) (scope : 24 let failingInput = append input [0] in 25 bind (run step scope echo input) (success : 26 bind (run step scope failLast failingInput) (failure : 27 bind (run step scope badLast failingInput) (broken : 28 let diagnostic = snd (fst broken) in pure (pair [success failure broken] 29 (foldl and? true [ 30 (equal? success (pair (ok input t) input)) 31 (equal? failure (pair (err (pair "stopped" 0) [91]) failingInput)) 32 (equal? (fst (fst broken)) E.faultTag) 33 (equal? (E.faultKind diagnostic) "protocol") 34 (equal? (E.faultDetail diagnostic) "invalid operation Result") 35 (equal? (E.faultLocation diagnostic) (pair "entry" "entry")) 36 (equal? (E.faultReturns diagnostic) (append (map (_ : pair "entry" (pair "again" "resume")) input) 37 [(pair "entry" (pair "relay" "resume"))])) 38 (equal? (snd broken) failingInput)]))))))) 39 (E.makePackage "entry" receivers [(pair "again" E.selfReference)])) 40 check rows callerRows input = (bind (checkBackend S.runConsumer (reference rows) (reference callerRows) input) (ref : 41 bind (checkBackend L.lEffectStep (lexical rows) (lexical callerRows) input) (lex : 42 bind (checkBackend L.lPreparedEffectStep (lexical rows) (lexical callerRows) input) (prepared : 43 putStrLn (matchBool "consumer-effect-depth-ok" "consumer-effect-depth-DIFFER" 44 (foldl and? true [(equal? ref lex) (snd lex) (equal? prepared lex) (snd prepared) 45 (equal? (L.lPrepareEffectReceivers (lexical rows)) (ok (lexical rows) t)) 46 (equal? (L.lPrepareEffectReceivers (lexical callerRows)) (ok (lexical callerRows) t))])))))) 47 inputPath = __INPUT_PATH__ 48 main = io (onResult_ (readFile "test/fixtures/effect-scopes/recursive.scp") 49 (_ : putStrLn "consumer-effect-depth-source-error") 50 (source : lazyResult (_ _ : putStrLn "consumer-effect-depth-compile-error") 51 (rows _ : onResult_ (readFile "test/fixtures/effect-scopes/result-caller.scp") 52 (_ : putStrLn "consumer-effect-depth-caller-source-error") 53 (callerSource : lazyResult (_ _ : putStrLn "consumer-effect-depth-caller-compile-error") 54 (callerRows _ : onResult_ (readFile inputPath) 55 (_ : putStrLn "consumer-effect-depth-input-error") (input : check rows callerRows input)) 56 (U.compileScpUnit callerSource t))) 57 (U.compileScpUnit source t))) 58 main