Commit 0f027c30 authored by Mart Lubbers's avatar Mart Lubbers

Fix multiuser stuff and remove trailing space in examples

parent 0f6de3a5
Pipeline #12627 passed with stage
in 3 minutes and 38 seconds
...@@ -33,7 +33,7 @@ import Incidone.OP.Concepts ...@@ -33,7 +33,7 @@ import Incidone.OP.Concepts
} }
:: ActionTasks :: ActionTasks
= E.c: ActionTasks = E.c: ActionTasks
([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) //Configuration task ([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) //Configuration task
(c (Shared ActionStatus) -> Task ()) & iTask c //An action item that needs to be configured before it can be deployed (c (Shared ActionStatus) -> Task ()) & iTask c //An action item that needs to be configured before it can be deployed
...@@ -97,7 +97,7 @@ import Incidone.OP.Concepts ...@@ -97,7 +97,7 @@ import Incidone.OP.Concepts
:: CommunicationMeanSuggestion :: CommunicationMeanSuggestion
= CommunicateUsingPhone = CommunicateUsingPhone
| CommunicateUsingVHF | CommunicateUsingVHF
| CommunicateUsingP2000 | CommunicateUsingP2000
| CommunicateUsingEmail | CommunicateUsingEmail
:: UserActionListDefinition = :: UserActionListDefinition =
......
implementation module Incidone.ContactPosition implementation module Incidone.ContactPosition
import iTasks, iTasks.UI.Editor, iTasks.UI.Editor.Controls, iTasks.UI.Editor.Modifiers, iTasks.UI.Definition import iTasks, iTasks.UI.Editor, iTasks.UI.Editor.Controls, iTasks.UI.Editor.Modifiers, iTasks.UI.Definition
import qualified Data.Map as DM import qualified Data.Map as DM
import Data.Functor, Data.List, Text import Data.Functor, Data.List, Text
import qualified Text.Parsers.ZParsers.ParsersKernel as PK import qualified Text.Parsers.ZParsers.ParsersKernel as PK
import qualified Text.Parsers.ZParsers.ParsersDerived as PD import qualified Text.Parsers.ZParsers.ParsersDerived as PD
import qualified Control.Applicative as CA import qualified Control.Applicative as CA
...@@ -15,7 +15,7 @@ import Incidone.Util.TaskPatterns ...@@ -15,7 +15,7 @@ import Incidone.Util.TaskPatterns
derive JSONEncode ContactPosition derive JSONEncode ContactPosition
derive JSONDecode ContactPosition derive JSONDecode ContactPosition
gEditor{|ContactPosition|} = bijectEditorValue printPosition parsePosition textField gEditor{|ContactPosition|} = bijectEditorValue printPosition parsePosition textField
gText{|ContactPosition|} _ val = [maybe "" printPosition val] gText{|ContactPosition|} _ val = [maybe "" printPosition val]
derive gDefault ContactPosition derive gDefault ContactPosition
......
...@@ -7,7 +7,7 @@ import Text.HTML ...@@ -7,7 +7,7 @@ import Text.HTML
selectVideoWallContent :: Task () selectVideoWallContent :: Task ()
selectVideoWallContent selectVideoWallContent
= (header ||- selectContent) <<@ (ArrangeWithSideBar 0 TopSide 30 False) = (header ||- selectContent) <<@ (ArrangeWithSideBar 0 TopSide 30 False)
@! () @! ()
where where
header header
......
...@@ -38,7 +38,7 @@ answerPhoneCall communicationNo ...@@ -38,7 +38,7 @@ answerPhoneCall communicationNo
>>| connectInboundPhoneCall communicationNo >>| connectInboundPhoneCall communicationNo
||- ((manageCommunicationContact communicationNo ||- ((manageCommunicationContact communicationNo
-&&- -&&-
manageVoiceCallContent PhoneCall communicationNo) <<@ ArrangeWithSideBar 0 LeftSide 300 True) manageVoiceCallContent PhoneCall communicationNo) <<@ ArrangeWithSideBar 0 LeftSide 300 True)
<<@ ArrangeWithSideBar 0 TopSide 60 False <<@ ArrangeWithSideBar 0 TopSide 60 False
<<@ Title ("Answer phone call") <<@ Title ("Answer phone call")
/* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600)) */ //FIXME /* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600)) */ //FIXME
......
...@@ -26,7 +26,7 @@ selectContact = withShared Nothing ...@@ -26,7 +26,7 @@ selectContact = withShared Nothing
(viewContactsOnMap mapContacts sel <<@ Title "Map") (viewContactsOnMap mapContacts sel <<@ Title "Map")
<<@ ArrangeWithTabs True <<@ ArrangeWithTabs True
) )
where where
mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |+| contactsProvidingHelpGeo) mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |+| contactsProvidingHelpGeo)
selectContactFromLists :: (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) selectContactFromLists :: (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI)
...@@ -40,7 +40,7 @@ where ...@@ -40,7 +40,7 @@ where
/* /*
,(editSharedSelectionWithShared (Title "AIS") False ,(editSharedSelectionWithShared (Title "AIS") False
(SelectInTree ungrouped) (mapRead (sortBy (\x y -> contactTitle x < contactTitle y) o map aisToContact) allAISContacts) (Right o contactIdentity)) sel (SelectInTree ungrouped) (mapRead (sortBy (\x y -> contactTitle x < contactTitle y) o map aisToContact) allAISContacts) (Right o contactIdentity)) sel
*/ ] <<@ (ArrangeSplit Horizontal True) @? tvHd */ ] <<@ (ArrangeSplit Horizontal True) @? tvHd
fromOpenOption [{ContactShortWithIncidents|contactNo}] = contactNo fromOpenOption [{ContactShortWithIncidents|contactNo}] = contactNo
...@@ -195,7 +195,7 @@ manageContactCommunicationMeans compact contactNo = forever ( ...@@ -195,7 +195,7 @@ manageContactCommunicationMeans compact contactNo = forever (
>^* [OnAction ActionAdd (always (addMean contactNo <<@ InWindow @! ())) >^* [OnAction ActionAdd (always (addMean contactNo <<@ InWindow @! ()))
,OnAction ActionEdit (hasValue (\{CommunicationMean|id} -> editMean id <<@ InWindow @! ())) ,OnAction ActionEdit (hasValue (\{CommunicationMean|id} -> editMean id <<@ InWindow @! ()))
,OnAction ActionRemove (hasValue (\{CommunicationMean|id} -> removeMean id)) ,OnAction ActionRemove (hasValue (\{CommunicationMean|id} -> removeMean id))
] ]
) )
where where
ActionAdd = Action (if compact "Add" "/Add") ActionAdd = Action (if compact "Add" "/Add")
...@@ -263,7 +263,7 @@ manageContactIncidents :: Workspace ContactNo -> Task () ...@@ -263,7 +263,7 @@ manageContactIncidents :: Workspace ContactNo -> Task ()
manageContactIncidents ws contactNo manageContactIncidents ws contactNo
= feedForward choose = feedForward choose
( \sel -> ( \sel ->
withSelection viewNoSelection viewIncidentDetails sel withSelection viewNoSelection viewIncidentDetails sel
-&&- -&&-
doAddRemoveOpen (add <<@ InWindow) (\c -> (remove c) <<@ InWindow) (\c -> doOrClose (open c)) ws 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 300 True) <<@ (Icon "incidents") <<@ (Title "Incidents")
...@@ -596,7 +596,7 @@ where ...@@ -596,7 +596,7 @@ where
selection _ = NoValue selection _ = NoValue
sharePerspective (_,perspective) = set (WallOverview perspective) wallContent @! () sharePerspective (_,perspective) = set (WallOverview perspective) wallContent @! ()
toMarkers sel contacts toMarkers sel contacts
= [contactGeoToMapMarker ais (isSelected contactNo sel) c \\ (ais,c=:{ContactGeo|contactNo,name=Just _,position=Just _}) <- contacts] = [contactGeoToMapMarker ais (isSelected contactNo sel) c \\ (ais,c=:{ContactGeo|contactNo,name=Just _,position=Just _}) <- contacts]
...@@ -609,7 +609,7 @@ where ...@@ -609,7 +609,7 @@ where
| startsWith "c" markerId = Just (Left (toInt (subString 1 (textSize markerId) markerId))) | startsWith "c" markerId = Just (Left (toInt (subString 1 (textSize markerId) markerId)))
| startsWith "a" markerId = Just (Right (toInt (subString 1 (textSize markerId) markerId))) | startsWith "a" markerId = Just (Right (toInt (subString 1 (textSize markerId) markerId)))
= updateSelection ms = updateSelection ms
findContactNo title contacts = case [(isAis,contactNo) \\ (isAis,{ContactGeo|contactNo,name}) <- contacts | name == title] of findContactNo title contacts = case [(isAis,contactNo) \\ (isAis,{ContactGeo|contactNo,name}) <- contacts | name == title] of
[(False,contactNo)] = Just (Left contactNo) [(False,contactNo)] = Just (Left contactNo)
[(True,mmsi)] = Just (Right mmsi) [(True,mmsi)] = Just (Right mmsi)
......
...@@ -94,11 +94,11 @@ where ...@@ -94,11 +94,11 @@ where
contactSummary :: Contact -> ContactShort contactSummary :: Contact -> ContactShort
contactSummary {Contact|contactNo,name,type,group} contactSummary {Contact|contactNo,name,type,group}
= {ContactShort|contactNo = contactNo, name = name, type = type, group = group} = {ContactShort|contactNo = contactNo, name = name, type = type, group = group}
incidentDetails :: Incident -> IncidentDetails incidentDetails :: Incident -> IncidentDetails
incidentDetails {Incident|incidentNo,title,summary,type,phase} incidentDetails {Incident|incidentNo,title,summary,type,phase}
= {IncidentDetails|incidentNo = incidentNo, title = title, summary = summary, type = type, phase = phase} = {IncidentDetails|incidentNo = incidentNo, title = title, summary = summary, type = type, phase = phase}
contactDetails :: Contact -> ContactDetails contactDetails :: Contact -> ContactDetails
contactDetails {Contact|contactNo,name,type,position,notes} contactDetails {Contact|contactNo,name,type,position,notes}
= {ContactDetails|contactNo = contactNo, name = name, type = type, position = position, notes = notes} = {ContactDetails|contactNo = contactNo, name = name, type = type, position = position, notes = notes}
......
...@@ -27,7 +27,7 @@ manageIncidentInformation ws incidentNo ...@@ -27,7 +27,7 @@ manageIncidentInformation ws incidentNo
,(Embedded, \_ -> manageIncidentContacts ws incidentNo) ,(Embedded, \_ -> manageIncidentContacts ws incidentNo)
,(Embedded, \_ -> manageIncidentActions incidentNo) ,(Embedded, \_ -> manageIncidentActions incidentNo)
,(Embedded, \_ -> manageIncidentWeather incidentNo) ,(Embedded, \_ -> manageIncidentWeather incidentNo)
,(Embedded, \_ -> manageIncidentLog incidentNo) ,(Embedded, \_ -> manageIncidentLog incidentNo)
] [] <<@ ArrangeWithTabs False) ] [] <<@ ArrangeWithTabs False)
@! () @! ()
...@@ -101,7 +101,7 @@ manageIncidentActions incidentNo ...@@ -101,7 +101,7 @@ manageIncidentActions incidentNo
@! () @! ()
where where
selectAndWorkOnPlannedActions selectAndWorkOnPlannedActions
= (feedForward (chooseActionItem (Title "Overview") False True (sdsFocus incidentNo actionStatusesByIncident) /* <<@ AfterLayout (tweakUI fill) */) = (feedForward (chooseActionItem (Title "Overview") False True (sdsFocus incidentNo actionStatusesByIncident) /* <<@ AfterLayout (tweakUI fill) */)
(\s -> whileUnchanged s (\s -> whileUnchanged s
(\t -> case t of (\t -> case t of
Just taskId = workOnActionItem taskId Just taskId = workOnActionItem taskId
...@@ -152,7 +152,7 @@ where ...@@ -152,7 +152,7 @@ where
( enterInformation () [] @ string ( enterInformation () [] @ string
>>* [OnAction (Action "Add log message") (hasValue (\msg -> addLogMessage msg incidentNo))] >>* [OnAction (Action "Add log message") (hasValue (\msg -> addLogMessage msg incidentNo))]
) )
string :: String -> String string :: String -> String
string x = x string x = x
...@@ -350,7 +350,7 @@ createIncident incident ...@@ -350,7 +350,7 @@ createIncident incident
logIncidentCreated incidentNo incident logIncidentCreated incidentNo incident
@! incidentNo @! incidentNo
where where
create :: NewIncident -> Task IncidentNo create :: NewIncident -> Task IncidentNo
create {NewIncident|type,title,summary} create {NewIncident|type,title,summary}
= get databaseDef = get databaseDef
>>- \db -> sqlExecute db ["allIncidents"] (execInsert "INSERT INTO Incident (type,title,summary) VALUES (?,?,?)" >>- \db -> sqlExecute db ["allIncidents"] (execInsert "INSERT INTO Incident (type,title,summary) VALUES (?,?,?)"
......
...@@ -143,7 +143,7 @@ where ...@@ -143,7 +143,7 @@ where
# (err,cur) = execute "INSERT INTO PhoneCall (communicationNo,externalNo) VALUES (?,?)" # (err,cur) = execute "INSERT INTO PhoneCall (communicationNo,externalNo) VALUES (?,?)"
(flatten [toSQL communicationNo,mbToSQL externalNo]) cur (flatten [toSQL communicationNo,mbToSQL externalNo]) cur
| isJust err | isJust err
# (err,cur) = execute "UPDATE PhoneCall SET externalNo = ? WHERE communicationNo = ?" # (err,cur) = execute "UPDATE PhoneCall SET externalNo = ? WHERE communicationNo = ?"
(flatten [mbToSQL externalNo,toSQL communicationNo]) cur (flatten [mbToSQL externalNo,toSQL communicationNo]) cur
| isJust err = (Error (toString (fromJust err)),cur) | isJust err = (Error (toString (fromJust err)),cur)
= (Ok (), cur) = (Ok (), cur)
...@@ -193,7 +193,7 @@ where ...@@ -193,7 +193,7 @@ where
detailsIncidents :: (Maybe RowFilterDef) -> ReadOnlyShared [IncidentDetails] detailsIncidents :: (Maybe RowFilterDef) -> ReadOnlyShared [IncidentDetails]
detailsIncidents mbWhere = mapRead (map prj) (baseIncidents mbWhere) detailsIncidents mbWhere = mapRead (map prj) (baseIncidents mbWhere)
where where
prj {Incident|incidentNo,title,summary,type,phase} prj {Incident|incidentNo,title,summary,type,phase}
= {IncidentDetails|incidentNo=incidentNo,title=title,summary=summary,type=type,phase=phase} = {IncidentDetails|incidentNo=incidentNo,title=title,summary=summary,type=type,phase=phase}
...@@ -327,7 +327,7 @@ where ...@@ -327,7 +327,7 @@ where
, communications = fromMaybe [] ('DM'.get incident.Incident.incidentNo cmlinks) , communications = fromMaybe [] ('DM'.get incident.Incident.incidentNo cmlinks)
, log = log , log = log
} }
writePrj (incident=:{Incident|incidentNo,contacts,communications}) (((_,cnlinks),cmlinks),_) writePrj (incident=:{Incident|incidentNo,contacts,communications}) (((_,cnlinks),cmlinks),_)
= Just ((incident,'DM'.put incidentNo contacts cnlinks),'DM'.put incidentNo communications cmlinks) = Just ((incident,'DM'.put incidentNo contacts cnlinks),'DM'.put incidentNo communications cmlinks)
writePrj _ _ = Nothing writePrj _ _ = Nothing
...@@ -758,7 +758,7 @@ where ...@@ -758,7 +758,7 @@ where
# (err,mbRow,cur) = fetchOne cur # (err,mbRow,cur) = fetchOne cur
| isJust err = (Error (toString (fromJust err)),cur) | isJust err = (Error (toString (fromJust err)),cur)
= (Ok (fmap fromSQL mbRow), cur) = (Ok (fmap fromSQL mbRow), cur)
writeFun mmsi Nothing cur = (Ok (), cur) //Only write on Just writeFun mmsi Nothing cur = (Ok (), cur) //Only write on Just
writeFun mmsi (Just contact=:{Contact|contactNo,type,name,group,position,heading,track,positionUpdated,needsHelp,providesHelp,notes,status}) cur writeFun mmsi (Just contact=:{Contact|contactNo,type,name,group,position,heading,track,positionUpdated,needsHelp,providesHelp,notes,status}) cur
//Update contact info //Update contact info
...@@ -795,7 +795,7 @@ contactCommunicationMeans = sdsTranslate "contactCommunicationMeans" query (dbRe ...@@ -795,7 +795,7 @@ contactCommunicationMeans = sdsTranslate "contactCommunicationMeans" query (dbRe
where where
query contactNo = {columns=columns,rows=rows contactNo,order = Nothing} query contactNo = {columns=columns,rows=rows contactNo,order = Nothing}
rows contactNo = Just (EqualsValue ("communicationMeans1_communicationMeans2","communicationMeans2") [SQLVInteger contactNo]) rows contactNo = Just (EqualsValue ("communicationMeans1_communicationMeans2","communicationMeans2") [SQLVInteger contactNo])
columns = InnerJoin columnsCommunicationMean columns = InnerJoin columnsCommunicationMean
{name="communicationMeans1_communicationMeans2",alias="communicationMeans1_communicationMeans2",columns=[]} {name="communicationMeans1_communicationMeans2",alias="communicationMeans1_communicationMeans2",columns=[]}
("communicationMeans1_communicationMeans2","communicationMeans1") ("CommunicationMean","id") ("communicationMeans1_communicationMeans2","communicationMeans1") ("CommunicationMean","id")
...@@ -880,7 +880,7 @@ airplaneDetailsByNo = sdsTranslate "airplaneDetailsByNo" query (dbReadWriteOneSD ...@@ -880,7 +880,7 @@ airplaneDetailsByNo = sdsTranslate "airplaneDetailsByNo" query (dbReadWriteOneSD
where where
query contactNo = {columns=columnsAirplaneDetails,rows=Just (EqualsValue ("Airplane","contactNo") [SQLVInteger contactNo]), order=Nothing} query contactNo = {columns=columnsAirplaneDetails,rows=Just (EqualsValue ("Airplane","contactNo") [SQLVInteger contactNo]), order=Nothing}
helicopterDetailsByNo :: RWShared ContactNo HelicopterDetails HelicopterDetails helicopterDetailsByNo :: RWShared ContactNo HelicopterDetails HelicopterDetails
helicopterDetailsByNo = sdsTranslate "helicopterDetailsByNo" query (dbReadWriteOneSDS "helicopterDetailsByNo") helicopterDetailsByNo = sdsTranslate "helicopterDetailsByNo" query (dbReadWriteOneSDS "helicopterDetailsByNo")
where where
query contactNo = {columns=columnsHelicopterDetails,rows=Just (EqualsValue ("Helicopter","contactNo") [SQLVInteger contactNo]), order=Nothing} query contactNo = {columns=columnsHelicopterDetails,rows=Just (EqualsValue ("Helicopter","contactNo") [SQLVInteger contactNo]), order=Nothing}
...@@ -947,7 +947,7 @@ where ...@@ -947,7 +947,7 @@ where
writeFun mmsi (Just {AISContact|position,heading,track,lastPositionMsg,lastInfoMsg,positionUpdated,infoUpdated}) cur writeFun mmsi (Just {AISContact|position,heading,track,lastPositionMsg,lastInfoMsg,positionUpdated,infoUpdated}) cur
//Brute force upsert, try insert, if it fails, try update //Brute force upsert, try insert, if it fails, try update
# (res,cur) = execInsert "INSERT INTO AISContact (mmsi,position_lat,position_lon,position_desc,heading,track,lastPositionMsg,lastInfoMsg,positionUpdated,infoUpdated) VALUES (?,?,?,?,?,?,?,?,?,?)" # (res,cur) = execInsert "INSERT INTO AISContact (mmsi,position_lat,position_lon,position_desc,heading,track,lastPositionMsg,lastInfoMsg,positionUpdated,infoUpdated) VALUES (?,?,?,?,?,?,?,?,?,?)"
(flatten [toSQL mmsi, mbToSQL position, mbToSQL heading, mbToSQL track, mbToSQL lastPositionMsg, mbToSQL lastInfoMsg,mbToSQL positionUpdated, mbToSQL infoUpdated]) cur (flatten [toSQL mmsi, mbToSQL position, mbToSQL heading, mbToSQL track, mbToSQL lastPositionMsg, mbToSQL lastInfoMsg,mbToSQL positionUpdated, mbToSQL infoUpdated]) cur
| res=:(Error _) //Try update | res=:(Error _) //Try update
......
...@@ -141,7 +141,7 @@ manageUsers = forever (catchAll ( ...@@ -141,7 +141,7 @@ manageUsers = forever (catchAll (
) (\e -> viewInformation "Error" [] e >>| return ())) ) (\e -> viewInformation "Error" [] e >>| return ()))
where where
manageExistingUsers manageExistingUsers
= (enterChoiceWithSharedAs () [ChooseFromGrid id] allContactsShort contactIdentity = (enterChoiceWithSharedAs () [ChooseFromGrid id] allContactsShort contactIdentity
>&> withSelection viewNoSelection manageContactAccess >&> withSelection viewNoSelection manageContactAccess
)<<@ ArrangeWithSideBar 0 LeftSide 200 True )<<@ ArrangeWithSideBar 0 LeftSide 200 True
...@@ -222,7 +222,7 @@ configureMaps ...@@ -222,7 +222,7 @@ configureMaps
where where
previewMapLayers :: Task ContactMapPerspective previewMapLayers :: Task ContactMapPerspective
previewMapLayers = withShared defaultValue previewMapLayers = withShared defaultValue
\perspective -> updateSharedInformation (Title "Preview") [UpdateAs toPrj fromPrj] (perspective >*| standardMapLayers) <<@ ApplyLayout flexMap @ fst \perspective -> updateSharedInformation (Title "Preview") [UpdateAs toPrj fromPrj] (perspective >*| standardMapLayers) <<@ ApplyLayout flexMap @ fst
where where
toPrj (perspective,layers) = toLeafletMap {ContactMap|defaultValue & perspective=perspective,layers=layers} toPrj (perspective,layers) = toLeafletMap {ContactMap|defaultValue & perspective=perspective,layers=layers}
fromPrj _ {LeafletMap|perspective} = fromLeafletPerspective perspective fromPrj _ {LeafletMap|perspective} = fromLeafletPerspective perspective
...@@ -258,7 +258,7 @@ where ...@@ -258,7 +258,7 @@ where
) (\e -> viewInformation "Failed import of web links" [] e @! ()) ) (\e -> viewInformation "Failed import of web links" [] e @! ())
) <<@ Title "Import web links" ) <<@ Title "Import web links"
where where
instructions = toString instructions = toString
(PTag [] [Text "Please select a JSON export file to upload.",BrTag [] (PTag [] [Text "Please select a JSON export file to upload.",BrTag []
,Text "The file needs to be formatted like ",ATag [HrefAttr "/demo-content/weblinks.json",TargetAttr "_blank"] [Text "weblinks.json"] ,Text "The file needs to be formatted like ",ATag [HrefAttr "/demo-content/weblinks.json",TargetAttr "_blank"] [Text "weblinks.json"]
]) ])
......
...@@ -40,7 +40,7 @@ where ...@@ -40,7 +40,7 @@ where
/* /*
* The incident dashboard gives an overview of all open incidents, * The incident dashboard gives an overview of all open incidents,
* provides ad-hoc creation of new incidents and provides * provides ad-hoc creation of new incidents and provides
* a way to open the incident information browsing incident task for open incidents. * a way to open the incident information browsing incident task for open incidents.
*/ */
browseIncidents :: Workspace -> Task () browseIncidents :: Workspace -> Task ()
...@@ -91,7 +91,7 @@ where ...@@ -91,7 +91,7 @@ where
{ status :: Maybe String { status :: Maybe String
, title :: Maybe String , title :: Maybe String
, createdOn :: Maybe String , createdOn :: Maybe String
, createdBy :: Maybe String , createdBy :: Maybe String
} }
derive class iTask ActionSet, ActionShort derive class iTask ActionSet, ActionShort
......
...@@ -47,7 +47,7 @@ definition module Incidone.Util.AIS ...@@ -47,7 +47,7 @@ definition module Incidone.Util.AIS
, day :: Int // Day , day :: Int // Day
, hour :: Int // Hour , hour :: Int // Hour
, minute :: Int // Minute , minute :: Int // Minute
, second :: Int // Second , second :: Int // Second
, accuracy :: Bool // Fix quality , accuracy :: Bool // Fix quality
, lon :: Int // Longitude , lon :: Int // Longitude
, lat :: Int // Latitude , lat :: Int // Latitude
......
...@@ -56,7 +56,7 @@ TESTMESSAGES :== ...@@ -56,7 +56,7 @@ TESTMESSAGES :==
, day :: Int // Day , day :: Int // Day
, hour :: Int // Hour , hour :: Int // Hour
, minute :: Int // Minute , minute :: Int // Minute
, second :: Int // Second , second :: Int // Second
, accuracy :: Bool // Fix quality , accuracy :: Bool // Fix quality
, lon :: Int // Longitude , lon :: Int // Longitude
, lat :: Int // Latitude , lat :: Int // Latitude
...@@ -113,7 +113,7 @@ where ...@@ -113,7 +113,7 @@ where
= ([f6],remainder) = ([f6],remainder)
| otherwise | otherwise
# (fragments,remainder) = decodeWrapper remainder # (fragments,remainder) = decodeWrapper remainder
= ([f6:fragments],remainder) = ([f6:fragments],remainder)
_ = ([],remainder) _ = ([],remainder)
//Decode the message data //Decode the message data
...@@ -138,7 +138,7 @@ where ...@@ -138,7 +138,7 @@ where
initMessage 4 = AIVDM4 initType4 initMessage 4 = AIVDM4 initType4
initMessage 5 = AIVDM5 initType5 initMessage 5 = AIVDM5 initType5
initMessage i = AIVDM i initMessage i = AIVDM i
initCNB type = {msgtype=type,repeat=0,mmsi=0,status=0,turn=0,speed=0,accuracy=False initCNB type = {msgtype=type,repeat=0,mmsi=0,status=0,turn=0,speed=0,accuracy=False
,lon=0,lat=0,course=0,heading=0,second=0,maneuver=0,raim=False,radio=0} ,lon=0,lat=0,course=0,heading=0,second=0,maneuver=0,raim=False,radio=0}
initType4 = {msgtype=4,repeat=0,mmsi=0,year=0,month=0,day=0,hour=0,minute=0 initType4 = {msgtype=4,repeat=0,mmsi=0,year=0,month=0,day=0,hour=0,minute=0
...@@ -206,7 +206,7 @@ where ...@@ -206,7 +206,7 @@ where
updMMSI i (AIVDM4 m) = AIVDM4 {AIVDM4|m & mmsi = i} updMMSI i (AIVDM4 m) = AIVDM4 {AIVDM4|m & mmsi = i}
updMMSI i (AIVDM5 m) = AIVDM5 {AIVDM5|m & mmsi = i} updMMSI i (AIVDM5 m) = AIVDM5 {AIVDM5|m & mmsi = i}
updMMSI i msg = msg updMMSI i msg = msg
updCNB f i (AIVDM1 m) = AIVDM1 (f i m) updCNB f i (AIVDM1 m) = AIVDM1 (f i m)
updCNB f i (AIVDM2 m) = AIVDM2 (f i m) updCNB f i (AIVDM2 m) = AIVDM2 (f i m)
updCNB f i (AIVDM3 m) = AIVDM3 (f i m) updCNB f i (AIVDM3 m) = AIVDM3 (f i m)
......
...@@ -4,7 +4,7 @@ import iTasks.Extensions.DateTime ...@@ -4,7 +4,7 @@ import iTasks.Extensions.DateTime
import Text, System.Time import Text, System.Time
import Incidone.Util.TaskPatterns import Incidone.Util.TaskPatterns
//Notifications are stored newest first //Notifications are stored newest first
notifications :: Shared [(DateTime,String)] notifications :: Shared [(DateTime,String)]
notifications = sharedStore "notifications" [] notifications = sharedStore "notifications" []
...@@ -15,7 +15,7 @@ where ...@@ -15,7 +15,7 @@ where
prj (now,notifications) = [toString dt +++ msg \\ (dt,msg) <- notifications | limit now dt ] prj (now,notifications) = [toString dt +++ msg \\ (dt,msg) <- notifications | limit now dt ]
limit t1 t2 = False //FIXME: We need an non-pure function to convert the datetime values, we can't do that with a mapRead... limit t1 t2 = False //FIXME: We need an non-pure function to convert the datetime values, we can't do that with a mapRead...
/* /*
# (Timestamp s1) = datetimeToTimestamp t1 # (Timestamp s1) = datetimeToTimestamp t1
# (Timestamp s2) = datetimeToTimestamp t2 # (Timestamp s2) = datetimeToTimestamp t2
= s1 - s2 < 3 = s1 - s2 < 3
*/ */
......
...@@ -23,7 +23,7 @@ createNewIncident :: Task (Maybe IncidentNo) ...@@ -23,7 +23,7 @@ createNewIncident :: Task (Maybe IncidentNo)
createNewIncident createNewIncident
= enterInformation ("Create new incident", "Fill in the following basic information to create a new incident") [] = enterInformation ("Create new incident", "Fill in the following basic information to create a new incident") []
>>? createIncident >>? createIncident
createNewContact :: Task (Maybe ContactNo) createNewContact :: Task (Maybe ContactNo)
createNewContact createNewContact
= enterInformation ("New contact","Enter the basic information of the new contact") [] = enterInformation ("New contact","Enter the basic information of the new contact") []
...@@ -167,7 +167,7 @@ manageSharedListWithDetails :: (Int -> Task ()) (Task Int) (Shared [Int]) -> Tas ...@@ -167,7 +167,7 @@ manageSharedListWithDetails :: (Int -> Task ()) (Task Int) (Shared [Int]) -> Tas
manageSharedListWithDetails detailsTask addTask refsList //Not the best implementation, but good enough for now manageSharedListWithDetails detailsTask addTask refsList //Not the best implementation, but good enough for now
= get refsList = get refsList
>>- \initList -> >>- \initList ->
parallel ([(Embedded, removeWhenStable (detailsTask i)) \\ i <- initList] ++ [(Embedded,add)]) [] parallel ([(Embedded, removeWhenStable (detailsTask i)) \\ i <- initList] ++ [(Embedded,add)]) []