consumer_native_modules.tri (6822B)
1 -- Code builds and configuration execution are distinct operations. The latter 2 -- selects named code from one manifest, executes normally, then publishes data. 3 !import "prelude" !Local 4 !import "io" !Local 5 !import "lexer" X 6 !import "parser" P 7 !import "source.module" M 8 !import "consumers.source" C 9 !import "consumers.unit-build" U 10 !import "consumers.unit-compile" UC 11 !import "consumers.lexical-worker" L 12 !import "consumers.linked-reference" R 13 !import "consumers.configure" CF 14 root = "__ROOT__" 15 workspace = "__WORKSPACE__" 16 compiler = "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef" 17 lookup rows name = lazyMaybe (_ : t) (value : value) (C.cSlot rows name) 18 compileRows name available = (onOk_ 19 (readFile (append workspace (append "/" (append name ".scp")))) 20 (source : pure (bindResult (U.scpUnitStage source) 21 (staged _ : UC.compileScpModuleBody (snd (snd (snd staged))) available)))) 22 referenceRows_ self names = (lazyList (_ : pure (ok t t)) 23 (name rest : onOk_ (compileRows name []) (rows : 24 onOk_ (self rest) (remaining : pure (ok (append rows remaining) t)))) names) 25 referenceRows names = y referenceRows_ names 26 privateMissing manifest = (onResult_ (M.sourceModuleLoadSelected root manifest "makeWorker") 27 (_ : pure (ok true t)) (_ : pure (ok false t))) 28 renderLines worker bytes = (lazyResult (_ _ : "failed") 29 (rows _ : append (showNumber (length rows)) 30 (append ":" (lazyList (_ : "none") (first rest : first) rows))) 31 (L.lRunChecked worker bytes)) 32 renderCount worker bytes = (lazyResult (_ _ : "failed") 33 (count _ : showNumber count) (L.lRunChecked worker bytes)) 34 problemLocation result = lazyResult (problem _ : P.parserDiagnosticLocation problem) (_ _ : t) result 35 stageChecks = (let source = "-- lead\r\n!import base as Base\n!export a\n\nconsumer a\n _ @ _ => Missing.code" in 36 let staged = resultOr t (U.scpUnitStage source) in 37 let failure = UC.compileScpModuleBody (snd (snd (snd staged))) [] in 38 foldl and? true [ 39 (equal? (X.lexerPositionLine (problemLocation failure)) 6) 40 (equal? (X.lexerPositionColumn (problemLocation failure)) 11) 41 (equal? (X.lexerPositionOffset (problemLocation failure)) 62) 42 (equal? (length (snd (snd (snd staged)))) (length source)) 43 (resultIsErr (U.scpUnitStage "!source a\n!source a\nconsumer a\n _ @ _ => leaf")) 44 (resultIsErr (U.scpUnitStage "!import a *\nconsumer a\n _ @ _ => leaf")) 45 (resultIsErr (U.scpUnitStage "!import a as Self\nconsumer a\n _ @ _ => leaf")) 46 (resultIsErr (U.scpUnitStage "!import a as A.B\nconsumer a\n _ @ _ => leaf")) 47 (equal? (X.lexerPositionLine (problemLocation 48 (U.scpUnitStage "\n-- comment\n!import a as Self\nconsumer a\n _ @ _ => leaf"))) 3)]) 49 scenario = do onOk_ 50 built <- U.scpUnitBuildGraph workspace root compiler "configurations" 51 base <- U.scpUnitBuildGraph workspace root compiler "base" 52 barrel <- U.scpUnitBuildGraph workspace root compiler "barrel" 53 _ <- writeFile (append workspace "/pinned.scp") 54 (append "!import " (append (fst base) 55 " as Base\n!export entryValue\nconsumer entryValue\n _ @ _ => Base.nonempty\n")) 56 pinned <- U.scpUnitBuildGraph workspace root compiler "pinned" 57 pinnedEntry <- M.sourceModuleLoadSelected root (fst pinned) "entryValue" 58 app <- U.scpUnitBuildGraph workspace root compiler "application" 59 available <- M.sourceModuleExtendUses root 60 [[(fst base) "as" "Base"] [(fst app) "as" "App"]] 61 baseRows <- referenceRows ["countLines" "filter" "fold" "nonempty" 62 "prepend" "reverse" "splitLines" "succ"] 63 appRows <- referenceRows ["dataLine" "dataLines"] 64 configRows <- compileRows "configurations" available 65 dataEntry <- M.sourceModuleLoadSelected root (fst built) "configureData" 66 nonemptyEntry <- M.sourceModuleLoadSelected root (fst built) "configureNonempty" 67 counterEntry <- M.sourceModuleLoadSelected root (fst built) "configureCounter" 68 dataConfig <- pure (L.lRunChecked (L.lWorker t dataEntry) t) 69 nonemptyConfig <- pure (L.lRunChecked (L.lWorker t nonemptyEntry) t) 70 countConfig <- pure (L.lRunChecked (L.lWorker t counterEntry) t) 71 dataManifest <- CF.configurationPublish root dataConfig 72 nonemptyManifest <- CF.configurationPublish root nonemptyConfig 73 countManifest <- CF.configurationPublish root countConfig 74 dataWorker <- M.sourceModuleLoadSelected root dataManifest "dataLines" 75 nonemptyWorker <- M.sourceModuleLoadSelected root nonemptyManifest "nonemptyLines" 76 counter <- M.sourceModuleLoadSelected root countManifest "countLines" 77 private <- privateMissing (fst built) 78 runnable <- M.sourceModulePublishNames root 79 [(pair "runData" (bytes : renderLines dataWorker bytes)) 80 (pair "runNonempty" (bytes : renderLines nonemptyWorker bytes)) 81 (pair "runCount" (bytes : renderCount counter bytes))] 82 ["runData" "runNonempty" "runCount"] 83 let registry = R.linkedReferenceRows (append configRows (append baseRows appRows)) in 84 let input = "alpha\n\n# note\nbeta\n" in 85 let checks = foldl and? true [stageChecks private 86 (equal? (fst barrel) (fst base)) 87 (equal? (L.lRunChecked (L.lWorker t pinnedEntry) t) 88 (ok (lookup available "Base.nonempty") t)) 89 (equal? dataEntry (fst (lookup configRows "configureData"))) 90 (equal? (ok dataConfig t) (R.runLinkedReference registry (L.lWorker t dataEntry) t)) 91 (equal? (ok nonemptyConfig t) (R.runLinkedReference registry (L.lWorker t nonemptyEntry) t)) 92 (equal? (ok countConfig t) (R.runLinkedReference registry (L.lWorker t counterEntry) t)) 93 (equal? (snd (snd dataWorker)) (snd (snd nonemptyWorker))) 94 (not? (equal? dataWorker nonemptyWorker)) 95 (not? (equal? dataManifest nonemptyManifest)) 96 (equal? (L.lRunChecked dataWorker input) (ok ["alpha" "beta"] t)) 97 (equal? (L.lRunChecked nonemptyWorker input) (ok ["alpha" "# note" "beta"] t)) 98 (equal? (L.lRunChecked counter input) (ok 4 t)) 99 (equal? (L.lRunChecked dataWorker input) (R.runLinkedReference registry dataWorker input)) 100 (equal? (L.lRunChecked nonemptyWorker input) (R.runLinkedReference registry nonemptyWorker input)) 101 (equal? (L.lRunChecked counter input) (R.runLinkedReference registry counter input)) 102 (resultIsErr (R.runLinkedReference [] dataWorker input)) 103 (resultIsErr (R.runLinkedReference registry t input))] in 104 pure (ok (pair (fst built) (pair dataManifest 105 (pair nonemptyManifest (pair runnable checks)))) t) 106 main = io (onResult_ scenario 107 (_ : putStrLn "native-modules-ERROR") 108 (outcome : do bind 109 _ <- putStrLn (append "code-manifest=" (fst outcome)) 110 _ <- putStrLn (append "data-manifest=" (fst (snd outcome))) 111 _ <- putStrLn (append "nonempty-manifest=" (fst (snd (snd outcome)))) 112 _ <- putStrLn (append "runnable-manifest=" (fst (snd (snd (snd outcome))))) 113 putStrLn (matchBool "scp-native-modules-ok" "scp-native-modules-DIFF" 114 (snd (snd (snd (snd outcome))))))) 115 main