Commit 9eafce85 authored by Tim Steenvoorden's avatar Tim Steenvoorden

Merge branch 'typed-task-editor-simple' into typed-task-editor

parents b2189b57 34deb068
Pipeline #25100 passed with stage
in 5 minutes and 50 seconds
...@@ -28,7 +28,7 @@ Start world = doTasks (editTaskExpr Nothing) world ...@@ -28,7 +28,7 @@ Start world = doTasks (editTaskExpr Nothing) world
editTaskExpr :: (Maybe (DynamicEditorValue TaskExpr)) -> Task (Maybe (DynamicEditorValue TaskExpr)) editTaskExpr :: (Maybe (DynamicEditorValue TaskExpr)) -> Task (Maybe (DynamicEditorValue TaskExpr))
editTaskExpr mv = editTaskExpr mv =
enterOrUpdateExpr ("Contruct a task", info1) mv >?> enterOrUpdateExpr ("Contruct a task", info1) mv >?>
[ ( "Run", always, \v -> viewInformation ("Evaluate the task", info2) [] () ||- (evalTaskConstExpr (toValue taskEditor v) <<@ ApplyLayout frameCompact) >?> [ ( "Run", always, \v -> viewInformation ("Evaluate the task", info2) [] () ||- (evalTaskExpr (toValue taskEditor v) <<@ ApplyLayout frameCompact) >?>
[ ( "Finish", always, \r -> viewInformation ("Done!", info3) [] r >?> [ ( "Finish", always, \r -> viewInformation ("Done!", info3) [] r >?>
[ ( "Back", always, \_ -> editTaskExpr (Just v) ) ] [ ( "Back", always, \_ -> editTaskExpr (Just v) ) ]
) )
...@@ -44,35 +44,47 @@ where ...@@ -44,35 +44,47 @@ where
info3 = "The program is done, the result is given below." info3 = "The program is done, the result is given below."
enterOrUpdateExpr msg Nothing = enterInformation msg [EnterUsing id $ dynamicEditor taskEditor] enterOrUpdateExpr msg Nothing = enterInformation msg [EnterUsing id $ dynamicEditor taskEditor]
enterOrUpdateExpr msg (Just v) = updateInformation msg [UpdateUsing id (curry fst) (dynamicEditor taskEditor)] v enterOrUpdateExpr msg (Just v) = updateInformation msg [UpdateUsing id (curry snd) (dynamicEditor taskEditor)] v
// Data //////////////////////////////////////////////////////////////////////// // Data ////////////////////////////////////////////////////////////////////////
:: TaskExpr :: TaskExpr
= Done Expr = Done Expr
// | Apply TaskFuncExpr Expr
| EnterInfo String Ty | EnterInfo String Ty
| Then TaskExpr TaskFuncExpr | Then TaskExpr TaskFunc
| Or TaskExpr TaskExpr | Both TaskExpr TaskExpr
| And TaskExpr TaskExpr | Any TaskExpr TaskExpr
| When TaskExpr (List TaskContExpr) | One TaskExpr TaskExpr
:: TaskFuncExpr :: TaskFunc
= ViewInfo String = ViewF String Func
| UpdateInfo String | UpdateF String
| ThenF TaskFunc TaskFunc
:: TaskContExpr
= { name :: String, pred :: FuncExpr, cont :: TaskFuncExpr}
:: Expr :: Expr
= Int Int = Int Int
| Bool Bool | Bool Bool
| String String | String String
| Tuple Expr Expr | Tuple Expr Expr
| Fst Expr | Apply Func Expr
| Snd Expr
| Eq Expr Expr :: Func
= Identity
| Conj Expr
| Disj Expr
| Not
| Gt Expr
| Ge Expr
| Eq Expr
| Le Expr
| Lt Expr
| Add Expr
| Sub Expr
| Mul Expr
| Div Expr
| Fst
| Snd
:: Value :: Value
= VInt Int = VInt Int
...@@ -80,18 +92,13 @@ where ...@@ -80,18 +92,13 @@ where
| VString String | VString String
| VTuple Value Value | VTuple Value Value
:: FuncExpr
= EqV Value
| GrtV Value
| LessV Value
:: Ty :: Ty
= E.a: Ty (a -> Value) & iTask a = E.a: Ty (a -> Value) & iTask a
:: Typed a b :: Typed a b
=: Typed a =: Typed a
derive class iTask TaskExpr, TaskFuncExpr, TaskContExpr, Expr, FuncExpr, Value, Typed derive class iTask TaskExpr, TaskFunc, Expr, Func, Value, Typed
// These instances cannot be auto derived because of the existential quantifier. // These instances cannot be auto derived because of the existential quantifier.
// However, they will be never used, so we make them undefined. // However, they will be never used, so we make them undefined.
...@@ -106,233 +113,324 @@ gEditor{|Ty|} = undef ...@@ -106,233 +113,324 @@ gEditor{|Ty|} = undef
// Editor ////////////////////////////////////////////////////////////////////// // Editor //////////////////////////////////////////////////////////////////////
taskEditor :: DynamicEditor TaskExpr taskEditor :: DynamicEditor TaskExpr
taskEditor = DynamicEditor conses taskEditor = DynamicEditor
where [ // This cons is used to provide untyped `TaskExpr` values.
conses = DynamicCons
[ // This cons is used to provide untyped `TaskExpr` values. $ functionConsDyn "TaskExpr" "(enter task)" (dynamic \(Typed taskExpr) -> taskExpr :: A.a: (Typed TaskExpr a) -> TaskExpr)
DynamicCons <<@@@ HideIfOnlyChoice
$ functionConsDyn "TaskExpr" "(enter task)" (dynamic \(Typed taskExpr) -> taskExpr :: A.a: (Typed TaskExpr a) -> TaskExpr) , DynamicConsGroup "Combinators"
<<@@@ HideIfOnlyChoice [ functionConsDyn "Then" "sequence"
, DynamicConsGroup "Combinators" ( dynamic \(Typed task) (Typed taskFunc) -> Typed (Then task taskFunc) ::
[ functionConsDyn "Done" "done" A.a b:
( dynamic \(Typed expr) -> Typed (Done expr) :: (Typed TaskExpr (Task a)) (Typed TaskFunc (a -> Task b))
A.a: -> Typed TaskExpr (Task b)
(Typed Expr a) )
-> Typed TaskExpr (Task a) , functionConsDyn "ThenF" "sequence"
) ( dynamic \(Typed taskFunc1) (Typed taskFunc2) -> Typed (ThenF taskFunc1 taskFunc2) ::
, functionConsDyn "Then" "sequence" A.a b c:
( dynamic \(Typed task) (Typed taskFunc) -> Typed (Then task taskFunc) :: (Typed TaskFunc (a -> Task b)) (Typed TaskFunc (b -> Task c))
A.a b: -> Typed TaskFunc (a -> Task c)
(Typed TaskExpr (Task a)) (Typed TaskFuncExpr (a -> Task b)) )
-> Typed TaskExpr (Task b) <<@@@ applyVerticalClasses
) , functionConsDyn "Both" "both"
, functionConsDyn "When" "guarded sequence" ( dynamic \(Typed task1) (Typed task2) -> Typed (Both task1 task2) ::
( dynamic \(Typed task1) (Typed steps) -> Typed (When task1 steps) :: A.a b:
// Typed (When task1 [(expr, pred, tfExpr) \\ (Typed expr, pred, Typed tfExpr) <- steps]) :: (Typed TaskExpr (Task a))
A.a b: (Typed TaskExpr (Task b))
(Typed TaskExpr (Task a)) -> Typed TaskExpr (Task (a, b))
(Typed (List TaskContExpr) (a -> Task b)) )
// (Typed (List (Typed FuncExpr (a -> Bool), String, Typed TaskFuncExpr (a -> Task a))) (a -> Task b)) <<@@@ applyHorizontalClasses
-> Typed TaskExpr (Task b) , functionConsDyn "Any" "any of"
) ( dynamic \(Typed task1) (Typed task2) -> Typed (Any task1 task2) ::
<<@@@ applyHorizontalClasses A.a b:
, functionConsDyn "Or" "or" (Typed TaskExpr (Task a))
( dynamic \(Typed task1) (Typed task2) -> Typed (Or task1 task2) :: (Typed TaskExpr (Task a))
A.a b: -> Typed TaskExpr (Task a)
(Typed TaskExpr (Task a)) )
(Typed TaskExpr (Task a)) <<@@@ applyHorizontalClasses
-> Typed TaskExpr (Task a) , functionConsDyn "One" "one of"
) ( dynamic \(Typed task1) (Typed task2) -> Typed (One task1 task2) ::
<<@@@ applyHorizontalClasses A.a b:
, functionConsDyn "And" "and" (Typed TaskExpr (Task a))
( dynamic \(Typed task1) (Typed task2) -> Typed (And task1 task2) :: (Typed TaskExpr (Task a))
A.a b: -> Typed TaskExpr (Task a)
(Typed TaskExpr (Task a)) )
(Typed TaskExpr (Task b)) <<@@@ applyHorizontalClasses
-> Typed TaskExpr (Task (a, b)) // , functionConsDyn "When" "guarded sequence"
) // ( dynamic \(Typed task1) (Typed steps) -> Typed (When task1 steps) ::
<<@@@ applyHorizontalClasses // // Typed (When task1 [(expr, pred, tfExpr) \\ (Typed expr, pred, Typed tfExpr) <- steps]) ::
, listConsDyn "List TaskContExpr" "continuations" // A.a b:
( dynamic \typedSteps -> Typed ((\(Typed expr) -> expr) <$> typedSteps) :: // (Typed TaskExpr (Task a))
A.a b: // (Typed (List TaskContExpr) (a -> Task b))
(List (Typed TaskContExpr (a -> Task b))) // // (Typed (List (Typed Func (a -> Bool), String, Typed TaskFunc (a -> Task a))) (a -> Task b))
-> Typed (List TaskContExpr) (a -> Task b) // -> Typed TaskExpr (Task b)
) // )
<<@@@ HideIfOnlyChoice // <<@@@ applyHorizontalClasses
, functionConsDyn "TaskContExpr" "continuation" // , listConsDyn "List TaskContExpr" "continuations"
( dynamic \s (Typed func) (Typed taskFunc) -> Typed {name = s, pred = func, cont = taskFunc} :: // ( dynamic \typedSteps -> Typed ((\(Typed expr) -> expr) <$> typedSteps) ::
A.a b: // A.a b:
String // (List (Typed TaskContExpr (a -> Task b)))
(Typed FuncExpr a) // -> Typed (List TaskContExpr) (a -> Task b)
(Typed TaskFuncExpr (a -> Task b)) // )
-> Typed TaskContExpr (a -> Task b) // <<@@@ HideIfOnlyChoice
) // , functionConsDyn "TaskContExpr" "continuation"
<<@@@ HideIfOnlyChoice // ( dynamic \s (Typed func) (Typed taskFunc) -> Typed {name = s, pred = func, cont = taskFunc} ::
<<@@@ AddLabels [Just "name", Just "predicate", Just "continuation"] // A.a b:
] // String
, DynamicConsGroup "Editors" // (Typed Func a)
// [ functionConsDyn "Apply" "apply" // (Typed TaskFunc (a -> Task b))
// ( dynamic \(Typed taskFunc) (Typed expr) -> // -> Typed TaskContExpr (a -> Task b)
// Typed (Apply taskFunc expr) :: // )
// A.a b: // <<@@@ HideIfOnlyChoice
// (Typed TaskFuncExpr (a -> Task b)) // <<@@@ AddLabels [Just "name", Just "predicate", Just "continuation"]
// (Typed Expr a) ]
// -> Typed TaskExpr (Task b) , DynamicConsGroup "Editors"
// ) [ functionConsDyn "Enter" "enter"
[ functionConsDyn "EnterInfo" "enter information" ( dynamic \s (Typed ty) -> Typed (EnterInfo s ty) ::
( dynamic \s (Typed ty) -> Typed (EnterInfo s ty) :: A.a:
A.a: String
String (Typed Ty a) (Typed Ty a)
-> Typed TaskExpr (Task a) -> Typed TaskExpr (Task a)
) )
<<@@@ applyHorizontalClasses <<@@@ applyHorizontalClasses
, functionConsDyn "ViewInfo" "view information" , functionConsDyn "ViewF" "view"
( dynamic \s -> Typed (ViewInfo s) :: ( dynamic \s (Typed func) -> Typed (ViewF s func) ::
A.a: A.a b:
String String
-> Typed TaskFuncExpr (a -> Task a) (Typed Func (a -> b))
) -> Typed TaskFunc (a -> Task b)
<<@@@ applyHorizontalClasses )
, functionConsDyn "UpdateInfo" "update information" <<@@@ applyHorizontalClasses
( dynamic \s -> Typed (UpdateInfo s) :: , functionConsDyn "UpdateF" "update"
A.a: ( dynamic \s -> Typed (UpdateF s) ::
String A.a:
-> Typed TaskFuncExpr (a -> Task a) String
) -> Typed TaskFunc (a -> Task a)
<<@@@ applyHorizontalClasses )
] <<@@@ applyHorizontalClasses
// ordinary (non-task) expressions ]
, DynamicCons , DynamicConsGroup "Special"
$ functionConsDyn "EqV" "equal" (dynamic \i -> Typed (EqV (VInt i)) :: Int -> Typed FuncExpr Int) [ functionConsDyn "Done" "done"
<<@@@ applyHorizontalClasses ( dynamic \(Typed expr) -> Typed (Done expr) ::
, DynamicCons A.a:
$ functionConsDyn "GrtV" "greater" (dynamic \i -> Typed (GrtV (VInt i)) :: Int -> Typed FuncExpr Int) (Typed Expr a)
<<@@@ applyHorizontalClasses -> Typed TaskExpr (Task a)
, DynamicCons )
$ functionConsDyn "LessV" "less" (dynamic \i -> Typed (LessV (VInt i)) :: Int -> Typed FuncExpr Int) <<@@@ applyHorizontalClasses
<<@@@ applyHorizontalClasses ]
, DynamicCons // Non-task functions:
$ functionConsDyn "int" "enter an integer:" (dynamic \i -> Typed (Int i) :: Int -> Typed Expr Int) , DynamicConsGroup "Basics"
, DynamicCons [ functionConsDyn "Identity" "this value"
$ functionConsDyn "bool" "enter a boolean:" (dynamic \b -> Typed (Bool b) :: Bool -> Typed Expr Bool) (dynamic Typed Identity :: A.a: Typed Func (a -> a))
, DynamicCons , functionConsDyn "Apply" "apply"
$ functionConsDyn "string" "enter a string:" (dynamic \s -> Typed (String s) :: String -> Typed Expr String) ( dynamic \(Typed func) (Typed expr) ->
, DynamicCons Typed (Apply func expr) ::
$ functionConsDyn "tuple" "enter tuple:" A.a b:
( dynamic \(Typed a) (Typed b) -> (Typed Func (a -> b))
Typed (Tuple a b) :: (Typed Expr a)
A.a b: -> Typed Expr b
(Typed Expr a) (Typed Expr b) -> Typed Expr (a, b) )
) <<@@@ applyHorizontalClasses
, DynamicCons , functionConsDyn "Fst" "fst"
$ functionConsDyn "fst" "fst" (dynamic \(Typed (Tuple a _)) -> Typed a :: A.a b: (Typed Expr (a, b)) -> Typed Expr a) (dynamic Typed Fst :: A.a b: Typed Func ((a, b) -> a))
<<@@@ applyHorizontalClasses <<@@@ applyHorizontalClasses
, DynamicCons , functionConsDyn "Snd" "snd"
$ functionConsDyn "snd" "snd" (dynamic \(Typed (Tuple _ b)) -> Typed b :: A.a b: (Typed Expr (a, b)) -> Typed Expr b) (dynamic Typed Snd :: A.a b: Typed Func ((a, b) -> b))
<<@@@ applyHorizontalClasses <<@@@ applyHorizontalClasses
, DynamicCons ]
$ functionConsDyn "==" "==" , DynamicConsGroup "Arithmetic"
( dynamic \(Typed a) (Typed b) -> [ functionConsDyn "Add" "add"
Typed (Eq a b) :: (dynamic \(Typed i) -> Typed (Add i) :: (Typed Expr Int) -> Typed Func (Int -> Int)) //XXX (Typed Expr Int) -> Typed Func (Int -> Int)
A.a: <<@@@ applyHorizontalClasses
(Typed Expr a) (Typed Expr a) -> Typed Expr Bool , functionConsDyn "Sub" "sub"
) (dynamic \(Typed i) -> Typed (Sub i) :: (Typed Expr Int) -> Typed Func (Int -> Int))
<<@@@ applyHorizontalClasses <<@@@ applyHorizontalClasses
, DynamicCons $ customEditorCons "Int" "(enter integer)" intEditor <<@@@ HideIfOnlyChoice , functionConsDyn "Mul" "mul"
, DynamicCons $ customEditorCons "Bool" "(enter boolean)" boolEditor <<@@@ HideIfOnlyChoice (dynamic \(Typed i) -> Typed (Mul i) :: (Typed Expr Int) -> Typed Func (Int -> Int))
, DynamicCons $ customEditorCons "String" "(enter string )" stringEditor <<@@@ HideIfOnlyChoice <<@@@ applyHorizontalClasses
// type specifications for enterInformation , functionConsDyn "Div" "div"
, DynamicCons $ functionConsDyn "Ty.Int" "Int" (dynamic Typed (Ty VInt) :: Typed Ty Int) (dynamic \(Typed i) -> Typed (Div i) :: (Typed Expr Int) -> Typed Func (Int -> Int))
, DynamicCons $ functionConsDyn "Ty.Bool" "Bool" (dynamic Typed (Ty VBool) :: Typed Ty Bool) <<@@@ applyHorizontalClasses
, DynamicCons $ functionConsDyn "Ty.String" "String" (dynamic Typed (Ty VString) :: Typed Ty String) ]
, DynamicCons , DynamicConsGroup "Logic"
$ functionConsDyn "Ty.Tuple" "Tuple" [ functionConsDyn "Conj" "and"
( dynamic \(Typed (Ty toValue1)) (Typed (Ty toValue2)) -> (dynamic \(Typed b) -> Typed (Conj b) :: (Typed Expr Bool) -> Typed Func (Bool -> Bool))
Typed (Ty \(x, y) -> VTuple (toValue1 x) (toValue2 y)) :: <<@@@ applyHorizontalClasses
A.a b: , functionConsDyn "Disj" "or"
(Typed Ty a) (Typed Ty b) -> Typed Ty (a, b) (dynamic \(Typed b) -> Typed (Disj b) :: (Typed Expr Bool) -> Typed Func (Bool -> Bool))
) <<@@@ applyHorizontalClasses
<<@@@ applyHorizontalClasses , functionConsDyn "Not" "not"
(dynamic Typed Not :: Typed Func (Bool -> Bool))
<<@@@ applyHorizontalClasses
]
, DynamicConsGroup "Comparison"
[ functionConsDyn "Gt" "greater than"
(dynamic \(Typed i) -> Typed (Gt i) :: (Typed Expr Int) -> Typed Func (Int -> Int))
<<@@@ applyHorizontalClasses
, functionConsDyn "Ge" "greater or equal"
(dynamic \(Typed i) -> Typed (Ge i) :: (Typed Expr Int) -> Typed Func (Int -> Int))
<<@@@ applyHorizontalClasses
, functionConsDyn "Eq" "equal to"
(dynamic \(Typed i) -> Typed (Eq i) :: (Typed Expr Int) -> Typed Func (Int -> Int))
<<@@@ applyHorizontalClasses
, functionConsDyn "Le" "lesser than"
(dynamic \(Typed i) -> Typed (Le i) :: (Typed Expr Int) -> Typed Func (Int -> Int))
<<@@@ applyHorizontalClasses
, functionConsDyn "Lt" "lesser than"
(dynamic \(Typed i) -> Typed (Lt i) :: (Typed Expr Int) -> Typed Func (Int -> Int))
<<@@@ applyHorizontalClasses
]
// Non-task expressions:
, DynamicConsGroup "Values"
[ functionConsDyn "Int" "the integer"
(dynamic \i -> Typed (Int i) :: Int -> Typed Expr Int)
<<@@@ applyHorizontalClasses
, functionConsDyn "Bool" "the boolean"
(dynamic \b -> Typed (Bool b) :: Bool -> Typed Expr Bool)
<<@@@ applyHorizontalClasses
, functionConsDyn "String" "the string"
(dynamic \s -> Typed (String s) :: String -> Typed Expr String)
<<@@@ applyHorizontalClasses
, functionConsDyn "Tuple" "the tuple"
( dynamic \(Typed a) (Typed b) ->
Typed (Tuple a b) ::
A.a b:
(Typed Expr a) (Typed Expr b) -> Typed Expr (a, b)
)
<<@@@ applyHorizontalClasses
] ]
// Types
, DynamicConsGroup "Types"
// Helpers // [ functionConsDyn "Ty.Int" "Int"
(dynamic Typed (Ty VInt) :: Typed Ty Int)
derivedType :: Typed Ty a | iTask a <<@@@ applyHorizontalClasses
derivedType = case dynToValue of , functionConsDyn "Ty.Bool" "Bool"
(toValue :: a^ -> Value | iTask a^) = Typed (Ty toValue) (dynamic Typed (Ty VBool) :: Typed Ty Bool)
<<@@@ applyHorizontalClasses
, functionConsDyn "Ty.String" "String"
(dynamic Typed (Ty VString) :: Typed Ty String)
<<@@@ applyHorizontalClasses
, functionConsDyn "Ty.Tuple" "Tuple"
( dynamic \(Typed (Ty toValue1)) (Typed (Ty toValue2)) -> Typed (Ty \(x, y) -> VTuple (toValue1 x) (toValue2 y)) ::
A.a b:
(Typed Ty a) (Typed Ty b) -> Typed Ty (a, b)
)
<<@@@ applyHorizontalClasses
]
// Internal helper editors
, DynamicConsGroup "Helpers"
[ customEditorCons "int" "(enter integer)" intEditor <<@@@ HideIfOnlyChoice
, customEditorCons "bool" "(enter boolean)" boolEditor <<@@@ HideIfOnlyChoice
, customEditorCons "string" "(enter string )" stringEditor <<@@@ HideIfOnlyChoice
]
]
where where
dynToValue = dynamic () intEditor :: Editor Int
intEditor = gEditor{|*|}
intEditor :: Editor Int
intEditor = gEditor{|*|}
boolEditor :: Editor Bool boolEditor :: Editor Bool
boolEditor = gEditor{|*|} boolEditor = gEditor{|*|}
stringEditor :: Editor String stringEditor :: Editor String
stringEditor = gEditor{|*|} stringEditor = gEditor{|*|}
applyHorizontalClasses = ApplyCssClasses ["itasks-horizontal", "itasks-wrap-width", "itasks-panel"] applyHorizontalClasses = ApplyCssClasses ["itasks-horizontal", "itasks-wrap-width", "itasks-panel"]
applyVerticalClasses = ApplyCssClasses ["itasks-vertical", "itasks-wrap-width", "itasks-panel"]
// Evaluation ////////////////////////////////////////////////////////////////// // Evaluation //////////////////////////////////////////////////////////////////
evalTaskConstExpr :: TaskExpr -> Task Value evalTaskExpr :: TaskExpr -> Task Value
evalTaskConstExpr (Done expr) = return $ evalExpr expr evalTaskExpr (Done expr) = return $ evalExpr expr
evalTaskConstExpr (EnterInfo msg (Ty toValue)) = enterInformation msg [] @ toValue evalTaskExpr (EnterInfo msg (Ty toValue)) = enterInformation msg [] @ toValue
// evalTaskConstExpr (Apply taskFunc expr) = evalTaskFuncExpr taskFunc $ evalExpr expr evalTaskExpr (Then task taskFunc) = evalTaskExpr task >>= evalTaskFunc taskFunc
evalTaskConstExpr (Then task taskFunc) = evalTaskConstExpr task >>= evalTaskFuncExpr taskFunc evalTaskExpr (Any task1 task2) = (evalTaskExpr task1 -||- evalTaskExpr task2) <<@ ApplyLayout arrangeHorizontal
evalTaskConstExpr (Or task1 task2) = (evalTaskConstExpr task1 -||- evalTaskConstExpr task2 <<@ ApplyLayout arrangeHorizontal) evalTaskExpr (Both task1 task2) = (evalTaskExpr task1 -&&- evalTaskExpr task2) <<@ ApplyLayout arrangeHorizontal @ \(a, b) -> VTuple a b
evalTaskConstExpr (And task1 task2) = (evalTaskConstExpr task1 -&&- evalTaskConstExpr task2 <<@ ApplyLayout arrangeHorizontal) @ \(a, b) -> VTuple a b // evalTaskExpr (When task1 options) = evalTaskExpr task1
evalTaskConstExpr (When task1 options) = evalTaskConstExpr task1 // >>* [ OnAction (Action name) (ifValue (test pred) (evalTaskFunc cont))
>>* [ OnAction (Action name) (ifValue (test pred) (evalTaskFuncExpr cont)) // \\ {name, pred, cont} <- options
\\ {name, pred, cont} <- options // ]
] // where
where // test pred (VInt i) = case pred of
test pred (VInt i) = case pred of // Lt (VInt j) -> i < j
LessV (VInt j) -> i < j // Gt (VInt j) -> i > j
GrtV (VInt j) -> i > j // Eq (VInt j) -> i == j
EqV (VInt j) -> i == j // test pred (VBool i) = case pred of
// Eq (VBool j) -> i == j
test pred (VBool i) = case pred of // Lt (VBool j) -> False
EqV (VBool j) -> i == j // Gt (VBool j) -> False
LessV (VBool j) -> False
GrtV (VBool j) -> False
evalTaskFunc :: TaskFunc Value -> Task Value
evalTaskFunc (ThenF this next) val = evalTaskFunc this val >>= evalTaskFunc next
evalTaskFuncExpr :: TaskFuncExpr Value -> Task Value
evalTaskFuncExpr (ViewInfo p) (VInt i) = (viewInformation p [] i @ VInt) <<@ ApplyLayout arrangeHorizontal evalTaskFunc (ViewF msg func) val = case evalFunc val func of
evalTaskFuncExpr (ViewInfo p) (VBool b) = (viewInformation p [] b @ VBool) <<@ ApplyLayout arrangeHorizontal (VInt i) -> (viewInformation msg [] i @ VInt) <<@ ApplyLayout arrangeHorizontal
evalTaskFuncExpr (ViewInfo p) (VString s) = (viewInformation p [] s @ VString) <<@ ApplyLayout arrangeHorizontal (VBool b) -> (viewInformation msg [] b @ VBool) <<@ ApplyLayout arrangeHorizontal
evalTaskFuncExpr (ViewInfo p) (VTuple a b) = (VString s) -> (viewInformation msg [] s @ VString) <<@ ApplyLayout arrangeHorizontal
( viewInformation p [] () (VTuple a b) ->
||- evalTaskFuncExpr (ViewInfo "") a ( viewInformation msg [] ()
-&&- evalTaskFuncExpr (ViewInfo "") b ||- evalTaskFunc (ViewF "" Identity) a -&&- evalTaskFunc (ViewF "" Identity) b
@ \(a, b) -> VTuple a b @ \(a, b) -> VTuple a b
) )
<<@ ApplyLayout arrangeHorizontal <<@ ApplyLayout arrangeHorizontal
evalTaskFuncExpr (UpdateInfo p) (VInt i) = (updateInformation p [] i @ VInt) <<@ ApplyLayout arrangeHorizontal
evalTaskFuncExpr (UpdateInfo p) (VBool b) = (updateInformation p [] b @ VBool) <<@ ApplyLayout arrangeHorizontal evalTaskFunc (UpdateF msg) val = case val of
evalTaskFuncExpr (UpdateInfo p) (VString s) = (updateInformation p [] s @ VString) <<@ ApplyLayout arrangeHorizontal (VInt i) -> (updateInformation msg [] i @ VInt) <<@ ApplyLayout arrangeHorizontal
evalTaskFuncExpr (UpdateInfo p) (VTuple a b) = (VBool b) -> (updateInformation msg [] b @ VBool) <<@ ApplyLayout arrangeHorizontal
( viewInformation p [] () (VString s) -> (updateInformation msg [] s @ VString) <<@ ApplyLayout arrangeHorizontal
||- evalTaskFuncExpr (UpdateInfo "") a (VTuple a b) ->
-&&- evalTaskFuncExpr (UpdateInfo "") b ( viewInformation msg [] ()
@ \(a, b) -> VTuple a b ||- evalTaskFunc (UpdateF "") a
) -&&- evalTaskFunc (UpdateF "") b
<<@ ApplyLayout arrangeHorizontal @ \(a, b) -> VTuple a b
)
<<@ 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
evalExpr (String s) = VString s evalExpr (String s) = VString s
evalExpr (Tuple fstExpr sndExpr) = VTuple (evalExpr fstExpr) (evalExpr sndExpr) evalExpr (Tuple fstExpr sndExpr) = VTuple (evalExpr fstExpr) (evalExpr sndExpr)
evalExpr (Fst expr) = fst evalExpr (Apply func expr) = evalFunc (evalExpr expr) func
evalFunc :: Value Func -> Value
evalFunc val Identity = val
evalFunc (VInt i1) func = case func of
(Gt expr) -> VBool $ i1 > evalInt expr
(Ge expr) -> VBool $ i1 >= evalInt expr
(Eq expr) -> VBool $ i1 == evalInt expr
(Le expr) -> VBool $ i1 <= evalInt expr
(Lt expr) -> VBool $ i1 < evalInt expr
(Add expr) -> VInt $ i1 + evalInt expr
(Sub expr) -> VInt $ i1 - evalInt expr