tricu

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

consumer_composition_usability.tri (3992B)

      1 -- Two public-library programs: collect matching route suffixes, then choose
      2 -- the first nonempty suffix with a caller-supplied fallback. No new SCP syntax.
      3 !import "consumers.base-source" B
      4 !import "consumers.structural" S
      5 !import "consumers.lexical-worker" L
      6 !import "prelude" !Local
      7 !import "io" !Local
      8 
      9 loadPath path = (onResult_ (readFile path)
     10   (problem : pure (err problem t))
     11   (source : pure (matchResult
     12     (_ _ : err "consumer source did not parse" t)
     13     (named _ : ok (snd named) t)
     14     (B.compileBaseSource source))))
     15 load name = loadPath (append "lib/consumer/" (append name ".scp"))
     16 worker program initial = S.makeConsumer initial (snd program)
     17 compare pureWorker lexicalWorker input = (equal?
     18   (S.runConsumer pureWorker input) (L.lRunChecked lexicalWorker input))
     19 referencePipeline collector chooser paths fallback =
     20   bindResult (S.runConsumer collector paths) (suffixes _ :
     21     S.runConsumer chooser (pair suffixes fallback))
     22 lexicalPipeline collector chooser paths fallback =
     23   bindResult (L.lRunChecked collector paths) (suffixes _ :
     24     L.lRunChecked chooser (pair suffixes fallback))
     25 badMapper = snd (resultOr t (B.compileBaseSource
     26   "consumer malformed\n  x @ _ => (leaf, leaf)"))
     27 checks prefix mapMaybe nonempty finder chooser =
     28   let refPrefix = worker prefix "/api/" in
     29   let lexPrefix = resultOr t (L.lCompile refPrefix) in
     30   let refCollect = worker mapMaybe refPrefix in
     31   let lexCollect = resultOr t (L.lCompile
     32     (worker mapMaybe lexPrefix)) in
     33   let refNonempty = worker nonempty t in
     34   let lexNonempty = resultOr t (L.lCompile refNonempty) in
     35   let refFind = worker finder refNonempty in
     36   let lexFind = resultOr t (L.lCompile (worker finder lexNonempty)) in
     37   let refChoose = worker chooser refFind in
     38   let lexChoose = resultOr t (L.lCompile
     39     (worker chooser lexFind)) in
     40   let refBad = worker mapMaybe badMapper in
     41   let lexBad = resultOr t (L.lCompile (worker mapMaybe
     42     (resultOr t (L.lCompile badMapper)))) in
     43   let routes = ["/api/" "/other" "/api/item" "/api/health"] in
     44   let collected = ["" "item" "health"] in
     45   let noRoutes = ["/other" "/else"] in
     46   foldl and? true [
     47     (resultIsOk (L.lCompile refPrefix))
     48     (resultIsOk (L.lCompile (worker mapMaybe lexPrefix)))
     49     (resultIsOk (L.lCompile (worker finder lexNonempty)))
     50     (resultIsOk (L.lCompile (worker chooser lexFind)))
     51     (compare refCollect lexCollect routes)
     52     (equal? (S.runConsumer refCollect routes) (ok collected t))
     53     (compare refCollect lexCollect ["/api/"])
     54     (equal? (S.runConsumer refCollect ["/api/"]) (ok [""] t))
     55     (compare refCollect lexCollect noRoutes)
     56     (equal? (S.runConsumer refCollect noRoutes) (ok [] t))
     57     (equal? (referencePipeline refCollect refChoose routes "none")
     58       (ok "item" t))
     59     (equal? (referencePipeline refCollect refChoose ["/api/"] "none")
     60       (ok "none" t))
     61     (equal? (referencePipeline refCollect refChoose noRoutes "none")
     62       (ok "none" t))
     63     (equal? (referencePipeline refCollect refChoose noRoutes "alternate")
     64       (ok "alternate" t))
     65     (equal? (referencePipeline refCollect refChoose routes "none")
     66       (lexicalPipeline lexCollect lexChoose routes "none"))
     67     (equal? (referencePipeline refCollect refChoose ["/api/"] "none")
     68       (lexicalPipeline lexCollect lexChoose ["/api/"] "none"))
     69     (equal? (referencePipeline refCollect refChoose noRoutes "alternate")
     70       (lexicalPipeline lexCollect lexChoose noRoutes "alternate"))
     71     (compare refBad lexBad routes)
     72     (equal? (S.runConsumer refBad routes) (err "no matching output arm" t))]
     73 stage = do onOk_
     74   prefix <- load "stripPrefix"
     75   mapMaybe <- load "mapMaybe"
     76   nonempty <- load "nonempty"
     77   finder <- load "find"
     78   chooser <- loadPath "demos/consumers/collect-prefixes/choose-found.scp"
     79   pure (ok (checks prefix mapMaybe nonempty finder chooser) t)
     80 main = io (onResult_ stage
     81   (_ : putStrLn "consumer-composition-LOAD-FAIL")
     82   (success : putStrLn (matchBool "consumer-composition-ok"
     83     "consumer-composition-DIFFER" success)))
     84 main