put generic functions for making local/shared copies into separate file & make...

put generic functions for making local/shared copies into separate file & make local copies in readDB

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@965 63da3aa8-80fd-4f01-9db8-e6ea747a3da2

Examples/src/General/FormFlowStorage.icl

@@ -6,10 +6,11 @@ from	EstherBackend import toStringDynamic
 
 import	FormData, FlowData, TaskContainer
 				
-derive gPrint 		FormStore, FlowStore
-derive gParse 		FormStore, FlowStore
-derive gUpdate 		FormStore, FlowStore
-derive gVisualize 	FormStore, FlowStore
+derive gPrint 			FormStore, FlowStore
+derive gParse 			FormStore, FlowStore
+derive gUpdate 			FormStore, FlowStore
+derive gVisualize 		FormStore, FlowStore
+derive gMakeLocalCopy	FormStore, FlowStore, Form, Flow, FormShape, FlowShape, CleanExpr, AssignInfo
 
 derive bimap Maybe, (,)
 

Examples/src/Miscellaneous/Newsgroups.icl

@@ -56,9 +56,9 @@ derive gParse		Appointment, Meeting, Attending
 derive gVisualize	Appointment, Meeting, Attending	
 derive gUpdate		Appointment, Meeting, Attending
 
-derive gMerge				Meeting, Appointment, UserName, Attending
-derive gMakeSharedCopy		Meeting, Appointment, UserName, Attending
-derive gMakeLocalCopy		Meeting, Appointment, UserName, Attending
+derive gMerge				Meeting, Appointment, Attending
+derive gMakeSharedCopy		Meeting, Appointment, Attending
+derive gMakeLocalCopy		Meeting, Appointment, Attending
 
 :: Appointment		=	{ topic :: Note
 						}

Examples/src/Miscellaneous/textEditor.icl

@@ -117,7 +117,7 @@ statistics sid =
 		updateShared "Statistics" [ButtonAction (ActionOk, Always)] sid [statsListener]
 	>>| return GContinue
 where
-	statsListener = listener {listenerFrom = \(AppState (Note txt) _) -> let txt = trim txt in {lines = length (split "\n" txt), words = length (split " " (replaceSubString "\n" " " txt)), characters = textSize txt}}
+	statsListener = listener {listenerFrom = \(AppState (Note text) _) -> let txt = trim text in {lines = length (split "\n" txt), words = length (split " " (replaceSubString "\n" " " txt)), characters = textSize txt}}
 
 about :: Task GAction
 about =

Language/src/Core/BasicTasks/InteractionTasks.dcl

@@ -5,7 +5,7 @@ from Types		import :: Role
 from Html		import :: HtmlTag
 from iTasks		import class iTask(..)
 from ProcessDB	import :: Action
-import GenPrint, GenParse, GenVisualize, GenUpdate, GenMerge, StoreTasks
+import GenPrint, GenParse, GenVisualize, GenUpdate, GenMerge, StoreTasks, GenCopy
 
 // This type class contains types that may be used as
 // messages and questions: plain strings and html.
@@ -250,16 +250,6 @@ showInstructionAbout 		:: !String !instruction b 	-> Task Void | html instructio
 //notifyGroup					:: message Role -> Task Void										| html message
 
 //*** Shared variable tasks ***//
-generic gMakeSharedCopy a :: !a !String -> a
-derive gMakeSharedCopy OBJECT, CONS, PAIR, FIELD, EITHER, UNIT
-derive gMakeSharedCopy Int, Real, Char, Bool, String
-derive gMakeSharedCopy Document, [], Maybe, Either, (,), (,,), (,,,), Void, Static, Hidden
-
-generic gMakeLocalCopy a :: !a !*TSt -> (a,!*TSt)
-derive gMakeLocalCopy OBJECT, CONS, PAIR, FIELD, EITHER, UNIT
-derive gMakeLocalCopy Int, Real, Char, Bool, String
-derive gMakeLocalCopy Document, [], Maybe, Either, (,), (,,), (,,,), Void, Static, Hidden
-
 class SharedVariable a | gMerge{|*|}, gMakeSharedCopy{|*|}, gMakeLocalCopy{|*|} a
 
 :: Editor s a	= {editorFrom :: s -> a, editorTo :: a s -> s}

