Commit 4b8b9001 authored by Tim Steenvoorden's avatar Tim Steenvoorden

add Date type

parent f5623ee9
Pipeline #25462 failed with stage
in 1 minute and 19 seconds
...@@ -4,6 +4,7 @@ import StdEnv ...@@ -4,6 +4,7 @@ import StdEnv
import Data.Func import Data.Func
import Data.Functor import Data.Functor
import iTasks import iTasks
import iTasks.Extensions.DateTime
import iTasks.Extensions.Editors.DynamicEditor import iTasks.Extensions.Editors.DynamicEditor
...@@ -75,6 +76,7 @@ where ...@@ -75,6 +76,7 @@ where
= Int Int = Int Int
| Bool Bool | Bool Bool
| String String | String String
| Date Date
| Pair Expr Expr | Pair Expr Expr
| Apply Func Expr | Apply Func Expr
...@@ -100,6 +102,7 @@ where ...@@ -100,6 +102,7 @@ where
| VInt Int | VInt Int
| VBool Bool | VBool Bool
| VString String | VString String
| VDate Date
| VPair Value Value | VPair Value Value
:: Ty :: Ty
...@@ -347,6 +350,9 @@ taskEditor = DynamicEditor ...@@ -347,6 +350,9 @@ taskEditor = DynamicEditor
, functionConsDyn "String" "the string" , functionConsDyn "String" "the string"
(dynamic \s -> Typed (String s) :: String -> Typed Expr String) (dynamic \s -> Typed (String s) :: String -> Typed Expr String)
<<@@@ applyHorizontalLayout <<@@@ applyHorizontalLayout
, functionConsDyn "Date" "the date"
(dynamic \d -> Typed (Date d) :: Date -> Typed Expr Date)
<<@@@ applyHorizontalLayout
, functionConsDyn "Pair" "the pair" , functionConsDyn "Pair" "the pair"
( dynamic \(Typed a) (Typed b) -> ( dynamic \(Typed a) (Typed b) ->
Typed (Pair a b) :: Typed (Pair a b) ::
...@@ -367,6 +373,9 @@ taskEditor = DynamicEditor ...@@ -367,6 +373,9 @@ taskEditor = DynamicEditor
, functionConsDyn "Ty.String" "String" , functionConsDyn "Ty.String" "String"
(dynamic Typed (Ty VString) :: Typed Ty String) (dynamic Typed (Ty VString) :: Typed Ty String)
<<@@@ applyHorizontalLayout <<@@@ applyHorizontalLayout
, functionConsDyn "Ty.Date" "Date"
(dynamic Typed (Ty VDate) :: Typed Ty Date)
<<@@@ applyHorizontalLayout
, functionConsDyn "Ty.Pair" "Pair" , functionConsDyn "Ty.Pair" "Pair"
( dynamic \(Typed (Ty toValue1)) (Typed (Ty toValue2)) -> Typed (Ty \(x, y) -> VPair (toValue1 x) (toValue2 y)) :: ( dynamic \(Typed (Ty toValue1)) (Typed (Ty toValue2)) -> Typed (Ty \(x, y) -> VPair (toValue1 x) (toValue2 y)) ::
A.a b: A.a b:
...@@ -379,6 +388,7 @@ taskEditor = DynamicEditor ...@@ -379,6 +388,7 @@ taskEditor = DynamicEditor
[ customEditorCons "int" "(enter integer)" intEditor <<@@@ HideIfOnlyChoice [ customEditorCons "int" "(enter integer)" intEditor <<@@@ HideIfOnlyChoice
, customEditorCons "bool" "(enter boolean)" boolEditor <<@@@ HideIfOnlyChoice , customEditorCons "bool" "(enter boolean)" boolEditor <<@@@ HideIfOnlyChoice
, customEditorCons "string" "(enter string )" stringEditor <<@@@ HideIfOnlyChoice , customEditorCons "string" "(enter string )" stringEditor <<@@@ HideIfOnlyChoice
, customEditorCons "date" "(enter date )" dateEditor <<@@@ HideIfOnlyChoice
] ]
] ]
where where
...@@ -391,6 +401,9 @@ where ...@@ -391,6 +401,9 @@ where
stringEditor :: Editor String stringEditor :: Editor String
stringEditor = gEditor{|*|} stringEditor = gEditor{|*|}
dateEditor :: Editor Date
dateEditor = gEditor{|*|}
basicClasses = [ "typedtasks-base" ] basicClasses = [ "typedtasks-base" ]
horizontalClasses = [ "typedtasks-horizontal" ] horizontalClasses = [ "typedtasks-horizontal" ]
verticalClasses = [ "typedtasks-vertical" ] verticalClasses = [ "typedtasks-vertical" ]
...@@ -446,6 +459,7 @@ evalTaskFunc (ViewF msg func) val = case evalFunc val func of ...@@ -446,6 +459,7 @@ evalTaskFunc (ViewF msg func) val = case evalFunc val func of
(VInt i) -> (viewInformation msg [] i @ VInt) <<@ ApplyLayout arrangeHorizontal (VInt i) -> (viewInformation msg [] i @ VInt) <<@ ApplyLayout arrangeHorizontal
(VBool b) -> (viewInformation msg [] b @ VBool) <<@ ApplyLayout arrangeHorizontal (VBool b) -> (viewInformation msg [] b @ VBool) <<@ ApplyLayout arrangeHorizontal
(VString s) -> (viewInformation msg [] s @ VString) <<@ ApplyLayout arrangeHorizontal (VString s) -> (viewInformation msg [] s @ VString) <<@ ApplyLayout arrangeHorizontal
(VDate s) -> (viewInformation msg [] s @ VDate) <<@ ApplyLayout arrangeHorizontal
(VPair a b) -> (VPair a b) ->
( viewInformation msg [] () ( viewInformation msg [] ()
||- (evalTaskFunc (ViewF "" Identity) a -&&- evalTaskFunc (ViewF "" Identity) b) ||- (evalTaskFunc (ViewF "" Identity) a -&&- evalTaskFunc (ViewF "" Identity) b)
...@@ -457,6 +471,7 @@ evalTaskFunc (UpdateF msg func) val = case evalFunc val func of ...@@ -457,6 +471,7 @@ evalTaskFunc (UpdateF msg func) val = case evalFunc val func of
(VInt i) -> (updateInformation msg [] i @ VInt) <<@ ApplyLayout arrangeHorizontal (VInt i) -> (updateInformation msg [] i @ VInt) <<@ ApplyLayout arrangeHorizontal
(VBool b) -> (updateInformation msg [] b @ VBool) <<@ ApplyLayout arrangeHorizontal (VBool b) -> (updateInformation msg [] b @ VBool) <<@ ApplyLayout arrangeHorizontal
(VString s) -> (updateInformation msg [] s @ VString) <<@ ApplyLayout arrangeHorizontal (VString s) -> (updateInformation msg [] s @ VString) <<@ ApplyLayout arrangeHorizontal
(VDate s) -> (updateInformation msg [] s @ VDate) <<@ ApplyLayout arrangeHorizontal
(VPair a b) -> (VPair a b) ->
( viewInformation msg [] () ( viewInformation msg [] ()
||- (evalTaskFunc (UpdateF "" Identity) a -&&- evalTaskFunc (UpdateF "" Identity) b) ||- (evalTaskFunc (UpdateF "" Identity) a -&&- evalTaskFunc (UpdateF "" Identity) b)
...@@ -477,6 +492,7 @@ evalExpr :: Expr -> Value ...@@ -477,6 +492,7 @@ 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 (Date d) = VDate d
evalExpr (Pair fstExpr sndExpr) = VPair (evalExpr fstExpr) (evalExpr sndExpr) evalExpr (Pair fstExpr sndExpr) = VPair (evalExpr fstExpr) (evalExpr sndExpr)
evalExpr (Apply func expr) = evalFunc (evalExpr expr) func evalExpr (Apply func expr) = evalFunc (evalExpr expr) func
...@@ -516,6 +532,18 @@ where ...@@ -516,6 +532,18 @@ where
evalString expr = case evalExpr expr of evalString expr = case evalExpr expr of
(VString s) -> s (VString s) -> s
evalFunc (VDate d1) func = case func of
(Eq expr) -> VBool $ d1 == evalDate expr
(Gt expr) -> VBool $ d1 > evalDate expr
(Ge expr) -> VBool $ d1 >= evalDate expr
(Eq expr) -> VBool $ d1 == evalDate expr
(Le expr) -> VBool $ d1 <= evalDate expr
(Lt expr) -> VBool $ d1 < evalDate expr
where
evalDate :: Expr -> Date
evalDate expr = case evalExpr expr of
(VDate d) -> d
evalFunc (VPair x1 x2) func = case func of evalFunc (VPair x1 x2) func = case func of
Fst -> x1 Fst -> x1
Snd -> x2 Snd -> x2
...@@ -527,4 +555,5 @@ instance toString Value where ...@@ -527,4 +555,5 @@ instance toString Value where
VInt i -> toString i VInt i -> toString i
VBool b -> toString b VBool b -> toString b
VString s -> toString s VString s -> toString s
VDate d -> toString d
VPair x y -> "( " +++ toString x +++ ", " +++ toString y +++ " )" VPair x y -> "( " +++ toString x +++ ", " +++ toString y +++ " )"
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