Commit 3ce3c6eb authored by Jurriën Stutterheim's avatar Jurriën Stutterheim

Qualified Data.Map imports


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@4251 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 4faad9d1
......@@ -2,7 +2,9 @@ implementation module iTasks._Framework.Engine
import StdMisc, StdArray, StdList, StdOrdList, StdTuple, StdChar, StdFile, StdBool, StdEnum
from StdFunc import o, seqList, ::St, const
import Data.Map, Data.Error, Data.Func, Data.Tuple, Math.Random, Internet.HTTP, Text, Text.Encodings.MIME, Text.Encodings.UrlEncoding
from Data.Map import :: Map
import qualified Data.Map as DM
import Data.Error, Data.Func, Data.Tuple, Math.Random, Internet.HTTP, Text, Text.Encodings.MIME, Text.Encodings.UrlEncoding
import System.Time, System.CommandLine, System.Environment, System.OSError, System.File, System.FilePath, System.Directory
import iTasks._Framework.Util, iTasks._Framework.HtmlUtil
import iTasks._Framework.IWorld, iTasks._Framework.WebService, iTasks._Framework.SDSService
......@@ -241,18 +243,18 @@ initIWorld mbSDKPath mbWebdirPaths mbStorePath mbSaplPath world
,sessionInstance = Nothing
,attachmentChain = []
,nextTaskNo = 0
,eventRoute = newMap
,editletDiffs = newMap
,eventRoute = 'DM'.newMap
,editletDiffs = 'DM'.newMap
}
,sdsNotifyRequests = []
,memoryShares = newMap
,cachedShares = newMap
,exposedShares = newMap
,jsCompilerState = (lst, ftmap, flavour, Nothing, newMap)
,memoryShares = 'DM'.newMap
,cachedShares = 'DM'.newMap
,exposedShares = 'DM'.newMap
,jsCompilerState = (lst, ftmap, flavour, Nothing, 'DM'.newMap)
,refreshQueue = []
,shutdown = False
,ioTasks = {done = [], todo = []}
,ioStates = newMap
,ioStates = 'DM'.newMap
,world = world
,resources = Nothing
,random = genRandInt seed
......
implementation module iTasks._Framework.Generic.Interaction
from Data.Map import :: Map
import qualified Data.Map as DM
from StdFunc import const
import StdList, StdBool, StdTuple, StdMisc
import Data.Maybe, Data.Either, Data.Error, Data.Map, Data.Generic, Data.Functor, Data.Tuple
import Data.Maybe, Data.Either, Data.Error, Data.Generic, Data.Functor, Data.Tuple
import Text, Text.JSON
import iTasks._Framework.IWorld
import iTasks._Framework.UIDefinition
......@@ -39,7 +41,7 @@ gEditor{|RECORD of {grd_arity}|} fx _ _ mx _ _ dp (RECORD x,mask,ver) meta vst=:
# viz = if (optional && not disabled) (OptionalEditor [checkbox True:controlsOf fieldsViz]) fieldsViz
= (viz,vst)
where
checkbox checked = (UIEditCheckbox defaultFSizeOpts {UIEditOpts|taskId = taskId, editorId = editorId dp, value = Just (JSONBool checked)},newMap)
checkbox checked = (UIEditCheckbox defaultFSizeOpts {UIEditOpts|taskId = taskId, editorId = editorId dp, value = Just (JSONBool checked)},'DM'.newMap)
gEditor{|FIELD of {gfd_name}|} fx _ _ mx _ _ dp (FIELD x,mask,ver) _ vst=:{VSt|disabled,layout}
# (vizBody,vst) = fx dp (x,mask,ver) (mx x) vst
......@@ -60,7 +62,7 @@ gEditor{|OBJECT of {gtd_num_conses,gtd_conses}|} fx _ _ mx _ _ dp vv=:(OBJECT x,
Untouched = ([],[])
Blanked = ([],[])
_ = (controlsOf items,[selectedConsIndex])
# content = layout.layoutSubEditor {UIForm|attributes = newMap, controls = controls,size = defaultSizeOpts}
# content = layout.layoutSubEditor {UIForm|attributes = 'DM'.newMap, controls = controls,size = defaultSizeOpts}
= (NormalEditor [(UIDropdown defaultHSizeOpts
{UIChoiceOpts
| taskId = taskId
......@@ -71,18 +73,18 @@ gEditor{|OBJECT of {gtd_num_conses,gtd_conses}|} fx _ _ mx _ _ dp vv=:(OBJECT x,
: content
]
,{vst & selectedConsIndex = oldSelectedConsIndex})
//ADT with one constructor or static render: put content into container, if empty show cons name
//ADT with one constructor or static render: 'DM'.put content into container, if empty show cons name
| otherwise
# (vis,vst) = fx dp (x,mask,ver) meta vst
# vis = case vis of
HiddenEditor = HiddenEditor
NormalEditor []
= NormalEditor [(stringDisplay (if (isTouched mask) (gtd_conses !! vst.selectedConsIndex).gcd_name ""),newMap)]
//= if (isTouched mask) (NormalEditor [((stringDisplay ((gtd_conses !! vst.selectedConsIndex).gcd_name)),newMap)]) (NormalEditor [])
= NormalEditor [(stringDisplay (if (isTouched mask) (gtd_conses !! vst.selectedConsIndex).gcd_name ""),'DM'.newMap)]
//= if (isTouched mask) (NormalEditor [((stringDisplay ((gtd_conses !! vst.selectedConsIndex).gcd_name)),'DM'.newMap)]) (NormalEditor [])
NormalEditor items
= NormalEditor (layout.layoutSubEditor {UIForm|attributes = newMap, controls = items, size = defaultSizeOpts})
= NormalEditor (layout.layoutSubEditor {UIForm|attributes = 'DM'.newMap, controls = items, size = defaultSizeOpts})
OptionalEditor items
= OptionalEditor (layout.layoutSubEditor {UIForm|attributes = newMap, controls = items, size = defaultSizeOpts})
= OptionalEditor (layout.layoutSubEditor {UIForm|attributes = 'DM'.newMap, controls = items, size = defaultSizeOpts})
= (vis,{vst & selectedConsIndex = oldSelectedConsIndex})
gEditor{|CONS of {gcd_index,gcd_arity}|} fx _ _ mx _ _ dp (CONS x,mask,ver) meta vst=:{VSt|taskId,optional,disabled}
......@@ -120,37 +122,37 @@ where
gEditor{|Int|} dp vv=:(val,mask,ver) meta vst=:{VSt|taskId,disabled}
| disabled
= (NormalEditor [(UIViewString defaultSizeOpts {UIViewOpts|value = fmap toString (checkMask mask val)},newMap)],vst)
= (NormalEditor [(UIViewString defaultSizeOpts {UIViewOpts|value = fmap toString (checkMask mask val)},'DM'.newMap)],vst)
| otherwise
= (NormalEditor [(UIEditInt defaultHSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=checkMaskValue mask val},editorAttributes vv meta)],vst)
gEditor{|Real|} dp vv=:(val,mask,ver) meta vst=:{VSt|taskId,disabled}
| disabled
= (NormalEditor [(UIViewString defaultSizeOpts {UIViewOpts|value = fmap toString (checkMask mask val)},newMap)],vst)
= (NormalEditor [(UIViewString defaultSizeOpts {UIViewOpts|value = fmap toString (checkMask mask val)},'DM'.newMap)],vst)
| otherwise
= (NormalEditor [(UIEditDecimal defaultHSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=checkMaskValue mask val},editorAttributes vv meta)],vst)
gEditor{|Char|} dp vv=:(val,mask,ver) meta vst=:{VSt|taskId,disabled}
| disabled
= (NormalEditor [(UIViewString defaultSizeOpts {UIViewOpts|value = fmap toString (checkMask mask val)},newMap)],vst)
= (NormalEditor [(UIViewString defaultSizeOpts {UIViewOpts|value = fmap toString (checkMask mask val)},'DM'.newMap)],vst)
| otherwise
= (NormalEditor [(UIEditString defaultHSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=checkMaskValue mask val},editorAttributes vv meta)],vst)
gEditor{|String|} dp vv=:(val,mask,ver) meta vst=:{VSt|taskId,disabled}
| disabled
= (NormalEditor [(UIViewString defaultSizeOpts {UIViewOpts|value= checkMask mask val},newMap)],vst)
= (NormalEditor [(UIViewString defaultSizeOpts {UIViewOpts|value= checkMask mask val},'DM'.newMap)],vst)
| otherwise
= (NormalEditor [(UIEditString defaultHSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=checkMaskValue mask val},editorAttributes vv meta)],vst)
gEditor{|Bool|} dp vv=:(val,mask,ver) meta vst=:{VSt|taskId,disabled} //Bools are shown as optional by default, because a mandatory bool makes little sense
| disabled
= (OptionalEditor [(UIViewCheckbox defaultFSizeOpts {UIViewOpts|value =checkMask mask val},newMap)],vst)
= (OptionalEditor [(UIViewCheckbox defaultFSizeOpts {UIViewOpts|value =checkMask mask val},'DM'.newMap)],vst)
| otherwise
= (OptionalEditor [(UIEditCheckbox defaultFSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=checkMaskValue mask val},editorAttributes vv meta)],vst)
gEditor{|[]|} fx _ _ mx _ _ dp (val,mask,ver) meta vst=:{VSt|taskId,disabled,layout}
# (items,vst) = listControl dp val (subMasks (length val) mask) (subVerifications (length val) ver) vst
= (NormalEditor [(listContainer items,newMap)],vst)
= (NormalEditor [(listContainer items,'DM'.newMap)],vst)
where
listControl dp items masks vers vst=:{VSt|optional,disabled}
# (itemsVis,vst) = childVisualizations fx mx dp items masks vers vst
......@@ -163,8 +165,8 @@ where
= ([listItemControl disabled numItems idx dx \\ dx <- itemsVis & idx <- [0..]] ++ [addItemControl numItems],vst)
listItemControl disabled numItems idx item
//# controls = map fst (layout.layoutSubEditor {UIForm| attributes = newMap, controls = controlsOf item, size = defaultSizeOpts})
# controls = decorateControls (layout.layoutSubEditor {UIForm| attributes = newMap, controls = controlsOf item, size = defaultSizeOpts})
//# controls = map fst (layout.layoutSubEditor {UIForm| attributes = 'DM'.newMap, controls = controlsOf item, size = defaultSizeOpts})
# controls = decorateControls (layout.layoutSubEditor {UIForm| attributes = 'DM'.newMap, controls = controlsOf item, size = defaultSizeOpts})
# buttons = [UIEditButton defaultSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=Just (JSONString ("mup_" +++ toString idx))} {UIButtonOpts|text=Nothing,iconCls=Just "icon-up",disabled=idx == 0}
,UIEditButton defaultSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=Just (JSONString ("mdn_" +++ toString idx))} {UIButtonOpts|text=Nothing,iconCls=Just "icon-down",disabled= idx == numItems - 1}
,UIEditButton defaultSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=Just (JSONString ("rem_" +++ toString idx))} {UIButtonOpts|text=Nothing,iconCls=Just "icon-remove",disabled=False}
......@@ -172,7 +174,7 @@ where
= setHeight WrapSize (setDirection Horizontal (defaultContainer (if disabled controls (controls ++ buttons))))
/*
newItemControl item
# controls = map fst (layout.layoutSubEditor (newMap,controlsOf item))
# controls = map fst (layout.layoutSubEditor ('DM'.newMap,controlsOf item))
# buttons = [UIEditButton defaultSizeOpts {UIEditOpts|taskId=taskId,editorId=name,value=Nothing} {UIButtonOpts|text=Nothing,iconCls=Just "icon-up",disabled=True}
,UIEditButton defaultSizeOpts {UIEditOpts|taskId=taskId,editorId=name,value=Nothing} {UIButtonOpts|text=Nothing,iconCls=Just "icon-down",disabled= True}
,UIEditButton defaultSizeOpts {UIEditOpts|taskId=taskId,editorId=name,value=Nothing} {UIButtonOpts|text=Nothing,iconCls=Just "icon-remove",disabled=True}
......@@ -192,7 +194,7 @@ where
gEditor{|EditableList|} fx _ _ mx _ _ dp ({EditableList|items,add,remove,reorder,count},mask,ver) meta vst=:{VSt|taskId,disabled,layout}
# (controls,vst) = listControls dp items (subMasks (length items) mask) (subVerifications (length items) ver) vst
= (NormalEditor [(listContainer controls,newMap)],vst)
= (NormalEditor [(listContainer controls,'DM'.newMap)],vst)
where
enableAdd = case add of ELNoAdd = False ; _ = True;
......@@ -205,7 +207,7 @@ where
= ([listItemControl disabled numItems idx dx \\ dx <- itemsVis & idx <- [0..]],vst)
listItemControl disabled numItems idx item
# controls = map (setWidth FlexSize) (decorateControls (layout.layoutSubEditor {UIForm| attributes = newMap, controls = controlsOf item, size = defaultSizeOpts}))
# controls = map (setWidth FlexSize) (decorateControls (layout.layoutSubEditor {UIForm| attributes = 'DM'.newMap, controls = controlsOf item, size = defaultSizeOpts}))
# buttons = (if reorder
[UIEditButton defaultSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=Just (JSONString ("mup_" +++ toString idx))} {UIButtonOpts|text=Nothing,iconCls=Just "icon-up",disabled=idx == 0}
,UIEditButton defaultSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=Just (JSONString ("mdn_" +++ toString idx))} {UIButtonOpts|text=Nothing,iconCls=Just "icon-down",disabled= idx == numItems - 1}
......@@ -250,7 +252,7 @@ where
gEditor{|Void|} _ _ _ vst = (HiddenEditor,vst)
gEditor{|HtmlTag|} dp (val,mask,ver) meta vst
= (NormalEditor [(UIViewHtml defaultSizeOpts {UIViewOpts|value = Just val},newMap)], vst)
= (NormalEditor [(UIViewHtml defaultSizeOpts {UIViewOpts|value = Just val},'DM'.newMap)], vst)
gEditor{|RWShared|} _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ vst = (HiddenEditor,vst)
derive gEditor JSONNode, Either, MaybeError, (,,), (,,,), Timestamp, Map //TODO Make specializations for (,,) and (,,,)
......@@ -546,18 +548,18 @@ editorAttributes (val,mask,ver) meta
[{EditMeta|hint}] = hint
_ = Nothing
# attr = case meta of
[{EditMeta|unit=Just (Left unit)}:_] = put PREFIX_ATTRIBUTE unit newMap
[{EditMeta|unit=Just (Right unit)}:_] = put POSTFIX_ATTRIBUTE unit newMap
_ = newMap
[{EditMeta|unit=Just (Left unit)}:_] = 'DM'.put PREFIX_ATTRIBUTE unit 'DM'.newMap
[{EditMeta|unit=Just (Right unit)}:_] = 'DM'.put POSTFIX_ATTRIBUTE unit 'DM'.newMap
_ = 'DM'.newMap
| isTouched mask = case ver of
(CorrectValue msg) = put VALID_ATTRIBUTE (fromMaybe "This value is ok" msg) attr
(WarningValue msg) = put WARNING_ATTRIBUTE msg attr
(IncorrectValue msg) = put ERROR_ATTRIBUTE msg attr
(UnparsableValue) = put ERROR_ATTRIBUTE "This value not in the required format" attr
(MissingValue) = put ERROR_ATTRIBUTE "This value is required" attr
(CorrectValue msg) = 'DM'.put VALID_ATTRIBUTE (fromMaybe "This value is ok" msg) attr
(WarningValue msg) = 'DM'.put WARNING_ATTRIBUTE msg attr
(IncorrectValue msg) = 'DM'.put ERROR_ATTRIBUTE msg attr
(UnparsableValue) = 'DM'.put ERROR_ATTRIBUTE "This value not in the required format" attr
(MissingValue) = 'DM'.put ERROR_ATTRIBUTE "This value is required" attr
_ = attr
| otherwise
= maybe attr (\h -> put HINT_ATTRIBUTE h attr) hint
= maybe attr (\h -> 'DM'.put HINT_ATTRIBUTE h attr) hint
controlsOf :: !VisualizationResult -> [(UIControl,UIAttributes)]
controlsOf (NormalEditor controls) = controls
......@@ -568,7 +570,7 @@ addLabel :: !Bool !String !UIAttributes -> UIAttributes
addLabel optional label attr = putCond LABEL_ATTRIBUTE (format optional label) attr
where
format optional label = camelCaseToWords label +++ if optional "" "*" +++ ":" //TODO: Move to layout
putCond k v m = maybe (put k v m) (const m) (get k m)
putCond k v m = maybe ('DM'.put k v m) (const m) ('DM'.get k m)
childVisualizations :: !(DataPath (VerifiedValue a) [EditMeta] -> .(*VSt -> *(!VisualizationResult,*VSt))) !(a -> [EditMeta]) !DataPath ![a] ![InteractionMask] ![Verification] !*VSt -> *(![VisualizationResult],!*VSt)
childVisualizations fx mx dp children masks vers vst = childVisualizations` 0 children masks vers [] vst
......
implementation module iTasks._Framework.HtmlUtil
import Text.HTML, Text.JSON, Text, Internet.HTTP, Data.Map, System.OS
from Data.Map import :: Map
import qualified Data.Map as DM
import Text.HTML, Text.JSON, Text, Internet.HTTP, System.OS
import StdList, StdBool
embeddedStyle :: HtmlTag
......@@ -40,14 +42,14 @@ notFoundResponse req
paramValue :: !String !HTTPRequest -> String
paramValue name req
= case get name req.arg_post of
= case 'DM'.get name req.arg_post of
Just val = val
Nothing = case get name req.arg_get of
Nothing = case 'DM'.get name req.arg_get of
Just val = val
Nothing = ""
hasParam :: !String !HTTPRequest -> Bool
hasParam name req = isJust (get name req.arg_post) || isJust (get name req.arg_get)
hasParam name req = isJust ('DM'.get name req.arg_post) || isJust ('DM'.get name req.arg_get)
nl2br :: !String -> HtmlTag
nl2br str = html [[Text line,BrTag []] \\ line <- split OS_NEWLINE str]
......
......@@ -15,7 +15,7 @@ from StdFunc import const
from Data.List import splitWith
from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SChannel_, :: TCP_DuplexChannel, :: DuplexChannel, :: IPAddress, :: ByteSeq
import System.Time, StdList, Text.Encodings.Base64, _SystemArray, StdBool, StdTuple, Text.JSON, Data.Error, Data.Map
import System.Time, StdList, Text.Encodings.Base64, _SystemArray, StdBool, StdTuple, Text.JSON, Data.Error
import iTasks._Framework.TaskStore, iTasks._Framework.Util
import iTasks._Framework.Serialization
import iTasks._Framework.SDS
......
......@@ -2,7 +2,9 @@ implementation module iTasks._Framework.SDS
from StdFunc import const
import StdString, StdTuple, StdMisc, StdList, StdBool
import Data.Error, Data.Func, Data.Tuple, Data.Map, System.Time, Text, Text.JSON
from Data.Map import :: Map
import qualified Data.Map as DM
import Data.Error, Data.Func, Data.Tuple, System.Time, Text, Text.JSON
import qualified Data.Set as Set
import iTasks._Framework.IWorld
import iTasks._Framework.Task, iTasks._Framework.TaskStore, iTasks._Framework.TaskEval
......@@ -309,10 +311,10 @@ where
keep (TaskId no _) nos = not (isMember no nos)
listAllSDSRegistrations :: *IWorld -> (![(InstanceNo,[(TaskId,SDSIdentity)])],!*IWorld)
listAllSDSRegistrations iworld=:{IWorld|sdsNotifyRequests} = (toList (foldr addReg newMap sdsNotifyRequests),iworld)
listAllSDSRegistrations iworld=:{IWorld|sdsNotifyRequests} = ('DM'.toList (foldr addReg 'DM'.newMap sdsNotifyRequests),iworld)
where
addReg {SDSNotifyRequest|reqTaskId=reqTaskId=:(TaskId taskInstance _),cmpSDSId} list
= put taskInstance [(reqTaskId,cmpSDSId):fromMaybe [] (get taskInstance list)] list
= 'DM'.put taskInstance [(reqTaskId,cmpSDSId):fromMaybe [] ('DM'.get taskInstance list)] list
formatSDSRegistrationsList :: [(InstanceNo,[(TaskId,SDSIdentity)])] -> String
formatSDSRegistrationsList list
......
......@@ -2,7 +2,9 @@ implementation module iTasks._Framework.Store
import StdEnv
import Data.Void
import Data.Maybe, Data.Map, Data.Functor, Data.Error
from Data.Map import :: Map
import qualified Data.Map as DM
import Data.Maybe, Data.Functor, Data.Error
import System.File, System.Directory, System.OSError, System.FilePath
import Text, Text.JSON
......@@ -39,14 +41,14 @@ memoryStore :: !StoreNamespace !(Maybe a) -> RWShared StoreName a a | TC a
memoryStore namespace defaultV = createReadWriteSDS namespace "memoryStore" read write
where
read key iworld=:{IWorld|memoryShares}
= case get (namespace,key) memoryShares of
= case 'DM'.get (namespace,key) memoryShares of
(Just (val :: a^)) = (Ok val,iworld)
(Just _) = (Error (exception StoreReadTypeError), iworld)
_ = case defaultV of
Nothing = (Error (exception StoreReadMissingError), iworld)
Just val = (Ok val, {IWorld|iworld & memoryShares = put (namespace,key) (dynamic val :: a^) memoryShares})
Just val = (Ok val, {IWorld|iworld & memoryShares = 'DM'.put (namespace,key) (dynamic val :: a^) memoryShares})
write key val iworld=:{IWorld|memoryShares}
= (Ok ((==) key),{IWorld|iworld & memoryShares = put (namespace,key) (dynamic val :: a^) memoryShares})
= (Ok ((==) key),{IWorld|iworld & memoryShares = 'DM'.put (namespace,key) (dynamic val :: a^) memoryShares})
//'Core' file storage SDS
fullFileStore :: !StoreNamespace !Bool !(Maybe {#Char}) -> RWShared StoreName (!BuildID,!{#Char}) {#Char}
......@@ -112,7 +114,7 @@ where
# (mbVal,iworld) = jsLoadValue namespace key iworld
= (maybe (Error (exception StoreReadMissingError)) Ok mbVal, iworld)
//Try cache first
# mbResult = case get (namespace,key) cachedShares of
# mbResult = case 'DM'.get (namespace,key) cachedShares of
(Just (val :: a^,_,_)) = Just (Ok val)
(Just _) = Just (Error (exception StoreReadTypeError))
Nothing = Nothing
......@@ -129,14 +131,14 @@ where
= case fromJSON json of
Just value
//Keep in cache
# iworld = {iworld & cachedShares = put (namespace,key) (dynamic value,keepBetweenEvals,Nothing) cachedShares}
# iworld = {iworld & cachedShares = 'DM'.put (namespace,key) (dynamic value,keepBetweenEvals,Nothing) cachedShares}
= (Ok value,iworld)
Nothing = (Error (exception StoreReadTypeError),iworld)
(Error StoreReadMissingError,Just def)
# iworld = {iworld & cachedShares = put (namespace,key) (dynamic def, keepBetweenEvals,Just (DeferredJSON def)) cachedShares}
# iworld = {iworld & cachedShares = 'DM'.put (namespace,key) (dynamic def, keepBetweenEvals,Just (DeferredJSON def)) cachedShares}
= (Ok def,iworld)
(Error e,Just def) | resetOnError
# iworld = {iworld & cachedShares = put (namespace,key) (dynamic def, keepBetweenEvals,Just (DeferredJSON def)) cachedShares}
# iworld = {iworld & cachedShares = 'DM'.put (namespace,key) (dynamic def, keepBetweenEvals,Just (DeferredJSON def)) cachedShares}
= (Ok def,iworld)
(Error e,Nothing) | resetOnError
# iworld = deleteValue namespace key iworld
......@@ -149,15 +151,15 @@ where
= (Ok ((==) key),jsStoreValue namespace key value iworld)
| otherwise
//Write to cache
# iworld = {iworld & cachedShares = put (namespace,key) (dynamic value, keepBetweenEvals,Just (DeferredJSON value)) cachedShares}
# iworld = {iworld & cachedShares = 'DM'.put (namespace,key) (dynamic value, keepBetweenEvals,Just (DeferredJSON value)) cachedShares}
= (Ok ((==) key),iworld)
flushShareCache :: *IWorld -> *IWorld
flushShareCache iworld=:{IWorld|onClient,cachedShares}
| onClient = iworld
| otherwise
# (shares,iworld) = foldr flushShare ([],iworld) (toList cachedShares)
= {iworld & cachedShares = fromList shares}
# (shares,iworld) = foldr flushShare ([],iworld) ('DM'.toList cachedShares)
= {iworld & cachedShares = 'DM'.fromList shares}
where
flushShare cached=:((namespace,key),(val,keep,mbDeferredWrite)) (shares,iworld)
# iworld = case mbDeferredWrite of
......
......@@ -2,7 +2,9 @@ implementation module iTasks._Framework.Task
from StdFunc import const, id
import StdClass, StdArray, StdTuple, StdInt, StdList, StdBool, StdMisc
import Text.HTML, Internet.HTTP, Data.Map, Data.Error, Text.JSON
from Data.Map import :: Map
import qualified Data.Map as DM
import Text.HTML, Internet.HTTP, Data.Error, Text.JSON
import iTasks._Framework.IWorld, iTasks._Framework.UIDefinition, iTasks._Framework.Util
import iTasks.API.Core.Types
import iTasks._Framework.Generic, iTasks._Framework.Generic.Interaction
......@@ -31,7 +33,7 @@ gUpdate{|Task|} _ _ _ _ target upd val iworld = basicUpdate (\Void t -> Just t)
gVerify{|Task|} _ _ mv = alwaysValid mv
gText{|Task|} _ _ _ = ["<Task>"]
gEditor{|Task|} _ _ _ _ _ _ _ _ _ vst = (NormalEditor [(stringDisplay "<Task>",newMap)],vst)
gEditor{|Task|} _ _ _ _ _ _ _ _ _ vst = (NormalEditor [(stringDisplay "<Task>", 'DM'.newMap)],vst)
gEditMeta{|Task|} _ _ = [{label=Just "Task",hint=Nothing,unit=Nothing}]
gEq{|Task|} _ _ _ = True // tasks are always equal??
......
implementation module iTasks._Framework.UIDiff
import StdBool, StdClass, StdList, StdEnum, StdMisc, StdTuple, sapldebug
import Text, Text.JSON, Data.Map
from Data.Map import :: Map
import qualified Data.Map as DM
import Text, Text.JSON
import iTasks._Framework.Util, iTasks._Framework.UIDefinition
from iTasks._Framework.Task import :: Event(..), :: EventNo
......@@ -35,7 +37,7 @@ diffUIDefinitions {UIDef|content=UIFinal (UIViewport iOpts1 opts1),windows=w1} {
++ diffMenus [] event editletDiffs opts1.UIViewportOpts.menu opts2.UIViewportOpts.menu
, removeEditletDiffs (findEditletsInViewport vp2 ++ findEditletsInWindows w2 []) editletDiffs)
removeEditletDiffs removeIds editletDiffs = fromList [(editletId,(ver,value,opts,if (isMember editletId removeIds) [] diffs)) \\ (editletId,(ver,value,opts,diffs)) <- toList editletDiffs]
removeEditletDiffs removeIds editletDiffs = 'DM'.fromList [(editletId,(ver,value,opts,if (isMember editletId removeIds) [] diffs)) \\ (editletId,(ver,value,opts,diffs)) <- 'DM'.toList editletDiffs]
//Compare controls
diffControls :: !UIPath !Event !UIEditletDiffs !UIControl !UIControl -> DiffResult
......@@ -146,7 +148,7 @@ diffEditletOpts path editletDiffs opts1 opts2
//Check if we have a local diff function for this editor...
| opts1.UIEditletOpts.taskId == opts2.UIEditletOpts.taskId
&& opts1.UIEditletOpts.editorId == opts2.UIEditletOpts.editorId
= case get (opts2.UIEditletOpts.taskId,opts2.UIEditletOpts.editorId) editletDiffs of
= case 'DM'.get (opts2.UIEditletOpts.taskId,opts2.UIEditletOpts.editorId) editletDiffs of
Just (_,_,_,[]) = DiffPossible []
Just (ver,_,_,diffs) = DiffPossible [UIUpdate path (map (toUpdFunc ver) diffs)]
_ = DiffImpossible
......
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