Language/src/Core/BasicTasks/InteractionTasks.icl

@@ -455,50 +455,6 @@ where
 addStorePrefix n key	= (toString n) +++ "_" +++ key
 editorId taskNr n		= "tf-" +++ (taskNrToString taskNr) +++ "_" +++ (toString n)
 
-generic gMakeSharedCopy a :: !a !String -> a
-gMakeSharedCopy{|Int|}		x _ = x
-gMakeSharedCopy{|Real|}		x _ = x
-gMakeSharedCopy{|Char|}		x _ = x
-gMakeSharedCopy{|Bool|}		x _ = x
-gMakeSharedCopy{|String|}	x _ = x
-gMakeSharedCopy{|OBJECT|}	f (OBJECT x) sid		= OBJECT (f x sid)
-gMakeSharedCopy{|CONS|}		f (CONS x) sid			= CONS (f x sid)
-gMakeSharedCopy{|FIELD|}	f (FIELD x) sid			= FIELD (f x sid)
-gMakeSharedCopy{|PAIR|}		fx fy (PAIR x y) sid	= PAIR (fx x sid) (fy y sid)
-gMakeSharedCopy{|EITHER|}	fx fy (LEFT x) sid		= LEFT (fx x sid)
-gMakeSharedCopy{|EITHER|}	fx fy (RIGHT y) sid		= RIGHT (fy y sid)
-gMakeSharedCopy{|UNIT|}		UNIT _					= UNIT
-gMakeSharedCopy{|Document|}	doc sid = {Document|doc & type = Shared sid}
-
-derive gMakeSharedCopy [], Maybe, Either, (,), (,,), (,,,), Void, Static, Hidden
-
-generic gMakeLocalCopy a :: !a !*TSt -> (a,!*TSt)
-gMakeLocalCopy{|Int|}		x tst = (x,tst)
-gMakeLocalCopy{|Real|}		x tst = (x,tst)
-gMakeLocalCopy{|Char|}		x tst = (x,tst)
-gMakeLocalCopy{|Bool|}		x tst = (x,tst)
-gMakeLocalCopy{|String|}	x tst = (x,tst)
-gMakeLocalCopy{|OBJECT|}	f (OBJECT x) tst		= app2 (OBJECT,id) (f x tst)
-gMakeLocalCopy{|CONS|}		f (CONS x) tst			= app2 (CONS,id) (f x tst)
-gMakeLocalCopy{|FIELD|}		f (FIELD x) tst			= app2 (FIELD,id) (f x tst)
-gMakeLocalCopy{|PAIR|}		fx fy (PAIR x y) tst	# (rx,tst) = fx x tst
-													= app2 ((PAIR rx),id) (fy y tst)
-gMakeLocalCopy{|EITHER|}	fx fy (LEFT x) tst		= app2 (LEFT,id) (fx x tst)
-gMakeLocalCopy{|EITHER|}	fx fy (RIGHT y) tst		= app2 (RIGHT,id) (fy y tst)
-gMakeLocalCopy{|UNIT|}		UNIT tst				= (UNIT,tst)
-gMakeLocalCopy{|Document|}	doc=:{content} tst=:{taskNr}
-	= case content of
-		DocumentContent info = case info.dataLocation of
-			SharedLocation _ _
-				# (mbDoc,tst) = retrieveDocument info.dataLocation info.DocumentInfo.index tst
-				= case mbDoc of
-					Just (doc,docdata) | not (isEmptyDoc doc)	= createDocument info.fileName info.mimeType Local (taskNrToString taskNr) docdata tst
-					_											= abort "non-empty doc without data"
-			LocalLocation _	= ({Document|doc & type = Local},tst)
-		EmptyDocument		= ({Document|doc & type = Local},tst)
-
-derive gMakeLocalCopy [], Maybe, Either, (,), (,,), (,,,), Void, Static, Hidden
-
 //TODO remove encapsulating TUIPanel -> Form elements should be placed directly in their containers				
 taskPanel :: String [HtmlTag] (Maybe [HtmlTag]) (Maybe [TUIDef]) [(Action,String,String,String,Bool)] -> (TUIDef,[TUIButton])
 taskPanel taskid description mbContext mbForm buttons

