Commit 445101de authored by ecrombag's avatar ecrombag

Fixed behavior of Maybe combined with Tuples

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1152 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 02e6658b
......@@ -22,6 +22,7 @@ instance GenMask VerifyMask
instance toString ErrorMessage
derive gVerify UNIT, PAIR, EITHER, OBJECT, CONS, FIELD, Int, Real, Char, Bool, String, (,), (,,), (,,,), [], Maybe, Dynamic, Void, Document, Either
derive JSONEncode VerifyMask
verifyValue :: !a !UpdateMask -> VerifyMask | gVerify{|*|} a
basicVerify :: String !*VerSt -> *VerSt
......
......@@ -6,6 +6,7 @@ import GenUpdate, StdMisc
derive bimap (,), Maybe
derive gVerify (,), (,,), (,,,), Void, Either
derive JSONEncode VerifyMask, ErrorMessage
generic gVerify a :: (Maybe a) *VerSt -> *VerSt
......@@ -26,8 +27,8 @@ gVerify{|EITHER|} _ fy (Just (RIGHT y)) vst = fy (Just y) vst
gVerify{|CONS of d|} _ Nothing vst = vst
gVerify{|CONS of d|} fx (Just (CONS x)) vst=:{VerSt | verifyMask,optional}
# vst = fx (Just x) {VerSt | vst & optional = False}
| not (isEmpty d.gcd_fields) //record
# vst = fx (Just x) {VerSt | vst & optional = False}
# vst=:{VerSt | verifyMask} = vst
# children = getMaskChildren verifyMask
| allUntouched children
......@@ -36,7 +37,9 @@ gVerify{|CONS of d|} fx (Just (CONS x)) vst=:{VerSt | verifyMask,optional}
= {VerSt | vst & verifyMask = (VMValid Nothing Nothing children), optional = optional}
| otherwise
= {VerSt | vst & verifyMask = (VMInvalid IsBlankError Nothing children), optional = optional}
| otherwise = {VerSt | vst & optional = optional}
| otherwise
# vst = fx (Just x) vst
= {VerSt | vst & optional = optional}
gVerify{|FIELD of d|} _ Nothing vst = vst
gVerify{|FIELD of d|} fx (Just (FIELD x)) vst = fx (Just x) vst
......@@ -44,14 +47,14 @@ gVerify{|FIELD of d|} fx (Just (FIELD x)) vst = fx (Just x) vst
gVerify{|OBJECT of d|} _ Nothing vst = vst
gVerify{|OBJECT of d|} fx (Just (OBJECT x)) vst=:{VerSt | verifyMask,updateMask,optional}
# (cm,um) = popMask updateMask
# vMask = case optional of
True = VMValid Nothing Nothing []
False = case cm of
(Blanked _ _) = (VMInvalid IsBlankError Nothing [])
(Untouched _ _) = (VMUntouched Nothing Nothing [])
(Touched _ _) = (VMValid Nothing Nothing [])
# vst=:{VerSt | verifyMask=childMask} = fx (Just x) {VerSt | vst & verifyMask = vMask, updateMask = cm}
= {VerSt | vst & updateMask = um, verifyMask = appendToMask verifyMask childMask}
# vst=:{VerSt | verifyMask=childMask} = fx (Just x) {VerSt | vst & verifyMask = (VMValid Nothing Nothing []), updateMask = cm}
# children = getMaskChildren childMask
| allUntouched children
= {VerSt | vst & updateMask = um, verifyMask = appendToMask verifyMask (VMUntouched Nothing Nothing children)}
| allValid children
= {VerSt | vst & updateMask = um, verifyMask = appendToMask verifyMask (VMValid Nothing Nothing children)}
| otherwise
= {VerSt | vst & updateMask = um, verifyMask = appendToMask verifyMask (VMInvalid IsBlankError Nothing children)}
gVerify{|Int|} _ vst = basicVerify "Enter a number" vst
gVerify{|Real|} _ vst = basicVerify "Enter a decimal number" vst
......
......@@ -23,8 +23,8 @@ visualizeAsEditor name mbSubIdx umask vmask x
Nothing = vst
Just idx = {VSt| vst & currentPath = dataPathSetSubEditorIdx vst.VSt.currentPath idx}
# (defs,vst=:{VSt | valid}) = gVisualize{|*|} val val vst
//= trace_n("==UMASK==\n"+++toString (toJSON umask) +++ "\n==VMASK==\n" +++ toString (toJSON vmask)+++"\n") (coerceToTUIDefs defs, valid)
= (coerceToTUIDefs defs, valid)
= trace_n("==UMASK==\n"+++toString (toJSON umask) +++ "\n==VMASK==\n" +++ toString (toJSON vmask)+++"\n") (coerceToTUIDefs defs, valid)
//= (coerceToTUIDefs defs, valid)
where
val = VValue x
......@@ -47,7 +47,9 @@ visualizeAsTextLabel :: a -> String | gVisualize{|*|} a
visualizeAsTextLabel x = join " " (coerceToStrings (fst (gVisualize{|*|} val val {mkVSt & origVizType = VTextLabel, vizType = VTextLabel})))
where
val = VValue x
import StdDebug
determineEditorUpdates :: String (Maybe SubEditorIndex) [DataPath] UpdateMask VerifyMask a a -> ([TUIUpdate],Bool) | gVisualize{|*|} a
determineEditorUpdates name mbSubIdx updatedPaths umask vmask old new
# vst = {mkVSt & vizType = VEditorUpdate, idPrefix = name, updateMask = umask, verifyMask = vmask, updates = updatedPaths}
......@@ -55,8 +57,8 @@ determineEditorUpdates name mbSubIdx updatedPaths umask vmask old new
Nothing = vst
Just idx = {VSt| vst & currentPath = dataPathSetSubEditorIdx vst.VSt.currentPath idx}
# (updates,vst=:{VSt | valid}) = (gVisualize{|*|} (VValue old) (VValue new) vst)
//= trace_n("==UMASK==\n"+++toString (toJSON umask) +++ "\n==VMASK==\n" +++ toString (toJSON vmask)+++"\n") (coerceToTUIUpdates updates, valid)
= (coerceToTUIUpdates updates, valid)
= trace_n("==UMASK==\n"+++toString (toJSON umask) +++ "\n==VMASK==\n" +++ toString (toJSON vmask)+++"\n") (coerceToTUIUpdates updates, valid)
//= (coerceToTUIUpdates updates, valid)
//Bimap for visualization values
derive bimap VisualizationValue
......
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