From 3ce3c6ebb67ab5931bc39b3ae3e9e1fa292630f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jurri=C3=ABn=20Stutterheim?= Date: Fri, 26 Jun 2015 13:55:00 +0000 Subject: [PATCH] Qualified Data.Map imports git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@4251 63da3aa8-80fd-4f01-9db8-e6ea747a3da2 --- Server/iTasks/_Framework/Engine.icl | 18 +++--- .../iTasks/_Framework/Generic/Interaction.icl | 62 ++++++++++--------- Server/iTasks/_Framework/HtmlUtil.icl | 10 +-- Server/iTasks/_Framework/IWorld.icl | 2 +- Server/iTasks/_Framework/SDS.icl | 8 ++- Server/iTasks/_Framework/Store.icl | 24 +++---- Server/iTasks/_Framework/Task.icl | 6 +- Server/iTasks/_Framework/UIDiff.icl | 8 ++- 8 files changed, 76 insertions(+), 62 deletions(-) diff --git a/Server/iTasks/_Framework/Engine.icl b/Server/iTasks/_Framework/Engine.icl index a96fe6d60..cc531e62d 100644 --- a/Server/iTasks/_Framework/Engine.icl +++ b/Server/iTasks/_Framework/Engine.icl @@ -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 diff --git a/Server/iTasks/_Framework/Generic/Interaction.icl b/Server/iTasks/_Framework/Generic/Interaction.icl index 9caadd1ca..f2e8e382a 100644 --- a/Server/iTasks/_Framework/Generic/Interaction.icl +++ b/Server/iTasks/_Framework/Generic/Interaction.icl @@ -1,8 +1,10 @@ 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 diff --git a/Server/iTasks/_Framework/HtmlUtil.icl b/Server/iTasks/_Framework/HtmlUtil.icl index a64d5b8a8..4114544ad 100644 --- a/Server/iTasks/_Framework/HtmlUtil.icl +++ b/Server/iTasks/_Framework/HtmlUtil.icl @@ -1,6 +1,8 @@ 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] diff --git a/Server/iTasks/_Framework/IWorld.icl b/Server/iTasks/_Framework/IWorld.icl index d2ef66ba7..f4080ef94 100644 --- a/Server/iTasks/_Framework/IWorld.icl +++ b/Server/iTasks/_Framework/IWorld.icl @@ -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 diff --git a/Server/iTasks/_Framework/SDS.icl b/Server/iTasks/_Framework/SDS.icl index a660f5b36..553cbc28c 100644 --- a/Server/iTasks/_Framework/SDS.icl +++ b/Server/iTasks/_Framework/SDS.icl @@ -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 diff --git a/Server/iTasks/_Framework/Store.icl b/Server/iTasks/_Framework/Store.icl index 8b736375a..78a93f636 100644 --- a/Server/iTasks/_Framework/Store.icl +++ b/Server/iTasks/_Framework/Store.icl @@ -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 diff --git a/Server/iTasks/_Framework/Task.icl b/Server/iTasks/_Framework/Task.icl index d1ec21afb..6b17976a4 100644 --- a/Server/iTasks/_Framework/Task.icl +++ b/Server/iTasks/_Framework/Task.icl @@ -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|} _ _ _ = [""] -gEditor{|Task|} _ _ _ _ _ _ _ _ _ vst = (NormalEditor [(stringDisplay "",newMap)],vst) +gEditor{|Task|} _ _ _ _ _ _ _ _ _ vst = (NormalEditor [(stringDisplay "", 'DM'.newMap)],vst) gEditMeta{|Task|} _ _ = [{label=Just "Task",hint=Nothing,unit=Nothing}] gEq{|Task|} _ _ _ = True // tasks are always equal?? diff --git a/Server/iTasks/_Framework/UIDiff.icl b/Server/iTasks/_Framework/UIDiff.icl index 407ce477e..42ef607b3 100644 --- a/Server/iTasks/_Framework/UIDiff.icl +++ b/Server/iTasks/_Framework/UIDiff.icl @@ -1,7 +1,9 @@ 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 -- GitLab