Commit be6e2f4a authored by Bas Lijnse's avatar Bas Lijnse

- Removed outdated ad-hoc extensions

- Removed need for setup. Minimal setup is done automatically or set through commandline options. 

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1918 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 2677a521
......@@ -37,9 +37,6 @@ import SharedVariables
//Graphical iTask Notation
//import GinExamples
//Ad-hoc work extensions
import Groups, Lists, Messages, Consensus
//Client
import WorkflowAdmin
......@@ -65,7 +62,6 @@ where
//, changeHandlingExample
, changeExamples
, sharedValueExamples
, [workflow "Examples/General/Ask opinions" "Gather opinions regarding a specific subject" askOpinions]
//, rpcExamples
//, ginExamples
, apiDocumentationExamples
......
......@@ -4,7 +4,7 @@ import StdInt, StdFile, StdTuple, StdList
import Directory, File, FilePath, Error, OSError, UrlEncoding, Text, Tuple
import SystemTypes, IWorld, Task, TaskContext, Config
import SystemTypes, IWorld, Task, TaskContext
import ExceptionCombinators, TuningCombinators
import InteractionTasks
import Shared
......@@ -40,7 +40,7 @@ callProcess cmd args
where
//Start the process
init :: TaskNr *IWorld -> (!TaskContextTree,!*IWorld)
init taskNr iworld =:{IWorld | config, tmpDirectory, world}
init taskNr iworld =:{IWorld | sdkDirectory, tmpDirectory, world}
# outfile = tmpDirectory </> (iTaskId taskNr "callprocess")
# context = TCBasic 'Map'.newMap
# asyncArgs = [ "--taskid"
......@@ -51,7 +51,7 @@ where
, cmd
]
++ args
# (res,world) = 'Process'.runProcess config.Config.runAsyncPath asyncArgs Nothing world
# (res,world) = 'Process'.runProcess (sdkDirectory </> "Tools" </> "RunAsync" </> "RunAsync.exe") asyncArgs Nothing world
= case res of
Error e = (setLocalVar "error" e context, {IWorld|iworld & world = world})
Ok _ = (setLocalVar "outfile" outfile context, {IWorld|iworld & world = world})
......@@ -122,13 +122,13 @@ where
initRPC = mkInstantTask("Call RPC", "Initializing") eval
eval taskNr iworld=:{IWorld|config,tmpDirectory,world}
eval taskNr iworld=:{IWorld|sdkDirectory,tmpDirectory,world}
# infile = tmpDirectory </> (mkFileName taskNr "request")
# outfile = tmpDirectory </> (mkFileName taskNr "response")
# (res,world) = writeFile infile request world
| isError res
= (taskException (RPCException ("Write file " +++ infile +++ " failed: " +++ toString (fromError res))),{IWorld|iworld & world = world})
# cmd = config.Config.curlPath
# cmd = sdkDirectory </> "Tools" </> "Curl" </> "curl.exe"
# args = [ options
, "--data-binary"
, "@" +++ infile
......
......@@ -5,9 +5,9 @@ definition module SystemData
*/
import Maybe
from SharedCombinators import :: ReadWriteShared, :: ReadOnlyShared, :: Shared
from SystemTypes import :: DateTime, :: Date, :: Time, :: User, :: Role, :: UserDetails, :: TaskList, :: Tree, :: ProcessId, :: TaskInstanceMeta
from SystemTypes import :: DateTime, :: Date, :: Time, :: User, :: Role, :: UserDetails, :: TaskList, :: Tree
from SystemTypes import :: ProcessId, :: TaskInstanceMeta, :: Config
from Void import :: Void
from Config import :: Config
// Date & time
currentDateTime :: ReadOnlyShared DateTime
......
......@@ -8,7 +8,6 @@ from IWorld import :: IWorld(..), :: Control
from Util import qualified currentDate, currentTime, currentDateTime, currentTimestamp
from WorkflowDB import qualified class WorkflowDB(..), instance WorkflowDB IWorld
from WorkflowDB import :: WorkflowDescription
from Config import :: Config
currentDateTime :: ReadOnlyShared DateTime
currentDateTime = makeReadOnlyShared "SystemData_currentDateTime" 'Util'.currentDateTime 'Util'.currentTimestamp
......
......@@ -383,21 +383,11 @@ noMeta :: ManagementMeta
//Configuration
:: Config =
{ clientPath :: !String // Where is the client located.
, staticPath :: !String // Additional location where statically served content may be placed
, rootPassword :: !String // Password for the 'root' superuser (default 'root').
{ rootPassword :: !String // Password for the 'root' superuser (default 'root').
, rootEmail :: !String // E-mail address for the 'root' superuser (default root@localhost).
, sessionTime :: !Int // Time (in seconds) before inactive sessions are garbage collected. Default is 3600 (one hour).
, serverPort :: !Int // The TCP port the server runs on. Default is 80.
, serverPath :: !String // The path at which the services are served (default /services)
, debug :: !Bool // Run the server in debug mode (default False).
, smtpServer :: !String // The smtp server to use for sending e-mails
, generalWorkflows :: !Bool // Enable the "general" workflows for managing ad-hoc work
, runAsyncPath :: !String // Path to RunAsync tool for running asynchronous OS tasks and timers.
, curlPath :: !String // Path to Curl needed for RPC tasks.
}
/*
* Gives the unique username of a user
*
......
definition module Consensus
/**
* This extension provides the possibility to poll a set of users
* for their opinion on some topic to come to a shared agreement.
*/
import iTasks
/**
* Top level flow for asking people for opinions.
*/
askOpinions :: Task Void
\ No newline at end of file
implementation module Consensus
import iTasks, GenEq
import Messages, Groups
:: Topic = { topic :: String, description :: Maybe Note}
:: Results a :== [(a,[(User,String)])]
derive class iTask Topic
askOpinions :: Task Void
askOpinions
= defineTopic
>>= \topic ->
defineItemType
>>= \type -> case type of
"Date" = askOpinionsDate topic >>| return Void
"Document" = askOpinionsDocument topic >>| return Void
"Other" = askOpinionsOther topic >>| return Void
//The type dependent second part of the flow
askOpinionsGeneric :: Topic -> Task (Results a) | iTask a
askOpinionsGeneric topic
= defineItems
>>= \items ->
defineAnswers
>>= \answers ->
defineParticipants
>>= \participants ->
collectOpinions topic items answers participants
>>= showResult
askOpinionsDate :: Topic -> Task (Results Date)
askOpinionsDate topic = askOpinionsGeneric topic
askOpinionsDocument :: Topic -> Task (Results Document)
askOpinionsDocument topic = askOpinionsGeneric topic
askOpinionsOther :: Topic -> Task (Results String)
askOpinionsOther topic = askOpinionsGeneric topic
defineTopic :: Task Topic
defineTopic
= enterInformation ("Define topic","Please define the topic that you would like to get opinions about") []
defineItemType :: Task String
defineItemType
= enterChoice ("Define item type","What type of item(s) would you like to get opinions about") [] ["Date","Document","Other"]
defineItems :: Task [a] | iTask a
defineItems
= enterInformation ("Define items","Enter the item(s) you would like to get opinions about") []
defineAnswers :: Task [String]
defineAnswers
= enterInformation ("Define answers","Please define the available answer choices") []
-||-
enterChoice ("Common answers","Or select one of these common answer sets") []
[["Yes","No"],["Yes","No","Maybe"],["I agree","I disagree"],["1","2","3","4","5"]]
defineParticipants :: Task [User]
defineParticipants
= getMyGroups
>>= \groups -> case groups of
[] = enterInformation ("Define people","Enter the people you would like to ask for an opinion") []
_ = (enterChoice ("Choose a group","Choose a group...") [] groups >>= transform (\group -> group.members))
-||-
(enterInformation ("Define people","Or enter individual people to ask for an opinion") [])
collectOpinions :: Topic [a] [String] [User] -> Task (Results a) | iTask a
collectOpinions topic items answers participants
= ( Description "Collecting opinions..." @>>
Description "Waiting for everyone to give their opinion" @>>
allTasks [collectOpinion topic user items answers \\ user <- participants ]
)
>>= transform (orderByItem items)
where
orderByItem :: [a] [(User,[(a,String)])] -> [(a,[(User,String)])]
orderByItem items opinions = [(item, [(user, snd (options !! i)) \\ (user,options) <- opinions ]) \\ item <- items & i <- [0..]]
collectOpinion :: Topic User [a] [String] -> Task (User,[(a,String)]) | iTask a
collectOpinion topic user items answers
= user @:
(Description ("Your opinion about: " +++ topic.topic) @>>
(allTasks [enterChoice ("Option " <+++ i,"What is your opinion about:") [ChoiceContext item] answers \\ item <- items & i <- [1..]] >>= transform (merge items)))
where
merge items opinions = (user,zip (items,opinions))
showResult :: (Results a) -> Task (Results a) | iTask a
showResult result = viewInformation ("Opinions","The results of your opinion request:") [] result
definition module Groups
/**
* This extension provides the possibility to create groups of users.
*
* - Users can create new groups (they automatically become member)
* - Group members can invite others to join a group
* - Group members can leave a group (when the last member is removed from a group it is deleted)
*/
import iTasks
:: Group =
{ groupId :: !Hidden Int
, name :: !String
, members :: ![User]
}
derive class iTask Group
instance DB Group
instance toString Group
/**
* Top level workflow for users to manage their own group
*
*/
manageGroups :: Task Void
/**
* Management workflow for a single group.
*
* @param The group to manage
*/
manageGroup :: !Group -> Task Void
/**
* Create a new group
*
* @param A name for the group
* @param The first member of the group
*
* @return The newly created group
*/
createGroup :: !String !User -> Task Group
/**
* Retrieve all groups that the current user is a member of.
*
* @return The list of groups
*/
getMyGroups :: Task [Group]
/**
* Retrieve all groups
*
* @return The list of groups
*/
getAllGroups :: Task [Group]
/**
* Delete a group from the system.
* This is not really neccesary because groups are automatically deleted when
* the last member is removed from them.
*
* @param The group to delete
*
* @return The deleted group
*/
deleteGroup :: !Group -> Task Group
/**
* Add a user to a group. Groups can not contain duplicates.
*
* @param The group to add the user to
* @param The user to add to the group
*
* @return The (updated) group
*/
addMemberToGroup :: !Group !User -> Task Group
/**
* Remove a user from a group.
* When the last user is removed it is deleted from the system.
*
* @param The group to remove the user from
* @param The user to remove from the group
*
* @return The (updated) group
*/
removeMemberFromGroup :: !Group !User -> Task Group
/**
* Ask a user if (s)he wants to join the group.
* If the invitation is accepted the user is added to the group.
* If it is declined, the group is unchanged.
*
* @param The group to invite the user to
* @param The user to invite
*
* @param The (possibly) updated group
*/
inviteUserToGroup :: !Group !User -> Task Group
implementation module Groups
import iTasks
derive class iTask Group
instance DB Group
where
databaseId = sharedStore "Groups" []
getItemId g = DBRef (fromHidden g.Group.groupId)
setItemId (DBRef groupId) g = {Group| g & groupId = toHidden groupId}
instance toString Group where toString g = g.Group.name
manageGroups :: Task Void
manageGroups
= Description "Manage groups" @>>
( getMyGroups
>>= overview
>>= \res -> case res of
(ActionOpen,Just group) = manageGroup group >>| return False
(ActionNew,_) = newGroup >>= manageGroup >>| return False
(ActionQuit,_) = return True
) <! id
>>| return Void
where
overview [] = viewInformation ("My groups",startMsg) [] Void >>+ \_ -> UserActions [(ActionNew,Just (ActionNew,Nothing)),(ActionQuit,Just (ActionQuit,Nothing))]
overview list = enterChoice ("My groups",listMsg) [] list >>+ (\{modelValue,localValid} -> let mbG = if localValid (Just modelValue) Nothing in UserActions [aOpen mbG,aNew,aQuit])
aOpen mbG = (ActionOpen, maybe Nothing (\g -> Just (ActionOpen,Just g)) mbG)
aNew = (ActionNew, Just (ActionNew,Nothing))
aQuit = (ActionQuit, Just (ActionQuit,Nothing))
newGroup = enterInformation ("New group","Please enter a name for the new group") []
>>= \name ->
get currentUser
>>= \user ->
createGroup name user
startMsg = [Text "You have no groups yet.",BrTag [], BrTag []
,Text "You can create your own user groups to which you can invite other users", BrTag []
,Text "Members of a group can easily send each other messages "
,Text "or ask each others opinions."
]
listMsg = [Text "You are a member of the groups listed below.", BrTag [], BrTag []
,Text "You may select one to view it or create a new group."
]
manageGroup :: !Group -> Task Void
manageGroup igroup
=
( justdo (dbReadItem (getItemId igroup))
>>= \group ->
viewInformation (toString group,"This group contains the following members:") [] group.members
>?* [(ActionClose, Always (return True))
,(Action "Invite new member", Always (invite group >>| return False))
,(Action "Leave group", Always (leave group >>| return False))
]
) <! id >>| return Void
where
invite group
= enterInformation ("Invite a someone to join " +++ toString group,"Please enter a user to invite to the group") []
>>= inviteUserToGroup group
leave group
= get currentUser
>>= removeMemberFromGroup group
createGroup :: !String !User -> Task Group
createGroup name user
= dbCreateItem {Group | groupId = Hidden 0, name = name, members = [user]}
getAllGroups :: Task [Group]
getAllGroups
= dbReadAll
getMyGroups :: Task [Group]
getMyGroups = get currentUser >>= \user -> dbReadAll >>= transform (filter (groupMember user))
where
groupMember user {Group|members} = isMember user members
deleteGroup :: !Group -> Task Group
deleteGroup group = dbDeleteItem (getItemId group) >>| return group
addMemberToGroup :: !Group !User -> Task Group
addMemberToGroup group user
= dbReadItem (getItemId group) >>= \mbGroup -> case mbGroup of
Just group = dbUpdateItem {Group|group & members = removeDup (group.members ++ [user])}
Nothing = return group
removeMemberFromGroup :: !Group !User -> Task Group
removeMemberFromGroup group user
= dbReadItem (getItemId group) >>= \mbGroup -> case mbGroup of
//If the current user is the last user, delete the group
Just group=:{members=[user]} = deleteGroup group
//Remove the user from the group
Just group=:{members} = dbUpdateItem {Group|group & members = removeMember user members}
Nothing = return group
inviteUserToGroup :: !Group !User -> Task Group
inviteUserToGroup group user
= get currentUser
>>= \fromUser ->
appendTopLevelTask noMeta (
user @: (invite fromUser group)
>>= \accept ->
if accept
(addMemberToGroup group user
>>= viewInformation ("Invitation accepted",toString user +++ " accepted your invitation to join the group " +++ toString group) []
)
(viewInformation ("Invitation declined",toString user +++ " declined your invitation to join the group " +++ toString group) [] group)
)
>>| viewInformation ("Invitation sent","An invitation to join the group has been sent to " +++ toString user) [] group
where
invite user group
= viewInformation (
"Invitation to join group " +++ toString group,
[Text (toString user +++ " invites you to join the group " +++ toString group +++ "."),BrTag [], Text "Do you accept this invitation?"])
[] Void
>>+ \_ -> UserActions [(ActionNo,Just False),(ActionYes,Just True)]
\ No newline at end of file
definition module Lists
/**
* This extension provides the ability to create lists
* (shopping lists, todo lists, meeting agendas etc) and
* share them with other users.
*/
import iTasks
:: List a =
{ listId :: !Hidden Int
, name :: !String
, description :: !Maybe Note
, items :: ![a]
}
:: SimpleList :== List String
:: TodoList :== List (Bool, String)
:: DateList :== List (Date, String)
:: DocumentList :== List (Document, String)
:: AnyList = SimpleList SimpleList
| TodoList TodoList
| DateList DateList
| DocumentList DocumentList
derive class iTask List, AnyList
/**
* Top level workflow for creating, viewing and sharing lists.
*/
manageLists :: Task Void
/**
* Top level flow for a single list.
*/
manageList :: !AnyList -> Task Void
/**
* Create a new list.
*
* @param type of list. Possible values "Simple list" "Todo list" "Date list" "Document list".
* @param A name
* @param An optional description
*
* @return The new list
*/
createList :: !String !String !(Maybe Note) -> Task AnyList
/**
* Retrieve all lists stored in the system.
*
* @return The list of lists
*/
getAllLists :: Task [AnyList]
/**
* Retrieve all lists that are created by, or shared with the current user.
* @return The list of lists
*/
getMyLists :: Task [AnyList]
/**
* Delete a list
*
* @param The list to delete
* @return The deleted list
*/
deleteList :: !AnyList -> Task AnyList
\ No newline at end of file
This diff is collapsed.
definition module Messages
/**
* This extension provides a simple e-mail-ish internal message system.
* If you receive messages they show up as tasks in your worklist.
* If you send messages you can choose to actively await a reply which will
* create a task in your worklist that is not completed until you receive a
* reply.
*/
import iTasks
:: Message =
{ messageId :: Hidden Int
, subject :: String
, sender :: Display User
, recipients :: [User]
, priority :: TaskPriority
, needsReply :: Bool
, message :: Note
, attachments :: Maybe [Document]
, thread :: Display [Message]
}
/**
* Top level workflow for managing your received messages and starting
* point for writing new messages.
*/
manageMessages :: Task Void
/**
* Top level flow for viewing a single message
*
* @param The message
*
* @return True if a reply has been sent
*/
manageMessage :: !Message -> Task Bool
/**
* Combination of writing a new message followed by sending it.
*/
newMessage :: Task Void
/**
* Combination of choosing a group to send a message to,
* writing the message and sending it.
*/
newGroupMessage :: Task Void
/**
* Composition of a new message.
*
* @param The sender of the message
* @param The initial subject of the message
* @param If this message is a followup of another message, that message
*
* @param The new message (not stored in the database yet)
*/
writeMessage :: User String [User] (Maybe Message) -> Task Message
/**
* Sending of a message.
* This stores the message to the database, making it available in "my messages" of
* the recipients. It also creates tasks for the recipients notifying them of the
* received message and if a reply is required creates the task for entering the reply.
*
* @param The message to be sent.
*/
sendMessage :: Message -> Task Void
/**
* Retrieve all messages of which the current user is a recipient.
*
* @return The list of messages
*/
getMyMessages :: Task [Message]
/**
* Retrieve all messages stored in the system.
*
* @return The list of messages
*/
getAllMessages :: Task [Message]
\ No newline at end of file
implementation module Messages
import iTasks
import Groups
derive class iTask Message
:: Message =
{ messageId :: Hidden Int
, subject :: String
, sender :: Display User
, recipients :: [User]
, priority :: TaskPriority
, needsReply :: Bool
, message :: Note
, attachments :: Maybe [Document]
, thread :: Display [Message]
}
instance DB Message
where
databaseId = sharedStore "Messages" []
getItemId m = DBRef (fromHidden m.Message.messageId)
setItemId (DBRef i) m = {Message|m & messageId = toHidden i}
mkMsg :: User -> Message
mkMsg me = { Message
| messageId = toHidden 0
, sender = toDisplay me
, subject = "New message"
, recipients = []