tricu

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

consumer_source_link_fresh.tri (1773B)

      1 !import "consumers.module" M
      2 !import "consumers.structural" S
      3 !import "consumers.lexical-worker" X
      4 !import "consumers.text-summary" T
      5 !import "source.module" Mod
      6 !import "source.resolve" R
      7 !import "io" !Local
      8 !import "prelude" !Local
      9 root = "__ROOT__"
     10 imports = "__IMPORTS__"
     11 sidecars = "__SIDECARS__"
     12 selected defs name = R.sourceFindExternal defs name
     13 successor defs = lazyMaybe t (value : value) (selected defs "successor")
     14 linked defs path = (lazyMaybe (_ : pure (pair 0 "missing counter"))
     15   (counter : lazyMaybe (_ : pure (pair 0 "missing entry"))
     16     (entry : lazyMaybe (_ : pure (pair 0 "missing receiver"))
     17       (receiver : T.summaryLexical
     18         (resultOr t (X.lCompile (S.makeConsumer
     19           (T.counterState (resultOr t (X.lCompile (successor defs))))
     20           (snd counter))))
     21         (resultOr t (X.lCompileOpen entry))
     22         (resultOr t (X.lCompileOpen receiver)) path)
     23       (selected defs "receiver")) (selected defs "entry")) (selected defs "counter"))
     24 run = (onOk_ (M.cmLoad root imports) (defs :
     25   onOk_ (Mod.sourceModuleLoadSelected root sidecars "counter") (original :
     26     onOk_ (Mod.sourceModuleLoadSelected root sidecars "entry") (entry :
     27       bind (linked defs "__SAMPLE__") (outcome :
     28         bind (linked defs "__MISSING__") (missing :
     29           pure (ok (foldl and? true [
     30             (equal? original (lazyMaybe (_ : t) (value : value) (selected defs "counter")))
     31             (equal? entry (lazyMaybe (_ : t) (value : value) (selected defs "entry")))
     32             (equal? (T.render outcome) "lines: 2")
     33             (equal? (fst missing) 0)]) t)))))))
     34 main = io (onResult_ run (problem : putStrLn (append "source-link-fresh-ERROR " problem))
     35   (valid : putStrLn (matchBool "source-link-fresh-ok" "source-link-fresh-DIFFER" valid)))
     36 main