tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

workflow.tri (1922B)

      1 !import base as B
      2 !export writeArtifact
      3 !export checkArtifact
      4 !export publishArtifact
      5 !export requireApproval
      6 !export explain
      7 !export execute
      8 
      9 join values = B.concatMap B.id values
     10 
     11 writeArtifact name path text = ["stage" name ["write" path text]]
     12 checkArtifact name path text = ["stage" name ["check" path text]]
     13 publishArtifact name source destination = ["stage" name ["publish" source destination]]
     14 
     15 -- A structural transformation over declared stages, preserving their actions.
     16 -- Existing approval wrappers remain intact, making repeat application idempotent.
     17 guard target whole{["stage" name action]} = case B.equal? target name of
     18   (t t) = ["approval" name whole]
     19   _ = whole
     20 guard _ whole = whole
     21 requireApproval target stages = B.map (guard target) stages
     22 
     23 explainStage ["stage" name ["write" path _]] = join [name ": write " path "\n"]
     24 explainStage ["stage" name ["check" path _]] = join [name ": check " path "\n"]
     25 explainStage ["stage" name ["publish" source destination]] =
     26   join [name ": publish " source " -> " destination "\n"]
     27 explainStage ["approval" name stage] =
     28   join ["approval required: " name "\n" (explainStage stage)]
     29 explainStage _ = "invalid stage\n"
     30 explain stages = join (B.map explainStage stages)
     31 
     32 -- Pure interaction values: the interpreter requests an action, then consumes a
     33 -- host reply. Only the host executes effects and decides approvals.
     34 resume ["ok"] _ next = next t
     35 resume ["error" reason] name _ = ["failed" name reason]
     36 resume _ name _ = ["failed" name "Malformed host reply"]
     37 runStage ["stage" name action] next =
     38   ["request" name action (reply : resume reply name next)]
     39 runStage ["approval" name stage] next =
     40   ["request" name ["approve"] (reply : resume reply name (_ : runStage stage next))]
     41 runStage _ _ = ["failed" "" "Malformed stage"]
     42 execute [] = ["done"]
     43 execute [stage | rest] = runStage stage (_ : execute rest)
     44 execute _ = ["failed" "" "Malformed pipeline"]