Skip to content

Instantly share code, notes, and snippets.

@joleuger
Last active August 29, 2015 14:15
Show Gist options
  • Save joleuger/e5473430d1107367ddaa to your computer and use it in GitHub Desktop.
Save joleuger/e5473430d1107367ddaa to your computer and use it in GitHub Desktop.
[F#] [Computation Expression] Implementation of a workflow with computation expressions
// The MIT License (MIT)
//
// Copyright (c) 2014-2015, Institute for Software & Systems Engineering
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to deal
// in the Software without restriction, including without limitation the rights
// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
// copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in
// all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
// THE SOFTWARE.
module WorkflowDemo1 =
type WorkflowState<'state> = {
State : 'state;
}
with
static member emptyInit =
{
WorkflowState.State = ()
}
type WorkflowFunction<'oldState,'newState,'returnType> = WorkflowFunction of (WorkflowState<'oldState> -> 'returnType * WorkflowState<'newState>)
//type WorkflowSimpleState = WorkflowState<unit> //simple state is a state without subState
//type WorkflowSimpleFunction<'returnType> = WorkflowSimpleFunction of (WorkflowSimpleState -> 'returnType * WorkflowSimpleState)
let runWorkflowState (WorkflowFunction s) a = s a
let getWorkflowState = WorkflowFunction (fun s -> (s,s)) //Called in workflow: (implicitly) gets wfState (s) from workflow; assign this State s to the let!; and set (in this case keep) wfState to s
let getState = WorkflowFunction (fun s -> (s.State,s)) // gets the inner state
let putWorkflowState s = WorkflowFunction (fun _ -> ((),s)) //Called in workflow: ignore state (_) from workflow; assign nothing () to the let!; and set wfState to the new wfState s
let putWorkflowStateAndReturn s returnValue = WorkflowFunction (fun _ -> (returnValue,s))//Called in workflow: ignore wfState (_); assign returnValue to the let!; and set wfState to the new wfState s
let runWorkflow (WorkflowFunction s) =
let result,newWfState = s WorkflowState<unit>.emptyInit
result
type Workflow() =
member this.Return(a) =
WorkflowFunction (fun s -> (a,s))
member this.Bind(m,k) =
WorkflowFunction (fun wfState ->
let (a,wfState') = runWorkflowState m wfState
runWorkflowState (k a) wfState')
member this.ReturnFrom (m) =
m
member this.Zero<'oldState> () =
let behavior (state:WorkflowState<'oldState>) =
state.State,state
WorkflowFunction(behavior)
let workflow = new Workflow()
let initialValue_int (initialValue:int) : WorkflowFunction<_,int,unit> =
putWorkflowState {WorkflowState.State=initialValue}
let addOne_int_int : WorkflowFunction<int,int,unit> =
let behavior (state:WorkflowState<int>) =
(),{WorkflowState.State=state.State+1}
WorkflowFunction(behavior)
let convertToString_int_string : WorkflowFunction<int,string,unit> =
let behavior (state:WorkflowState<int>) =
(),{WorkflowState.State=state.State.ToString()}
WorkflowFunction(behavior)
let append_suffix_string_string : WorkflowFunction<string,string,unit> =
let behavior (state:WorkflowState<string>) =
(),{WorkflowState.State=state.State+"_suffix"}
WorkflowFunction(behavior)
let demoWorkSpace : WorkflowFunction<unit,string,string> = workflow {
do! initialValue_int 3
do! addOne_int_int
do! convertToString_int_string
if true then
do! append_suffix_string_string
//let! result = getState
return! getState
}
[<EntryPoint>]
let main argv =
printfn "%A" argv
let resultOfDemo = runWorkflow demoWorkSpace
printfn "%A" resultOfDemo
0 // return an integer exit code
// The MIT License (MIT)
//
// Copyright (c) 2014-2015, Institute for Software & Systems Engineering
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to deal
// in the Software without restriction, including without limitation the rights
// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
// copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in
// all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
// THE SOFTWARE.
module WorkflowDemo2 =
type WorkflowState<'state> = {
State : 'state;
Tainted : bool; // Use tainted to indicate, if a function changed something. Do not compare states, because now it is obvious, what happens, when a mutable changes
}
with
static member emptyInit =
{
WorkflowState.State = ();
WorkflowState.Tainted = false;
}
type WorkflowFunction<'oldState,'newState,'returnType> = WorkflowFunction of (WorkflowState<'oldState> -> 'returnType * WorkflowState<'newState>)
//type WorkflowSimpleState = WorkflowState<unit> //simple state is a state without subState
//type WorkflowSimpleFunction<'returnType> = WorkflowSimpleFunction of (WorkflowSimpleState -> 'returnType * WorkflowSimpleState)
let runWorkflowState (WorkflowFunction s) a = s a
let getWorkflowState = WorkflowFunction (fun s -> (s,s)) //Called in workflow: (implicitly) gets wfState (s) from workflow; assign this State s to the let!; and set (in this case keep) wfState to s
let getState = WorkflowFunction (fun s -> (s.State,s)) // gets the inner state
let putWorkflowState s = WorkflowFunction (fun _ -> ((),s)) //Called in workflow: ignore state (_) from workflow; assign nothing () to the let!; and set wfState to the new wfState s
let putWorkflowStateAndReturn s returnValue = WorkflowFunction (fun _ -> (returnValue,s))//Called in workflow: ignore wfState (_); assign returnValue to the let!; and set wfState to the new wfState s
let iterateToFixpoint<'state,'returnType> ( (WorkflowFunction(functionToIterate)) : WorkflowFunction<'state,'state,'returnType> ) =
let adjust_tainted_and_call (wfState:WorkflowState<'state>) : (bool*'returnType*WorkflowState<'state>) =
// 1) Tainted is set to false
// 2) function is called
// 3) Tainted is set to true, if (at least one option applies)
// a) it was true before the function call
// b) the functionToIterate sets tainted to true
let wasTaintedBefore = wfState.Tainted
let stateButUntainted =
{ wfState with
WorkflowState.Tainted = false;
}
let (returnValue:'returnType,wfStateAfterCall) = functionToIterate stateButUntainted
let taintedByCall = wfStateAfterCall.Tainted
let newWfState =
{ wfStateAfterCall with
WorkflowState.Tainted = wasTaintedBefore || taintedByCall;
}
(taintedByCall,returnValue,newWfState)
let rec iterate (wfState:WorkflowState<'state>) : ('returnType*WorkflowState<'state>) =
let (taintedByCall,returnValue,wfStateAfterOneCall) = adjust_tainted_and_call wfState
if taintedByCall then
iterate wfStateAfterOneCall
else
(returnValue,wfStateAfterOneCall)
WorkflowFunction (iterate)
let runWorkflow (WorkflowFunction s) =
let result,newWfState = s WorkflowState<unit>.emptyInit
result
let ignoreResult ( (WorkflowFunction (functionToCall)):WorkflowFunction<'oldState,'newState,'returnType>) : WorkflowFunction<'oldState,'newState,unit> =
let ignoreResult oldState =
let result,newState = functionToCall oldState
(),newState
WorkflowFunction (ignoreResult)
type Workflow() =
member this.Return(a) =
WorkflowFunction (fun s -> (a,s))
member this.Bind(m,k) =
WorkflowFunction (fun wfState ->
let (a,wfState') = runWorkflowState m wfState
runWorkflowState (k a) wfState')
member this.ReturnFrom (m) =
m
member this.Zero<'oldState> () =
let behavior (wfState:WorkflowState<'oldState>) =
(),wfState
WorkflowFunction(behavior)
let workflow = new Workflow()
let initialValue_int (initialValue:int) : WorkflowFunction<_,int,unit> =
putWorkflowState {WorkflowState.State=initialValue; WorkflowState.Tainted=true;}
let addOne_int_int : WorkflowFunction<int,int,unit> =
let behavior (wfState:WorkflowState<int>) =
let newState = wfState.State+1
(),{WorkflowState.State=newState; WorkflowState.Tainted=true;}
WorkflowFunction(behavior)
let addOneAndReturn_int_int : WorkflowFunction<int,int,int> =
let behavior (wfState:WorkflowState<int>) =
let newState = wfState.State+1
newState,{WorkflowState.State=newState; WorkflowState.Tainted=true;}
WorkflowFunction(behavior)
let addOneTill5_int_int : WorkflowFunction<int,int,unit> =
let addOneIfSmallerThan5_int_int = workflow {
let! currentNumber = getState
if currentNumber < 5 then
do! addOne_int_int
}
iterateToFixpoint addOneIfSmallerThan5_int_int
let convertToString_int_string : WorkflowFunction<int,string,unit> =
let behavior (wfState:WorkflowState<int>) =
let newState = wfState.State.ToString()
(),{WorkflowState.State=newState; WorkflowState.Tainted=true;}
WorkflowFunction(behavior)
let append_suffix_string_string : WorkflowFunction<string,string,unit> =
let behavior (wfState:WorkflowState<string>) =
(),{WorkflowState.State=wfState.State+"_suffix"; WorkflowState.Tainted=true;}
WorkflowFunction(behavior)
let demoWorkSpace : WorkflowFunction<unit,string,string> = workflow {
do! initialValue_int 3
do! addOneTill5_int_int
do! addOneAndReturn_int_int |> ignoreResult
do! convertToString_int_string
if true then
do! append_suffix_string_string
//let! result = getState
return! getState
else
return! getState
}
[<EntryPoint>]
let main argv =
printfn "%A" argv
let resultOfDemo = runWorkflow demoWorkSpace
printfn "%A" resultOfDemo
0 // return an integer exit code
// The MIT License (MIT)
//
// Copyright (c) 2014-2015, Institute for Software & Systems Engineering
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to deal
// in the Software without restriction, including without limitation the rights
// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
// copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in
// all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
// THE SOFTWARE.
module WorkflowDemo3 =
type WorkflowState<'state> = {
State : 'state;
StepNumber : int list;
StepName : string list;
Log : string list;
CancellationToken : System.Threading.CancellationToken option; //https://msdn.microsoft.com/de-de/library/dd997364(v=vs.110).aspx
Tainted : bool; // Use tainted to indicate, if a function changed something. Do not compare states, because now it is obvious, what happens, when a mutable changes
}
with
static member emptyInit (ctk:System.Threading.CancellationToken option) =
{
WorkflowState.State = ();
WorkflowState.StepNumber = [];
WorkflowState.StepName = [];
WorkflowState.Log = [];
WorkflowState.CancellationToken = ctk;
WorkflowState.Tainted = false;
}
member this.CurrentStepNumber = this.StepNumber.Head
member this.CurrentStepName = this.StepName.Head
type WorkflowFunction<'oldState,'newState,'returnType> = WorkflowFunction of (WorkflowState<'oldState> -> 'returnType * WorkflowState<'newState>)
let runWorkflowState (WorkflowFunction s) a = s a
let getWorkflowState = WorkflowFunction (fun s -> (s,s)) //Called in workflow: (implicitly) gets wfState (s) from workflow; assign this State s to the let!; and set (in this case keep) wfState to s
let getState = WorkflowFunction (fun s -> (s.State,s)) // gets the inner state
let putWorkflowState s = WorkflowFunction (fun _ -> ((),s)) //Called in workflow: ignore state (_) from workflow; assign nothing () to the let!; and set wfState to the new wfState s
let putWorkflowStateAndReturn s returnValue = WorkflowFunction (fun _ -> (returnValue,s))//Called in workflow: ignore wfState (_); assign returnValue to the let!; and set wfState to the new wfState s
let updateState<'oldState,'newState> (newState:'newState) : WorkflowFunction<'oldState,'newState,unit> =
let behavior (wfState:WorkflowState<'oldState>) =
let newWfState =
{
WorkflowState.State = newState;
WorkflowState.StepNumber = wfState.StepNumber;
WorkflowState.StepName = wfState.StepName;
WorkflowState.Log = wfState.Log;
WorkflowState.CancellationToken = wfState.CancellationToken;
WorkflowState.Tainted = true;
}
(),newWfState
WorkflowFunction(behavior)
let logEntry<'state> (entry:string) : WorkflowFunction<'state,'state,unit> =
let behavior (wfState:WorkflowState<'oldState>) =
do printfn "%s" entry
let newWfState =
{ wfState with
WorkflowState.Log = entry :: wfState.Log;
// WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
(),newWfState
WorkflowFunction(behavior)
let trackSteps_NextStep<'state> (stepName:string) : WorkflowFunction<'state,'state,unit> =
let behavior (wfState:WorkflowState<'oldState>) =
let newWfState =
if wfState.StepNumber = [] then
{ wfState with
WorkflowState.StepName = [stepName] ;
WorkflowState.StepNumber = [1] ;
// WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
else
let previousStep = wfState.StepNumber.Head
{ wfState with
WorkflowState.StepName = stepName :: wfState.StepName.Tail ;
WorkflowState.StepNumber = (previousStep+1) :: wfState.StepNumber.Tail;
// WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
let newStepNumberString = newWfState.StepNumber |> List.rev |> List.map string |> String.concat "."
let newEntry = sprintf "Entering step %s '%s'" newStepNumberString stepName
do printfn "%s" newEntry
(),newWfState
WorkflowFunction(behavior)
let trackSteps_CreateSubstepAndEnter<'state> (stepName:string) : WorkflowFunction<'state,'state,unit> =
let behavior (wfState:WorkflowState<'oldState>) =
let newWfState =
{ wfState with
WorkflowState.StepNumber = 1 :: wfState.StepNumber; //begin with step 1
WorkflowState.StepName = stepName :: wfState.StepName ;
// WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
let newStepNumberString = newWfState.StepNumber |> List.rev |> List.map string |> String.concat "."
let newEntry = sprintf "Entering step %s '%s'" newStepNumberString stepName
do printfn "%s" newEntry
(),newWfState
WorkflowFunction(behavior)
let trackSteps_LeaveSubstep<'state> : WorkflowFunction<'state,'state,unit> =
let behavior (wfState:WorkflowState<'oldState>) =
let newWfState =
{ wfState with
WorkflowState.StepName = wfState.StepName.Tail ;
WorkflowState.StepNumber = wfState.StepNumber.Tail;
// WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
(),newWfState
WorkflowFunction(behavior)
let iterateToFixpoint<'state,'returnType> ( (WorkflowFunction(functionToIterate)) : WorkflowFunction<'state,'state,'returnType> ) =
let adjust_tainted_and_call (wfState:WorkflowState<'state>) : (bool*'returnType*WorkflowState<'state>) =
// 1) Tainted is set to false
// 2) function is called
// 3) Tainted is set to true, if (at least one option applies)
// a) it was true before the function call
// b) the functionToIterate sets tainted to true
let wasTaintedBefore = wfState.Tainted
let stateButUntainted =
{ wfState with
WorkflowState.Tainted = false;
}
let (returnValue:'returnType,wfStateAfterCall) = functionToIterate stateButUntainted
let taintedByCall = wfStateAfterCall.Tainted
let newWfState =
{ wfStateAfterCall with
WorkflowState.Tainted = wasTaintedBefore || taintedByCall;
}
(taintedByCall,returnValue,newWfState)
let rec iterate (wfState:WorkflowState<'state>) : ('returnType*WorkflowState<'state>) =
let (taintedByCall,returnValue,wfStateAfterOneCall) = adjust_tainted_and_call wfState
if taintedByCall then
iterate wfStateAfterOneCall
else
(returnValue,wfStateAfterOneCall)
WorkflowFunction (iterate)
let runWorkflow (WorkflowFunction s) =
// no cancellation token
let result,newWfState = s (WorkflowState<unit>.emptyInit None)
result
let ignoreResult ( (WorkflowFunction (functionToCall)):WorkflowFunction<'oldState,'newState,'returnType>) : WorkflowFunction<'oldState,'newState,unit> =
let ignoreResult oldState =
let result,newState = functionToCall oldState
(),newState
WorkflowFunction (ignoreResult)
type Workflow() =
member this.Return(a) =
WorkflowFunction (fun s -> (a,s))
member this.Bind(m,k) =
WorkflowFunction (fun wfState ->
let (a,wfState') = runWorkflowState m wfState
if wfState'.CancellationToken.IsSome && wfState'.CancellationToken.Value.IsCancellationRequested then //short-circuit
// TODO: Add log entry
// Was canceled. Do not execute next command in pipeline
raise (System.OperationCanceledException(wfState'.CancellationToken.Value))
else
runWorkflowState (k a) wfState')
member this.ReturnFrom (m) =
m
member this.Zero<'oldState> () =
let behavior (wfState:WorkflowState<'oldState>) =
(),wfState
WorkflowFunction(behavior)
let workflow = new Workflow()
////////////// EXAMPLE
let initialValue_int (initialValue:int) : WorkflowFunction<_,int,unit> = workflow {
do! updateState initialValue
}
let addOne_int_int : WorkflowFunction<int,int,unit> = workflow {
let! currentValue = getState
do! updateState (currentValue + 1)
}
let addOneAndReturn_int_int : WorkflowFunction<int,int,int> =
let behavior (wfState:WorkflowState<int>) =
let newState = wfState.State+1
newState,{wfState with WorkflowState.State=newState; WorkflowState.Tainted=true;}
WorkflowFunction(behavior)
let addOneTill5_int_int : WorkflowFunction<int,int,unit> =
let addOneIfSmallerThan5_int_int = workflow {
let! currentNumber = getState
if currentNumber < 5 then
do! addOne_int_int
}
iterateToFixpoint addOneIfSmallerThan5_int_int
let convertToString_int_string : WorkflowFunction<int,string,unit> = workflow {
let! currentValue = getState
do! updateState (currentValue.ToString())
}
let append_suffix_string_string : WorkflowFunction<string,string,unit> = workflow {
let! currentValue = getState
do! updateState (currentValue+"_suffix")
}
let demoWorkSpace : WorkflowFunction<unit,string,string> = workflow {
do! trackSteps_NextStep "set initial value"
do! initialValue_int 3
do! trackSteps_NextStep "iterate"
do! addOneTill5_int_int
do! trackSteps_NextStep "add 1"
do! addOneAndReturn_int_int |> ignoreResult
do! trackSteps_NextStep "convert to string"
do! convertToString_int_string
if true then
do! trackSteps_NextStep "add suffix"
do! append_suffix_string_string
//let! result = getState
return! getState
else
return! getState
}
[<EntryPoint>]
let main argv =
printfn "%A" argv
let resultOfDemo = runWorkflow demoWorkSpace
printfn "%A" resultOfDemo
0 // return an integer exit code
// The MIT License (MIT)
//
// Copyright (c) 2014-2015, Institute for Software & Systems Engineering
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to deal
// in the Software without restriction, including without limitation the rights
// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
// copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in
// all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
// THE SOFTWARE.
namespace SafetySharp
module internal Workflow =
// Note on compiler error "Value restriction":
// http://blogs.msdn.com/b/mulambda/archive/2010/05/01/value-restriction-in-f.aspx
// The solution we use is to make everything a function. Empty parameter is added, if otherwise no parameter.
type WorkflowState<'state,'traceableOfOrigin,'traceableOfState> = {
State : 'state;
TraceablesOfOrigin : 'traceableOfOrigin list
ForwardTracer : 'traceableOfOrigin -> 'traceableOfState //forward tracer traces from traceable of origin to a traceable of the current state
StepNumber : int list;
StepName : string list;
Log : string list;
CancellationToken : System.Threading.CancellationToken option; //https://msdn.microsoft.com/de-de/library/dd997364(v=vs.110).aspx
Tainted : bool; // Use tainted to indicate, if a function changed something. Do not compare states, because now it is obvious, what happens, when a mutable changes
}
type WorkflowState with
member this.CurrentStepNumber = this.StepNumber.Head
member this.CurrentStepName = this.StepName.Head
let workflowState_emptyInit : WorkflowState<unit,unit,unit> =
{
WorkflowState.State = ();
WorkflowState.TraceablesOfOrigin = [];
WorkflowState.ForwardTracer = (fun () -> ())
WorkflowState.StepNumber = [];
WorkflowState.StepName = [];
WorkflowState.Log = [];
WorkflowState.CancellationToken = None;
WorkflowState.Tainted = false;
}
let workflowState_stateInit<'state> (state:'state) : WorkflowState<'state,unit,unit> =
{
WorkflowState.State = state;
WorkflowState.TraceablesOfOrigin = [];
WorkflowState.ForwardTracer = (fun () -> ())
WorkflowState.StepNumber = [];
WorkflowState.StepName = [];
WorkflowState.Log = [];
WorkflowState.CancellationToken = None;
WorkflowState.Tainted = false;
}
// WorkflowFunction is the main and most generic primitive of the workflow computation expression
type WorkflowFunction<'oldState,'newState,'oldTraceableOfOrigin,'newTraceableOfOrigin,'oldTraceableOfState,'newTraceableOfState,'returnType> =
WorkflowFunction of (WorkflowState<'oldState,'oldTraceableOfOrigin,'oldTraceableOfState> -> 'returnType * WorkflowState<'newState,'newTraceableOfOrigin,'newTraceableOfState>)
// Convenience: Type abbreviations for WorkflowFunction. They also allow using "_" as placeholder in type annotations.
// InitialWorkflowFunction:
// These workflow functions have an empty state as 'oldState and only use unit as placeholder for tracing.
type InitialWorkflowFunction<'newState,'newTraceableOfOrigin,'newTraceableOfState,'returnType> =
WorkflowFunction<unit,'newState,unit,'newTraceableOfOrigin,unit,'newTraceableOfState,'returnType>
// LoadWorkflowFunction:
// These workflow functions a
type LoadWorkflowFunction<'newState,'newTraceableOfOrigin,'newTraceableOfState,'returnType> =
WorkflowFunction<unit,'newState,unit,'newTraceableOfOrigin,unit,'newTraceableOfState,'returnType>
// EndogenousWorkflowFunction:
// These workflow functions keep the type of the state and also of the tracer.
// A EndogenousWorkflowFunction may be used to implement a M2M-transformation when the type of the model does not change (endogenous transformation).
type EndogenousWorkflowFunction<'state,'traceableOfOrigin,'traceableOfState,'returnType> =
WorkflowFunction<'state,'state,'traceableOfOrigin,'traceableOfOrigin,'traceableOfState,'traceableOfState,'returnType>
// ExogenousWorkflowFunction:
// These workflow functions modify the type of state and also of the tracer.
// A ExogenousWorkflowFunction may be used to implement a M2M-transformation when the type of the model changes (exogenous transformation).
type ExogenousWorkflowFunction<'oldState,'newState,'traceableOfOrigin,'oldTraceableOfState,'newTraceableOfState,'returnType> =
WorkflowFunction<'oldState,'newState,'traceableOfOrigin,'traceableOfOrigin,'oldTraceableOfState,'newTraceableOfState,'returnType>
let runWorkflowState (WorkflowFunction s) a = s a
let getWorkflowState () = WorkflowFunction (fun s -> (s,s)) //Called in workflow: (implicitly) gets wfState (s) from workflow; assign this State s to the let!; and set (in this case keep) wfState to s
let getState () = WorkflowFunction (fun s -> (s.State,s)) // gets the inner state
let putWorkflowState s = WorkflowFunction (fun _ -> ((),s)) //Called in workflow: ignore state (_) from workflow; assign nothing () to the let!; and set wfState to the new wfState s
let putWorkflowStateAndReturn s returnValue = WorkflowFunction (fun _ -> (returnValue,s))//Called in workflow: ignore wfState (_); assign returnValue to the let!; and set wfState to the new wfState s
(*
let updateStateAndReturn<'oldState,'newState,'returnType> (newState:'newState) (returnValue:'returnType) : WorkflowKTFunction<'oldState,'newState,_,_,'returnType> =
let behavior (wfState:WorkflowState<'oldState,_,_>) =
let newWfState =
{
WorkflowState.State = newState;
WorkflowState.ForwardTracer = wfState.Tracer;
WorkflowState.StepNumber = wfState.StepNumber;
WorkflowState.StepName = wfState.StepName;
WorkflowState.Log = wfState.Log;
WorkflowState.CancellationToken = wfState.CancellationToken;
WorkflowState.Tainted = true;
}
returnValue,newWfState
WorkflowFunction(behavior)
*)
let updateState<'oldState,'newState,'traceableOfOrigin,'oldTraceableOfState,'returnType>
(newState:'newState)
: ExogenousWorkflowFunction<'oldState,'newState,'traceableOfOrigin,'oldTraceableOfState,'oldTraceableOfState,unit> =
let behavior (wfState:WorkflowState<'oldState,'traceableOfOrigin,'oldTraceableOfState>) =
let newWfState =
{
WorkflowState.State = newState;
WorkflowState.TraceablesOfOrigin = wfState.TraceablesOfOrigin;
WorkflowState.ForwardTracer = wfState.ForwardTracer;
WorkflowState.StepNumber = wfState.StepNumber;
WorkflowState.StepName = wfState.StepName;
WorkflowState.Log = wfState.Log;
WorkflowState.CancellationToken = wfState.CancellationToken;
WorkflowState.Tainted = true;
}
(),newWfState
WorkflowFunction(behavior)
let initializeTracer<'state,'newTraceables>
(traceables : 'newTraceables list)
: WorkflowFunction<'state,'state,unit,'newTraceables,unit,'newTraceables,unit> =
let behavior (wfState:WorkflowState<'state,unit,unit>) =
let newWfState =
{
WorkflowState.State = wfState.State;
WorkflowState.TraceablesOfOrigin = traceables;
WorkflowState.ForwardTracer = id;
WorkflowState.StepNumber = wfState.StepNumber;
WorkflowState.StepName = wfState.StepName;
WorkflowState.Log = wfState.Log;
WorkflowState.CancellationToken = wfState.CancellationToken;
WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
(),newWfState
WorkflowFunction(behavior)
let updateTracer<'state,'traceableOfOrigin,'oldTraceableOfState,'newTraceableOfState>
(intermediateForwardTracer : 'oldTraceableOfState -> 'newTraceableOfState)
: WorkflowFunction<'state,'state,'traceableOfOrigin,'traceableOfOrigin,'oldTraceableOfState,'newTraceableOfState,unit> =
let behavior (wfState:WorkflowState<'state,'traceableOfOrigin,'oldTraceableOfState>) =
let newWfState =
{
WorkflowState.State = wfState.State;
WorkflowState.TraceablesOfOrigin = wfState.TraceablesOfOrigin;
WorkflowState.ForwardTracer =
let newTracer (toTrace:'traceableOfOrigin) =
let toOldTraceEnd = wfState.ForwardTracer toTrace
intermediateForwardTracer toOldTraceEnd
newTracer;
WorkflowState.StepNumber = wfState.StepNumber;
WorkflowState.StepName = wfState.StepName;
WorkflowState.Log = wfState.Log;
WorkflowState.CancellationToken = wfState.CancellationToken;
WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
(),newWfState
WorkflowFunction(behavior)
let logEntry<'state,'traceableOfOrigin,'traceableOfState> (entry:string) : EndogenousWorkflowFunction<'state,'traceableOfOrigin,'traceableOfState,unit> =
let behavior (wfState:WorkflowState<'state,'traceableOfOrigin,'traceableOfState>) =
do printfn "%s" entry
let newWfState =
{ wfState with
WorkflowState.Log = entry :: wfState.Log;
// WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
(),newWfState
WorkflowFunction(behavior)
let trackSteps_NextStep<'state,'traceableOfOrigin,'traceableOfState> (stepName:string) : EndogenousWorkflowFunction<'state,'traceableOfOrigin,'traceableOfState,unit> =
let behavior (wfState:WorkflowState<'state,'traceableOfOrigin,'traceableOfState>) =
let newWfState =
if wfState.StepNumber = [] then
{ wfState with
WorkflowState.StepName = [stepName] ;
WorkflowState.StepNumber = [1] ;
// WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
else
let previousStep = wfState.StepNumber.Head
{ wfState with
WorkflowState.StepName = stepName :: wfState.StepName.Tail ;
WorkflowState.StepNumber = (previousStep+1) :: wfState.StepNumber.Tail;
// WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
let newStepNumberString = newWfState.StepNumber |> List.rev |> List.map string |> String.concat "."
let newEntry = sprintf "Entering step %s '%s'" newStepNumberString stepName
do printfn "%s" newEntry
(),newWfState
WorkflowFunction(behavior)
let trackSteps_CreateSubstepAndEnter<'state,'traceableOfOrigin,'traceableOfState> (stepName:string) : EndogenousWorkflowFunction<'state,'traceableOfOrigin,'traceableOfState,unit> =
let behavior (wfState:WorkflowState<'state,'traceableOfOrigin,'traceableOfState>) =
let newWfState =
{ wfState with
WorkflowState.StepNumber = 1 :: wfState.StepNumber; //begin with step 1
WorkflowState.StepName = stepName :: wfState.StepName ;
// WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
let newStepNumberString = newWfState.StepNumber |> List.rev |> List.map string |> String.concat "."
let newEntry = sprintf "Entering step %s '%s'" newStepNumberString stepName
do printfn "%s" newEntry
(),newWfState
WorkflowFunction(behavior)
let trackSteps_LeaveSubstep<'state,'traceableOfOrigin,'traceableOfState> () : EndogenousWorkflowFunction<'state,'traceableOfOrigin,'traceableOfState,unit> =
let behavior (wfState:WorkflowState<'state,'traceableOfOrigin,'traceableOfState>) =
let newWfState =
{ wfState with
WorkflowState.StepName = wfState.StepName.Tail ;
WorkflowState.StepNumber = wfState.StepNumber.Tail;
// WorkflowState.Tainted = wfState.Tainted; //tainted keeps old value, because state itself does not get changed!
}
(),newWfState
WorkflowFunction(behavior)
let iterateToFixpoint<'state,'traceableOfOrigin,'traceableOfState> ( (WorkflowFunction(functionToIterate)) : EndogenousWorkflowFunction<'state,'traceableOfOrigin,'traceableOfState,unit>) : EndogenousWorkflowFunction<'state,'traceableOfOrigin,'traceableOfState,unit> =
let adjust_tainted_and_call (wfState:WorkflowState<'state,'traceableOfOrigin,'traceableOfState>) : (bool*WorkflowState<'state,'traceableOfOrigin,'traceableOfState>) =
// 1) Tainted is set to false
// 2) function is called
// 3) Tainted is set to true, if (at least one option applies)
// a) it was true before the function call
// b) the functionToIterate sets tainted to true
let wasTaintedBefore = wfState.Tainted
let stateButUntainted =
{ wfState with
WorkflowState.Tainted = false;
}
let (returnValue:unit,wfStateAfterCall) = functionToIterate stateButUntainted
let taintedByCall = wfStateAfterCall.Tainted
let newWfState =
{ wfStateAfterCall with
WorkflowState.Tainted = wasTaintedBefore || taintedByCall;
}
(taintedByCall,newWfState)
let rec iterate (wfState:WorkflowState<'state,'traceableOfOrigin,'traceableOfState>) : (unit*WorkflowState<'state,'traceableOfOrigin,'traceableOfState>) =
let (taintedByCall,wfStateAfterOneCall) = adjust_tainted_and_call wfState
if taintedByCall then
iterate wfStateAfterOneCall
else
((),wfStateAfterOneCall)
WorkflowFunction (iterate)
let runWorkflow_getResultAndWfState<'newState,'newTraceableOfOrigin,'newTraceableOfState,'returnType>
(WorkflowFunction s:(WorkflowFunction<unit,'newState,unit,'newTraceableOfOrigin,unit,'newTraceableOfState,'returnType>)) =
// no cancellation token
let result,newWfState = s workflowState_emptyInit
(result,newWfState)
let runWorkflow_getResult<'newState,'newTraceableOfOrigin,'newTraceableOfState,'returnType>
(WorkflowFunction s:(WorkflowFunction<unit,'newState,unit,'newTraceableOfOrigin,unit,'newTraceableOfState,'returnType>)) =
// no cancellation token
let result,newWfState = s workflowState_emptyInit
result
let runWorkflow_getState<'newState,'newTraceableOfOrigin,'newTraceableOfState,'returnType>
(WorkflowFunction s:(WorkflowFunction<unit,'newState,unit,'newTraceableOfOrigin,unit,'newTraceableOfState,'returnType>)) =
// no cancellation token
let result,newWfState = s workflowState_emptyInit
newWfState.State
let runWorkflow_getWfState<'newState,'newTraceableOfOrigin,'newTraceableOfState,'returnType>
(WorkflowFunction s:(WorkflowFunction<unit,'newState,unit,'newTraceableOfOrigin,unit,'newTraceableOfState,'returnType>)) =
// no cancellation token
let result,newWfState = s workflowState_emptyInit
newWfState
let runWorkflowState_getState<'oldState,'newState,'oldTraceableOfOrigin,'newTraceableOfOrigin,'oldTraceableOfState,'newTraceableOfState,'returnType>
(WorkflowFunction s:(WorkflowFunction<'oldState,'newState,'oldTraceableOfOrigin,'newTraceableOfOrigin,'oldTraceableOfState,'newTraceableOfState,'returnType>))
(initialState:WorkflowState<'oldState,'oldTraceableOfOrigin,'oldTraceableOfState>)
: 'newState =
let result,newWfState = s (initialState)
newWfState.State
let runWorkflowState_getWfState<'oldState,'newState,'oldTraceableOfOrigin,'newTraceableOfOrigin,'oldTraceableOfState,'newTraceableOfState,'returnType>
(WorkflowFunction s:(WorkflowFunction<'oldState,'newState,'oldTraceableOfOrigin,'newTraceableOfOrigin,'oldTraceableOfState,'newTraceableOfState,'returnType>))
(initialState:WorkflowState<'oldState,'oldTraceableOfOrigin,'oldTraceableOfState>)
: WorkflowState<'newState,'newTraceableOfOrigin,'newTraceableOfState> =
let result,newWfState = s (initialState)
newWfState
let ignoreResult<'oldState,'newState,'oldTraceableOfOrigin,'newTraceableOfOrigin,'oldTraceableOfState,'newTraceableOfState,'returnType>
(WorkflowFunction s:(WorkflowFunction<'oldState,'newState,'oldTraceableOfOrigin,'newTraceableOfOrigin,'oldTraceableOfState,'newTraceableOfState,'returnType>))
: WorkflowFunction<'oldState,'newState,'oldTraceableOfOrigin,'newTraceableOfOrigin,'oldTraceableOfState,'newTraceableOfState,unit> =
let ignoreResult oldState =
let result,newState = s oldState
(),newState
WorkflowFunction (ignoreResult)
type Workflow() =
member this.Return(a) =
WorkflowFunction (fun s -> (a,s))
member this.Bind(m,k) =
WorkflowFunction (fun wfState ->
let (a,wfState') = runWorkflowState m wfState
if wfState'.CancellationToken.IsSome && wfState'.CancellationToken.Value.IsCancellationRequested then //short-circuit
// TODO: Add log entry
// Was canceled. Do not execute next command in pipeline
raise (System.OperationCanceledException(wfState'.CancellationToken.Value))
else
runWorkflowState (k a) wfState')
member this.ReturnFrom (m) =
m
member this.Zero<'oldState,'traceableOfOrigin,'oldTraceableOfState> () =
let behavior (wfState:WorkflowState<'oldState,'traceableOfOrigin,'oldTraceableOfState>) =
(),wfState
WorkflowFunction(behavior)
let workflow = new Workflow()
////////////// Basic Workflow element
let readFile<'oldIrrelevantState,'traceableOfOrigin,'oldTraceableOfState>
(inputFile:string)
: ExogenousWorkflowFunction<'oldIrrelevantState,string,'traceableOfOrigin,'oldTraceableOfState,'oldTraceableOfState,unit> = workflow {
let input = System.IO.File.ReadAllText inputFile
do! updateState input
}
let printToStdout ()
: EndogenousWorkflowFunction<string,'traceableOfOrigin,'traceableOfState,unit> = workflow {
let! input = getState ()
printfn "%s" input
return ()
}
let printObjectToStdout ()
: EndogenousWorkflowFunction<'a,'traceableOfOrigin,'traceableOfState,unit> = workflow {
let! input = getState ()
printfn "%+A" input
return ()
}
let printNewParagraphToConsole<'a,'traceableOfOrigin,'traceableOfState> ()
: EndogenousWorkflowFunction<'a,'traceableOfOrigin,'traceableOfState,unit> = workflow {
printfn ""
printfn ""
return ()
}
////////////// Example 1 (without trace)
let ex1InitialValue_int (initialValue:int) : LoadWorkflowFunction<int,_,_,unit> = workflow {
do! updateState initialValue
}
let ex1AddOne_int_int () : EndogenousWorkflowFunction<int,_,_,unit> = workflow {
let! currentValue = getState ()
do! updateState (currentValue + 1)
}
// example to show how to do it without "workflow". Omit some annotations.
let ex1AddOneAndReturn_int_int<'traceableOfOrigin,'traceableOfState> () : EndogenousWorkflowFunction<int,_,_,int> =
let behavior (wfState:WorkflowState<int,'traceableOfOrigin,'traceableOfState>) =
let newState = wfState.State+1
newState,{wfState with WorkflowState.State=newState; WorkflowState.Tainted=true;}
WorkflowFunction(behavior)
// example to show how to do it with the generic workflow type. Omit some annotations. Possible, because it is a function.
let ex1AddOneTill5_int_int () : WorkflowFunction<int,int,_,_,_,_,unit> =
let addOneIfSmallerThan5_int_int = workflow {
let! currentNumber = getState ()
if currentNumber < 5 then
do! ex1AddOne_int_int ()
}
iterateToFixpoint addOneIfSmallerThan5_int_int
let ex1ConvertToString_int_string () : ExogenousWorkflowFunction<int,string,_,_,_,unit> = workflow {
let! currentValue = getState ()
do! updateState (currentValue.ToString())
}
// example to show how to do it with the generic workflow type. Omit some annotations. Possible, because it is a function.
let ex1Append_suffix_string_string () : WorkflowFunction<string,string,_,_,_,_,unit> = workflow {
let! currentValue = getState ()
do! updateState (currentValue+"_suffix")
}
let ex1DemoWorkflow () : InitialWorkflowFunction<_,_,_,_> = workflow {
do! trackSteps_NextStep "set initial value"
do! ex1InitialValue_int 3
do! trackSteps_NextStep "iterate"
do! ex1AddOneTill5_int_int ()
do! trackSteps_NextStep "add 1"
do! ex1AddOneAndReturn_int_int () |> ignoreResult
do! trackSteps_NextStep "convert to string"
do! ex1ConvertToString_int_string ()
if true then
do! trackSteps_NextStep "add suffix"
do! ex1Append_suffix_string_string ()
//let! result = getState
return! getState ()
else
return! getState ()
}
////////////// Example 2 (with trace)
let ex2InitialValue_int (initialValue:int) : LoadWorkflowFunction<int,_,_,unit> = workflow {
do! updateState initialValue
do! initializeTracer ([initialValue])
}
let ex2AddOne_int_int () : EndogenousWorkflowFunction<int,_,_,unit> = workflow {
let! currentValue = getState ()
let newValue = currentValue + 1
do! updateState (newValue)
let mapInClosure = Map.empty<int,int>.Add(currentValue,newValue)
let intermediateTracer (oldValue:int) = mapInClosure.Item oldValue
do! updateTracer intermediateTracer
}
// example to show how to do it without "workflow". Omit some annotations.
let ex2AddOneAndReturn_int_int<'traceableOfOrigin> () : EndogenousWorkflowFunction<int,_,_,int> =
let behavior (wfState:WorkflowState<int,'traceableOfOrigin,int>) =
let currentValue = wfState.State
let newValue = currentValue + 1
let mapInClosure = Map.empty<int,int>.Add(currentValue,newValue)
let newTracer (toTrace) =
let toOldTraceEnd = wfState.ForwardTracer toTrace
let intermediateTracer (oldValue:int) =
mapInClosure.Item oldValue
intermediateTracer toOldTraceEnd
let intermediateTracer (oldValue:int) = mapInClosure.Item oldValue
let newWfState =
{ wfState with
WorkflowState.State=newValue;
WorkflowState.ForwardTracer=newTracer
WorkflowState.Tainted=true;
}
newValue,newWfState
WorkflowFunction(behavior)
// example to show how to do it with the generic workflow type. Omit some annotations. Possible, because it is a function.
let ex2AddOneTill5_int_int () : WorkflowFunction<int,int,_,_,_,_,unit> =
let addOneIfSmallerThan5_int_int = workflow {
let! currentNumber = getState ()
if currentNumber < 5 then
do! ex2AddOne_int_int () //this function already keeps the trace
}
iterateToFixpoint addOneIfSmallerThan5_int_int
let ex2ConvertToString_int_string () : ExogenousWorkflowFunction<int,string,_,_,_,unit> = workflow {
let! currentValue = getState ()
let newValue = currentValue.ToString()
do! updateState (newValue)
let mapInClosure = Map.empty<int,string>.Add(currentValue,newValue)
let intermediateTracer (oldValue:int) = mapInClosure.Item oldValue
do! updateTracer intermediateTracer
}
// example to show how to do it with the generic workflow type. Omit some annotations. Possible, because it is a function.
let ex2Append_suffix_string_string () : WorkflowFunction<string,string,_,_,_,_,unit> = workflow {
let! currentValue = getState ()
let newValue = currentValue+"_suffix"
do! updateState (newValue)
let mapInClosure = Map.empty<string,string>.Add(currentValue,newValue)
let intermediateTracer (oldValue:string) = mapInClosure.Item oldValue
do! updateTracer intermediateTracer
}
let ex2DemoWorkflow () : InitialWorkflowFunction<_,_,_,_> = workflow {
do! trackSteps_NextStep "set initial value"
do! ex2InitialValue_int 3
do! trackSteps_NextStep "iterate"
do! ex2AddOneTill5_int_int ()
do! trackSteps_NextStep "add 1"
do! ex2AddOneAndReturn_int_int () |> ignoreResult
do! trackSteps_NextStep "convert to string"
do! ex2ConvertToString_int_string ()
if true then
do! trackSteps_NextStep "add suffix"
do! ex2Append_suffix_string_string ()
//let! result = getState
return! getState ()
else
return! getState ()
}
[<EntryPoint>]
let main argv =
printfn "%A" argv
let resultOfExample1 = runWorkflow_getResult (ex1DemoWorkflow())
printfn "%A" resultOfExample1
let resultOfExample2,wfStateOfExample2 = runWorkflow_getResultAndWfState (ex2DemoWorkflow())
printfn "%A" resultOfExample2
printfn "traces:"
let printTracables (var:int) =
printfn "from: %d to: %s" (var) (wfStateOfExample2.ForwardTracer var)
wfStateOfExample2.TraceablesOfOrigin |> List.iter printTracables
0 // return an integer exit code
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment