tricu

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

consumer_prefix_lines.tri (3827B)

      1 -- Independent oracle for the application/configuration plus two separately
      2 -- published prefixes from one code manifest. No runtime compiler fallback.
      3 !import "prelude" !Local
      4 !import "io" !Local
      5 !import "consumers.unit-build" U
      6 !import "consumers.unit-compile" C
      7 !import "consumers.source" Slots
      8 !import "consumers.lexical-worker" L
      9 !import "consumers.linked-reference" R
     10 !import "consumers.build-driver" D
     11 !import "source.module" M
     12 root = "__ROOT__"
     13 repo = "__REPO__"
     14 load path bindings = (onOk_ (readFile (append repo path))
     15   (source : pure (bindResult (U.scpUnitStage source)
     16     (unit unused : C.compileScpModuleBody (snd (snd (snd unit))) bindings))))
     17 entry rows name = fst (lazyMaybe (_ : t) (value : value) (Slots.cSlot rows name))
     18 binding alias rows = pair (append alias (append "." (fst (head rows)))) (fst (snd (head rows)))
     19 check registry code prefix input expected = (let worker = snd (head (resultOr t
     20   (L.lRunChecked (L.lWorker t code) prefix))) in
     21   let referenceRows = R.runLinkedReference registry (L.lWorker t code) prefix in
     22   foldl and? true [
     23     (equal? (L.lRunChecked (L.lWorker t code) prefix) referenceRows)
     24     (equal? (L.lRunChecked worker input) expected)
     25     (equal? (R.runLinkedReference registry worker input) expected)])
     26 scenario = do onOk_
     27   make <- load "/lib/consumer/makeWorker.scp" []
     28   prepend <- load "/lib/consumer/prepend.scp" []
     29   fold <- load "/lib/consumer/fold.scp" []
     30   reverse <- load "/lib/consumer/reverse.scp" []
     31   split <- load "/lib/consumer/text/splitLines.scp" []
     32   prefix <- load "/lib/consumer/stripPrefix.scp" []
     33   collect <- load "/lib/consumer/mapMaybe.scp" []
     34   app <- load "/demos/consumers/prefix-lines/prefix-lines.scp" [
     35     (binding "Make" make) (binding "Prepend" prepend) (binding "Fold" fold)
     36     (binding "Reverse" reverse) (binding "Split" split)
     37     (binding "Prefix" prefix) (binding "Collect" collect)]
     38   code <- M.sourceModuleLoadSelected root "__CODE__" "configurePrefix"
     39   changed <- D.configurePinned root (D.configurationRequest "__CODE__" "configurePrefix" "WARN " t)
     40   invoke <- M.sourceModuleLoadSelected root (D.configurationInvocations changed) "prefixLines"
     41   let registry = R.linkedReferenceRows (append app (foldr append [] [make prepend fold reverse split prefix collect])) in
     42   let baselineRows = resultOr t (L.lRunChecked (L.lWorker t code) "ERROR ") in
     43   let changedRows = resultOr t (L.lRunChecked (L.lWorker t code) "WARN ") in
     44   let baselineWorker = snd (head baselineRows) in
     45   let changedWorker = snd (head changedRows) in
     46   let text = "INFO ready\nERROR \nERROR disk\nWARN retry\nERROR final" in
     47   let checks = foldl and? true [
     48     (equal? code (entry app "configurePrefix"))
     49     (check registry code "ERROR " text (ok ["" "disk" "final"] t))
     50     (check registry code "WARN " text (ok ["retry"] t))
     51     (check registry code "ERROR " "ERROR \nERROR again\n" (ok ["" "again"] t))
     52     (check registry code "ERROR " "INFO only\n" (ok [] t))
     53     (check registry code "ERROR " "" (ok [] t))
     54     (check registry code "" "a\n\nb" (ok ["a" "" "b"] t))
     55     (check registry code [34 92 32] [34 92 32 65 10] (ok ["A"] t))
     56     (check registry code "ERROR " (t t) (err "no matching consumer rule" t))
     57     (check registry code "ERROR " (pair 65 (t t)) (err "no matching consumer rule" t))
     58     (equal? (snd (snd baselineWorker)) (snd (snd changedWorker)))
     59     (not? (equal? (fst (snd baselineWorker)) (fst (snd changedWorker))))
     60     (equal? (invoke text) (ok ["retry"] t))
     61     (not? (equal? (D.configurationReceipt changed) "__RECEIPT__"))] in
     62   pure (lazyBool (_ : ok (D.configurationInvocations changed) t)
     63     (_ : err "prefix-lines-checks-failed" t) checks)
     64 main = io (onResult_ scenario
     65   (problem : pure problem)
     66   (manifest : do bind
     67     _ <- putStrLn (append "warn-invocations=" manifest)
     68     putStrLn "prefix-lines-checks-ok"))
     69 main