Language/src/Core/BasicTasks/StoreTasks.dcl

@@ -6,8 +6,7 @@ from TSt 			import :: Task
 from StdOverloaded	import class ==, class <
 
 from	iTasks import class iTask
-import	GenPrint, GenParse, GenVisualize, GenUpdate, GenMerge
-from InteractionTasks import generic gMakeSharedCopy, generic gMakeLocalCopy
+import	GenPrint, GenParse, GenVisualize, GenUpdate, GenMerge, GenCopy
 
 //Database identifier for storing a single value of type a
 ::DBid a :== String
@@ -51,14 +50,14 @@ createDB :: !a 				-> Task (DBid a) | iTask a
 * @param The database reference
 * @return The value in the database or a default value if no value is stored.
 */
-readDB :: !(DBid a) 		-> Task a | iTask a
+readDB :: !(DBid a) 		-> Task a | iTask, gMakeLocalCopy{|*|} a
 /**
 * Read the database.
 *
 * @param The database reference
 * @return The value in the database if a value is stored.
 */
-readDBIfStored :: !(DBid a)	-> Task (Maybe a) | iTask a
+readDBIfStored :: !(DBid a)	-> Task (Maybe a) | iTask, gMakeLocalCopy{|*|} a
 /**
 * Write the database.
 *
@@ -85,11 +84,11 @@ instance <  (DBRef a)
 
 eqItemId 		:: a a -> Bool | DB a
 
-dbReadAll		::                 Task [a]       | iTask, DB a
+dbReadAll		::                 Task [a]       | iTask, gMakeLocalCopy{|*|}, DB a
 dbWriteAll		:: ![a]         -> Task Void      | iTask, DB a
 
 //	C(reate)R(ead)U(pdate)D(elete) operations:
-dbCreateItem	:: a            -> Task a         | iTask, DB a
-dbReadItem		:: !(DBRef a)	-> Task (Maybe a) | iTask, DB a
-dbUpdateItem	:: a			-> Task a         | iTask, DB a
-dbDeleteItem	:: !(DBRef a)	-> Task Void      | iTask, DB a
+dbCreateItem	:: a            -> Task a         | iTask, gMakeLocalCopy{|*|}, DB a
+dbReadItem		:: !(DBRef a)	-> Task (Maybe a) | iTask, gMakeLocalCopy{|*|}, DB a
+dbUpdateItem	:: a			-> Task a         | iTask, gMakeLocalCopy{|*|}, DB a
+dbDeleteItem	:: !(DBRef a)	-> Task Void      | iTask, gMakeLocalCopy{|*|}, DB a

Language/src/Core/BasicTasks/StoreTasks.icl

@@ -16,7 +16,7 @@ derive gMerge			DBRef
 derive gMakeSharedCopy	DBRef
 derive gMakeLocalCopy	DBRef
 
-derive bimap	Maybe, (,)
+derive bimap Maybe, (,)
 
 ::DBid a :== String
 
@@ -32,24 +32,26 @@ createDB init =
 	>>= \id.	writeDB id init
 	>>|			return id
 
-readDB :: !(DBid a) -> Task a | iTask a
+readDB :: !(DBid a) -> Task a | iTask, gMakeLocalCopy{|*|} a
 readDB key = mkInstantTask "readDB" readDB`
 where
 	readDB` tst=:{TSt|dataStore,world}
 		# (mbVal,dstore,world) = loadValue key dataStore world
 		= case mbVal of
 			Just val
-				= (TaskFinished val,{TSt|tst & dataStore = dstore, world = world})
+				#(val,tst) = gMakeLocalCopy{|*|} val {TSt|tst & dataStore = dstore, world = world}
+				= (TaskFinished val,tst)
 			Nothing		
 				# (val,world) = defaultValue world
 				= (TaskFinished val,{TSt|tst & dataStore = dstore, world = world})
-				
-readDBIfStored :: !(DBid a)	-> Task (Maybe a) | iTask a
+		
+readDBIfStored :: !(DBid a)	-> Task (Maybe a) | iTask, gMakeLocalCopy{|*|} a
 readDBIfStored key = mkInstantTask "readDBIfStored" readDBIfStored`
 where
 	readDBIfStored` tst=:{dataStore,world}
-		# (mbVal,dstore,world) = loadValue key dataStore world
-		= (TaskFinished mbVal,{TSt|tst & dataStore = dstore, world = world})
+		# (mbVal,dstore,world)	= loadValue key dataStore world
+		# (mbVal,tst)			= gMakeLocalCopy{|*|} mbVal {TSt|tst & dataStore = dstore, world = world}
+		= (TaskFinished mbVal,tst)
 
 writeDB	:: !(DBid a) !a -> Task a | iTask a
 writeDB key value = mkInstantTask "writeDB" writeDB`
@@ -77,17 +79,17 @@ instance <  (DBRef a) where	(<)  (DBRef x) (DBRef y) = x <  y
 eqItemId :: a a -> Bool | DB a
 eqItemId a b	= getItemId a == getItemId b
 
-dbReadAll :: Task [a] | iTask, DB a
+dbReadAll :: Task [a] | iTask, gMakeLocalCopy{|*|}, DB a
 dbReadAll		= readDB databaseId
 
 dbWriteAll :: ![a] -> Task Void | iTask, DB a
 dbWriteAll all	= writeDB databaseId all >>| return Void
 
-dbModify :: ([a] -> [a]) -> Task Void | iTask, DB a
+dbModify :: ([a] -> [a]) -> Task Void | iTask, gMakeLocalCopy{|*|}, DB a
 dbModify f      = dbReadAll >>= \items -> dbWriteAll (f items)
 
 //	C(reate)R(ead)U(pdate)D(elete) operations:
-dbCreateItem :: a -> Task a | iTask, DB a
+dbCreateItem :: a -> Task a | iTask, gMakeLocalCopy{|*|}, DB a
 dbCreateItem new
 	= readDB databaseId >>= \items -> 
 	let newitem = (setItemId (newDBRef items) new) in
@@ -97,18 +99,18 @@ where
 	newDBRef []		= DBRef 1
 	newDBRef items	= let (DBRef i) = maxList (map getItemId items) in DBRef (i+1)
 
-dbReadItem :: !(DBRef a) -> Task (Maybe a) | iTask, DB a
+dbReadItem :: !(DBRef a) -> Task (Maybe a) | iTask, gMakeLocalCopy{|*|}, DB a
 dbReadItem itemid
 	= readDB databaseId >>= \items -> 
 	  case filter (\item -> itemid == getItemId item) items of
 	  	[found:_]	= return (Just found)
 	  	nothing		= return Nothing
 
-dbUpdateItem :: a -> Task a | iTask, DB a
+dbUpdateItem :: a -> Task a | iTask, gMakeLocalCopy{|*|}, DB a
 dbUpdateItem new
 	= dbModify (replace eqItemId new) >>| return new
 
-dbDeleteItem :: !(DBRef a) -> Task Void | iTask, DB a
+dbDeleteItem :: !(DBRef a) -> Task Void | iTask, gMakeLocalCopy{|*|}, DB a
 dbDeleteItem itemid
 	= dbModify (filter (\item -> itemid <> getItemId item))
  

Language/src/Domains/CommonDomain.dcl

@@ -7,7 +7,9 @@ import GenPrint, GenParse, GenVisualize, GenUpdate, GenMerge
 
 import StdString
 from Html	import :: HtmlTag
-from InteractionTasks import class html, generic gMakeSharedCopy, generic gMakeLocalCopy
+from InteractionTasks import class html 
+import GenCopy
+
 // Strings with special meanings
 :: EmailAddress	= EmailAddress String
 :: URL			= URL String

Server/src/Framework/GenCopy.dcl

+definition module GenCopy
+
+from TSt import :: TSt
+import Types
+
+generic gMakeSharedCopy a :: !a !String -> a
+generic gMakeLocalCopy a :: !a !*TSt -> (a,!*TSt)
+
+derive gMakeSharedCopy OBJECT, CONS, PAIR, FIELD, EITHER, UNIT
+derive gMakeSharedCopy Int, Real, Char, Bool, String, Dynamic
+derive gMakeSharedCopy [], Maybe, Either, (,), (,,), (,,,), Void, Static, Hidden, Document
+derive gMakeLocalCopy OBJECT, CONS, PAIR, FIELD, EITHER, UNIT
+derive gMakeLocalCopy Int, Real, Char, Bool, String, Dynamic
+derive gMakeLocalCopy [], Maybe, Either, (,), (,,), (,,,), Void, Static, Hidden, Document
\ No newline at end of file

Server/src/Framework/GenCopy.icl

+implementation module GenCopy
+
+import TSt, StdFunc, StdTuple, DocumentDB, StdMisc
+derive bimap (,)
+
+generic gMakeSharedCopy a :: !a !String -> a
+gMakeSharedCopy{|Int|}		x _ = x
+gMakeSharedCopy{|Real|}		x _ = x
+gMakeSharedCopy{|Char|}		x _ = x
+gMakeSharedCopy{|Bool|}		x _ = x
+gMakeSharedCopy{|String|}	x _ = x
+gMakeSharedCopy{|OBJECT|}	f (OBJECT x) sid		= OBJECT (f x sid)
+gMakeSharedCopy{|CONS|}		f (CONS x) sid			= CONS (f x sid)
+gMakeSharedCopy{|FIELD|}	f (FIELD x) sid			= FIELD (f x sid)
+gMakeSharedCopy{|PAIR|}		fx fy (PAIR x y) sid	= PAIR (fx x sid) (fy y sid)
+gMakeSharedCopy{|EITHER|}	fx fy (LEFT x) sid		= LEFT (fx x sid)
+gMakeSharedCopy{|EITHER|}	fx fy (RIGHT y) sid		= RIGHT (fy y sid)
+gMakeSharedCopy{|UNIT|}		UNIT _					= UNIT
+gMakeSharedCopy{|Dynamic|}	dyn _	= dyn
+gMakeSharedCopy{|Document|}	doc sid	= {Document|doc & type = Shared sid}
+
+derive gMakeSharedCopy [], Maybe, Either, (,), (,,), (,,,), Void, Static, Hidden
+
+generic gMakeLocalCopy a :: !a !*TSt -> (a,!*TSt)
+gMakeLocalCopy{|Int|}		x tst = (x,tst)
+gMakeLocalCopy{|Real|}		x tst = (x,tst)
+gMakeLocalCopy{|Char|}		x tst = (x,tst)
+gMakeLocalCopy{|Bool|}		x tst = (x,tst)
+gMakeLocalCopy{|String|}	x tst = (x,tst)
+gMakeLocalCopy{|OBJECT|}	f (OBJECT x) tst		= app2 (OBJECT,id) (f x tst)
+gMakeLocalCopy{|CONS|}		f (CONS x) tst			= app2 (CONS,id) (f x tst)
+gMakeLocalCopy{|FIELD|}		f (FIELD x) tst			= app2 (FIELD,id) (f x tst)
+gMakeLocalCopy{|PAIR|}		fx fy (PAIR x y) tst	# (rx,tst) = fx x tst
+													= app2 ((PAIR rx),id) (fy y tst)
+gMakeLocalCopy{|EITHER|}	fx fy (LEFT x) tst		= app2 (LEFT,id) (fx x tst)
+gMakeLocalCopy{|EITHER|}	fx fy (RIGHT y) tst		= app2 (RIGHT,id) (fy y tst)
+gMakeLocalCopy{|UNIT|}		UNIT tst				= (UNIT,tst)
+gMakeLocalCopy{|Dynamic|}	dyn tst = (dyn,tst)
+gMakeLocalCopy{|Document|}	doc=:{content} tst=:{taskNr}
+	= case content of
+		DocumentContent info = case info.dataLocation of
+			SharedLocation _ _
+				# (mbDoc,tst) = retrieveDocument info.dataLocation info.DocumentInfo.index tst
+				= case mbDoc of
+					Just (doc,docdata) | not (isEmptyDoc doc)	= createDocument info.fileName info.mimeType Local (taskNrToString taskNr) docdata tst
+					_											= abort "non-empty doc without data"
+			LocalLocation _	= ({Document|doc & type = Local},tst)
+		EmptyDocument		= ({Document|doc & type = Local},tst)
+
+derive gMakeLocalCopy [], Maybe, Either, (,), (,,), (,,,), Void, Static, Hidden
\ No newline at end of file

Server/src/Framework/Types.dcl

@@ -13,10 +13,13 @@ from iTasks			import class iTask
  
 import GenPrint, GenParse, GenVisualize, GenUpdate, JSON, StoreTasks
 
-derive gPrint		Session, Document, Hidden, Static, UserName
-derive gParse		Session, Document, Hidden, Static, UserName
-derive gVisualize	Session
-derive gUpdate		Session
+derive gPrint			Session, Document, Hidden, Static, UserName
+derive gParse			Session, Document, Hidden, Static, UserName
+derive gVisualize		Session
+derive gUpdate			Session
+derive gMerge			Session, UserName, User
+derive gMakeLocalCopy	Session, UserName, User
+derive gMakeSharedCopy	Session, UserName, User
 
 derive JSONEncode Document
 derive JSONDecode Document

Server/src/Framework/Types.icl

@@ -6,11 +6,14 @@ import Html
 import Text, Util
 import CommonDomain
 
-derive gPrint		Session, Document, DocumentType, DocumentInfo, DocumentContent, DocumentDataLocation, Hidden, Static, UserName
-derive gParse		Session, Document, DocumentType, DocumentInfo, DocumentContent, DocumentDataLocation,Hidden, Static, UserName
-derive gVisualize	Session
-derive gUpdate		Session
-derive bimap		Maybe, (,)
+derive gPrint			Session, Document, DocumentType, DocumentInfo, DocumentContent, DocumentDataLocation, Hidden, Static, UserName
+derive gParse			Session, Document, DocumentType, DocumentInfo, DocumentContent, DocumentDataLocation,Hidden, Static, UserName
+derive gVisualize		Session
+derive gUpdate			Session
+derive gMerge			Session, UserName, User
+derive gMakeLocalCopy	Session, UserName, User
+derive gMakeSharedCopy	Session, UserName, User
+derive bimap			Maybe, (,)
 
 derive JSONEncode Document, DocumentType, DocumentInfo, DocumentContent, DocumentDataLocation
 derive JSONDecode Document, DocumentType, DocumentInfo, DocumentContent, DocumentDataLocation