bork

[clean-tests.git] / dyneditors / DynEditorExample.icl

diff --git a/dyneditors/DynEditorExample.icl b/dyneditors/DynEditorExample.icl
new file mode 100644 (file)
index 0000000..854710c
--- /dev/null
+++ b/dyneditors/DynEditorExample.icl
@@ -0,0 +1,52 @@
+module DynEditorExample
+
+import Data.Func, Data.Functor, Data.Maybe
+import iTasks, iTasks.UI.Editor.Modifiers
+import DynamicEditor
+
+// non-typesafe expression
+:: Expr = IntLit Int | RealLit Real | Plus Expr Expr | ToInt Expr | ToReal Expr | Eq Expr Expr
+
+// expression with phantom type
+:: TypedExpr a =: TypedExpr Expr
+
+derive class iTask Expr, TypedExpr
+
+dslEditor :: DynamicEditor (TypedExpr a)
+dslEditor = DynamicEditor
+    ( [ functionConsDyn "plus" "plus"
+                        ( dynamic \(TypedExpr x) (TypedExpr y) -> TypedExpr (Plus x y) ::
+                          A.b: (TypedExpr b) (TypedExpr b) -> TypedExpr b
+                        )
+      , functionCons "toInt"  "to integer" toIntExpr
+      , functionCons "toReal" "to decimal" toRealExpr
+      , customEditorCons "int"  "(enter integer)"
+                         (bijectEditorValue (\(TypedExpr (IntLit i)) -> i)  intLit  gEditor{|*|})
+      , customEditorCons "real" "(enter decimal)"
+                         (bijectEditorValue (\(TypedExpr (RealLit r)) -> r) realLit gEditor{|*|})
+      , functionConsDyn "eq" "are equal"
+                        ( dynamic \(TypedExpr x) (TypedExpr y) -> TypedExpr (Eq x y) ::
+                          A.b: (TypedExpr b) (TypedExpr b) -> TypedExpr Bool
+                        )
+      ]
+    )
+where
+    toIntExpr :: (TypedExpr Real) -> TypedExpr Int
+    toIntExpr (TypedExpr x) = TypedExpr (ToInt x)
+
+    toRealExpr :: (TypedExpr Int) -> TypedExpr Real
+    toRealExpr (TypedExpr x) = TypedExpr (ToReal x)
+
+    intLit :: Int -> TypedExpr Int
+    intLit i = TypedExpr (IntLit i)
+
+    realLit :: Real -> TypedExpr Real
+    realLit r = TypedExpr (RealLit r)
+
+// possible results can be Int, Real
+// Bool does not work yet
+enterExpr :: Task (Maybe (DynamicEditorValue (TypedExpr Int)))
+enterExpr = enterInformation      () [EnterUsing id $ dynamicEditor dslEditor] >&>
+            viewSharedInformation () [ViewAs $ fmap $ toValue dslEditor]
+
+Start world = doTasks enterExpr world