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