Commit 13f72573 authored by Steffen Michels's avatar Steffen Michels

- added tree control

- added example starting up workflows

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1293 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent e0270032
......@@ -30,6 +30,7 @@
,{"text":"ChoiceControl.js","path":"src/js/tui/"}
,{"text":"AppletControl.js","path":"src/js/tui/"}
,{"text":"GridControl.js","path":"src/js/tui/"}
,{"text":"TreeControl.js","path":"src/js/tui/"}
,{"text":"TUICommon.js","path":"src/js/tui/"}
,{"text":"ListContainer.js","path":"src/js/tui/"}
......
Ext.ns('itasks.tui');
itasks.tui.TreeControl = Ext.extend(Ext.tree.TreePanel,{
rootVisible: false,
loader: new Ext.tree.TreeLoader({preloadChildren: true}),
initComponent : function(){
this.msgTarget = 'side';
this.hideLabel = this.fieldLabel == null;
this.fieldLabel = itasks.util.fieldLabel(this.optional,this.fieldLabel);
this.root = {
xtype: 'treenode',
text:'tree',
children: this.tuiTree
};
itasks.tui.TreeControl.superclass.initComponent.apply(this,arguments);
this.addEvents('tuichange');
this.enableBubble('tuichange');
this.on('click',function(node){
if(!this.staticDisplay && node.leaf){
this.fireEvent('tuichange',this.name,node.attributes.index.toString());
}
},this);
},
afterRender : function(){
itasks.tui.TreeControl.superclass.afterRender.call(this);
if(Ext.isNumber(this.selIndex)){
this.setValue(this.selIndex);
}
},
setValue : function(sel){
var selNode = function(node){
if(node.attributes.index == sel){
this.selectPath(node.getPath());
return false;
} else {
node.eachChild(selNode,this);
}
};
var unselNodes = function(node){
node.unselect();
node.eachChild(unselNodes,this);
};
if(sel != "")
this.getRootNode().eachChild(selNode,this);
else
this.getRootNode().eachChild(unselNodes,this);
},
setError: function(msg){
if(msg == "")
itasks.tui.common.clearError(this);
else
itasks.tui.common.markError(this,msg);
},
setHint: function(msg){
if(msg == "")
itasks.tui.common.clearHint(this);
else
itasks.tui.common.markHint(this,msg);
}
});
Ext.reg('itasks.tui.Tree', itasks.tui.TreeControl);
\ No newline at end of file
......@@ -90,6 +90,7 @@
<script type="text/javascript" src="../js/tui/ChoiceControl.js"></script>
<script type="text/javascript" src="../js/tui/AppletControl.js"></script>
<script type="text/javascript" src="../js/tui/GridControl.js"></script>
<script type="text/javascript" src="../js/tui/TreeControl.js"></script>
<script type="text/javascript" src="../js/tui/ListContainer.js"></script>
<script type="text/javascript" src="../js/tui/RecordContainer.js"></script>
......
......@@ -42,6 +42,9 @@ import SharedVariables
//Ad-hoc work extensions
import Groups, Lists, Messages, Consensus
//Workflow starter
import WorkflowStarter
Start :: *World -> *World
Start world = startEngine workflows world
where
......@@ -71,4 +74,5 @@ where
, sharedValueExamples
, [workflow "General/Ask opinions" "Gather opinions regarding a specific subject" askOpinions
]
]
\ No newline at end of file
, workflowStarter
]
......@@ -32,21 +32,21 @@ where
calculateSum = updateInformationA ("Sum","Auto compute sum") (\t=:(x,y) -> (t,Display (x+y)),\(t,_) _ -> t) [quitButton] (0,0)
//Tree Example
:: Tree a = Leaf | Node (Node a)
:: Node a = { rightChildren :: Tree a
, value :: a
, leftChildren :: Tree a
:: Tree` a = Leaf` | Node` (Node` a)
:: Node` a = { rightChildren :: Tree` a
, value :: a
, leftChildren :: Tree` a
}
derive class iTask Tree, Node
derive class iTask Tree`, Node`
toTree :: [a] -> (Tree a) | Ord a
toTree :: [a] -> (Tree` a) | Ord a
toTree list = makeTree (sort list)
where
makeTree :: [a] -> (Tree a)
makeTree [] = Leaf
makeTree [el:[]] = Node {rightChildren = Leaf, value = el, leftChildren = Leaf}
makeTree list = Node {rightChildren = makeTree end, value = middle, leftChildren = makeTree begin}
makeTree :: [a] -> (Tree` a)
makeTree [] = Leaf`
makeTree [el:[]] = Node` {rightChildren = Leaf`, value = el, leftChildren = Leaf`}
makeTree list = Node` {rightChildren = makeTree end, value = middle, leftChildren = makeTree begin}
where
middlePos = (length list) / 2
begin = take (middlePos) list
......
definition module WorkflowStarter
import iTasks
workflowStarter :: [Workflow]
implementation module WorkflowStarter
import iTasks, TSt, Text
from UserDB import qualified class UserDB(..)
from UserDB import qualified instance UserDB TSt
from StdFunc import o, seq
workflowStarter :: [Workflow]
workflowStarter = [workflow "Examples/Workflow starter" "This task rebuilds the client's panel for starting up new workflows." starter]
starter =
getWorkflowTree
>>= \workflows. createDB workflows
>>= \ref. chooseWorkflow ref ||- showDescription ref
>>| deleteDB ref
chooseWorkflow ref = updateSharedInformationA "Tasks" idBimap [] ref
showDescription ref =
showMessageShared "Task description" view actions ref
>>= \(event,tree). case fst event of
Action "start-task" _ =
startWorkflowByIndex (fromHidden (thd3 (fromJust (getSelectedLeaf tree))))
>>| showDescription ref
_ =
stop
where
actions = [(Action "start-task" " Start task",startPred),(ActionQuit,always)]
startPred (Valid tree) = isJust (getSelectedLeaf tree)
startPred _ = False
view tree = case getSelectedLeaf tree of
Just (_,Hidden desc,_) = desc
Nothing = ""
getWorkflowTree :: Task (Tree (String,Hidden String,Hidden Int))
getWorkflowTree = mkInstantTask "get a tree of workflows" getWorkflowTree`
where
getWorkflowTree` tst
# (workflows,tst) = getAllowedWorkflows tst
= (TaskFinished (mkFlowTree workflows),tst)
mkFlowTree workflows = mkTree (seq (map insertWorkflow (zip2 workflows (indexList workflows))) [])
where
insertWorkflow ({path,description},idx) nodeList = insertWorkflow` (split "/" path) nodeList
where
insertWorkflow` [] nodeList = nodeList
insertWorkflow` [title] nodeList = nodeList ++ [Leaf (title,Hidden description,Hidden idx)]
insertWorkflow` path=:[nodeP:pathR] [node=:(Node nodeL nodes):nodesR]
| nodeP == nodeL = [Node nodeL (insertWorkflow` pathR nodes):nodesR]
| otherwise = [node:insertWorkflow` path nodesR]
insertWorkflow` path [leaf=:(Leaf _):nodesR] = [leaf:insertWorkflow` path nodesR]
insertWorkflow` [nodeP:pathR] [] = [Node nodeP (insertWorkflow` pathR [])]
startWorkflow :: Workflow -> Task Void
startWorkflow {thread} = mkInstantTask "create new task" (startWorkflow` thread)
startWorkflow` thread tst
# (_,_,_,tst) = createTaskInstance thread True Nothing True True tst
= (TaskFinished Void,tst)
startWorkflowByIndex :: Int -> Task Void
startWorkflowByIndex idx = mkInstantTask "create new task by index in workflow list" startWorkflowByIndex`
where
startWorkflowByIndex` tst
# (workflows,tst) = getAllowedWorkflows tst
= startWorkflow` (workflows !! idx).thread tst
getAllowedWorkflows tst
# (session,tst) = getCurrentSession tst
# (mbDetails,tst) = 'UserDB'.getUserDetails session.Session.user tst
# (workflows,tst) = getWorkflows tst
# workflows = filter (isAllowed (session.Session.user,mbDetails)) workflows
= (workflows,tst)
where
//Allow the root user
isAllowed (RootUser,_) _ = True
//Allow workflows for which the user has permission
isAllowed (_,Just details) wf = or [isMember role (mb2list details.UserDetails.roles) \\ role <- wf.Workflow.roles] || isEmpty wf.Workflow.roles
//Allow workflows without required roles
isAllowed _ wf = isEmpty wf.Workflow.roles
......@@ -23,13 +23,13 @@ guiDemoExample
, grades :: [Int]
, pet :: String
, note :: Maybe Note
, tree :: Tree Int String
, tree :: Tree` Int String
, luckyNo :: Int
}
:: Tree a b = Leaf b | Node (Tree a b) a (Tree a b)
:: Tree` a b = Leaf` b | Node` (Tree` a b) a (Tree` a b)
derive class iTask Person, Address, Tree
derive class iTask Person, Address, Tree`
derive bimap (,), Maybe
address = {Address | street = "Heyendaalseweg", number = 135, postalCode = "6525 AJ", city = "Nijmegen"}
......@@ -42,7 +42,7 @@ person = {Person | name = "John Doe"
, grades = []
, pet = "Cat"
, note = Nothing
, tree = Leaf "Tree"
, tree = Leaf` "Tree"
, luckyNo = 42
}
guiDemo :: Task Person
......
definition module GenUpdate
import StdGeneric, StdMaybe, Void, Either, Store, Shared
import StdGeneric, StdMaybe, Void, Either, Store, Shared, Types
from Map import :: Map
from Types import :: Time, :: DateTime, :: FormButton, :: Currency, :: User, :: UserDetails, :: Task, :: Choice, :: MultipleChoice, :: Password, :: Note, :: Document, :: Date
from GenVisualize import :: Display, :: Editable, :: Hidden, :: VisualizationHint
//Datapath is used to point to substructures of data structures
......@@ -38,7 +37,7 @@ generic gUpdate a :: a *USt -> (a, *USt)
derive gUpdate UNIT, PAIR, EITHER, CONS, OBJECT, FIELD
derive gUpdate Int, Real, Char, Bool, String
derive gUpdate Dynamic, [], Maybe, Either, (,), (,,), (,,,), (->), Void, Display, Editable, Hidden, VisualizationHint, Timestamp
derive gUpdate Note, DateTime, Document, FormButton, Password, Currency, Date, Time, User, UserDetails, Task, Choice, MultipleChoice, Shared, SharedReadOnly, Map
derive gUpdate Note, DateTime, Document, FormButton, Password, Currency, Date, Time, User, UserDetails, Task, Choice, MultipleChoice, Shared, SharedReadOnly, Map, Tree
//Wrapper functions for updating
defaultValue :: !*IWorld -> (!a,!*IWorld) | gUpdate{|*|} a
......
......@@ -543,6 +543,24 @@ gUpdate{|MultipleChoice|} _ c=:(MultipleChoice opts _) ust=:{USt|mode=UDSearch,s
gUpdate{|MultipleChoice|} _ c ust=:{USt|mode=UDMask,currentPath,newMask}
= (c, {USt|ust & currentPath = stepDataPath currentPath, newMask = appendToMask newMask (Touched True [])})
gUpdate{|Tree|} _ _ ust=:{USt|mode=UDCreate,newMask}
= (Tree [] Nothing, {USt | ust & newMask = appendToMask newMask Untouched})
gUpdate{|Tree|} _ tree=:(Tree nodes _) ust=:{USt|mode=UDSearch,searchPath,currentPath,update,oldMask,newMask}
# (cm,om) = popMask oldMask
# ust = {ust & currentPath = stepDataPath currentPath, oldMask = om}
| currentPath == searchPath
# selIdx = toInt update
# (n,mask) = if (selIdx >= 0)
(Tree nodes (Just (toInt update)), Touched True [])
(Tree nodes Nothing, Blanked True)
= (n, {ust & newMask = appendToMask newMask mask})
| otherwise
= (tree, {ust & newMask = appendToMask newMask (cleanUpdMask cm)})
gUpdate{|Tree|} _ tree=:(Tree _ mbSel) ust=:{USt|mode=UDMask,currentPath,newMask}
// if no valid selection is made, start with untouched mask
# mask = if (isJust mbSel) (Touched True []) (Untouched)
= (tree, {USt|ust & currentPath = stepDataPath currentPath, newMask = appendToMask newMask mask})
gUpdate{|Shared|} _ _ ust=:{mode=UDCreate} = (Shared "" Nothing, ust)
gUpdate{|Shared|} _ x ust = (x,ust)
gUpdate{|SharedReadOnly|} _ _ ust=:{mode=UDCreate} = (SharedReadOnly "" Nothing, ust)
......
......@@ -24,7 +24,7 @@ instance toString ErrorMessage
derive gVerify UNIT, PAIR, EITHER, OBJECT, CONS, FIELD, Int, Real, Char, Bool, String, (,), (,,),(,,,),(->), []
derive gVerify Maybe, Dynamic, Void, Document, Either, Editable, Hidden, Display, VisualizationHint, Timestamp
derive gVerify Password, Date, Time, FormButton, Currency, User, UserDetails, Task, Note, DateTime, Choice, MultipleChoice, Shared, SharedReadOnly, Map
derive gVerify Password, Date, Time, FormButton, Currency, User, UserDetails, Task, Note, DateTime, Choice, MultipleChoice, Shared, SharedReadOnly, Map, Tree
/**
* Verify a value based on the value and its update mask.
......
......@@ -173,6 +173,7 @@ gVerify{|SharedReadOnly|} _ _ vst = vst
gVerify{|Choice|} _ _ vst = simpleVerify "Choose one item" vst
gVerify{|MultipleChoice|} _ _ vst = simpleVerify "Choose a number of items" vst
gVerify{|Tree|} _ _ vst = simpleVerify "Choose a leaf of the tree" vst
//********************************************************************************************************
anyError :: ![VerifyMask] -> Bool
......
......@@ -13,7 +13,7 @@ generic gVisualize a :: (Maybe a) *VSt -> ([Visualization], *VSt)
derive gVisualize UNIT, PAIR, EITHER, CONS, OBJECT, FIELD
derive gVisualize Int, Real, Char, Bool, String
derive gVisualize Dynamic, [], Maybe, Either, (,), (,,), (,,,), (->), Void, Display, Editable, Hidden, VisualizationHint, Timestamp
derive gVisualize Note, Password, Date, Time, DateTime, Document, FormButton, Currency, User, UserDetails, Task, Choice, MultipleChoice, Shared, SharedReadOnly, Map
derive gVisualize Note, Password, Date, Time, DateTime, Document, FormButton, Currency, User, UserDetails, Task, Choice, MultipleChoice, Shared, SharedReadOnly, Map, Tree
//Wrapper functions for visualization
visualizeAsEditor :: String a UpdateMask VerifyMask -> [TUIDef] | gVisualize{|*|} a
......
......@@ -54,7 +54,7 @@ diffEditorDefinitions path old new
(TUIDocumentControl odoc, TUIDocumentControl ndoc)
| odoc.TUIDocumentControl.document == ndoc.TUIDocumentControl.document = []
| otherwise = [TUIReplace_ (dp2s path) new]
// Choices are replaced if the options are changed, otherwise there selection is updated
// Choices are replaced if the options are changed, otherwise their selection is updated
(TUIChoiceControl oc, TUIChoiceControl nc)
# updates = if (oc.options == nc.options)
if (oc.selection == nc.selection)
......@@ -62,6 +62,14 @@ diffEditorDefinitions path old new
[TUISetValue_ (dp2s path) (toString (toJSON nc.selection))]
[TUIReplace_ (dp2s path) new]
= updates ++ hintUpdate path old new ++ errorUpdate path old new
// Trees are replaced if the nodes are changed, otherwise their selection is updated
(TUITreeControl ot, TUITreeControl nt)
# updates = if (ot.tuiTree == nt.tuiTree)
if (ot.selIndex == nt.selIndex)
[]
[TUISetValue_ (dp2s path) (toString nt.selIndex)]
[TUIReplace_ (dp2s path) new]
= updates ++ hintUpdate path old new ++ errorUpdate path old new
// Fallback: always replace
_ = [TUIReplace_ (dp2s path) new]
| otherwise
......@@ -139,6 +147,8 @@ sameType (TUIHiddenControl _) (TUIHiddenControl _) = True
sameType (TUIFormButtonControl _) (TUIFormButtonControl _) = True
sameType (TUIListItemControl _) (TUIListItemControl _) = True
sameType (TUIAppletControl _) (TUIAppletControl _) = True
sameType (TUIGridControl _) (TUIGridControl _) = True
sameType (TUITreeControl _) (TUITreeControl _) = True
sameType (TUITupleContainer _) (TUITupleContainer _) = True
sameType (TUIRecordContainer _) (TUIRecordContainer _) = True
......@@ -909,6 +919,49 @@ where
# (vis,vst) = fx (Just choice) vst
= visualiseChoices choices (acc ++ vis ++ (if (isEmpty choices) [] [TextFragment ", "])) vst
gVisualize{|Tree|} fx val vst=:{vizType,label,idPrefix,currentPath,useLabels,optional,renderAsStatic,verifyMask,updateMask,updates}
# (cmu,um) = popMask updateMask
# (cmv,vm) = popMask verifyMask
# vst = {VSt|vst & updateMask = um, verifyMask = vm}
= case val of
Nothing
= ([TextFragment "Empty tree"],{VSt|vst & currentPath = stepDataPath currentPath})
Just (Tree nodes mbSel)
# vst = {vst & vizType = VTextLabel}
# (tree,_,vst) = mkTree nodes 0 vst
# vst = {vst & vizType = VEditorDefinition}
= case vizType of
VEditorDefinition
# (err,hnt) = verifyElementStr cmu cmv
# id = dp2id idPrefix currentPath
= ([TUIFragment (TUITreeControl { TUITreeControl
| name = dp2s currentPath
, id = id
, tuiTree = tree
, selIndex = mbSel
, fieldLabel = labelAttr useLabels label
, optional = optional
, staticDisplay = renderAsStatic
, errorMsg = err
, hintMsg = hnt
})]
, {VSt|vst & currentPath = stepDataPath currentPath})
_
= ([TextFragment "tree"],{VSt|vst & currentPath = stepDataPath currentPath})
where
mkTree [] idx vst
= ([],idx,vst)
mkTree [Node label nodes:r] idx vst
# (children,idx,vst) = mkTree nodes idx vst
# (rtree,idx,vst) = mkTree r idx vst
= ([{id = Nothing, text = label, index = Nothing, leaf = False, children = Just children}:rtree],idx,vst)
mkTree [Leaf v:r] idx vst
# (leaf,vst) = fx (Just v) vst
# (rtree,idx`,vst) = mkTree r (inc idx) vst
= ([{id = Just (nodeId idx), text = join " " (coerceToStrings leaf), index = Just idx, leaf = True, children = Nothing}:rtree],idx`,vst)
nodeId idx = (dp2id idPrefix currentPath) +++ "-" +++ toString idx
gVisualize{|Shared|} _ _ vst = ([TextFragment "Reference to shared data"],vst)
gVisualize{|SharedReadOnly|} _ _ vst = ([TextFragment "Read-Only reference to shared data"],vst)
......
......@@ -10,7 +10,7 @@ from Types import :: Document(..), :: DocumentId, :: Hotkey
//Specialized JSON encoding of TUI definitions
derive JSONEncode TUIDef, TUIUpdate
instance == TUIDef
instance == TUIDef, TUITree
:: TUIId :== String
......@@ -59,6 +59,7 @@ instance == TUIDef
| TUIListItemControl TUIListItemControl
| TUIAppletControl TUIAppletControl
| TUIGridControl TUIGridControl
| TUITreeControl TUITreeControl
| TUITupleContainer TUITupleContainer
| TUIRecordContainer TUIRecordContainer
......@@ -93,6 +94,24 @@ instance == TUIDef
, errorMsg :: !String
, hintMsg :: !String
}
:: TUITreeControl =
{ name :: !String
, id :: !TUIId
, tuiTree :: ![TUITree]
, selIndex :: !Maybe Int
, fieldLabel :: !Maybe String
, staticDisplay :: !Bool
, optional :: !Bool
, errorMsg :: !String
, hintMsg :: !String
}
:: TUITree =
{ id :: !Maybe TUIId
, text :: !String
, children :: !Maybe [TUITree]
, leaf :: !Bool
, index :: !Maybe Int
}
:: TUICurrencyControl =
{ name :: !String
, id :: !TUIId
......
......@@ -4,15 +4,11 @@ import JSON,StdList,StdBool,GenEq
from Types import :: Document, :: DocumentId, :: Hotkey, :: Key
derive gEq TUIDef, TUIBasicControl, TUICurrencyControl, TUIDocumentControl, TUIConstructorControl, TUIButtonControl, TUIListItemControl, TUIGridControl, TUIGridColumn
derive gEq TUIAppletControl, TUITupleContainer, TUIRecordContainer, TUIListContainer, TUIHtmlContainer, JSONNode, Maybe, Document
derive gEq TUIButton, TUIUpdate, TUIChoiceControl, TUIMenuButton, TUIMenu, TUIMenuItem, Hotkey, Key
//JSON Encoding of TUI definitions is directly encoded as JSON data.
derive JSONEncode TUIButton, TUIUpdate, TUIMenuButton, TUIMenu, TUIMenuItem, Key, Hotkey
derive JSONEncode TUIBasicControl, TUICurrencyControl, TUIDocumentControl, TUIConstructorControl
derive JSONEncode TUIButtonControl, TUIListItemControl, TUIChoiceControl, TUIAppletControl
derive JSONEncode TUITupleContainer, TUIRecordContainer, TUIListContainer, TUIHtmlContainer, TUIGridControl, TUIGridColumn
derive JSONEncode TUITupleContainer, TUIRecordContainer, TUIListContainer, TUIHtmlContainer, TUIGridControl, TUIGridColumn, TUITreeControl, TUITree
//TODO: Separate control elements from form-widgets
JSONEncode{|TUIDef|} (TUIButton r) = addXType "itasks.ttc.Button" (JSONEncode{|*|} r)
......@@ -41,6 +37,7 @@ JSONEncode{|TUIDef|} (TUIConstructorControl r) = addXType "itasks.tui.Constructo
JSONEncode{|TUIDef|} (TUIListItemControl r) = addXType "itasks.tui.list.Item" (JSONEncode{|*|} r)
JSONEncode{|TUIDef|} (TUIAppletControl r) = addXType "itasks.tui.Applet" (JSONEncode{|*|} r)
JSONEncode{|TUIDef|} (TUIGridControl r) = addXType "itasks.tui.Grid" (JSONEncode{|*|} r)
JSONEncode{|TUIDef|} (TUITreeControl r) = addXType "itasks.tui.Tree" (JSONEncode{|*|} r)
JSONEncode{|TUIDef|} (TUITupleContainer r) = addXType "itasks.tui.Tuple" (JSONEncode{|*|} r)
JSONEncode{|TUIDef|} (TUIRecordContainer r) = addXType "itasks.tui.Record" (JSONEncode{|*|} r)
......@@ -59,6 +56,8 @@ where
(==) (TUIRealControl a) (TUIRealControl b) = a == b
(==) (TUIBoolControl a) (TUIBoolControl b) = a == b
(==) (TUIChoiceControl a) (TUIChoiceControl b) = a == b
(==) (TUITreeControl a) (TUITreeControl b) = a == b
(==) (TUIGridControl a) (TUIGridControl b) = a == b
(==) (TUINoteControl a) (TUINoteControl b) = a == b
(==) (TUIDateControl a) (TUIDateControl b) = a == b
(==) (TUITimeControl a) (TUITimeControl b) = a == b
......@@ -96,6 +95,30 @@ where
(==) a b = (a.TUIChoiceControl.id == b.TUIChoiceControl.id)
&& (a.TUIChoiceControl.optional == b.TUIChoiceControl.optional)
&& (a.TUIChoiceControl.options == a.TUIChoiceControl.options)
instance == TUIGridControl
where
(==) a b = (a.TUIGridControl.id == b.TUIGridControl.id)
&& (a.TUIGridControl.columns == a.TUIGridControl.columns)
instance == TUIGridColumn
where
(==) a b = (a.TUIGridColumn.header == b.TUIGridColumn.header)
&& (a.TUIGridColumn.dataIndex == a.TUIGridColumn.dataIndex)
instance == TUITreeControl
where
(==) a b = (a.TUITreeControl.id == b.TUITreeControl.id)
&& (a.TUITreeControl.optional == b.TUITreeControl.optional)
&& (a.TUITreeControl.tuiTree == a.TUITreeControl.tuiTree)
instance == TUITree
where
(==) a b = (a.TUITree.id == b.TUITree.id)
&& (a.TUITree.text == b.TUITree.text)
&& (a.TUITree.children == b.TUITree.children)
&& (a.TUITree.leaf == a.TUITree.leaf)
&& (a.TUITree.index == a.TUITree.index)
instance == TUICurrencyControl
where
......
......@@ -12,8 +12,8 @@ from Config import :: Config
from TaskTree import :: TaskProperties, :: GroupedBehaviour(..), :: GroupActionsBehaviour(..)
derive class iTask EmailAddress, Session, Action, ProcessRef, TaskStatus
derive JSONEncode Currency, FormButton, User, UserDetails, Task, TaskResult, Document, Hidden, Display, Editable, VisualizationHint, Note, Password, Date, Time, DateTime, Choice, MultipleChoice, Map, Void, Either, Timestamp
derive JSONDecode Currency, FormButton, User, UserDetails, Task, TaskResult, Document, Hidden, Display, Editable, VisualizationHint, Note, Password, Date, Time, DateTime, Choice, MultipleChoice, Map, Void, Either, Timestamp
derive JSONEncode Currency, FormButton, User, UserDetails, Task, TaskResult, Document, Hidden, Display, Editable, VisualizationHint, Note, Password, Date, Time, DateTime, Choice, MultipleChoice, Map, Void, Either, Timestamp, Tree, TreeNode
derive JSONDecode Currency, FormButton, User, UserDetails, Task, TaskResult, Document, Hidden, Display, Editable, VisualizationHint, Note, Password, Date, Time, DateTime, Choice, MultipleChoice, Map, Void, Either, Timestamp, Tree, TreeNode
instance toString User
instance toString TaskPriority
......@@ -316,6 +316,14 @@ setOptionsM :: ![a] !(MultipleChoice a) -> MultipleChoice a | gEq{|*|} a
:: DocumentId :== String
:: Tree a = Tree ![TreeNode a] !(Maybe Int)
:: TreeNode a = Leaf !a | Node !TreeLabel ![TreeNode a]
:: TreeLabel :== String
mkTree :: ![TreeNode a] -> Tree a
getSelectedLeaf :: !(Tree a) -> Maybe a
/*
* Gives the unique username of a user
*
......
......@@ -11,8 +11,8 @@ from Config import :: Config
from Time import :: Timestamp(..)
derive class iTask EmailAddress, Session, Action, ProcessRef, TaskStatus
derive JSONEncode Currency, FormButton, ButtonState, UserDetails, TaskResult, Document, Hidden, Display, Editable, VisualizationHint, Password, Note, Choice, MultipleChoice, Map, Void, Either
derive JSONDecode Currency, FormButton, ButtonState, UserDetails, TaskResult, Document, Hidden, Display, Editable, VisualizationHint, Password, Note, Choice, MultipleChoice, Map, Void, Either
derive JSONEncode Currency, FormButton, ButtonState, UserDetails, TaskResult, Document, Hidden, Display, Editable, VisualizationHint, Password, Note, Choice, MultipleChoice, Map, Void, Either, Tree, TreeNode
derive JSONDecode Currency, FormButton, ButtonState, UserDetails, TaskResult, Document, Hidden, Display, Editable, VisualizationHint, Password, Note, Choice, MultipleChoice, Map, Void, Either, Tree, TreeNode
derive gLexOrd Currency
derive bimap Maybe, (,)
......@@ -92,7 +92,27 @@ where
| i == choiceIndex = nr
| otherwise = nrOfOccurrence` (inc i) (inc nr) oldOpts
| otherwise = nrOfOccurrence` (inc i) nr oldOpts
mkTree :: ![TreeNode a] -> Tree a
mkTree nodes = Tree nodes Nothing
getSelectedLeaf :: !(Tree a) -> Maybe a
getSelectedLeaf (Tree nodes mbSel)
= case mbSel of
Just sel = searchV nodes sel
Nothing = Nothing
where
searchV nodes selIdx = fst (searchV` nodes 0)
where
searchV` [] c = (Nothing,c)
searchV` [Leaf v:r] c
| c == selIdx = (Just v,c)