tricu

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

consumer_map_maybe.tri (2577B)

      1 -- A library-only list transform: keep the optional values produced by a
      2 -- mapper; check reference and lexical behavior on present leaf and failures.
      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 load name = (onResult_ (readFile (append "lib/consumer/" (append name ".scp")))
     10   (problem : pure (err problem t))
     11   (source : pure (matchResult
     12     (_ _ : err "consumer source did not parse" t)
     13     (program _ : ok (snd program) t)
     14     (B.compileBaseSource source))))
     15 worker program state = S.makeConsumer state (snd program)
     16 compare authored executable input = (equal?
     17   (S.runConsumer authored input) (L.lRunChecked executable input))
     18 selected = snd (resultOr t (B.compileBaseSource
     19   "consumer selected\n  [] @ _ => leaf\n  [head | tail] @ _ => stem head"))
     20 onlyEmpty = snd (resultOr t (B.compileBaseSource
     21   "consumer onlyEmpty\n  [] @ _ => stem leaf"))
     22 malformedOption = snd (resultOr t (B.compileBaseSource
     23   "consumer malformedOption\n  x @ _ => (leaf, leaf)"))
     24 checks mapper =
     25   let refSelected = worker selected t in
     26   let lexSelected = resultOr t (L.lCompile refSelected) in
     27   let refMap = worker mapper refSelected in
     28   let lexMap = resultOr t (L.lCompile
     29     (worker mapper lexSelected)) in
     30   let refFail = worker mapper onlyEmpty in
     31   let lexFail = resultOr t (L.lCompile
     32     (worker mapper (resultOr t (L.lCompile onlyEmpty)))) in
     33   let refMalformed = worker mapper malformedOption in
     34   let lexMalformed = resultOr t (L.lCompile
     35     (worker mapper (resultOr t (L.lCompile malformedOption)))) in
     36   let mixed = [[] [t] [] [2]] in
     37   foldl and? true [
     38     (resultIsOk (L.lCompile refSelected))
     39     (resultIsOk (L.lCompile (worker mapper lexSelected)))
     40     (compare refMap lexMap [])
     41     (equal? (S.runConsumer refMap []) (ok [] t))
     42     (compare refMap lexMap [[] []])
     43     (equal? (S.runConsumer refMap [[] []]) (ok [] t))
     44     (compare refMap lexMap mixed)
     45     (equal? (S.runConsumer refMap mixed) (ok [t 2] t))
     46     (compare refMap lexMap [[1] [2] [3]])
     47     (equal? (S.runConsumer refMap [[1] [2] [3]]) (ok [1 2 3] t))
     48     (compare refFail lexFail [[] [1]])
     49     (equal? (S.runConsumer refFail [[] [1]])
     50       (err "no matching consumer rule" t))
     51     (compare refMalformed lexMalformed [[1]])
     52     (equal? (S.runConsumer refMalformed [[1]])
     53       (err "no matching output arm" t))]
     54 main = io (onResult_ (load "mapMaybe") (_ : putStrLn "mapMaybe-load-fail") (mapper :
     55   putStrLn (matchBool "consumer-map-maybe-ok" "consumer-map-maybe-DIFFER"
     56     (checks mapper))))
     57 main