We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

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.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