tricu

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

workspace_mixed_build.tri (5056B)

      1 -- Source paths/frontends are portable explicit data, not source-language
      2 -- directives or the bootstrap !import workspace resolver.
      3 !import "prelude" !Local
      4 !import "io" !Local
      5 !import "source.workspace-build" W
      6 !import "source.module" M
      7 !import "source.object" O
      8 !import "consumers.unit-build" U
      9 !import "consumers.unit-compile" UC
     10 !import "consumers.lexical-worker" L
     11 !import "consumers.linked-reference" R
     12 !import "consumers.configure" C
     13 root = "__ROOT__"
     14 directory = "__WORKSPACE__"
     15 compiler = "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef"
     16 declarations = [
     17   (pair "data" (pair "__DATA_PATH__" "tri"))
     18   (pair "app" (pair "app.tri" "__APP_FRONTEND__"))
     19   (pair "bridge" (pair "bridge.blob" "tri"))]
     20 build name = W.workspaceBuildGraph directory declarations root compiler name
     21 mapChecks = foldl and? true [
     22   (resultIsOk (W.workspaceDeclarations declarations))
     23   (resultIsOk (W.workspaceDeclarations []))
     24   (resultIsErr (W.workspaceDeclarations [(pair "dup" (pair "a" "tri")) (pair "dup" (pair "b" "scp"))]))
     25   (resultIsErr (W.workspaceDeclarations [(pair "a" (pair "a" "guess"))]))
     26   (resultIsErr (W.workspaceDeclarations [(pair "bad.name" (pair "a" "tri"))]))
     27   (resultIsErr (W.workspaceDeclarations [(pair "a" (pair "" "tri"))]))
     28   (resultIsErr (W.workspaceDeclarations [(pair "a" (pair "/absolute" "tri"))]))
     29   (resultIsErr (W.workspaceDeclarations [(pair "a" (pair (pair 0 t) "tri"))]))
     30   (resultIsErr (W.workspaceDeclarations [(pair "a" (pair (t t) "tri"))]))
     31   (resultIsErr (W.workspaceDeclarations [(pair "a" t)]))
     32   (resultIsErr (W.workspaceDeclarations [t]))
     33   (resultIsErr (W.workspaceDeclarations (t t)))
     34   (not? (equal? (W.wbOptions (pair "p" (pair "tri" (pair "source-module.reference.v1" t))))
     35     (W.wbOptions (pair "p" (pair "scp" (pair "scp-unit.lexical-worker.v2" t))))))
     36   (not? (equal? (W.wbOptions (pair "p" (pair "tri" (pair "source-module.reference.v1" t))))
     37     (W.wbOptions (pair "p" (pair "tri" (pair "changed-profile" t))))))]
     38 scenario = do onOk_
     39   bridge <- build "bridge"
     40   app <- build "app"
     41   data <- build "data"
     42   missingDependency <- onResult_ (W.workspaceBuildGraph directory
     43     (tail declarations) root compiler "bridge")
     44     (_ : pure (ok true t)) (_ : pure (ok false t))
     45   missingRoot <- onResult_ (W.workspaceBuildGraph directory declarations root compiler "ghost")
     46     (_ : pure (ok true t)) (_ : pure (ok false t))
     47   invalidUnused <- onResult_ (W.workspaceBuildGraph directory
     48     (pair (pair "unusedbad" (pair "not-read" "guess")) declarations) root compiler "bridge")
     49     (problem : pure (ok (equal? problem "invalid workspace name, path or frontend") t))
     50     (_ : pure (ok false t))
     51   changedOrder <- W.workspaceBuildGraph directory
     52     (pair (pair "unused" (pair "not-read.scp" "scp")) (reverse declarations)) root compiler "bridge"
     53   configEntry <- M.sourceModuleLoadSelected root (fst bridge) "configure"
     54   boxEntry <- M.sourceModuleLoadSelected root (fst bridge) "box"
     55   rows <- pure (L.lRunChecked (L.lWorker t configEntry) t)
     56   configured <- C.configurationPublish root rows
     57   box <- M.sourceModuleLoadSelected root configured "box"
     58   runnable <- M.sourceModulePublishNames root
     59     [(pair "box" (input : lazyResult (_ _ : "failed")
     60       (result _ : showNumber (fst result)) (L.lRunChecked box input)))] ["box"]
     61   source <- readFile (append directory "/app.tri")
     62   imports <- M.sourceModuleExtendUses root [[(fst data) "as" "Data"]]
     63   authored <- pure (bindResult (U.scpUnitStage source)
     64     (staged _ : UC.compileScpUnit (snd (snd (snd staged))) imports))
     65   receipt <- O.sourceObjectGet root "arboricx.build-receipt.v1" (snd data)
     66   options <- O.sourceObjectDigest "arboricx.build-options.v1"
     67     (W.wbOptions (pair "__DATA_PATH__" (pair "tri" (pair "source-module.reference.v1" t))))
     68   rawSource <- readFile (append directory "/__DATA_PATH__")
     69   sourceDigest <- O.sourceObjectDigest "arboricx.source.v1" rawSource
     70   let registry = R.linkedReferenceRows authored in
     71   let checks = foldl and? true [mapChecks missingDependency missingRoot invalidUnused
     72     (equal? bridge changedOrder)
     73     (equal? (fst bridge) (fst app))
     74     (equal? (L.lRunChecked box 9) (ok (pair 42 t) t))
     75     (equal? (L.lRunChecked (L.lWorker t boxEntry) 9) (ok (pair 42 t) t))
     76     (equal? (R.runLinkedReference registry (L.lWorker t configEntry) t) (ok rows t))
     77     (equal? (R.runLinkedReference registry box 9) (ok (pair 42 t) t))
     78     (lExist? (append "options\t" options) (lines receipt))
     79     (lExist? (append "source\t" sourceDigest) (lines receipt))] in
     80   pure (ok (pair (fst bridge) (pair (snd bridge)
     81     (pair configured (pair runnable checks)))) t)
     82 main = io (onResult_ scenario (_ : putStrLn "workspace-mixed-ERROR")
     83   (outcome : do bind
     84     _ <- putStrLn (append "code=" (fst outcome))
     85     _ <- putStrLn (append "receipt=" (fst (snd outcome)))
     86     _ <- putStrLn (append "configured=" (fst (snd (snd outcome))))
     87     _ <- putStrLn (append "runnable=" (fst (snd (snd (snd outcome)))))
     88     putStrLn (matchBool "workspace-mixed-ok" "workspace-mixed-DIFF"
     89       (snd (snd (snd (snd outcome)))))))
     90 main