Commit c42db611 authored by Bas Lijnse's avatar Bas Lijnse

Adapted Incidone to changes in interaction API to get it compiling again. All...

Adapted Incidone to changes in interaction API to get it compiling again. All tree selections have been temporary disabled.
parent b0defd2f
......@@ -143,7 +143,6 @@ derive gEq CatalogAction
derive gDefault CatalogAction
derive gText CatalogAction
derive gEditor CatalogAction
derive gVerify CatalogAction
toInstantAction :: c ActionProgress [ContactNo] [IncidentNo] (ActionDefinition c) -> CatalogAction | iTask c
toConfigurableAction :: ([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) (ActionDefinition c) -> CatalogAction | iTask c
......
......@@ -79,10 +79,7 @@ standardMapLayers :: Shared [ContactMapLayer]
derive JSONEncode ContactPosition, ContactMapPerspective
derive JSONDecode ContactPosition, ContactMapPerspective
derive gEditor ContactPosition, ContactMapPerspective
derive gVerify ContactPosition, ContactMapPerspective
derive gText ContactPosition, ContactMapPerspective
derive gDefault ContactPosition, ContactMapPerspective
......
implementation module Incidone.ContactPosition
import iTasks, iTasks.UI.Editor, iTasks.UI.Definition
import iTasks, iTasks.UI.Editor, iTasks.UI.Editor.Builtin, iTasks.UI.Editor.Combinators, iTasks.UI.Definition
import qualified Data.Map as DM
import Data.Functor, Text
import qualified Text.Parsers.ZParsers.ParsersKernel as PK
......@@ -14,30 +14,7 @@ import Incidone.Util.TaskPatterns
derive JSONEncode ContactPosition
derive JSONDecode ContactPosition
gEditor{|ContactPosition|} = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
where
genUI path val mask vst=:{VSt|taskId,optional,disabled}
| disabled
# attr = 'DM'.unions [optionalAttr optional,valueAttr (toJSON (toSingleLineText val))]
= (Ok (uia UIViewString attr), vst)
# value = case val of
PositionDescription s _ = JSONString s
PositionLatLng l = JSONString (formatLatLng l)
# attr = 'DM'.unions [optionalAttr optional, stdAttributes "position" optional mask
,editAttrs taskId (editorId path) (Just (toJSON value))]
= (Ok (uia UIEditString attr), vst)
updUI dp old om new nm vst
= (Ok (if (old === new) NoChange (ChangeUI [SetAttribute "value" (toJSON new)] [])),vst)
onEdit [] JSONNull val _ ust = (PositionDescription "" Nothing,Blanked,ust)
onEdit [] (JSONString nval) _ _ ust = (parsePosition nval, Touched, ust)
onEdit dp e val mask ust = (val,mask,ust)
gVerify{|ContactPosition|} {VerifyOptions|optional=False} (_,Blanked) = MissingValue
gVerify{|ContactPosition|} _ (PositionDescription _ Nothing,mask) = WarningValue "This position can not be plotted on a map"
gVerify{|ContactPosition|} _ _ = CorrectValue Nothing
gEditor{|ContactPosition|} = liftEditor printPosition parsePosition (textField 'DM'.newMap)
gText{|ContactPosition|} _ val = [maybe "" printPosition val]
derive gDefault ContactPosition
......@@ -105,7 +82,6 @@ derive class iTask ContactMap, ContactMapLayer, ContactMapLayerDefinition, Conta
derive JSONEncode ContactMapPerspective
derive JSONDecode ContactMapPerspective
derive gEditor ContactMapPerspective
derive gVerify ContactMapPerspective
derive gText ContactMapPerspective
gEq{|ContactMapPerspective|} {ContactMapPerspective|center=(xla,xlo),zoom=xz,bounds=xb} {ContactMapPerspective|center=(yla,ylo),zoom=yz,bounds=yb}
......
......@@ -3,6 +3,7 @@ import iTasks
import Incidone.OP.Concepts, Incidone.OP.SDSs
import Incidone.DeviceBased.VideoWall
import Incidone.Util.TaskPatterns
import Text.HTML
selectVideoWallContent :: Task ()
selectVideoWallContent
......@@ -16,7 +17,7 @@ where
selectContent
= (switchContent >&> withSelection viewNoSelection configureContent) <<@ (ArrangeWithSideBar 0 LeftSide 300 False)
switchContent = enterChoice (Title "Choose Content") [ChooseWith (ChooseFromList bigLabel)] contentOptions
switchContent = enterChoice (Title "Choose Content") [ChooseFromList bigLabel] contentOptions
contentOptions
= ["Overview","Incident","Contact","Clock","Countdown"]
......@@ -29,7 +30,7 @@ where
= get (standardMapLayers |+| standardPerspective)
>>- \(baseLayers,perspective) ->
withShared perspective
\p -> updateSharedInformation (Title title) [UpdateWith (toMap baseLayers) fromMap] (p >+| mapContacts)
\p -> updateSharedInformation (Title title) [UpdateAs (toMap baseLayers) fromMap] (p >+| mapContacts) @ fst
//<<@ AfterLayout (tweakUI fill) //FIXME
@ WallOverview
where
......@@ -38,9 +39,9 @@ where
fromMap _ {LeafletMap|perspective}
= fromLeafletPerspective perspective
configure "Incident"
= enterChoiceWithSharedAs (Title title) [ChooseWith (ChooseFromList bigLabel)] allIncidentsShort (\{IncidentShort|incidentNo} -> WallIncidentSummary (Just incidentNo))
= enterChoiceWithSharedAs (Title title) [ChooseFromList bigLabel] allIncidentsShort (\{IncidentShort|incidentNo} -> WallIncidentSummary (Just incidentNo))
configure "Contact"
= enterChoiceWithSharedAs (Title title) [ChooseWith (ChooseFromList bigLabel)] allContactsShort (\{ContactShort|contactNo} -> WallContactSummary (Just contactNo))
= enterChoiceWithSharedAs (Title title) [ChooseFromList bigLabel] allContactsShort (\{ContactShort|contactNo} -> WallContactSummary (Just contactNo))
configure "Clock"
= viewInformation (Title title) [] "No configuration is needed for the clock."
//<<@ AfterLayout (tweakUI fill) //FIXME
......
......@@ -2,7 +2,7 @@ implementation module Incidone.DeviceBased.VideoWall
import iTasks
import Incidone.OP.Concepts, Incidone.OP.SDSs, Incidone.ActionManagementTasks
import Incidone.Util.TaskPatterns
import Text, Data.List, iTasks._Framework.HtmlUtil
import Text, Text.HTML, Data.List, iTasks._Framework.HtmlUtil
derive class iTask WallContent
......@@ -14,14 +14,14 @@ viewVideoWallContent
= (header ||- content) <<@ (ArrangeWithSideBar 0 TopSide 30 False) //<<@ AfterLayout plainLayoutFinal //FIXME
where
header
= viewSharedInformation () [ViewWith view] (currentTime |+| currentUTCTime) //<<@ (AfterLayout (uiDefSetHalign AlignRight o uiDefSetBaseCls "wall-header")) //FIXME
= viewSharedInformation () [ViewAs view] (currentTime |+| currentUTCTime) //<<@ (AfterLayout (uiDefSetHalign AlignRight o uiDefSetBaseCls "wall-header")) //FIXME
where
view (local,utc) = "LOCAL: " + lpad (toString local.Time.hour) 2 '0' + ":" + lpad (toString local.Time.min) 2 '0' + " "
+ "UTC: " + lpad (toString utc.Time.hour) 2 '0' + ":" + lpad (toString utc.Time.min) 2 '0'
content
= whileUnchanged wallContent \content -> case content of
WallClock = (viewSharedInformation (Title "Local Time") [ViewWith formatTime] currentTime @! content)
WallCountDown until = (viewSharedInformation (Title "Countdown") [ViewWith (\t -> formatDateTime (until - t))] currentDateTime @! content)
WallClock = (viewSharedInformation (Title "Local Time") [ViewAs formatTime] currentTime @! content)
WallCountDown until = (viewSharedInformation (Title "Countdown") [ViewAs (\t -> formatDateTime (until - t))] currentDateTime @! content)
WallOverview perspective = viewWallOverview perspective @! content
WallContactSummary (Just contactNo) = viewWallContactSummary contactNo @! content
WallIncidentSummary (Just incidentNo) = viewWallIncidentSummary incidentNo @! content
......@@ -33,11 +33,11 @@ formatDateTime time = DivTag [StyleAttr "font-size: 80pt; text-align: center; pa
mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |+| contactsProvidingHelpGeo)
viewWallOverview perspective
= ((viewSharedInformation (Title "Open Incidents") [ViewWith formatIncidents] openIncidentsDetails)
= ((viewSharedInformation (Title "Open Incidents") [ViewAs formatIncidents] openIncidentsDetails)
-&&-
(get standardMapLayers
>>- \baseLayers ->
viewSharedInformation () [ViewWith (toMap perspective baseLayers)] mapContacts /* <<@ AfterLayout (tweakUI (setMargins 0 0 0 0 o fill))*/ ) //FIXME
viewSharedInformation () [ViewAs (toMap perspective baseLayers)] mapContacts /* <<@ AfterLayout (tweakUI (setMargins 0 0 0 0 o fill))*/ ) //FIXME
) <<@ ArrangeWithSideBar 0 LeftSide 300 False
where
toMap perspective baseLayers contacts
......@@ -64,7 +64,7 @@ where
viewDetails
= (viewPhoto -&&- viewTypeDetails) <<@ (Title "Details")
viewPhoto
= viewSharedInformation () [ViewWith formatPhoto] contact
= viewSharedInformation () [ViewAs formatPhoto] contact
where
formatPhoto {Contact|photos,type,notes}
= ImgTag [ClassAttr "wall-contact-details",WidthAttr "200",HeightAttr "200",SrcAttr (photoSrc photos)]
......@@ -79,9 +79,9 @@ where
_ = viewInformation () [] ()
viewPosition
= ((viewSharedInformation (Title "Position") [ViewWith formatPosition] contact /* <<@ AfterLayout (uiDefSetBaseCls "wall-contact-position") */) //FIXME
= ((viewSharedInformation (Title "Position") [ViewAs formatPosition] contact /* <<@ AfterLayout (uiDefSetBaseCls "wall-contact-position") */) //FIXME
-&&-
(viewSharedInformation (Title "Map") [ViewWith contactMap] contact /*<<@ AfterLayout (tweakUI (setMargins 0 0 0 0 o fill)) */) //FIXME
(viewSharedInformation (Title "Map") [ViewAs contactMap] contact /*<<@ AfterLayout (tweakUI (setMargins 0 0 0 0 o fill)) */) //FIXME
)
where
formatPosition {Contact|position=Just pos} = toSingleLineText pos
......@@ -98,7 +98,7 @@ where
markers c _ = []
viewCommunication
= viewSharedInformation (Title "Last communication") [ViewWith (formatComms o take 5)] (sdsFocus contactNo contactCommunications)
= viewSharedInformation (Title "Last communication") [ViewAs (formatComms o take 5)] (sdsFocus contactNo contactCommunications)
where
formatComms items
= DivTag []
......@@ -117,7 +117,7 @@ where
viewIncidentTitle
= viewSharedInformation () [] (sdsFocus incidentNo incidentTitleByNo) //<<@ AfterLayout (uiDefSetBaseCls "wall-contact-title") //FIXME
viewIncidentContacts
= viewSharedInformation (Title "Involved Contacts") [ViewWith toView] (sdsFocus incidentNo contactsByIncident)
= viewSharedInformation (Title "Involved Contacts") [ViewAs toView] (sdsFocus incidentNo contactsByIncident)
where
toView contacts = DivTag [ClassAttr "wall-incident-contacts"] (map formatContact contacts)
......@@ -131,14 +131,14 @@ where
photoSrc _ = "/no-photo.jpg"
viewIncidentActions
= viewSharedInformation (Title "Open Actions") [ViewWith toView] (sdsFocus incidentNo actionStatusesByIncident) /* <<@ AfterLayout (tweakUI fill) */ //FIXME
= viewSharedInformation (Title "Open Actions") [ViewAs toView] (sdsFocus incidentNo actionStatusesByIncident) /* <<@ AfterLayout (tweakUI fill) */ //FIXME
where
toView actions = DivTag [] [vizAction a \\ (_,_,a) <- actions]
vizAction {ActionStatus|title}
= DivTag [ClassAttr "wall-action"] [H2Tag [ClassAttr "wall-action-title"] [Text title]]
viewIncidentLog
= viewSharedInformation (Title "Last Log Messages") [ViewWith (toView o take 5)] (sdsFocus incidentNo incidentLog)
= viewSharedInformation (Title "Last Log Messages") [ViewAs (toView o take 5)] (sdsFocus incidentNo incidentLog)
where
toView log = DivTag [] (flatten [[vizDate date:map vizEntry entries] \\ (date,entries) <- groupByDate log])
......
......@@ -21,12 +21,12 @@ manageContactCrew :: ContactNo -> Task ()
manageContactCrew contactNo
= updateSharedContactRefList "Manage crew" (sdsFocus contactNo crewListsStore)
//Optional Improvements
-|| forever (addStandardCrewMembers contactNo)
// -|| forever (addStandardCrewMembers contactNo)
-|| forever (quickAddStandardCrewMembers contactNo)
@! ()
where
addStandardCrewMembers contactNo
= enterSharedMultipleChoice "Select standard crew members" [ChooseMultipleWith ChooseFromCheckBoxes view] items
= enterInformation "FIXME" []//editSharedMultipleChoice "Select standard crew members" [ChooseFromCheckGroup view] [] items
>>* [OnAction (Action "Add members" []) (hasValue (\sel -> addCrewMembers contactNo (map (contactIdentity o snd) sel)))]
where
view (no,c) = (no,contactTitle c)
......@@ -55,13 +55,13 @@ where
refs = sdsFocus contactNo crewAliasListsStore
manageCurrentItems
= updateSharedInformation "Manage crew list" [UpdateWith toPrj fromPrj] items
= updateSharedInformation "Manage crew list" [UpdateAs toPrj fromPrj] items
where
items = sdsDeref refs snd contactsByNosShort derefAliasList
//toPrj l = [Row (Hidden (contactIdentity c),Display aNo,Display (contactTitle c)) \\ (aNo,c) <- l]
//fromPrj _ l = [(aNo,cNo) \\ Row (Hidden cNo,Display aNo,_) <- l]
toPrj l = {EditableList|items = [Row (Hidden (contactIdentity c),Display aNo, Display (contactTitle c))\\(aNo,c) <-l],add=ELNoAdd,remove=True,reorder=True,count=False}
fromPrj _ {EditableList|items} = [(aNo,cNo) \\ Row (Hidden cNo,Display aNo,_) <- items]
toPrj l = [Row (Hidden (contactIdentity c),Display aNo, Display (contactTitle c))\\(aNo,c) <-l]
fromPrj _ items = [(aNo,cNo) \\ Row (Hidden cNo,Display aNo,_) <- items]
addItem
= (enterInformation "Enter a number to use when refering to this contact" []
......
......@@ -255,12 +255,12 @@ determineContact mbPrevious
<<@ ArrangeVertical
where
createNewContact filter
= enterInformation (Title "Contact") [] @> (mapToFilter,filter)
= enterInformation (Title "Contact") [] // @> (mapToFilter,filter)
>>* [OnAction ActionCreate (hasValue (createContact))]
selectExistingContact filter
= whileUnchanged filter
\curFilter ->
enterChoiceWithSharedAs (Title "Select contact") [ChooseWith (ChooseFromList contactTitle)] (sdsFocus curFilter filteredContactsShort) contactIdentity
enterChoiceWithSharedAs (Title "Select contact") [ChooseFromList contactTitle] (sdsFocus curFilter filteredContactsShort) contactIdentity
>>* [OnValue (hasValue return)
:maybe [] (\contactNo -> [OnAction ActionCancel (always (return contactNo))]) mbPrevious]
......
......@@ -21,7 +21,5 @@ derive JSONEncode Temperature, Meters, Feet, Miles, Knots, Degrees, Contac
derive JSONDecode Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gText Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gEditor Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gVerify Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gDefault Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gEq Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
......@@ -29,7 +29,6 @@ gText{|IncidentShort|} _ i = [maybe "" incidentTitle i]
derive JSONEncode Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive JSONDecode Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gEditor Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gVerify Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gDefault Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
derive gEq Temperature, Meters, Feet, Miles, Knots, Degrees, ContactShort, IncidentShort
implementation module Incidone.OP.Conversions
import Incidone.OP.Concepts
import Text
import Text, Text.HTML
class contactTitle a :: a -> String
instance contactTitle Contact
......
......@@ -10,6 +10,7 @@ import Incidone.DeviceBased.VideoWall
import Incidone.ActionManagementTasks
import Data.List
import qualified Data.Map as DM
import Text.HTML
openIncidentInWorkspace :: Workspace IncidentNo -> Task ()
openIncidentInWorkspace ws incidentNo
......@@ -66,14 +67,14 @@ where
,(OnAction (Action "/Update status" [ActionIcon "edit"]) (ifValue (\c -> c=:(Left _)) (\(Left c) -> updateContactStatus c <<@ InWindow @! ())))
,(OnAction (Action "/Open contact" [ActionIcon "open"]) (ifValue (\c -> c=:(Left _)) (\(Left c) -> openContactInWorkspace ws c)))
]
chooseFromList sel = editSharedChoiceWithSharedAs () [ChooseWith (ChooseFromList listView)] contacts (Left o contactIdentity) sel
chooseFromList sel = editSharedChoiceWithSharedAs () [ChooseFromList listView] contacts (Left o contactIdentity) sel
chooseFromMap sel = viewContactsOnMap (sdsFocus incidentNo contactsByIncidentGeo) sel
listView c=:{Contact|name,type,status,photos}
= ">" <+++ type <+++ ": " <+++ name <+++ " (" <+++ status <+++ ")"
add = oneOrAnother (Title "Add contact..")
("Known contact",enterChoiceWithSharedAs () [ChooseWith (ChooseFromComboBox id)] allContactsShort contactNo)
("Known contact",enterChoiceWithSharedAs () [ChooseFromDropdown id] allContactsShort contactNo)
("Add new contact",enterInformation () [])
>>? \contact ->
createContactIfNew contact
......@@ -127,7 +128,7 @@ manageIncidentLog incidentNo
@! ()
where
viewIncidentLog :: IncidentNo -> Task [LogEntry]
viewIncidentLog incident = viewSharedInformation () [ViewWith toView] (sdsFocus incidentNo incidentLog)
viewIncidentLog incident = viewSharedInformation () [ViewAs toView] (sdsFocus incidentNo incidentLog)
where
toView log = DivTag [ClassAttr "incident-log"] (flatten [[vizDate date:map vizEntry entries] \\ (date,entries) <- groupByDate log])
......@@ -167,11 +168,11 @@ updateSharedIncidentRefList d compact refs
>^* [OnAction (Action "Add" []) (always (addItem <<@ InWindow))]
where
manageCurrentItems
= updateSharedInformation d [UpdateWith toPrj fromPrj] items
= updateSharedInformation d [UpdateAs toPrj fromPrj] items @ map incidentIdentity
where
items = sdsDeref refs id incidentsByNosShort (\_ is -> is)
toPrj l = {EditableList|items = [(Hidden (incidentIdentity i),Display (incidentTitle i))\\i <-l],add=ELNoAdd,remove=True,reorder=True,count=False}
fromPrj _ {EditableList|items} = [i \\ (Hidden i,_) <- items]
toPrj l = [(Hidden (incidentIdentity i),Display (incidentTitle i)) \\i <-l]
fromPrj _ items = [i \\ (Hidden i,_) <- items]
addItem
= selectKnownOrDefineNewIncident
......@@ -184,7 +185,7 @@ selectKnownOrDefineNewIncident
("Add new incident",enterNewIncident)
where
chooseKnownIncident
= enterChoiceWithSharedAs () [ChooseWith (ChooseFromComboBox id)] openIncidentsShort incidentIdentity
= enterChoiceWithSharedAs () [ChooseFromDropdown id] openIncidentsShort incidentIdentity
enterNewIncident
= enterInformation () []
......
......@@ -12,6 +12,7 @@ import Incidone.ActionManagementTasks
import Incidone.Util.TaskPatterns
import iTasks.API.Extensions.Admin.ServerAdmin
import iTasks.API.Extensions.Dashboard
import Text.HTML
:: DatabaseProblem
= NoDatabaseAccess
......@@ -45,7 +46,7 @@ where
= whileUnchanged databaseConfig
\config ->
checkDatabaseConfig config
>>- viewInformation (Title "Database configuration") [ViewWith databaseStatusView]
>>- viewInformation (Title "Database configuration") [ViewAs databaseStatusView]
databaseStatusView (Ok InternalSQLiteDB) = Row (LightOnGreen, "Incidone is correctly configured to use an internal SQLite database.")
databaseStatusView (Ok (ExternalMySQLDB _)) = Row (LightOnGreen, "Incidone is correctly configured to use an external MySQL database.")
......@@ -72,7 +73,7 @@ where
]
Error e
= viewInformation ("Warning","The new configuration appears to have a problem") [ViewWith databaseStatusView] (Error e)
= viewInformation ("Warning","The new configuration appears to have a problem") [ViewAs databaseStatusView] (Error e)
>>* [OnAction (Action "Set anyway" []) (always (set config databaseConfig @! ()))
,OnAction (Action "Change and try again" []) (always (editDatabaseConfig newConfig))
]
......@@ -94,7 +95,7 @@ where
manageDatabase
= get databaseDef
>>- \db ->
( (enterChoiceWithShared (Title "Tables") [ChooseWith (ChooseFromTree group)] (sdsFocus db sqlTables)
( (enterChoiceWithShared (Title "Tables") [/*ChooseFromTree group */] (sdsFocus db sqlTables)
>^* [OnAction ActionDelete (hasValue (\table -> deleteTable db table <<@ InWindow @! ()))
,OnAction (Action "Empty database" []) (always (emptyDatabase db <<@ InWindow @! ()))
,OnAction (Action "Load Incidone tables" []) (always (createIncidoneTables db <<@ InWindow ))
......@@ -107,7 +108,7 @@ where
) (\e -> viewInformation () [] e @! ())
) <<@ (ArrangeWithSideBar 0 LeftSide 300 True)
where
group items _ = [{ChoiceTree|defaultValue & label=o,value=ChoiceNode i}\\(i,o) <- items]
//group items _ = [{ChoiceTree|defaultValue & label=o,value=ChoiceNode i}\\(i,o) <- items]
deleteTable db table
= viewInformation "Are your sure you want to delete this table?" [] table
......@@ -138,7 +139,7 @@ manageUsers = forever (catchAll (
) (\e -> viewInformation "Error" [] e >>| return ()))
where
manageExistingUsers
= (enterChoiceWithSharedAs () [ChooseWith (ChooseFromGrid id)] allContactsShort contactIdentity
= (enterChoiceWithSharedAs () [ChooseFromGrid id] allContactsShort contactIdentity
>&> withSelection viewNoSelection manageContactAccess
)<<@ ArrangeWithSideBar 0 LeftSide 200 True
......@@ -220,7 +221,7 @@ configureMaps
where
previewMapLayers :: Task ContactMapPerspective
previewMapLayers = withShared defaultValue
\perspective -> updateSharedInformation (Title "Preview") [UpdateWith toPrj fromPrj] (perspective >+| standardMapLayers) /* <<@ AfterLayout (tweakUI fill) */ //FIXME
\perspective -> updateSharedInformation (Title "Preview") [UpdateAs toPrj fromPrj] (perspective >+| standardMapLayers) @ fst /* <<@ AfterLayout (tweakUI fill) */ //FIXME
where
toPrj (perspective,layers) = toLeafletMap {ContactMap|defaultValue & perspective=perspective,layers=layers}
fromPrj _ {LeafletMap|perspective} = fromLeafletPerspective perspective
......
......@@ -9,7 +9,7 @@ managePartnerActions :: [Workspace -> Task ()]
managePartnerActions = [welcome,myactions]
where
welcome _
= viewSharedInformation (Title "Welcome") [ViewWith (\u -> "Welcome "+++toString u)] currentUser @! ()
= viewSharedInformation (Title "Welcome") [ViewAs (\u -> "Welcome "+++toString u)] currentUser @! ()
myactions _
= get currentUser @ userContactNo
......
implementation module Incidone.Util.TaskPatterns
import iTasks, iTasks.API.Extensions.Dashboard
import iTasks.UI.Definition
import Incidone.OP.IncidentManagementTasks, Incidone.OP.ContactManagementTasks
import Text, Data.Functor, Data.Either
import qualified Data.Map as DM
......@@ -135,7 +136,7 @@ viewNoSelection = viewTitle "Select..." @! ()
oneOrAnother :: !d (String,Task a) (String,Task b) -> Task (Either a b) | toPrompt d & iTask a & iTask b
oneOrAnother desc (labela,taska) (labelb,taskb)
= updateChoice desc [ChooseWith (ChooseFromRadioButtons ((!!) [labela,labelb]))] [0,1] 0 /* <<@ AfterLayout (uiDefSetHeight WrapSize) */ //FIXME
= updateChoice desc [ChooseFromCheckGroup ((!!) [labela,labelb])] [0,1] 0 <<@ ApplyLayout (setAttributes (heightAttr WrapSize))
>&> \s -> whileUnchanged s (
\choice -> case choice of
Nothing = (viewInformation () [] "You have to make a choice" @? const NoValue)
......@@ -173,7 +174,7 @@ where
manageBackgroundTask :: !d !String !String (Task a) -> Task () | toPrompt d & iTask a
manageBackgroundTask d identity title task
= viewSharedInformation d [ViewWith (view title)] taskPid
= viewSharedInformation d [ViewAs (view title)] taskPid
>^* [OnAction (Action "Start" []) (ifValue isNothing startTask)
,OnAction (Action "Stop" []) (ifValue isJust stopTask)
]
......
......@@ -4,7 +4,7 @@ module IncidoneCCC
* to support SAR operations of the Netherlands Coast guard. It is loosely based on their
* procedure documentation and observation of, and interviews with, Coast guard officers.
*/
import iTasks, StdMisc, System.Time, Text, Data.Tuple
import iTasks, StdMisc, System.Time, Text, Text.HTML, Data.Tuple
import iTasks.UI.Layout, iTasks.UI.Definition
import qualified Data.Map as DM
......
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