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 ...@@ -2,7 +2,9 @@ implementation module iTasks._Framework.Engine
import StdMisc, StdArray, StdList, StdOrdList, StdTuple, StdChar, StdFile, StdBool, StdEnum import StdMisc, StdArray, StdList, StdOrdList, StdTuple, StdChar, StdFile, StdBool, StdEnum
from StdFunc import o, seqList, ::St, const 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 System.Time, System.CommandLine, System.Environment, System.OSError, System.File, System.FilePath, System.Directory
import iTasks._Framework.Util, iTasks._Framework.HtmlUtil import iTasks._Framework.Util, iTasks._Framework.HtmlUtil
import iTasks._Framework.IWorld, iTasks._Framework.WebService, iTasks._Framework.SDSService import iTasks._Framework.IWorld, iTasks._Framework.WebService, iTasks._Framework.SDSService
...@@ -241,18 +243,18 @@ initIWorld mbSDKPath mbWebdirPaths mbStorePath mbSaplPath world ...@@ -241,18 +243,18 @@ initIWorld mbSDKPath mbWebdirPaths mbStorePath mbSaplPath world
,sessionInstance = Nothing ,sessionInstance = Nothing
,attachmentChain = [] ,attachmentChain = []
,nextTaskNo = 0 ,nextTaskNo = 0
,eventRoute = newMap ,eventRoute = 'DM'.newMap
,editletDiffs = newMap ,editletDiffs = 'DM'.newMap
} }
,sdsNotifyRequests = [] ,sdsNotifyRequests = []
,memoryShares = newMap ,memoryShares = 'DM'.newMap
,cachedShares = newMap ,cachedShares = 'DM'.newMap
,exposedShares = newMap ,exposedShares = 'DM'.newMap
,jsCompilerState = (lst, ftmap, flavour, Nothing, newMap) ,jsCompilerState = (lst, ftmap, flavour, Nothing, 'DM'.newMap)
,refreshQueue = [] ,refreshQueue = []
,shutdown = False ,shutdown = False
,ioTasks = {done = [], todo = []} ,ioTasks = {done = [], todo = []}
,ioStates = newMap ,ioStates = 'DM'.newMap
,world = world ,world = world
,resources = Nothing ,resources = Nothing
,random = genRandInt seed ,random = genRandInt seed
......
implementation module iTasks._Framework.Generic.Interaction implementation module iTasks._Framework.Generic.Interaction
from Data.Map import :: Map
import qualified Data.Map as DM
from StdFunc import const from StdFunc import const
import StdList, StdBool, StdTuple, StdMisc 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 Text, Text.JSON
import iTasks._Framework.IWorld import iTasks._Framework.IWorld
import iTasks._Framework.UIDefinition import iTasks._Framework.UIDefinition
...@@ -39,7 +41,7 @@ gEditor{|RECORD of {grd_arity}|} fx _ _ mx _ _ dp (RECORD x,mask,ver) meta vst=: ...@@ -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 = if (optional && not disabled) (OptionalEditor [checkbox True:controlsOf fieldsViz]) fieldsViz
= (viz,vst) = (viz,vst)
where 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} 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 # (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, ...@@ -60,7 +62,7 @@ gEditor{|OBJECT of {gtd_num_conses,gtd_conses}|} fx _ _ mx _ _ dp vv=:(OBJECT x,
Untouched = ([],[]) Untouched = ([],[])
Blanked = ([],[]) Blanked = ([],[])
_ = (controlsOf items,[selectedConsIndex]) _ = (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 = (NormalEditor [(UIDropdown defaultHSizeOpts
{UIChoiceOpts {UIChoiceOpts
| taskId = taskId | taskId = taskId
...@@ -71,18 +73,18 @@ gEditor{|OBJECT of {gtd_num_conses,gtd_conses}|} fx _ _ mx _ _ dp vv=:(OBJECT x, ...@@ -71,18 +73,18 @@ gEditor{|OBJECT of {gtd_num_conses,gtd_conses}|} fx _ _ mx _ _ dp vv=:(OBJECT x,
: content : content
] ]
,{vst & selectedConsIndex = oldSelectedConsIndex}) ,{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 | otherwise
# (vis,vst) = fx dp (x,mask,ver) meta vst # (vis,vst) = fx dp (x,mask,ver) meta vst
# vis = case vis of # vis = case vis of
HiddenEditor = HiddenEditor HiddenEditor = HiddenEditor
NormalEditor [] NormalEditor []
= NormalEditor [(stringDisplay (if (isTouched mask) (gtd_conses !! vst.selectedConsIndex).gcd_name ""),newMap)] = NormalEditor [(stringDisplay (if (isTouched mask) (gtd_conses !! vst.selectedConsIndex).gcd_name ""),'DM'.newMap)]
//= if (isTouched mask) (NormalEditor [((stringDisplay ((gtd_conses !! vst.selectedConsIndex).gcd_name)),newMap)]) (NormalEditor []) //= if (isTouched mask) (NormalEditor [((stringDisplay ((gtd_conses !! vst.selectedConsIndex).gcd_name)),'DM'.newMap)]) (NormalEditor [])
NormalEditor items 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 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}) = (vis,{vst & selectedConsIndex = oldSelectedConsIndex})
gEditor{|CONS of {gcd_index,gcd_arity}|} fx _ _ mx _ _ dp (CONS x,mask,ver) meta vst=:{VSt|taskId,optional,disabled} 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 ...@@ -120,37 +122,37 @@ where
gEditor{|Int|} dp vv=:(val,mask,ver) meta vst=:{VSt|taskId,disabled} gEditor{|Int|} dp vv=:(val,mask,ver) meta vst=:{VSt|taskId,disabled}
| 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 | otherwise
= (NormalEditor [(UIEditInt defaultHSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=checkMaskValue mask val},editorAttributes vv meta)],vst) = (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} gEditor{|Real|} dp vv=:(val,mask,ver) meta vst=:{VSt|taskId,disabled}
| 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 | otherwise
= (NormalEditor [(UIEditDecimal defaultHSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=checkMaskValue mask val},editorAttributes vv meta)],vst) = (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} gEditor{|Char|} dp vv=:(val,mask,ver) meta vst=:{VSt|taskId,disabled}
| 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 | otherwise
= (NormalEditor [(UIEditString defaultHSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=checkMaskValue mask val},editorAttributes vv meta)],vst) = (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} gEditor{|String|} dp vv=:(val,mask,ver) meta vst=:{VSt|taskId,disabled}
| disabled | disabled
= (NormalEditor [(UIViewString defaultSizeOpts {UIViewOpts|value= checkMask mask val},newMap)],vst) = (NormalEditor [(UIViewString defaultSizeOpts {UIViewOpts|value= checkMask mask val},'DM'.newMap)],vst)
| otherwise | otherwise
= (NormalEditor [(UIEditString defaultHSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=checkMaskValue mask val},editorAttributes vv meta)],vst) = (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 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 | disabled
= (OptionalEditor [(UIViewCheckbox defaultFSizeOpts {UIViewOpts|value =checkMask mask val},newMap)],vst) = (OptionalEditor [(UIViewCheckbox defaultFSizeOpts {UIViewOpts|value =checkMask mask val},'DM'.newMap)],vst)
| otherwise | otherwise
= (OptionalEditor [(UIEditCheckbox defaultFSizeOpts {UIEditOpts|taskId=taskId,editorId=editorId dp,value=checkMaskValue mask val},editorAttributes vv meta)],vst) = (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} 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 # (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 where
listControl dp items masks vers vst=:{VSt|optional,disabled} listControl dp items masks vers vst=:{VSt|optional,disabled}
# (itemsVis,vst) = childVisualizations fx mx dp items masks vers vst # (itemsVis,vst) = childVisualizations fx mx dp items masks vers vst
...@@ -163,8 +165,8 @@ where ...@@ -163,8 +165,8 @@ where
= ([listItemControl disabled numItems idx dx \\ dx <- itemsVis & idx <- [0..]] ++ [addItemControl numItems],vst) = ([listItemControl disabled numItems idx dx \\ dx <- itemsVis & idx <- [0..]] ++ [addItemControl numItems],vst)
listItemControl disabled numItems idx item listItemControl disabled numItems idx item
//# controls = map fst (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 = 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} # 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 ("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} ,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 ...@@ -172,7 +174,7 @@ where
= setHeight WrapSize (setDirection Horizontal (defaultContainer (if disabled controls (controls ++ buttons)))) = setHeight WrapSize (setDirection Horizontal (defaultContainer (if disabled controls (controls ++ buttons))))
/* /*
newItemControl item 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} # 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-down",disabled= True}
,UIEditButton defaultSizeOpts {UIEditOpts|taskId=taskId,editorId=name,value=Nothing} {UIButtonOpts|text=Nothing,iconCls=Just "icon-remove",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 ...@@ -192,7 +194,7 @@ where
gEditor{|EditableList|} fx _ _ mx _ _ dp ({EditableList|items,add,remove,reorder,count},mask,ver) meta vst=:{VSt|taskId,disabled,layout} 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 # (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 where
enableAdd = case add of ELNoAdd = False ; _ = True; enableAdd = case add of ELNoAdd = False ; _ = True;
...@@ -205,7 +207,7 @@ where ...@@ -205,7 +207,7 @@ where
= ([listItemControl disabled numItems idx dx \\ dx <- itemsVis & idx <- [0..]],vst) = ([listItemControl disabled numItems idx dx \\ dx <- itemsVis & idx <- [0..]],vst)
listItemControl disabled numItems idx item 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 # 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 ("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 ("mdn_" +++ toString idx))} {UIButtonOpts|text=Nothing,iconCls=Just "icon-down",disabled= idx == numItems - 1}
...@@ -250,7 +252,7 @@ where ...@@ -250,7 +252,7 @@ where
gEditor{|Void|} _ _ _ vst = (HiddenEditor,vst) gEditor{|Void|} _ _ _ vst = (HiddenEditor,vst)
gEditor{|HtmlTag|} dp (val,mask,ver) meta 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) gEditor{|RWShared|} _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ vst = (HiddenEditor,vst)
derive gEditor JSONNode, Either, MaybeError, (,,), (,,,), Timestamp, Map //TODO Make specializations for (,,) and (,,,) derive gEditor JSONNode, Either, MaybeError, (,,), (,,,), Timestamp, Map //TODO Make specializations for (,,) and (,,,)
...@@ -546,18 +548,18 @@ editorAttributes (val,mask,ver) meta ...@@ -546,18 +548,18 @@ editorAttributes (val,mask,ver) meta
[{EditMeta|hint}] = hint [{EditMeta|hint}] = hint
_ = Nothing _ = Nothing
# attr = case meta of # attr = case meta of
[{EditMeta|unit=Just (Left unit)}:_] = put PREFIX_ATTRIBUTE unit newMap [{EditMeta|unit=Just (Left unit)}:_] = 'DM'.put PREFIX_ATTRIBUTE unit 'DM'.newMap
[{EditMeta|unit=Just (Right unit)}:_] = put POSTFIX_ATTRIBUTE unit newMap [{EditMeta|unit=Just (Right unit)}:_] = 'DM'.put POSTFIX_ATTRIBUTE unit 'DM'.newMap
_ = newMap _ = 'DM'.newMap
| isTouched mask = case ver of | isTouched mask = case ver of
(CorrectValue msg) = put VALID_ATTRIBUTE (fromMaybe "This value is ok" msg) attr (CorrectValue msg) = 'DM'.put VALID_ATTRIBUTE (fromMaybe "This value is ok" msg) attr
(WarningValue msg) = put WARNING_ATTRIBUTE msg attr (WarningValue msg) = 'DM'.put WARNING_ATTRIBUTE msg attr
(IncorrectValue msg) = put ERROR_ATTRIBUTE msg attr (IncorrectValue msg) = 'DM'.put ERROR_ATTRIBUTE msg attr
(UnparsableValue) = put ERROR_ATTRIBUTE "This value not in the required format" attr (UnparsableValue) = 'DM'.put ERROR_ATTRIBUTE "This value not in the required format" attr
(MissingValue) = put ERROR_ATTRIBUTE "This value is required" attr (MissingValue) = 'DM'.put ERROR_ATTRIBUTE "This value is required" attr
_ = attr _ = attr
| otherwise | 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 :: !VisualizationResult -> [(UIControl,UIAttributes)]
controlsOf (NormalEditor controls) = controls controlsOf (NormalEditor controls) = controls
...@@ -568,7 +570,7 @@ addLabel :: !Bool !String !UIAttributes -> UIAttributes ...@@ -568,7 +570,7 @@ addLabel :: !Bool !String !UIAttributes -> UIAttributes
addLabel optional label attr = putCond LABEL_ATTRIBUTE (format optional label) attr addLabel optional label attr = putCond LABEL_ATTRIBUTE (format optional label) attr
where where
format optional label = camelCaseToWords label +++ if optional "" "*" +++ ":" //TODO: Move to layout 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 :: !(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 childVisualizations fx mx dp children masks vers vst = childVisualizations` 0 children masks vers [] vst
......
implementation module iTasks._Framework.HtmlUtil 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 import StdList, StdBool
embeddedStyle :: HtmlTag embeddedStyle :: HtmlTag
...@@ -40,14 +42,14 @@ notFoundResponse req ...@@ -40,14 +42,14 @@ notFoundResponse req
paramValue :: !String !HTTPRequest -> String paramValue :: !String !HTTPRequest -> String
paramValue name req paramValue name req
= case get name req.arg_post of = case 'DM'.get name req.arg_post of
Just val = val Just val = val
Nothing = case get name req.arg_get of Nothing = case 'DM'.get name req.arg_get of
Just val = val Just val = val
Nothing = "" Nothing = ""
hasParam :: !String !HTTPRequest -> Bool 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 :: !String -> HtmlTag
nl2br str = html [[Text line,BrTag []] \\ line <- split OS_NEWLINE str] nl2br str = html [[Text line,BrTag []] \\ line <- split OS_NEWLINE str]
......
...@@ -15,7 +15,7 @@ from StdFunc import const ...@@ -15,7 +15,7 @@ from StdFunc import const
from Data.List import splitWith from Data.List import splitWith
from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SChannel_, :: TCP_DuplexChannel, :: DuplexChannel, :: IPAddress, :: ByteSeq 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.TaskStore, iTasks._Framework.Util
import iTasks._Framework.Serialization import iTasks._Framework.Serialization
import iTasks._Framework.SDS import iTasks._Framework.SDS
......
...@@ -2,7 +2,9 @@ implementation module iTasks._Framework.SDS ...@@ -2,7 +2,9 @@ implementation module iTasks._Framework.SDS
from StdFunc import const from StdFunc import const
import StdString, StdTuple, StdMisc, StdList, StdBool 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 qualified Data.Set as Set
import iTasks._Framework.IWorld import iTasks._Framework.IWorld
import iTasks._Framework.Task, iTasks._Framework.TaskStore, iTasks._Framework.TaskEval import iTasks._Framework.Task, iTasks._Framework.TaskStore, iTasks._Framework.TaskEval
...@@ -309,10 +311,10 @@ where ...@@ -309,10 +311,10 @@ where
keep (TaskId no _) nos = not (isMember no nos) keep (TaskId no _) nos = not (isMember no nos)
listAllSDSRegistrations :: *IWorld -> (![(InstanceNo,[(TaskId,SDSIdentity)])],!*IWorld) 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 where
addReg {SDSNotifyRequest|reqTaskId=reqTaskId=:(TaskId taskInstance _),cmpSDSId} list 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 :: [(InstanceNo,[(TaskId,SDSIdentity)])] -> String
formatSDSRegistrationsList list formatSDSRegistrationsList list
......
...@@ -2,7 +2,9 @@ implementation module iTasks._Framework.Store ...@@ -2,7 +2,9 @@ implementation module iTasks._Framework.Store
import StdEnv import StdEnv
import Data.Void 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 System.File, System.Directory, System.OSError, System.FilePath
import Text, Text.JSON import Text, Text.JSON
...@@ -39,14 +41,14 @@ memoryStore :: !StoreNamespace !(Maybe a) -> RWShared StoreName a a | TC a ...@@ -39,14 +41,14 @@ memoryStore :: !StoreNamespace !(Maybe a) -> RWShared StoreName a a | TC a
memoryStore namespace defaultV = createReadWriteSDS namespace "memoryStore" read write memoryStore namespace defaultV = createReadWriteSDS namespace "memoryStore" read write
where where
read key iworld=:{IWorld|memoryShares} 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 (val :: a^)) = (Ok val,iworld)
(Just _) = (Error (exception StoreReadTypeError), iworld) (Just _) = (Error (exception StoreReadTypeError), iworld)
_ = case defaultV of _ = case defaultV of
Nothing = (Error (exception StoreReadMissingError), iworld) 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} 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 //'Core' file storage SDS
fullFileStore :: !StoreNamespace !Bool !(Maybe {#Char}) -> RWShared StoreName (!BuildID,!{#Char}) {#Char} fullFileStore :: !StoreNamespace !Bool !(Maybe {#Char}) -> RWShared StoreName (!BuildID,!{#Char}) {#Char}
...@@ -112,7 +114,7 @@ where ...@@ -112,7 +114,7 @@ where
# (mbVal,iworld) = jsLoadValue namespace key iworld # (mbVal,iworld) = jsLoadValue namespace key iworld
= (maybe (Error (exception StoreReadMissingError)) Ok mbVal, iworld) = (maybe (Error (exception StoreReadMissingError)) Ok mbVal, iworld)
//Try cache first //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 (val :: a^,_,_)) = Just (Ok val)
(Just _) = Just (Error (exception StoreReadTypeError)) (Just _) = Just (Error (exception StoreReadTypeError))
Nothing = Nothing Nothing = Nothing
...@@ -129,14 +131,14 @@ where ...@@ -129,14 +131,14 @@ where
= case fromJSON json of = case fromJSON json of
Just value Just value
//Keep in cache //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) = (Ok value,iworld)
Nothing = (Error (exception StoreReadTypeError),iworld) Nothing = (Error (exception StoreReadTypeError),iworld)
(Error StoreReadMissingError,Just def) (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) = (Ok def,iworld)
(Error e,Just def) | resetOnError (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) = (Ok def,iworld)
(Error e,Nothing) | resetOnError (Error e,Nothing) | resetOnError
# iworld = deleteValue namespace key iworld # iworld = deleteValue namespace key iworld
...@@ -149,15 +151,15 @@ where ...@@ -149,15 +151,15 @@ where
= (Ok ((==) key),jsStoreValue namespace key value iworld) = (Ok ((==) key),jsStoreValue namespace key value iworld)
| otherwise | otherwise
//Write to cache //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) = (Ok ((==) key),iworld)
flushShareCache :: *IWorld -> *IWorld flushShareCache :: *IWorld -> *IWorld
flushShareCache iworld=:{IWorld|onClient,cachedShares} flushShareCache iworld=:{IWorld|onClient,cachedShares}
| onClient = iworld | onClient = iworld
| otherwise | otherwise
# (shares,iworld) = foldr flushShare ([],iworld) (toList cachedShares) # (shares,iworld) = foldr flushShare ([],iworld) ('DM'.toList cachedShares)
= {iworld & cachedShares = fromList shares} = {iworld & cachedShares = 'DM'.fromList shares}
where where
flushShare cached=:((namespace,key),(val,keep,mbDeferredWrite)) (shares,iworld) flushShare cached=:((namespace,key),(val,keep,mbDeferredWrite)) (shares,iworld)
# iworld = case mbDeferredWrite of # iworld = case mbDeferredWrite of
......
...@@ -2,7 +2,9 @@ implementation module iTasks._Framework.Task ...@@ -2,7 +2,9 @@ implementation module iTasks._Framework.Task
from StdFunc import const, id from StdFunc import const, id
import StdClass, StdArray, StdTuple, StdInt, StdList, StdBool, StdMisc 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._Framework.IWorld, iTasks._Framework.UIDefinition, iTasks._Framework.Util
import iTasks.API.Core.Types import iTasks.API.Core.Types
import iTasks._Framework.Generic, iTasks._Framework.Generic.Interaction