tricu

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

consumer_registry_comparison.tri (2002B)

      1 -- Same parsed request and real local ReadFile path for both authored programs.
      2 !import "consumers.registry-source" RS
      3 !import "consumers.registry" R
      4 !import "consumers.structural" SCP
      5 !import "consumers.comparison.registry-lambda" L
      6 !import "http" H
      7 !import "parser" P
      8 !import "io" !Local
      9 !import "prelude" !Local
     10 root = "__ROOT__"
     11 compare program request expected = bind (R.routeRun program root request) (observed :
     12   bind (L.lambdaRoute root request) (reference :
     13     pure (and? (equal? observed reference)
     14       (lazyMaybe
     15         (_ : maybe? (L.prefixRest "HTTP/1.1 404 Not Found" observed))
     16         (body : equal? observed body) expected))))
     17 main = io (onResult_ (readFile "demos/consumers/registry/registry.scp")
     18   (problem : putStrLn (append "source-read-error=" problem))
     19   (source : lazyResult
     20     (diagnostic _ : putStrLn (append "parse-error=" (showNumber (P.parserDiagnosticCode diagnostic))))
     21     (program _ : bind (compare program (pair "GET" "/_arboricx/health") (just (H.okResponse "OK\n"))) (health :
     22       bind (compare program (pair "GET" "/_arboricx/bundle/hash/abc123") (just (H.response 200 "application/vnd.arboricx.bundle" "sample-bundle"))) (found :
     23         bind (compare program (pair "GET" "/_arboricx/bundle/hash/abc999") nothing) (missing :
     24           bind (compare program (pair "POST" "/_arboricx/health") (just H.notFoundResponse)) (badMethod :
     25             bind (compare program (pair "GET" "/random") (just H.notFoundResponse)) (unknown :
     26               bind (R.routeRun (pair (fst program)
     27                 (SCP.replaceLiteral (snd program) "OK\n" "READY\n")) root
     28                 (pair "GET" "/_arboricx/health")) (transformed :
     29                 putStrLn (matchBool "registry-source-and-lambda-match"
     30                   "registry-source-and-lambda-DIFFER"
     31                   (foldl and? true
     32                     [health found missing badMethod unknown
     33                      (equal? transformed (H.okResponse "READY\n"))])))))))))
     34     (RS.compileRouteSource source)))
     35 main