Commit fe254a7c authored by Tim Steenvoorden's avatar Tim Steenvoorden

add Done, remove Apply

parent ea0264b3
Pipeline #25034 passed with stage
in 5 minutes and 48 seconds
...@@ -38,7 +38,8 @@ where ...@@ -38,7 +38,8 @@ where
// Data //////////////////////////////////////////////////////////////////////// // Data ////////////////////////////////////////////////////////////////////////
:: TaskExpr :: TaskExpr
= Apply TaskFuncExpr Expr = Done Expr
// | Apply TaskFuncExpr Expr
| EnterInfo String Ty | EnterInfo String Ty
| Then TaskExpr TaskFuncExpr | Then TaskExpr TaskFuncExpr
| Or TaskExpr TaskExpr | Or TaskExpr TaskExpr
...@@ -101,16 +102,20 @@ where ...@@ -101,16 +102,20 @@ where
$ functionConsDyn "TaskExpr" "(enter task)" (dynamic \(Typed taskExpr) -> taskExpr :: A.a: (Typed TaskExpr a) -> TaskExpr) $ functionConsDyn "TaskExpr" "(enter task)" (dynamic \(Typed taskExpr) -> taskExpr :: A.a: (Typed TaskExpr a) -> TaskExpr)
<<@@@ HideIfOnlyChoice <<@@@ HideIfOnlyChoice
, DynamicConsGroup "Combinators" , DynamicConsGroup "Combinators"
[ functionConsDyn "Then" "sequence" [ functionConsDyn "Done" "done"
( dynamic \(Typed task) (Typed taskFunc) -> ( dynamic \(Typed expr) -> Typed (Done expr) ::
Typed (Then task taskFunc) :: A.a:
(Typed Expr a)
-> Typed TaskExpr (Task a)
)
, functionConsDyn "Then" "sequence"
( dynamic \(Typed task) (Typed taskFunc) -> Typed (Then task taskFunc) ::
A.a b: A.a b:
(Typed TaskExpr (Task a)) (Typed TaskFuncExpr (a -> Task b)) (Typed TaskExpr (Task a)) (Typed TaskFuncExpr (a -> Task b))
-> Typed TaskExpr (Task b) -> Typed TaskExpr (Task b)
) )
, functionConsDyn "When" "guarded sequence" , functionConsDyn "When" "guarded sequence"
( dynamic \(Typed task1) (Typed steps) -> ( dynamic \(Typed task1) (Typed steps) -> Typed (When task1 steps) ::
Typed (When task1 steps) ::
// Typed (When task1 [(expr, pred, tfExpr) \\ (Typed expr, pred, Typed tfExpr) <- steps]) :: // Typed (When task1 [(expr, pred, tfExpr) \\ (Typed expr, pred, Typed tfExpr) <- steps]) ::
A.a b: A.a b:
(Typed TaskExpr (Task a)) (Typed TaskExpr (Task a))
...@@ -120,8 +125,7 @@ where ...@@ -120,8 +125,7 @@ where
) )
<<@@@ applyHorizontalClasses <<@@@ applyHorizontalClasses
, functionConsDyn "Or" "or" , functionConsDyn "Or" "or"
( dynamic \(Typed task1) (Typed task2) -> ( dynamic \(Typed task1) (Typed task2) -> Typed (Or task1 task2) ::
Typed (Or task1 task2) ::
A.a b: A.a b:
(Typed TaskExpr (Task a)) (Typed TaskExpr (Task a))
(Typed TaskExpr (Task a)) (Typed TaskExpr (Task a))
...@@ -129,8 +133,7 @@ where ...@@ -129,8 +133,7 @@ where
) )
<<@@@ applyHorizontalClasses <<@@@ applyHorizontalClasses
, functionConsDyn "And" "and" , functionConsDyn "And" "and"
( dynamic \(Typed task1) (Typed task2) -> ( dynamic \(Typed task1) (Typed task2) -> Typed (And task1 task2) ::
Typed (And task1 task2) ::
A.a b: A.a b:
(Typed TaskExpr (Task a)) (Typed TaskExpr (Task a))
(Typed TaskExpr (Task b)) (Typed TaskExpr (Task b))
...@@ -138,16 +141,14 @@ where ...@@ -138,16 +141,14 @@ where
) )
<<@@@ applyHorizontalClasses <<@@@ applyHorizontalClasses
, listConsDyn "List TaskContExpr" "continuations" , listConsDyn "List TaskContExpr" "continuations"
( dynamic \typedSteps -> ( dynamic \typedSteps -> Typed ((\(Typed expr) -> expr) <$> typedSteps) ::
Typed ((\(Typed expr) -> expr) <$> typedSteps) ::
A.a b: A.a b:
(List (Typed TaskContExpr (a -> Task b))) (List (Typed TaskContExpr (a -> Task b)))
-> Typed (List TaskContExpr) (a -> Task b) -> Typed (List TaskContExpr) (a -> Task b)
) )
<<@@@ HideIfOnlyChoice <<@@@ HideIfOnlyChoice
, functionConsDyn "TaskContExpr" "continuation" , functionConsDyn "TaskContExpr" "continuation"
( dynamic \s (Typed func) (Typed taskFunc) -> ( dynamic \s (Typed func) (Typed taskFunc) -> Typed {name = s, pred = func, cont = taskFunc} ::
Typed {name = s, pred = func, cont = taskFunc} ::
A.a b: A.a b:
String String
(Typed FuncExpr a) (Typed FuncExpr a)
...@@ -158,33 +159,30 @@ where ...@@ -158,33 +159,30 @@ where
<<@@@ AddLabels [Just "name", Just "predicate", Just "continuation"] <<@@@ AddLabels [Just "name", Just "predicate", Just "continuation"]
] ]
, DynamicConsGroup "Editors" , DynamicConsGroup "Editors"
[ functionConsDyn "Apply" "apply" // [ functionConsDyn "Apply" "apply"
( dynamic \(Typed taskFunc) (Typed expr) -> // ( dynamic \(Typed taskFunc) (Typed expr) ->
Typed (Apply taskFunc expr) :: // Typed (Apply taskFunc expr) ::
A.a b: // A.a b:
(Typed TaskFuncExpr (a -> Task b)) // (Typed TaskFuncExpr (a -> Task b))
(Typed Expr a) // (Typed Expr a)
-> Typed TaskExpr (Task b) // -> Typed TaskExpr (Task b)
) // )
, functionConsDyn "EnterInfo" "enter information" [ functionConsDyn "EnterInfo" "enter information"
( dynamic \s (Typed ty) -> ( dynamic \s (Typed ty) -> Typed (EnterInfo s ty) ::
Typed (EnterInfo s ty) ::
A.a: A.a:
String (Typed Ty a) String (Typed Ty a)
-> Typed TaskExpr (Task a) -> Typed TaskExpr (Task a)
) )
<<@@@ applyHorizontalClasses <<@@@ applyHorizontalClasses
, functionConsDyn "ViewInfo" "view information" , functionConsDyn "ViewInfo" "view information"
( dynamic \s -> ( dynamic \s -> Typed (ViewInfo s) ::
Typed (ViewInfo s) ::
A.a: A.a:
String String
-> Typed TaskFuncExpr (a -> Task a) -> Typed TaskFuncExpr (a -> Task a)
) )
<<@@@ applyHorizontalClasses <<@@@ applyHorizontalClasses
, functionConsDyn "UpdateInfo" "update information" , functionConsDyn "UpdateInfo" "update information"
( dynamic \s -> ( dynamic \s -> Typed (UpdateInfo s) ::
Typed (UpdateInfo s) ::
A.a: A.a:
String String
-> Typed TaskFuncExpr (a -> Task a) -> Typed TaskFuncExpr (a -> Task a)
...@@ -270,8 +268,9 @@ applyHorizontalClasses = ApplyCssClasses ["itasks-horizontal", "itasks-wrap-widt ...@@ -270,8 +268,9 @@ applyHorizontalClasses = ApplyCssClasses ["itasks-horizontal", "itasks-wrap-widt
// Evaluation ////////////////////////////////////////////////////////////////// // Evaluation //////////////////////////////////////////////////////////////////
evalTaskConstExpr :: TaskExpr -> Task Value evalTaskConstExpr :: TaskExpr -> Task Value
evalTaskConstExpr (Done expr) = return $ evalExpr expr
evalTaskConstExpr (EnterInfo msg (Ty toValue)) = enterInformation msg [] @ toValue evalTaskConstExpr (EnterInfo msg (Ty toValue)) = enterInformation msg [] @ toValue
evalTaskConstExpr (Apply taskFunc expr) = evalTaskFuncExpr taskFunc $ evalExpr expr // evalTaskConstExpr (Apply taskFunc expr) = evalTaskFuncExpr taskFunc $ evalExpr expr
evalTaskConstExpr (Then task taskFunc) = evalTaskConstExpr task >>= evalTaskFuncExpr taskFunc evalTaskConstExpr (Then task taskFunc) = evalTaskConstExpr task >>= evalTaskFuncExpr taskFunc
evalTaskConstExpr (Or task1 task2) = (evalTaskConstExpr task1 -||- evalTaskConstExpr task2 <<@ ApplyLayout arrangeHorizontal) evalTaskConstExpr (Or task1 task2) = (evalTaskConstExpr task1 -||- evalTaskConstExpr task2 <<@ ApplyLayout arrangeHorizontal)
evalTaskConstExpr (And task1 task2) = (evalTaskConstExpr task1 -&&- evalTaskConstExpr task2 <<@ ApplyLayout arrangeHorizontal) @ \(a, b) -> VTuple a b evalTaskConstExpr (And task1 task2) = (evalTaskConstExpr task1 -&&- evalTaskConstExpr task2 <<@ ApplyLayout arrangeHorizontal) @ \(a, b) -> VTuple a b
...@@ -313,7 +312,6 @@ evalTaskFuncExpr (UpdateInfo p) (VTuple a b) = ...@@ -313,7 +312,6 @@ evalTaskFuncExpr (UpdateInfo p) (VTuple a b) =
) )
<<@ ApplyLayout arrangeHorizontal <<@ ApplyLayout arrangeHorizontal
evalExpr :: Expr -> Value evalExpr :: Expr -> Value
evalExpr (Int i) = VInt i evalExpr (Int i) = VInt i
evalExpr (Bool b) = VBool b evalExpr (Bool b) = VBool b
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment