Commit 441a1e80 authored by Camil Staps's avatar Camil Staps 🍃

Merge remote-tracking branch 'origin/master' into abc-interpreter-instead-of-sapl

parents 18778e1c 923ff66e
......@@ -44,7 +44,7 @@ So to use a custom task UI we need to do two things: We need to specify an edito
The iTask framework provides a number of builtin UI components that it can render in a browser. These are the lowest level building blocks with which all iTasks GUI's are constructed.
In the example of the previous section we have seen the `slider` editor. This editor is one of the builtin componentens in the `iTasks.UI.Editor.Controls` module. All builtin editors have no arguments, but can dynamically be configured by setting attributes. For example if we wanted to set the maximum value of the slider, we would write `slider <<@ maxAttr 42`. The tuning combinators `<<@` or `@>>` are used to set attributes on editors. This pattern is used to make it easy to create editors without the need to specify all attributes in advance. In many cases, it is not necessary to deviate from the default values of the configurable attributes. Forcing a programmer to specify them all makes our GUI code too verbose. The price we pay for this convenience is that we lose some type safety. We dynamically set arbitrary attributes on editors, whether the UI rendering code uses them or not.
In the example of the previous section we have seen the `slider` editor. This editor is one of the builtin componentens in the `iTasks.UI.Editor.Controls` module. All builtin editors have no arguments, but can dynamically be configured by setting attributes. For example if we wanted to set the maximum value of the slider, we would write `slider <<@ maxAttr 42`. The tuning combinators `<<@` or `@>>` are used to set attributes on editors. This pattern is used to make it easy to create editors without the need to specify all attributes in advance. In many cases, it is not necessary to deviate from the default values of the configurable attributes. Forcing a programmer to specify them all makes our GUI code too verbose. The price we pay for this convenience is that we lose some type safety. We dynamically set arbitrary attributes on editors, whether the UI rendering code uses them or not. Two noteworthy attributes are `classAttr` and `styleAttr` which let you attach CSS classes and inline styles to editors.
## Composing editors ##
......@@ -56,7 +56,7 @@ myTask = updateInformation "Change the magic number"
[UpdateUsing (\x -> ("Mylabel",x)) (\_ (_,x) -> x) editor] 42
where
editor :: Editor (String,Int)
editor = (container2 label slider) <<@ directionAttr Horizontal
editor = (container2 label slider) <<@ classAttr ["itasks-horizontal"]
```
When you run this example, you'll see the same slider as before, but this time with a label "Mylabel" to the left of it. There are a few things going on here. The first new thing is the `label` builtin editor that we are using. This is an editor of type `String` and simply displays its value. The next new thing is the `container2` combinator. This is where the composition happens. This combinator takes two editors and puts them together in a container. The values are combined into a tuple, so the type of the combined editor in this case is `(String,Int)`. There are combinators for different kinds of containers, such as `panel`, `window` or `tabset`. Because grouping editors with these combinators creates tuples, we need different versions of each depending on how many items we group together. In this case we are using `container2` to group two editors. The last thing we are doing in this example is providing the actual label. We are using the model-to-view mapping of `UpdateUsing` to add the static label to the value.
......@@ -70,7 +70,7 @@ myTask = updateInformation "Change the magic number"
where
editor :: Editor Int
editor = bijectEditorValue (\x -> ("Mylabel",x)) snd
(panel2 label slider <<@ directionAttr Horizontal)
(panel2 label slider <<@ classAttr ["itasks-horizontal"])
```
In this revision, we have used a new combinator from `iTasks.UI.Editor.Modifiers`: The `bijectEditorValue` combinator. With this function we can change the type of the editor. In this case the two functions `(\x -> "Mylabel",x))` and `snd` define a bijection between the domain of the composed editor (of type `(String,Int)`) and the domain we would like our editor to work on (of type `Int`).
......@@ -93,9 +93,9 @@ where
(panel2
(row "Footastic:" passwordField)
(row "Barmagic:" slider)
) <<@ heightAttr WrapSize
row l e = bijectEditorValue (\x -> (l,x)) snd
((container2 (viewConstantValue l label) e) <<@ directionAttr Horizontal)
) <<@ classAttr ["itasks-wrap-height"]
row l e = bijectEditorValue (\x -> ((),x)) snd
((container2 (viewConstantValue l label) e) <<@ classAttr ["itasks-horizontal"])
```
This example is a little more complex, but uses only things we have already seen. By constructing editors from the basic building blocks and transforming the value domain of the editors, we can construct any kind of GUI we like.
......
......@@ -438,7 +438,7 @@ communicationItemTask (contactNo,mbP2000Template) status
)
//Manage list of communication attempts and initiate communications
-&&- attemptCommunication contactNo
) <<@ ArrangeWithSideBar 0 LeftSide 200 True) <<@ ArrangeWithSideBar 0 TopSide 50 True
) <<@ ArrangeWithSideBar 0 LeftSide True) <<@ ArrangeWithHeader 0
@! ()
where
attemptCommunication contactNo
......@@ -730,7 +730,7 @@ addSubAction initContacts initIncidents list
addPredefinedAction initContacts initIncidents list
= (enterChoiceWithShared (Title "Choose action") [/*ChooseFromTree groupCatalog*/] actionCatalog
>&> \mbSel -> configureAction mbSel) <<@ (ArrangeWithSideBar 0 LeftSide 300 True)
>&> \mbSel -> configureAction mbSel) <<@ (ArrangeWithSideBar 0 LeftSide True)
where
configureAction selSds = whileUnchanged selSds configTask
where
......
......@@ -7,7 +7,7 @@ import Text.HTML
selectVideoWallContent :: Task ()
selectVideoWallContent
= (header ||- selectContent) <<@ (ArrangeWithSideBar 0 TopSide 30 False)
= (header ||- selectContent) <<@ (ArrangeWithHeader 0)
@! ()
where
header
......@@ -15,7 +15,7 @@ where
mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |*| contactsProvidingHelpGeo)
selectContent
= (switchContent >&> withSelection viewNoSelection configureContent) <<@ (ArrangeWithSideBar 0 LeftSide 300 False)
= (switchContent >&> withSelection viewNoSelection configureContent) <<@ (ArrangeWithSideBar 0 LeftSide False)
switchContent = enterChoice (Title "Choose Content") [ChooseFromList bigLabel] contentOptions
contentOptions
......
......@@ -12,7 +12,7 @@ wallContent = sharedStore "WallContent" (WallOverview defaultValue)
viewVideoWallContent :: Task WallContent
viewVideoWallContent
= (header ||- content) <<@ (ArrangeWithSideBar 0 TopSide 30 False) //<<@ AfterLayout plainLayoutFinal //FIXME
= (header ||- content) <<@ (ArrangeWithHeader 0) //<<@ AfterLayout plainLayoutFinal //FIXME
where
header
= viewSharedInformation () [ViewAs view] (currentTime |*| currentUTCTime) //<<@ (AfterLayout (uiDefSetHalign AlignRight o uiDefSetBaseCls "wall-header")) //FIXME
......@@ -39,7 +39,7 @@ viewWallOverview perspective
(get standardMapLayers
>>- \baseLayers ->
viewSharedInformation () [ViewAs (toMap perspective baseLayers)] mapContacts /* <<@ AfterLayout (tweakUI (setMargins 0 0 0 0 o fill))*/ ) //FIXME
) <<@ ArrangeWithSideBar 0 LeftSide 300 False
) <<@ ArrangeWithSideBar 0 LeftSide False
where
toMap perspective baseLayers contacts
= toLeafletMap {ContactMap|perspective=perspective,layers=baseLayers++[{title="Contacts",def=CMMarkersLayer [contactGeoToMapMarker False False c \\ c=:{ContactGeo|position=Just _} <- contacts]}]}
......@@ -55,8 +55,8 @@ viewWallContactSummary contactNo
= withHeader viewContactTitle
((viewDetails
-&&-
((viewPosition -&&- viewCommunication ) <<@ArrangeWithSideBar 1 RightSide 350 False)
) <<@ArrangeWithSideBar 0 LeftSide 250 False)
((viewPosition -&&- viewCommunication ) <<@ArrangeWithSideBar 1 RightSide False)
) <<@ArrangeWithSideBar 0 LeftSide False)
where
contact = sdsFocus contactNo contactByNo
......
......@@ -38,8 +38,8 @@ answerPhoneCall communicationNo
>>| connectInboundPhoneCall communicationNo
||- ((manageCommunicationContact communicationNo
-&&-
manageVoiceCallContent PhoneCall communicationNo) <<@ ArrangeWithSideBar 0 LeftSide 300 True)
<<@ ArrangeWithSideBar 0 TopSide 60 False
manageVoiceCallContent PhoneCall communicationNo) <<@ ArrangeWithSideBar 0 LeftSide True)
<<@ ArrangeWithHeader 0
<<@ Title ("Answer phone call")
/* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600)) */ //FIXME
@! communicationNo
......@@ -51,8 +51,8 @@ initiatePhoneCall communicationNo
>>| connectOutboundPhoneCall communicationNo
||- ((manageCommunicationContact communicationNo
-&&-
manageVoiceCallContent PhoneCall communicationNo) <<@ ArrangeWithSideBar 0 LeftSide 300 True)
<<@ ArrangeWithSideBar 0 TopSide 60 False
manageVoiceCallContent PhoneCall communicationNo) <<@ ArrangeWithSideBar 0 LeftSide True)
<<@ ArrangeWithHeader 0
<<@ Title ("Make phone call")
/* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600)) */ //FIXME
@! communicationNo
......@@ -64,8 +64,8 @@ answerRadioCall communicationNo
>>| updateRadioCallMeta communicationNo
||- ((manageCommunicationContact communicationNo
-&&-
manageVoiceCallContent RadioCall communicationNo) <<@ ArrangeWithSideBar 0 LeftSide 300 True)
<<@ ArrangeWithSideBar 0 TopSide 60 False
manageVoiceCallContent RadioCall communicationNo) <<@ ArrangeWithSideBar 0 LeftSide True)
<<@ ArrangeWithHeader 0
<<@ Title ("Answer radio call")
/* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600)) */ //FIXME
@! communicationNo
......@@ -77,8 +77,8 @@ initiateRadioCall communicationNo
>>| updateRadioCallMeta communicationNo
||- ((manageCommunicationContact communicationNo
-&&-
manageVoiceCallContent RadioCall communicationNo) <<@ ArrangeWithSideBar 0 LeftSide 300 True)
<<@ ArrangeWithSideBar 0 TopSide 60 False
manageVoiceCallContent RadioCall communicationNo) <<@ ArrangeWithSideBar 0 LeftSide True)
<<@ ArrangeWithHeader 0
<<@ Title "Initiate radio call"
/* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600)) */ //FIXME
@! communicationNo
......@@ -91,7 +91,7 @@ composeEmailMessage communicationNo
||- ((composeAndSendMessage communicationNo message transmitEmailMessage
-&&-
relateMessageToIncidents communicationNo) <<@ ArrangeWithTabs True)
<<@ ArrangeWithSideBar 0 TopSide 60 False
<<@ ArrangeWithHeader 0
<<@ Title "Compose E-mail"
/* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600) ) */ //FIXME
@! communicationNo
......@@ -106,7 +106,7 @@ composeP2000Message communicationNo
||- ((composeAndSendMessage communicationNo message transmitP2000Message
-&&-
relateMessageToIncidents communicationNo) <<@ ArrangeWithTabs True)
<<@ ArrangeWithSideBar 0 TopSide 60 False
<<@ ArrangeWithHeader 0
<<@ Title "Compose P2000 message"
/* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600)) */ //FIXME
@! communicationNo
......
......@@ -183,7 +183,7 @@ manageContactCommunication contactNo
= ((manageContactCommunicationMeans True contactNo) // <<@ AfterLayout (tweakUI fill)) //FIXME
-&&-
(viewContactCommunications contactNo) //<<@ AfterLayout (tweakUI fill)) //FIXME
) <<@ ArrangeWithSideBar 0 LeftSide 200 True <<@ Title "Communication" <<@ Icon "communication"
) <<@ ArrangeWithSideBar 0 LeftSide True <<@ Title "Communication" <<@ Icon "communication"
@! ()
where
viewContactCommunications contactNo
......@@ -259,7 +259,7 @@ where
Just taskId = workOnActionItem taskId @! taskId
Nothing = viewInformation () [] () @? const NoValue
)
) <<@ (ArrangeWithSideBar 0 LeftSide 250 True) <<@ (Icon "actions") <<@ (Title "Actions")
) <<@ (ArrangeWithSideBar 0 LeftSide True) <<@ (Icon "actions") <<@ (Title "Actions")
manageContactIncidents :: Workspace ContactNo -> Task ()
manageContactIncidents ws contactNo
......@@ -268,7 +268,7 @@ manageContactIncidents ws contactNo
withSelection viewNoSelection viewIncidentDetails sel
-&&-
doAddRemoveOpen (add <<@ InWindow) (\c -> (remove c) <<@ InWindow) (\c -> doOrClose (open c)) ws sel
) <<@ (ArrangeWithSideBar 1 RightSide 300 True) <<@ (Icon "incidents") <<@ (Title "Incidents")
) <<@ (ArrangeWithSideBar 1 RightSide True) <<@ (Icon "incidents") <<@ (Title "Incidents")
@! ()
where
incidents = sdsFocus contactNo incidentsByContactDetails
......
......@@ -62,7 +62,7 @@ manageIncidentContacts ws incidentNo
@! ()
where
contacts = sdsFocus incidentNo contactsByIncident
manageContacts = ((withShared Nothing (\sel -> (chooseFromList sel -||- chooseFromMap sel) <<@ (ArrangeWithSideBar 0 LeftSide 250 True))))
manageContacts = ((withShared Nothing (\sel -> (chooseFromList sel -||- chooseFromMap sel) <<@ (ArrangeWithSideBar 0 LeftSide True))))
>^* [(OnAction (Action "/Add contact") (always (add <<@ InWindow @! ())))
,(OnAction (Action "/Remove contact") (ifValue (\c -> c=:(Left _)) (\(Left c) -> (remove c <<@ InWindow @! ()))))
,(OnAction (Action "/Update position") (ifValue (\c -> c=:(Left _)) (\(Left c) -> updateContactPosition c <<@ InWindow @! ())))
......@@ -108,13 +108,13 @@ where
Just taskId = workOnActionItem taskId
Nothing = viewInformation () [] ()
)
)) <<@ (ArrangeWithSideBar 0 LeftSide 250 True) <<@ (Icon "actions") <<@ (Title "Incident Actions") //FIXME
)) <<@ (ArrangeWithSideBar 0 LeftSide True) <<@ (Icon "actions") <<@ (Title "Incident Actions") //FIXME
manageIncidentWeather :: IncidentNo -> Task ()
manageIncidentWeather incidentNo
= (get webLinksConfig
>>- \webConfig -> case webConfig.weatherWidgets of
Just widgets = (viewWebWeather widgets ||- viewOrEdit (Title "Weather on scene") weather log) <<@ (ArrangeWithSideBar 0 RightSide 300 True)
Just widgets = (viewWebWeather widgets ||- viewOrEdit (Title "Weather on scene") weather log) <<@ (ArrangeWithSideBar 0 RightSide True)
Nothing = viewOrEdit (Title "Weather on scene") weather log
) <<@ Title "Weather" <<@ Icon "weather"
......@@ -126,7 +126,7 @@ where
manageIncidentLog :: IncidentNo -> Task ()
manageIncidentLog incidentNo
= addMessages incidentNo
||- viewIncidentLog incidentNo <<@ ArrangeWithSideBar 0 TopSide 100 False <<@ Title "Log" <<@ Icon "Log"
||- viewIncidentLog incidentNo <<@ ArrangeWithHeader 0 <<@ Title "Log" <<@ Icon "Log"
@! ()
where
viewIncidentLog :: IncidentNo -> Task [LogEntry]
......
......@@ -108,7 +108,7 @@ where
catchAll (
viewSharedInformation (Title ("Schema of"+++ table)) [] (sdsFocus (db,table) sqlTableDefinition) @! ()
) (\e -> viewInformation () [] e @! ())
) <<@ (ArrangeWithSideBar 0 LeftSide 300 True)
) <<@ (ArrangeWithSideBar 0 LeftSide True)
where
//group items _ = [{ChoiceTree|defaultValue & label=o,value=ChoiceNode i}\\(i,o) <- items]
......@@ -143,7 +143,7 @@ where
manageExistingUsers
= (enterChoiceWithSharedAs () [ChooseFromGrid id] allContactsShort contactIdentity
>&> withSelection viewNoSelection manageContactAccess
)<<@ ArrangeWithSideBar 0 LeftSide 200 True
)<<@ ArrangeWithSideBar 0 LeftSide True
viewNoSelection = viewInformation "Select a user" [] ()
addUser
......
......@@ -52,7 +52,7 @@ browseIncidents ws
]
)
( withSelection viewNoSelection viewIncidentDetails
) <<@ (ArrangeWithSideBar 1 RightSide 300 True) <<@ (Icon "incidents") <<@ (Title "Incidents")
) <<@ (ArrangeWithSideBar 1 RightSide True) <<@ (Icon "incidents") <<@ (Title "Incidents")
@! ()
where
selectIncident
......@@ -74,7 +74,7 @@ browseContacts ws
]
)
( withSelection viewNoSelection viewDetails
) <<@ (ArrangeWithSideBar 1 RightSide 300 True) <<@ (Icon "contacts") <<@ (Title "Contacts")
) <<@ (ArrangeWithSideBar 1 RightSide True) <<@ (Icon "contacts") <<@ (Title "Contacts")
@! ()
where
viewDetails (Left contactNo) = viewContactDetails contactNo
......@@ -109,7 +109,7 @@ where
Just taskId = workOnActionItem taskId
Nothing = viewInformation () [] ()
)
) <<@ (ArrangeWithSideBar 0 LeftSide 250 True) <<@ (Icon "actions") <<@ (Title "Actions")
) <<@ (ArrangeWithSideBar 0 LeftSide True) <<@ (Icon "actions") <<@ (Title "Actions")
......@@ -83,7 +83,7 @@ where
whileAuthenticated :: User [Workspace -> Task ()] -> Task ()
whileAuthenticated user tasks
= (controlDash -|| workOnTasks) <<@ (ArrangeWithSideBar 0 TopSide 30 False)
= (controlDash -|| workOnTasks) <<@ (ArrangeWithHeader 0)
where
controlDash = (
viewInformation () [] ("Welcome " +++ toString user)
......@@ -99,6 +99,6 @@ where
,moveSubUIs (SelectByPath [0,0]) [] 2
,removeSubUIs (SelectByPath [0])
,layoutSubUIs (SelectByType UIAction) actionToButton
,setUIAttributes ('DM'.unions [directionAttr Horizontal,paddingAttr 2 2 2 250, classAttr "summary-bar"])
,addCSSClass "summary-bar"
,setUIType UIContainer
]
......@@ -13,6 +13,8 @@ body {
.summary-bar {
color: #fff;
background: #004584 url('summary-bar.png') top left no-repeat;
padding: 2px 2px 2px 250px;
flex-direction: row;
}
.icon-incidents {
background-image: url('icons/incident.png');
......
......@@ -219,7 +219,7 @@ where
, moveSubAt[2] [1,0]
, moveSubAt[2] [1,1]
, moveSubAt[2] [1,2]
, arrangeWithSideBar 1 LeftSide 350 False //Move the 'tool' tasks to the side
, arrangeWithSideBar 1 LeftSide False //Move the 'tool' tasks to the side
]
*/
......@@ -287,7 +287,7 @@ editSectionContents
,moveSubAt [2] [1,0]
,moveSubAt [2] [1,1]
,moveSubAt [2] [1,2]
,arrangeWithSideBar 1 BottomSide 250 False
,arrangeWithSideBar 1 BottomSide False
]
*/
......
......@@ -36,15 +36,15 @@ whileAuthenticated :: User [Entity]
(User -> [(String, User [Entity] -> Task ())])
-> Task ()
whileAuthenticated user ents alwaysOnTasks tlist
= controlDash -|| workOnTasks <<@ ApplyLayout (arrangeWithSideBar 0 TopSide 30 False)
= controlDash -|| workOnTasks <<@ ApplyLayout (arrangeWithHeader 0)
where
controlDash :: Task ()
controlDash
= (allTasks [ viewInformation () [] ("Welcome " +++ toString user) @! ()
, viewNotifications
] <<@ ApplyLayout (setUIAttributes (directionAttr Horizontal))
] <<@ ArrangeHorizontal
>>* [OnAction (Action "Log out") (always (return ()))]
) <<@ ApplyLayout (setUIAttributes (directionAttr Horizontal))
) <<@ ArrangeHorizontal
workOnTasks :: Task ()
workOnTasks = parallel [ (Embedded, \_ -> listview)
......@@ -61,7 +61,7 @@ whileAuthenticated user ents alwaysOnTasks tlist
layout = sequenceLayouts
[removeSubUIs (SelectByPath [1]) //Don't show the openAssignedTasks UI
,arrangeWithSideBar 0 RightSide 300 True
,arrangeWithSideBar 0 RightSide True
,layoutSubUIs (SelectByPath [0]) (arrangeWithTabs True)
]
......
......@@ -117,30 +117,30 @@ doTasksSequentially [t:ts] = t >>| doTasksSequentially ts
allTabs :: [Task a] -> (Task [a]) | iTask a
allTabs ts = allTasks ts <<@ ArrangeWithTabs True
allSideBar :: Int UISide Int [Task a] -> (Task [a]) | iTask a
allSideBar b place size ts
= allTasks ts <<@ (ArrangeWithSideBar b place size True)
allSideBar :: Int UISide [Task a] -> (Task [a]) | iTask a
allSideBar b place ts
= allTasks ts <<@ (ArrangeWithSideBar b place True)
c2view :: (Task a) (Task ()) [Task c] [Task d] -> Task () | iTask a & iTask c & iTask d
c2view main top left right
= allSideBar 0 TopSide 30
= allSideBar 0 TopSide
[ top
, splitscreenview main left right
] @! ()
splitscreenview main left right
= allSideBar 1 RightSide 300
= allSideBar 1 RightSide
[ innersplitscreenview main left
, sidebar right
] @! ()
innersplitscreenview main left
= allSideBar 0 LeftSide 25
= allSideBar 0 LeftSide
[ sidebar left
, main @! ()
] @! ()
sidebar ts = allSideBar 0 TopSide 25 ts @! ()
sidebar ts = allSideBar 0 TopSide ts @! ()
chats :: SimpleSDSLens [ChatMessage]
chats = sharedStore "chats" []
......
......@@ -29,7 +29,7 @@ viewSelectedCitizen :: Task ()
viewSelectedCitizen
= (enterChoiceWithShared () [ChooseFromGrid (\{Citizen|name,ssn} -> "" <+++ name <+++ " (" <+++ ssn <+++ ")") ] citizens
>&> withSelection (viewInformation () [] "Select a citizen")
(\citizen -> viewCitizenInformation citizen.Citizen.ssn defaultValue) )<<@ ApplyLayout (arrangeWithSideBar 0 LeftSide 200 True)
(\citizen -> viewCitizenInformation citizen.Citizen.ssn defaultValue) )<<@ ApplyLayout (arrangeWithSideBar 0 LeftSide True)
viewCitizenInformation :: SSN Date -> Task ()
viewCitizenInformation ssn date
......
......@@ -13,7 +13,7 @@ crudWith descr choiceOpts enterOpts viewOpts updateOpts toList putItem delItem s
where
crud
= ( enterChoiceWithShared descr [ChooseFromGrid id:choiceOpts] (mapRead toList sh)
>&^ viewSharedInformation (Title "Selected") []) <<@ ApplyLayout (arrangeWithSideBar 1 RightSide 350 True)
>&^ viewSharedInformation (Title "Selected") []) <<@ ApplyLayout (arrangeWithSideBar 1 RightSide True)
>>* [ OnAction (Action "New") (always newItem)
, OnAction (Action "Edit") (hasValue editItem)
, OnAction (Action "Delete") (hasValue deleteItem)
......
......@@ -19,11 +19,9 @@ where
= updateSharedInformation ("Text","Edit text") [noteEditor] state
-||-
updateSharedInformation ("Lines","Edit lines") [listEditor] state
<<@ ApplyLayout horizontal
<<@ ArrangeHorizontal
>>= viewInformation "Result:" []
>>= return
noteEditor = UpdateUsing id (const id) textArea
listEditor = UpdateAs (split "\n") (\_ l -> join "\n" l)
horizontal = setUIAttributes (directionAttr Horizontal)
......@@ -20,10 +20,8 @@ sharedNotes
( updateSharedInformation "Update shared note 1" [UpdateUsing id (const id) textArea] note // an editor to update the shared string
-||-
updateSharedInformation "Update shared note 2" [UpdateUsing id (const id) textArea] note // and an other updating editor
<<@ ApplyLayout horizontal
<<@ ArrangeHorizontal
)
)
>>= viewInformation "Resulting string is:" [ViewUsing id textArea]
>>= return
where
horizontal = setUIAttributes (directionAttr Horizontal)
......@@ -26,8 +26,6 @@ enterSharedPersons
\sharedList -> updateSharedInformation "Modify the Shared List of Persons:" [] sharedList // update that list
-||
viewSharedInformation "Current Content of this Shared List:" [] sharedList // while showing that list
<<@ ApplyLayout horizontal // show both list next to each other (default is below)
<<@ ArrangeHorizontal // show both list next to each other (default is below)
>>= viewInformation "The List contains the following:" [] // show the final result
>>= return // done
where
horizontal = setUIAttributes (directionAttr Horizontal)
......@@ -24,10 +24,8 @@ person1by1 :: [Person] -> Task [Person]
person1by1 persons
= enterInformation "Add a person" []
-||
viewInformation "List so far.." [] persons // <<@ horizontal
viewInformation "List so far.." [] persons
>>* [ OnAction (Action "Add") (hasValue (\v -> person1by1 [v : persons]))
, OnAction (Action "Finish") (always (return persons))
, OnAction ActionCancel (always (return []))
]
where
horizontal = ApplyLayout (setUIAttributes (directionAttr Horizontal))
......@@ -10,7 +10,7 @@ playWithMaps = withShared {defaultValue & icons = shipIcons} (\m ->
(allTasks [managePerspective m, manageMapObjects m])
-&&-
manipulateMap m
) <<@ ArrangeWithSideBar 0 LeftSide 600 True @! ()
) <<@ ArrangeWithSideBar 0 LeftSide True @! ()
manipulateMap :: (Shared sds LeafletMap) -> Task () | RWShared sds
manipulateMap m = updateSharedInformation () [] m
......
<!DOCTYPE html>
<html style="width: 100%; height: 100%;">
<head>
<meta charset="UTF-8">
<title></title>
<link rel="stylesheet" href="/css/itasks.css" type="text/css" >
<link rel="stylesheet" href="/css/WorkflowAdmin.css" type="text/css" >
<!-- Sapl dependencies -->
<script type="text/javascript" src="/js/sapl-utils.js"></script>
<script type="text/javascript" src="/js/sapl-builtin.js"></script>
<script type="text/javascript" src="/js/sapl-dynamic.js"></script>
<script type="text/javascript" src="/js/sapl-itasks.js"></script>
<script type="text/javascript" src="/js/sapl-rt.js"></script>
<script type="text/javascript" src="/js/sapl-support.js"></script>
<script type="text/javascript" src="/js/sapl-debug.js"></script>
<!-- iTasks framework -->
<script type="text/javascript" src="/js/itasks-core.js"></script>
<script type="text/javascript" src="/js/itasks-components-raw.js"></script>
<script type="text/javascript" src="/js/itasks-components-form.js"></script>
<script type="text/javascript" src="/js/itasks-components-display.js"></script>
<script type="text/javascript" src="/js/itasks-components-selection.js"></script>
<script type="text/javascript" src="/js/itasks-components-container.js"></script>
<script type="text/javascript" src="/js/itasks-js-interface.js"></script>
<!-- load iTasks viewport -->
<script type="text/javascript">
window.onload = function() {
itasks.viewport({syncTitle: true}, document.body);
};
</script>
</head>
<body style="width: 100%; height: 100%">
</body>
</html>
......@@ -63,6 +63,7 @@ instance Startable (a,b) | Startable a & Startable b
, appVersion :: String
, serverPort :: Int
, serverUrl :: String
, allowedHosts :: [String] // Only allow connections from these hosts (default ["127.0.0.1"])
, keepaliveTime :: Timespec
, sessionTime :: Timespec
, persistTasks :: Bool
......
......@@ -106,6 +106,9 @@ where
("Specify the HTTP port (default: " +++ toString defaults.serverPort +++ ")")
, Option [] ["timeout"] (OptArg (\mp->fmap \o->{o & timeout=fmap toInt mp}) "MILLISECONDS")
"Specify the timeout in ms (default: 500)\nIf not given, use an indefinite timeout."
, Option [] ["allowed-hosts"] (ReqArg (\p->fmap \o->{o & allowedHosts = split "," p}) "IPADRESSES")
("Specify a comma separated white list of hosts that are allowed to connected to this application\ndefault: "
+++ join "," defaults.allowedHosts)
, Option [] ["keepalive"] (ReqArg (\p->fmap \o->{o & keepaliveTime={tv_sec=toInt p,tv_nsec=0}}) "SECONDS")
"Specify the keepalive time in seconds (default: 300)"
, Option [] ["maxevents"] (ReqArg (\p->fmap \o->{o & maxEvents=toInt p}) "NUM")
......@@ -201,6 +204,7 @@ defaultEngineOptions world
, appVersion = appVersion
, serverPort = IF_POSIX_OR_WINDOWS 8080 80
, serverUrl = "http://localhost/"
, allowedHosts = ["127.0.0.1"]
, keepaliveTime = {tv_sec=300,tv_nsec=0} // 5 minutes
, sessionTime = {tv_sec=60,tv_nsec=0} // 1 minute, (the client pings every 10 seconds by default)
, persistTasks = False
......
......@@ -59,7 +59,7 @@ tonicStaticBrowser rs
>&> withSelection noModuleSelection (
\mn -> getModule mn
>>- \tm -> tonicBrowseWithModule allbps rs navstack tm
)) <<@ ArrangeWithSideBar 0 LeftSide 200 True
)) <<@ ArrangeWithSideBar 0 LeftSide True
)) ) @! ()
where
selectModule = getTonicModules >>- enterChoice "Select a module" [ChooseFromDropdown id]
......@@ -80,7 +80,7 @@ tonicBrowseWithModule allbps rs navstack tm
, bpr_taskName = tt.tf_name
} tm tt sett.StaticDisplaySettings.unfold_depth sett.StaticDisplaySettings.display_compact @! ()))
(getTonicFunc tm tn)
)) <<@ ArrangeWithSideBar 0 LeftSide 200 True
)) <<@ ArrangeWithSideBar 0 LeftSide True
@! ()
where
selectTask tm = enterChoice "Select task" [ChooseFromDropdown id] (getTasks tm)
......@@ -286,7 +286,7 @@ where
(Title "Active blueprint instances")
[ChooseFromGrid customView]
(mapRead (\(trt, q) -> filterActiveTasks q (flattenRTMap trt)) (tonicSharedRT |*| queryShare))
setTaskId selectedBlueprint <<@ ArrangeWithSideBar 0 TopSide 175 True
setTaskId selectedBlueprint <<@ ArrangeWithSideBar 0 TopSide True
where
setTaskId x = { click_origin_mbbpident = Nothing
, click_origin_mbnodeId = Nothing
......
div.itasks-container.manage-work-header {
padding: 2px 2px 2px 10px;
flex-direction: row;
}
div.itasks-window.new-work-window {
min-width: 600px;
min-height: 350px;
}
......@@ -118,7 +118,7 @@ loginAndManageWork welcome
,
viewInformation ("Guest access","Alternatively, you can continue anonymously as guest user") [] ()
>>| (return Nothing)
] <<@ ApplyLayout (setUIAttributes (directionAttr Horizontal)))
] <<@ ArrangeHorizontal)
) <<@ ApplyLayout layout
>>- browse) //Compact layout before login, full screen afterwards
) <<@ ApplyLayout (setUIAttributes (titleAttr welcome))
......@@ -145,7 +145,7 @@ manageWorkOfCurrentUser
where
layout = sequenceLayouts
[unwrapUI //Get rid of the step
,arrangeWithSideBar 0 TopSide 50 False
,arrangeWithHeader 0
,layoutSubUIs (SelectByPath [0]) layoutManageSession
,layoutSubUIs (SelectByPath [1]) (sequenceLayouts [unwrapUI,layoutWhatToDo])
//Use maximal screen space
......@@ -156,9 +156,9 @@ where
[layoutSubUIs SelectChildren actionToButton
,layoutSubUIs (SelectByPath [0]) (setUIType UIContainer)
,setUIType UIContainer
,setUIAttributes ('DM'.unions [heightAttr WrapSize,directionAttr Horizontal,paddingAttr 2 2 2 10])
,addCSSClass "manage-work-header"
]
layoutWhatToDo = sequenceLayouts [arrangeWithSideBar 0 LeftSide 150 True, layoutSubUIs (SelectByPath [1]) unwrapUI]
layoutWhatToDo = sequenceLayouts [arrangeWithSideBar 0 LeftSide True, layoutSubUIs (SelectByPath [1]) unwrapUI]
manageSession :: Task ()
manageSession =
......@@ -176,7 +176,6 @@ where
manageWork :: Task ()
manageWork = parallel [(Embedded, manageList)] [] <<@ ApplyLayout layoutManageWork @! ()
where
manageList taskList
= get currentUser @ userRoles
>>- \roles ->
......@@ -188,7 +187,7 @@ where
worklist roles = if (isMember "admin" roles) allWork myWork
continuations roles taskList = if (isMember "manager" roles) [new,open,delete] [open]
where
new = OnAction (Action "New") (always (appendTask Embedded (removeWhenStable (addNewTask taskList)) taskList @! () ))
new = OnAction (Action "New") (always (appendTask Embedded (removeWhenStable (addNewTask taskList <<@ InWindow <<@ AddCSSClass "new-work-window")) taskList @! () ))
open = OnAction (Action "Open") (hasValue (\(taskId,_) -> openTask taskList taskId @! ()))
delete = OnAction (Action "Delete") (ifValue (\x -> snd x || isMember "admin" roles) (\(taskId,_) -> removeTask taskId topLevelTasks @! ()))
......@@ -197,16 +196,16 @@ where
layoutManageWork = sequenceLayouts
//Split the screen space
[ arrangeWithSideBar 0 TopSide 200 True
[ arrangeWithSideBar 0 TopSide True
//Layout all dynamically added tasks as tabs
, layoutSubUIs (SelectByPath [1]) (arrangeWithTabs False)
, layoutSubUIs (SelectByPath [1]) (arrangeWithTabs True)
, layoutSubUIs (SelectByPath [1]) $
layoutSubUIs (SelectByDepth 1) (setUIAttributes $ 'DM'.put "fullscreenable" (JSONBool True) 'DM'.newMap)
]
addNewTask :: !(SharedTaskList ()) -> Task ()
addNewTask list
= ((chooseWorkflow >&> viewWorkflowDetails) <<@ ApplyLayout (setUIAttributes (directionAttr Horizontal))
= ((chooseWorkflow >&> viewWorkflowDetails) <<@ ArrangeHorizontal
>>* [OnAction (Action "Start task") (hasValue (\wf -> startWorkflow list wf @! ()))
,OnAction ActionCancel (always (return ()))
] ) <<@ Title "New work"
......@@ -328,9 +327,10 @@ where
removeWhenStable :: (Task a) (SharedTaskList a) -> Task a | iTask a
removeWhenStable task slist
= task
= (task
>>* [OnValue (ifStable (\_ -> get (taskListSelfId slist) >>- \selfId -> removeTask selfId slist))]
@? const NoValue
@? const NoValue)
<<@ ApplyLayout unwrapUI
addWorkflows :: ![Workflow] -> Task [Workflow]
addWorkflows additional
......
definition module iTasks.Extensions.Editors.DynamicEditors
definition module iTasks.Extensions.Editors.DynamicEditor
import iTasks
......@@ -13,7 +13,7 @@ derive class iTask DynamicEditorValue
:: DynamicEditorElement = DynamicCons !DynamicCons | DynamicConsGroup !String ![DynamicCons]
:: DynamicCons
:: DynamicConsOption = HideIfOnlyChoice | UseAsDefault
:: DynamicConsOption = HideIfOnlyChoice | UseAsDefault | LayoutVertical
(<<@@@) infixl 2 :: !DynamicCons !DynamicConsOption -> DynamicCons
(@@@>>) infixr 2 :: !DynamicConsOption !DynamicCons -> DynamicCons
......
implementation module iTasks.Extensions.Editors.DynamicEditors
implementation module iTasks.Extensions.Editors.DynamicEditor
import StdEnv => qualified foldl
import StdMisc, Data.Tuple, Text, Data.Maybe, Text.GenPrint
......@@ -7,7 +7,6 @@ from Data.Tuple import appFst
import iTasks, iTasks.UI.Definition, iTasks.UI.Editor.Common, iTasks.UI.Editor.Modifiers
import qualified Data.Map as Map
from Data.Func import $
import Util
from Data.List import zip3, intersperse
import Data.Functor
......@@ -17,6 +16,7 @@ import Data.Functor
, builder :: !DynamicConsBuilder
, showIfOnlyChoice :: !Bool
, useAsDefault :: !Bool
, uiAttributes :: !UIAttributes
}
(<<@@@) infixl 2 :: !DynamicCons !DynamicConsOption -> DynamicCons
......@@ -28,6 +28,7 @@ import Data.Functor
tunedDynamicConsEditor :: !DynamicConsOption !DynamicCons -> DynamicCons
tunedDynamicConsEditor HideIfOnlyChoice cons = {cons & showIfOnlyChoice = False}
tunedDynamicConsEditor UseAsDefault cons = {cons & useAsDefault = True}
tunedDynamicConsEditor LayoutVertical cons = {cons & uiAttributes = 'Map'.union (classAttr ["itasks-vertical"]) cons.uiAttributes}
functionCons :: !String !String !a -> DynamicCons | TC a
functionCons consId label func = functionConsDyn consId label (dynamic func)
......@@ -38,6 +39,7 @@ functionConsDyn consId label func = { consId = consId
, builder = FunctionCons func
, showIfOnlyChoice = True
, useAsDefault = False
, uiAttributes = 'Map'.newMap
}
listCons :: !String !String !([a] -> b) -> DynamicCons | TC a & TC b
......@@ -49,6 +51,7 @@ listConsDyn consId label func = { consId = consId
, builder = ListCons func
, showIfOnlyChoice = True
, useAsDefault = False
, uiAttributes = 'Map'.newMap
}
customEditorCons :: !String !String !(Editor a) -> DynamicCons
......@@ -58,6 +61,7 @@ customEditorCons consId label editor = { consId = consId
, builder = CustomEditorCons editor
, showIfOnlyChoice = True
, useAsDefault = False
, uiAttributes = 'Map'.newMap
}
// TODO: don't use aborts here
......@@ -353,7 +357,7 @@ where
where