Commit 1ef5f3ae authored by Bas Lijnse's avatar Bas Lijnse

Made Incidone compile again

parent 3f9a7af8
......@@ -10,7 +10,7 @@ import Incidone.OP.Concepts, Incidone.OP.SDSs, Incidone.OP.Conversions
import Incidone.OP.IncidentManagementTasks, Incidone.OP.ContactManagementTasks, Incidone.OP.CommunicationManagementTasks
import qualified Data.Map as DM
import Data.Tuple, Data.Functor, Data.List, Text, Text.HTML
import Data.Tuple, Data.Functor, Data.List, Data.Either, Text, Text.HTML
//Extensions
import Incidone.Extensions.CrewLists
......@@ -43,7 +43,7 @@ where
filterFun contactNo (_,_,{ActionStatus|contacts}) = isMember contactNo contacts
actionStatusesOfCurrentContact :: ROShared () [(InstanceNo,InstanceNo,ActionStatus)]
actionStatusesOfCurrentContact = sdsSequence "actionStatusesOfCurrentContact" (\_ r -> r) snd writel writer currentUserContactNo actionStatusesByContact
actionStatusesOfCurrentContact = sdsSequence "actionStatusesOfCurrentContact" id (\_ r -> r) (\_ _ -> Right snd) writel writer currentUserContactNo actionStatusesByContact
where
writel = SDSWriteConst (\_ _ -> Ok Nothing)
writer = SDSWriteConst (\_ _ -> Ok Nothing)
......@@ -100,7 +100,7 @@ fromSelfActionStatus status (_,items) = case [i \\ i=:{TaskListItem|taskId,self}
[{TaskListItem|taskId,attributes}:_] = Ok (Just [(taskId,fromActionStatus status attributes)])
_ = Error (exception "Task id not found in self management share")
selfActionStatus :: (SharedTaskList a) -> Shared ActionStatus
selfActionStatus :: (SharedTaskList a) -> Shared ActionStatus | iTask a
selfActionStatus list = sdsFocus taskListFilter (mapReadWriteError (toSelfActionStatus,fromSelfActionStatus) list)
where
taskListFilter = {TaskListFilter|onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False
......
implementation module Incidone.ContactPosition
import iTasks, iTasks.UI.Editor, iTasks.UI.Editor.Builtin, iTasks.UI.Editor.Combinators, 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 Data.Functor, Data.List, Text
import qualified Text.Parsers.ZParsers.ParsersKernel as PK
......@@ -15,7 +15,7 @@ import Incidone.Util.TaskPatterns
derive JSONEncode ContactPosition
derive JSONDecode ContactPosition
gEditor{|ContactPosition|} = liftEditor printPosition parsePosition (textField 'DM'.newMap)
gEditor{|ContactPosition|} = bijectEditorValue printPosition parsePosition textField
gText{|ContactPosition|} _ val = [maybe "" printPosition val]
derive gDefault ContactPosition
......
......@@ -90,7 +90,7 @@ composeEmailMessage communicationNo
>>| updateMessageMeta communicationNo
||- ((composeAndSendMessage communicationNo message transmitEmailMessage
-&&-
relateMessageToIncidents communicationNo) <<@ ArrangeWithTabs)
relateMessageToIncidents communicationNo) <<@ ArrangeWithTabs True)
<<@ ArrangeWithSideBar 0 TopSide 60 False
<<@ Title "Compose E-mail"
/* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600) ) */ //FIXME
......@@ -105,7 +105,7 @@ composeP2000Message communicationNo
>>| updateMessageMeta communicationNo
||- ((composeAndSendMessage communicationNo message transmitP2000Message
-&&-
relateMessageToIncidents communicationNo) <<@ ArrangeWithTabs)
relateMessageToIncidents communicationNo) <<@ ArrangeWithTabs True)
<<@ ArrangeWithSideBar 0 TopSide 60 False
<<@ Title "Compose P2000 message"
/* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600)) */ //FIXME
......@@ -290,7 +290,7 @@ manageLinkedIncidentInfo incidentNo
manageVoiceCallContent :: CommunicationType CommunicationNo -> Task ()
manageVoiceCallContent type communicationNo
= updateCallNotes -|| relateMessageToIncidents communicationNo <<@ ArrangeWithTabs
= updateCallNotes -|| relateMessageToIncidents communicationNo <<@ ArrangeWithTabs True
where
updateCallNotes
= updateSharedInformation (Title "Notes") [] (callNotes type) //<<@ FillNotes //FIXME
......
......@@ -44,4 +44,4 @@ deleteCommunicationMean :: CommunicationMeanId -> Task ()
//Check credentials for contacts that can log in
verifyContactCredentials :: Credentials -> Task (Maybe User)
viewContactsOnMap :: (ReadWriteShared [ContactGeo] w) (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI)
viewContactsOnMap :: (ReadWriteShared [ContactGeo] w) (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | iTask w
......@@ -7,9 +7,10 @@ import Incidone.Util.TaskPatterns
import Incidone.DeviceBased.VideoWall
import Incidone.Extensions.CrewLists //For demo
import qualified Data.Map as DM
import Text, Text.HTML, Data.Either
import iTasks.UI.Editor.Builtin
import Text, Text.HTML, Data.Either, Data.Functor
import iTasks.UI.Editor.Controls
CONVERT_BIN :== "/opt/local/bin/convert"
//CONVERT_BIN :== "/usr/bin/convert"
......@@ -23,7 +24,7 @@ selectContact = withShared Nothing
(selectContactFromLists sel <<@ Title "Browse")
-||-
(viewContactsOnMap mapContacts sel <<@ Title "Map")
<<@ ArrangeWithTabs
<<@ ArrangeWithTabs True
)
where
mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |+| contactsProvidingHelpGeo)
......@@ -92,7 +93,7 @@ manageContactInformation ws contactNo
,manageContactIncidents ws contactNo
,manageContactActions False contactNo
,manageContactCrew` contactNo <<@ Title "Crew"
] <<@ ArrangeWithTabs) @! ()
] <<@ ArrangeWithTabs True) @! ()
where
viewTitle contactNo = viewSharedTitle (mapRead contactTitle (sdsFocus contactNo contactByNo))
......@@ -551,7 +552,7 @@ verifyContactCredentials credentials
= get (sdsFocus credentials contactByCredentials)
@ fmap contactUser
viewContactsOnMap :: (ReadWriteShared [ContactGeo] w) (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI)
viewContactsOnMap :: (ReadWriteShared [ContactGeo] w) (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | iTask w
viewContactsOnMap sharedContacts sel
= get (standardMapLayers |+| standardPerspective)
>>- \(baseLayers,perspective) ->
......@@ -567,10 +568,10 @@ where
mapState :: (Shared (Bool,ContactMapPerspective))
(ReadWriteShared [ContactGeo] w)
(Shared (Maybe (Either ContactNo MMSI))) ->
ReadWriteShared ([(Bool,ContactGeo)], Maybe (Either ContactNo MMSI), ContactMapPerspective) (Maybe (Either ContactNo MMSI), ContactMapPerspective)
mapState local contacts sel = sdsSequence "mapState" (\_ r -> r) read writel writer (local >+< sel) mapContacts
ReadWriteShared ([(Bool,ContactGeo)], Maybe (Either ContactNo MMSI), ContactMapPerspective) (Maybe (Either ContactNo MMSI), ContactMapPerspective) | iTask w
mapState local contacts sel = sdsSequence "mapState" id (\_ r -> r) (\_ _ -> Right read) writel writer (local >+< sel) mapContacts
where
mapContacts = sdsSelect "mapContacts" choose (\_ _ _ _ -> False) (\_ _ _ _ -> False) withoutAISContacts withAISContacts
mapContacts = sdsSelect "mapContacts" choose (SDSNotifyConst (\_ _ _ -> False)) (SDSNotifyConst (\_ _ _ -> False)) withoutAISContacts withAISContacts
where
choose ((withAIS,{ContactMapPerspective|bounds=Just bounds}),_) = (if withAIS (Right bounds) (Left bounds))
choose _ = (Left defaultValue)
......
......@@ -28,7 +28,7 @@ manageIncidentInformation ws incidentNo
,(Embedded, \_ -> manageIncidentActions incidentNo)
,(Embedded, \_ -> manageIncidentWeather incidentNo)
,(Embedded, \_ -> manageIncidentLog incidentNo)
] [] <<@ ArrangeWithTabs)
] [] <<@ ArrangeWithTabs False)
@! ()
//Basic incident information (title, summary, type, phase etc..)
......
......@@ -5,14 +5,14 @@ import qualified Data.Map as DM
import Incidone.Configuration
import Incidone.OP.Concepts, Incidone.OP.Conversions
import Incidone.Util.SQLSDS
import Data.Functor
import Data.Functor, Data.Either
derive class iTask ContactFilter
dbReadSDS :: String -> ROShared QueryDef [r] | mbFromSQL r
dbReadSDS :: String -> ROShared QueryDef [r] | mbFromSQL r & TC r
dbReadSDS notifyId = databaseDef >++> sqlReadSDS notifyId
dbReadWriteOneSDS :: String -> RWShared QueryDef r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
dbReadWriteOneSDS :: String -> RWShared QueryDef r r | mbFromSQL, mbToSQL r & gDefault{|*|} r & TC r
dbReadWriteOneSDS notifyId = databaseDef >++> sqlReadWriteOneSDS notifyId
dbLinkSDS :: String String String String -> RWShared (Maybe [Int]) [(Int,Int)] [(Int,Int)]
......@@ -481,7 +481,7 @@ where
query group = Just (EqualsValue ("Contact","group") (toSQL group))
contactsOfOpenIncidentsShort :: ROShared () [ContactShortWithIncidents]
contactsOfOpenIncidentsShort = sdsSequence "contactsOfOpenIncidentsShort" param read writel writer contactsOfOpenIncidentsShortBase openIncidentsByContactsShortIndexed
contactsOfOpenIncidentsShort = sdsSequence "contactsOfOpenIncidentsShort" id param (\_ _ -> Right read) writel writer contactsOfOpenIncidentsShortBase openIncidentsByContactsShortIndexed
where
writel = SDSWriteConst (\_ _ -> Ok Nothing)
writer = SDSWriteConst (\_ _ -> Ok Nothing)
......@@ -828,7 +828,8 @@ where
_ = Nothing
contactAIS :: ROShared ContactNo (Maybe AISContact)
contactAIS = sdsSequence "contactAIS" (\_ mbMMSI -> mbMMSI) snd (SDSWriteConst (\_ _ -> Ok Nothing)) (SDSWriteConst (\_ w -> Ok (Just w))) contactMMSI (roMaybe (toReadOnly AISContactByMMSI))
contactAIS = sdsSequence "contactAIS" id (\_ mbMMSI -> mbMMSI) (\_ _ -> Right snd) (SDSWriteConst (\_ _ -> Ok Nothing)) (SDSWriteConst (\_ w -> Ok (Just w)))
contactMMSI (roMaybe (toReadOnly AISContactByMMSI))
contactCommunications :: ROShared ContactNo [CommunicationDetails]
contactCommunications = sdsTranslate "contactCommunications" cond filteredCommunications
......@@ -957,7 +958,7 @@ where
= (Ok (),cur)
currentUserAvatar :: ROShared () (Maybe ContactAvatar)
currentUserAvatar = sdsSequence "userContactNo" (\_ u -> userContactNo u) snd writel writer currentUser (roMaybe (mapRead Just (toReadOnly contactAvatar)))
currentUserAvatar = sdsSequence "userContactNo" id (\_ u -> userContactNo u) (\_ _ -> Right snd) writel writer currentUser (roMaybe (mapRead Just (toReadOnly contactAvatar)))
where
writel = SDSWriteConst (\_ _ -> Ok Nothing)
writer = SDSWriteConst (\_ _ -> Ok Nothing)
......
......@@ -61,7 +61,7 @@ where
-||-
(enterChoiceWithSharedAs (Title "Recent incidents")
[ChooseFromGrid id] recentIncidentsDetails (\{IncidentDetails|incidentNo} -> incidentNo) /* <<@ AfterLayout (tweakUI fill) */) //FIXME
) <<@ ArrangeWithTabs
) <<@ ArrangeWithTabs True
browseContacts :: Workspace -> Task ()
browseContacts ws
......
......@@ -13,10 +13,12 @@ currentNotifications :: ReadOnlyShared [String]
currentNotifications = mapRead prj (currentDateTime |*| notifications)
where
prj (now,notifications) = [toString dt +++ msg \\ (dt,msg) <- notifications | limit now dt ]
limit t1 t2
# (Timestamp s1) = datetimeToTimestamp t1
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 s2) = datetimeToTimestamp t2
= s1 - s2 < 3
*/
addNotification :: String -> Task ()
addNotification msg
......
......@@ -56,7 +56,7 @@ toOrderBySQL :: [RowOrderDef] -> String
fromSQLWithId :: [SQLValue] -> (Int,a) | mbFromSQL a
(>++>) infixl 6 :: (RWShared () SQLDatabaseDef SQLDatabaseDef) (RWShared (SQLDatabaseDef,p) r w) -> RWShared p r w | iTask p
(>++>) infixl 6 :: (RWShared () SQLDatabaseDef SQLDatabaseDef) (RWShared (SQLDatabaseDef,p) r w) -> RWShared p r w | iTask p & TC r & TC w
sqlReadSDS :: String -> ROShared (SQLDatabaseDef,QueryDef) [r] | mbFromSQL r
sqlReadWriteOneSDS :: String -> RWShared (SQLDatabaseDef,QueryDef) r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
......@@ -64,4 +64,4 @@ sqlLinkSDS :: String String String String-> RWShared (SQLDatabaseDef,Ma
groupByFst :: [(a,b)] -> Map a [b] | Eq a & Ord a
ungroupByFst :: (Map a [b]) -> [(a,b)]
roMaybe :: (RWShared p (Maybe r) ()) -> RWShared (Maybe p) (Maybe r) () | iTask p
roMaybe :: (RWShared p (Maybe r) ()) -> RWShared (Maybe p) (Maybe r) () | iTask p & TC r
......@@ -147,8 +147,8 @@ fromSQLWithId :: [SQLValue] -> (Int,a) | mbFromSQL a
fromSQLWithId row = (fromSQL [last row],fromSQL (init row))
//UTIL SDS Combinators
(>++>) infixl 6 :: (RWShared () SQLDatabaseDef SQLDatabaseDef) (RWShared (SQLDatabaseDef,p) r w) -> RWShared p r w | iTask p
(>++>) db sds = sdsSequence ">++>" (\p db -> (db,p)) snd (SDSWriteConst (\_ _ -> Ok Nothing)) (SDSWriteConst (\_ w -> Ok (Just w))) (sdsFocus () db) sds
(>++>) infixl 6 :: (RWShared () SQLDatabaseDef SQLDatabaseDef) (RWShared (SQLDatabaseDef,p) r w) -> RWShared p r w | iTask p & TC r & TC w
(>++>) db sds = sdsSequence ">++>" id (\p db -> (db,p)) (\_ _ -> Right snd) (SDSWriteConst (\_ _ -> Ok Nothing)) (SDSWriteConst (\_ w -> Ok (Just w))) (sdsFocus () db) sds
sqlReadSDS :: String -> ROShared (SQLDatabaseDef,QueryDef) [r] | mbFromSQL r
sqlReadSDS notifyId = sqlShare notifyId readFun writeFun
......@@ -231,8 +231,8 @@ where
ungroupByFst :: (Map a [b]) -> [(a,b)]
ungroupByFst index = flatten [[(a,b) \\ b <- bs] \\ (a,bs) <- 'DM'.toList index]
roMaybe :: (RWShared p (Maybe r) ()) -> RWShared (Maybe p) (Maybe r) () | iTask p
roMaybe sds = sdsSelect "roMaybe" choose (\_ _ _ _ -> False) (\_ _ _ _ -> False) (constShare Nothing) sds
roMaybe :: (RWShared p (Maybe r) ()) -> RWShared (Maybe p) (Maybe r) () | iTask p & TC r
roMaybe sds = sdsSelect "roMaybe" choose (SDSNotifyConst (\_ _ _ -> False)) (SDSNotifyConst (\_ _ _ -> False)) (constShare Nothing) sds
where
choose Nothing = Left ()
choose (Just p) = Right p
......
......@@ -14,10 +14,10 @@ createNewIncident :: Task (Maybe IncidentNo)
createNewContact :: Task (Maybe ContactNo)
indexedStore :: String v -> RWShared k v v | Eq k & Ord k & iTask k & iTask v
sdsDeref :: (RWShared p [a] [a]) (a -> Int) (RWShared [Int] [b] x) ([a] [b] -> [c]) -> (RWShared p [c] [a])
sdsDeref :: (RWShared p [a] [a]) (a -> Int) (RWShared [Int] [b] x) ([a] [b] -> [c]) -> (RWShared p [c] [a]) | iTask p & TC a & TC b & TC c & TC x
// Information management
viewDetails :: !d (ReadOnlyShared (Maybe i)) (RWShared i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v
viewDetails :: !d (ReadOnlyShared (Maybe i)) (RWShared i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v & iTask c
optionalNewOrOpen :: (String,Task ()) (String,i -> Task ()) Workspace (ReadOnlyShared (Maybe i)) -> Task () | iTask i
......
......@@ -3,7 +3,7 @@ implementation module Incidone.Util.TaskPatterns
import iTasks, iTasks.Extensions.Dashboard
import iTasks.UI.Definition
import Incidone.OP.IncidentManagementTasks, Incidone.OP.ContactManagementTasks
import Text, Data.Functor, Data.Either
import Text, Data.Functor, Data.Either, Data.Maybe
import qualified Data.Map as DM
import StdMisc
......@@ -35,25 +35,32 @@ where
read p mapping = fromMaybe def ('DM'.get p mapping)
write p mapping v = ('DM'.put p v mapping,(==) p)
sdsDeref :: (RWShared p [a] [a]) (a -> Int) (RWShared [Int] [b] x) ([a] [b] -> [c]) -> (RWShared p [c] [a])
sdsDeref sds1 toRef sds2 merge = sdsSequence "sdsDeref" (\_ r -> map toRef r) read writel writer sds1 sds2
sdsDeref :: (RWShared p [a] [a]) (a -> Int) (RWShared [Int] [b] x) ([a] [b] -> [c]) -> (RWShared p [c] [a]) | iTask p & TC a & TC b & TC c & TC x
sdsDeref sds1 toRef sds2 merge = sdsSequence "sdsDeref" paraml paramr (\_ _ -> Right read) writel writer sds1 sds2
where
paraml p = p
paramr p r1 = map toRef r1
param _ r = (\_ r -> map toRef r)
read (as,bs) = merge as bs
writel = SDSWriteConst (\_ w -> Ok (Just w))
writer = SDSWriteConst (\_ _ -> Ok Nothing)
viewDetails :: !d (ReadOnlyShared (Maybe i)) (RWShared i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v
viewDetails desc sel target prj = viewSharedInformation desc [] (mapRead (fmap prj) targetShare)
viewDetails :: !d (ReadOnlyShared (Maybe i)) (RWShared i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v & iTask c
viewDetails desc sel target prj = viewSharedInformation desc [] (mapRead (fmap prj) (targetShare sel target))
where
targetShare = sdsSequence "viewDetailsSeq" (\_ i -> i) snd writel writer sel valueShare
targetShare :: (RWShared () (Maybe i) ()) (RWShared i c c) -> RWShared () (Maybe c) () | iTask i & iTask c
targetShare sel target = sdsSequence "viewDetailsSeq" id (\_ i -> i) (\_ _ -> Right snd) writel writer sel (valueShare target)
where
writel = SDSWriteConst (\_ _ -> Ok Nothing)
writer = SDSWriteConst (\_ _ -> Ok Nothing)
valueShare = sdsSelect "viewDetailsValue" param (\_ _ _ _ -> False) (\_ _ _ _ -> False) (constShare Nothing) (mapRead Just (toReadOnly target))
param Nothing = Left ()
param (Just i) = Right i
valueShare :: (RWShared i c c) -> RWShared (Maybe i) (Maybe c) () | iTask i & iTask c
valueShare target = sdsSelect "viewDetailsValue" param (SDSNotifyConst (\_ _ _ -> False)) (SDSNotifyConst (\_ _ _ -> False))
(constShare Nothing) (mapRead Just (toReadOnly target))
where
param Nothing = Left ()
param (Just i) = Right i
optionalNewOrOpen :: (String,Task ()) (String,i -> Task ()) Workspace (ReadOnlyShared (Maybe i)) -> Task () | iTask i
optionalNewOrOpen (newLabel,newTask) (openLabel,openTask) ws selection
......
......@@ -88,7 +88,7 @@ where
>>* [OnAction (Action "Log out") (always (return ()))]
) <<@ ApplyLayout layoutControlDash
workOnTasks = doIndependent tasks <<@ ArrangeWithTabs
workOnTasks = doIndependent tasks <<@ ArrangeWithTabs True
layoutControlDash = foldl1 sequenceLayouts
[moveSubUIs (SelectByPath [0,0]) [] 1
......
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