Commit 3b0be312 authored by Steffen Michels's avatar Steffen Michels

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
parent acace369
......@@ -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, (,)
......
......@@ -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
}
......
......@@ -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 =
......
......@@ -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}
......
......@@ -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
......
......@@ -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
......@@ -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))
......
......@@ -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
......
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
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
......@@ -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
......
......@@ -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
......
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