tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

consumer_base_effect_protocol.tri (2709B)

      1 -- Independent effect name and receiver, with explicit retained state.
      2 !import "consumers.base-source" B
      3 !import "consumers.effect" E
      4 !import "consumers.lowerings.specialize" P
      5 !import "consumers.structural" S
      6 !import "io" !Local
      7 !import "prelude" !Local
      8 
      9 succeed value = pure (ok value t)
     10 fail value = pure (err "offline" t)
     11 runEcho program receiver operations = E.run P.runFull [(pair "echo" program)] operations receiver 7 91
     12 check value expected = matchResult (_ _ : false) (actual _ : equal? actual expected) value
     13 checkError value expected = matchResult (message _ : equal? message expected) (_ _ : false) value
     14 checkAll program = bind (runEcho program "echo" [(pair "Echo" succeed)]) (success :
     15   bind (runEcho program "echo" [(pair "Echo" fail)]) (failure :
     16     bind (runEcho program "echo" t) (unknownOperation :
     17       bind (runEcho program "absent" [(pair "Echo" succeed)]) (unknownReceiver :
     18         putStrLn (matchBool "effect-receiver-ok" "effect-receiver-DIFFER"
     19           (foldl and? true
     20             [(check success (pair 91 7)) (check failure (pair 91 "offline"))
     21              (checkError unknownOperation "unknown operation")
     22              (checkError unknownReceiver "unknown receiver")]))))))
     23 -- Synthetic steps isolate driver behavior from source lowering. Distinct
     24 -- receiver bodies make accidentally reusing the initiating receiver observable.
     25 protocolStep program input = ok ((snd program) input (fst program)) t
     26 startStep input environment = E.request "Echo" input "middle" 91
     27 middleStep input environment = E.request "Echo" (pair environment input) "last" 92
     28 lastStep input environment = E.done (pair environment input)
     29 missingStep input environment = E.request "Echo" input "absent" environment
     30 unexpectedHandler value = thenIO (putStrLn "UNEXPECTED-HANDLER") (pure (ok value t))
     31 protocolRegistry = [(pair "start" (S.makeConsumer t startStep)) (pair "middle" (S.makeConsumer t middleStep)) (pair "last" (S.makeConsumer t lastStep)) (pair "missing" (S.makeConsumer t missingStep))]
     32 checkDriver = bind (E.run protocolStep protocolRegistry [(pair "Echo" succeed)] "start" 7 t) (hops :
     33   bind (E.run protocolStep protocolRegistry [(pair "Echo" unexpectedHandler)] "missing" 7 t) (missing :
     34     putStrLn (matchBool "effect-driver-ok" "effect-driver-DIFFER" (and?
     35       (check hops (pair 92 (pair 1 (pair 91 (pair 1 7)))))
     36       (checkError missing "unknown receiver")))))
     37 main = io (thenIO checkDriver (onResult_ (readFile "demos/consumers/echo/echo-effect.scp")
     38   (problem : putStrLn (append "echo-read-error=" problem))
     39   (source : lazyResult
     40     (_ _ : putStrLn "echo-source-error")
     41     (compiled _ : checkAll (P.prepareFully (snd compiled)))
     42     (B.compileBaseSource source))))
     43 main