Commit b8b732f8 authored by Haye Böhm's avatar Haye Böhm

Some steps towards fixing InciDone

parent 6f4f6f10
Pipeline #13777 failed with stage
in 1 minute and 31 seconds
......@@ -15,10 +15,10 @@ import Incidone.OP.Concepts
// are limited by what can be constructed with the user catalog editor.
//Wrapped action for usage in action plans
:: ActionDefinition c
:: ActionDefinition c sds
= { identity :: String
, meta :: ItemMeta
, task :: c (Shared ActionStatus) -> Task ()
, task :: c (sds () ActionStatus ActionStatus) -> Task ()
}
//Wrapped action for storage in the action catalog
:: CatalogAction =
......@@ -33,9 +33,9 @@ import Incidone.OP.Concepts
}
:: ActionTasks
= E.c: ActionTasks
= E.c sds: ActionTasks
([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 (sds () ActionStatus ActionStatus) -> Task ()) & iTask c & RWShared sds //An action item that needs to be configured before it can be deployed
:: ActionProgress
= ActionPlanned
......@@ -144,45 +144,45 @@ derive gDefault CatalogAction
derive gText CatalogAction
derive gEditor CatalogAction
toInstantAction :: c ActionProgress [ContactNo] [IncidentNo] (ActionDefinition c) -> CatalogAction | iTask c
toConfigurableAction :: ([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) (ActionDefinition c) -> CatalogAction | iTask c
toContactAction :: (Maybe String) (ActionDefinition ContactNo) -> CatalogAction
toIncidentAction :: (ActionDefinition IncidentNo) -> CatalogAction
toContactForIncidentAction :: (Maybe String) (ActionDefinition (ContactNo,IncidentNo)) -> CatalogAction
toInstantAction :: c ActionProgress [ContactNo] [IncidentNo] (ActionDefinition c sds) -> CatalogAction | iTask c & RWShared sds
toConfigurableAction :: ([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) (ActionDefinition c sds) -> CatalogAction | iTask c & RWShared sds
toContactAction :: (Maybe String) (ActionDefinition ContactNo sds) -> CatalogAction | RWShared sds
toIncidentAction :: (ActionDefinition IncidentNo sds) -> CatalogAction | RWShared sds
toContactForIncidentAction :: (Maybe String) (ActionDefinition (ContactNo,IncidentNo) sds) -> CatalogAction | RWShared sds
forIncident :: IncidentNo (ActionDefinition (ContactNo,IncidentNo)) -> ActionDefinition ContactNo
forIncident :: IncidentNo (ActionDefinition (ContactNo,IncidentNo) sds) -> ActionDefinition ContactNo sds | RWShared sds
addDefaultStatus :: (Task c) -> ([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) | iTask c
//Shared catalog of predefined action items
actionCatalog :: ReadOnlyShared [CatalogAction]
builtinActionCatalog :: ReadOnlyShared [CatalogAction]
userActionCatalog :: Shared [UserCatalogAction]
actionCatalog :: SDSLens () [CatalogAction] ()
builtinActionCatalog :: SDSLens () [CatalogAction] ()
userActionCatalog :: SDSLens () [UserCatalogAction] [UserCatalogAction]
//Shares providing filtered views on iTasks task instances.
//They select only those detached tasks that are tagged to be action items
actionStatuses :: ROShared () [(InstanceNo,InstanceNo,ActionStatus)] //(Instance no, parent instance no, status)
actionStatusesByIncident :: ROShared IncidentNo [(InstanceNo,InstanceNo,ActionStatus)]
actionStatusesByContact :: ROShared ContactNo [(InstanceNo,InstanceNo,ActionStatus)]
actionStatusesOfCurrentContact :: ROShared () [(InstanceNo,InstanceNo,ActionStatus)]
actionStatuses :: SDSLens () [(InstanceNo,InstanceNo,ActionStatus)] () //(Instance no, parent instance no, status)
actionStatusesByIncident :: SDSLens IncidentNo [(InstanceNo,InstanceNo,ActionStatus)] ()
actionStatusesByContact :: SDSLens ContactNo [(InstanceNo,InstanceNo,ActionStatus)] ()
actionStatusesOfCurrentContact :: SDSSequence () [(InstanceNo,InstanceNo,ActionStatus)] ()
actionStatusByNo :: RWShared InstanceNo ActionStatus ActionStatus
actionStatusByNo :: SDSLens InstanceNo ActionStatus ActionStatus
numActionsByContact :: ROShared ContactNo Int
numActionsByContact :: SDSLens ContactNo Int ()
//Todo items
todoItemTask :: () (Shared ActionStatus) -> Task ()
todoItemTask :: () (sds () ActionStatus ActionStatus) -> Task () | RWShared sds
blankTodoItem :: CatalogAction
predefinedTodoItem :: String ItemMeta -> CatalogAction
predefinedInstantItem :: String ItemMeta ActionProgress ((Shared ActionStatus) -> Task a) -> CatalogAction| iTask a
predefinedConfigurableItem :: String ItemMeta ([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) (c (Shared ActionStatus) -> Task a) -> CatalogAction | iTask a & iTask c
predefinedInstantItem :: String ItemMeta ActionProgress ((sds () ActionStatus ActionStatus) -> Task a) -> CatalogAction | iTask a & RWShared sds
predefinedConfigurableItem :: String ItemMeta ([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) (c (sds () ActionStatus ActionStatus) -> Task a) -> CatalogAction | iTask a & iTask c & RWShared sds
//Contact or incident
predefinedIncidentItem :: String ItemMeta (IncidentNo (Shared ActionStatus) -> Task a) -> CatalogAction | iTask a
predefinedContactItem :: String ItemMeta (Maybe String) (ContactNo (Shared ActionStatus) -> Task a) -> CatalogAction | iTask a
predefinedIncidentItem :: String ItemMeta (IncidentNo (sds () ActionStatus ActionStatus) -> Task a) -> CatalogAction | iTask a & RWShared sds
predefinedContactItem :: String ItemMeta (Maybe String) (ContactNo (sds () ActionStatus ActionStatus) -> Task a) -> CatalogAction | iTask a & RWShared sds
//Action lists items
listItemTask :: (String,ActionPlan) (Shared ActionStatus) -> Task ()
listItemTask :: (String,ActionPlan) (sds () ActionStatus ActionStatus) -> Task () | RWShared sds
blankListItem :: CatalogAction
predefinedListItem :: String ItemMeta ActionPlan -> CatalogAction
configurableListItem :: String ItemMeta (Task c) (c -> ActionPlan) -> CatalogAction | iTask c
......@@ -192,7 +192,7 @@ configurableListItem :: String ItemMeta (Task c) (c -> ActionPlan)
* @param Group by incidents
* @param Use 'my actions' group for current user
*/
chooseActionItem :: d Bool Bool (ROShared () [(InstanceNo,InstanceNo,ActionStatus)]) -> Task InstanceNo | toPrompt d
chooseActionItem :: d Bool Bool (sds () [(InstanceNo,InstanceNo,ActionStatus)] ()) -> Task InstanceNo | toPrompt d & RWShared sds
workOnActionItem :: InstanceNo -> Task ()
editActionItem :: InstanceNo -> Task (Maybe ActionStatus)
deleteActionItem :: InstanceNo -> Task (Maybe ActionStatus)
......
......@@ -34,15 +34,15 @@ from iTasks.Extensions.Web import :: URL
derive class iTask DBConfig, AISConfig, AsteriskConfig, SMTPConfig, WebLinksConfig, WebLink
//Master configuration shares
databaseConfig :: Shared DBConfig
aisLinkConfig :: Shared AISConfig
asteriskLinkConfig :: Shared AsteriskConfig
smtpConfig :: Shared SMTPConfig
webLinksConfig :: Shared WebLinksConfig
adminPassword :: Shared Password
databaseConfig :: SDSLens () DBConfig DBConfig
aisLinkConfig :: SDSLens () AISConfig AISConfig
asteriskLinkConfig :: SDSLens () AsteriskConfig AsteriskConfig
smtpConfig :: SDSLens () SMTPConfig SMTPConfig
webLinksConfig :: SDSLens () WebLinksConfig WebLinksConfig
adminPassword :: SDSLens () Password Password
//Derived configuration shares
databaseDef :: RWShared () SQLDatabaseDef SQLDatabaseDef
databaseDef :: SDSLens () SQLDatabaseDef SQLDatabaseDef
//Conversion functions
toDatabaseDef :: DBConfig -> SQLDatabaseDef
......
......@@ -4,27 +4,27 @@ import iTasks, iTasks.Extensions.SQLDatabase, iTasks.Extensions.Web
derive class iTask DBConfig, AISConfig, AsteriskConfig, SMTPConfig, WebLinksConfig, WebLink
//Shared stores
databaseConfig :: Shared DBConfig
databaseConfig :: SDSLens () DBConfig DBConfig
databaseConfig = sharedStore "databaseConfig" InternalSQLiteDB
aisLinkConfig :: Shared AISConfig
aisLinkConfig :: SDSLens () AISConfig AISConfig
aisLinkConfig = sharedStore "aisLinkConfig" {AISConfig|host="localhost",port=2000}
asteriskLinkConfig :: Shared AsteriskConfig
asteriskLinkConfig :: SDSLens () AsteriskConfig AsteriskConfig
asteriskLinkConfig = sharedStore "asteriskLinkConfig" {AsteriskConfig|host="localhost",port=5038,username="admin",password="secret"}
smtpConfig :: Shared SMTPConfig
smtpConfig :: SDSLens () SMTPConfig SMTPConfig
smtpConfig = sharedStore "smtpConfig" {SMTPConfig|host="localhost",port=25}
webLinksConfig :: Shared WebLinksConfig
webLinksConfig :: SDSLens () WebLinksConfig WebLinksConfig
webLinksConfig = sharedStore "webLinksConfig" {WebLinksConfig|weatherWidgets=Nothing,vesselLinks=[]}
adminPassword :: Shared Password
adminPassword :: SDSLens () Password Password
adminPassword = sharedStore "adminPassword" (Password "admin")
//Derived configuration shares
databaseDef :: RWShared () SQLDatabaseDef SQLDatabaseDef
databaseDef = mapReadWrite (toDatabaseDef,\_ _ -> Nothing) (toReadOnly databaseConfig)
databaseDef :: SDSLens () SQLDatabaseDef SQLDatabaseDef
databaseDef = mapReadWrite (toDatabaseDef,\_ r -> Nothing) Nothing (toReadOnly databaseConfig)
//Conversion functions
toDatabaseDef :: DBConfig -> SQLDatabaseDef
......
......@@ -74,8 +74,8 @@ fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective
selectionFromLeafletMap :: LeafletMap -> [String]
//Standard layers available to use in all map views
standardPerspective :: Shared ContactMapPerspective
standardMapLayers :: Shared [ContactMapLayer]
standardPerspective :: SDSLens () ContactMapPerspective ContactMapPerspective
standardMapLayers :: SDSLens () [ContactMapLayer] [ContactMapLayer]
derive JSONEncode ContactPosition, ContactMapPerspective
derive JSONDecode ContactPosition, ContactMapPerspective
......
......@@ -224,9 +224,9 @@ fromLeafletLatLng {LeafletLatLng|lat,lng} = (lat,lng)
fromLeafletBounds :: !LeafletBounds -> (!(!Real,!Real),!(!Real,!Real))
fromLeafletBounds {LeafletBounds|southWest,northEast} = (fromLeafletLatLng southWest,fromLeafletLatLng northEast)
standardPerspective :: Shared ContactMapPerspective
standardPerspective :: SDSLens () ContactMapPerspective ContactMapPerspective
standardPerspective = sharedStore "standardPerspective" defaultValue
standardMapLayers :: Shared [ContactMapLayer]
standardMapLayers :: SDSLens () [ContactMapLayer] [ContactMapLayer]
standardMapLayers = sharedStore "standardMapLayers" [{ContactMapLayer|title="Local OSM tiles",def=CMTileLayer "/tiles/{z}/{x}/{y}.png"}]
......@@ -14,7 +14,7 @@ import Incidone.OP.Concepts
derive class iTask WallContent
//Current content of the video wall
wallContent :: Shared WallContent
wallContent :: SDSLens () WallContent WallContent
//View content that was selected for viewing on the video wall
viewVideoWallContent :: Task WallContent
......@@ -7,7 +7,7 @@ import Text, Text.HTML, Data.List, iTasks.Internal.HtmlUtil
derive class iTask WallContent
wallContent :: Shared WallContent
wallContent :: SDSLens () WallContent WallContent
wallContent = sharedStore "WallContent" (WallOverview defaultValue)
viewVideoWallContent :: Task WallContent
......
......@@ -5,7 +5,7 @@ import Incidone.OP.Concepts, Incidone.ActionManagementTasks
crewListActions :: [CatalogAction]
manageContactCrew :: ContactNo -> Task ()
manageContactCrewAction :: ActionDefinition ContactNo
manageContactCrewAction :: ActionDefinition ContactNo sds
manageCrewAliasList :: ContactNo -> Task ()
manageCrewAliasListAction :: ActionDefinition ContactNo
manageCrewAliasListAction :: ActionDefinition ContactNo sds
......@@ -27,7 +27,7 @@ viewContactCommunicationMeans :: ContactNo -> Task [CommunicationMean]
updateContactPosition :: ContactNo -> Task (Maybe (Maybe ContactPosition))
updateContactStatus :: ContactNo -> Task (Maybe (Maybe ContactStatus))
updateSharedContactRefList :: d (RWShared () [ContactNo] [ContactNo]) -> Task [ContactNo] | toPrompt d
updateSharedContactRefList :: d (sds () [ContactNo] [ContactNo]) -> Task [ContactNo] | toPrompt d & RWShared sds
selectKnownOrDefineNewContact :: Task (Either ContactNo NewContact)
createContactIfNew :: (Either ContactNo NewContact) -> Task ContactNo
......@@ -36,7 +36,7 @@ createContact :: NewContact -> Task ContactNo
deleteContact :: ContactNo -> Task ()
addContactPhoto :: ContactNo Document -> Task ContactPhoto
updatePosition :: ContactPosition String (Shared Contact) -> Task Contact
updatePosition :: ContactPosition String (sds () Contact Contact) -> Task Contact | RWShared sds
createCommunicationMean :: ContactNo NewCommunicationMean -> Task CommunicationMeanId
deleteCommunicationMean :: CommunicationMeanId -> Task ()
......@@ -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) | iTask w
viewContactsOnMap :: (sds1 () [ContactGeo] w) (sds2 () (Maybe (Either ContactNo MMSI)) (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | iTask w & RWShared sds1 & RWShared sds2
......@@ -27,9 +27,9 @@ selectContact = withShared Nothing
<<@ ArrangeWithTabs True
)
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 :: (sds () (Maybe (Either ContactNo MMSI)) (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | RWShared sds
selectContactFromLists sel
= anyTask [editSharedSelectionWithShared (Title "Involved in open incidents") False
(SelectInTree groupByIncident select) contactsOfOpenIncidentsShort (selIds sel)
......@@ -44,7 +44,8 @@ where
fromOpenOption [{ContactShortWithIncidents|contactNo}] = contactNo
selIds sel = mapReadWrite (toPrj,fromPrj) sel
selIds :: (sds () (Maybe (Either ContactNo MMSI)) (Maybe (Either ContactNo MMSI))) -> SDSLens () [Int] [Int] | RWShared sds
selIds sel = mapReadWrite (toPrj,fromPrj) (Just \p w. Ok (toPrj w)) sel
where
toPrj Nothing = []
toPrj (Just (Left contactNo)) = [contactNo]
......@@ -112,7 +113,7 @@ manageContactBasics contactNo = (
] @! ()) <<@ Title "General" <<@ (ApplyAttribute "icon" "basic-information")
where
contactBasics contactNo = mapReadWrite (toPrj,fromPrj) (sdsFocus contactNo contactByNo)
contactBasics contactNo = mapReadWrite (toPrj,fromPrj) (Just \p w. Ok (toPrj w)) (sdsFocus contactNo contactByNo)
where
toPrj {Contact|type,name,group,position,heading,needsHelp,providesHelp,status,notes}
= {ContactBasic|type=type,name=name,group=group,position=position,heading=heading,needsHelp=needsHelp,providesHelp=providesHelp,status=status,notes=notes}
......@@ -387,7 +388,7 @@ where
updateContactPosition :: ContactNo -> Task (Maybe (Maybe ContactPosition))
updateContactPosition contactNo
= get (sdsFocus contactNo contactByNo |+| standardMapLayers)
= get (sdsFocus contactNo contactByNo |*| standardMapLayers)
>>- \({Contact|name,type,position},baseLayers) ->
withShared (position,initPerspective position)
\tmpInfo ->
......@@ -434,7 +435,7 @@ updateContactStatus contactNo
>>| logContactStatusUpdated contactNo status newStatus
@! newStatus
updateSharedContactRefList :: d (RWShared () [ContactNo] [ContactNo]) -> Task [ContactNo] | toPrompt d
updateSharedContactRefList :: d (sds () [ContactNo] [ContactNo]) -> Task [ContactNo] | toPrompt d & RWShared sds
updateSharedContactRefList d refs
= manageCurrentItems
>^* [OnAction (Action "Add") (always (addItem <<@ InWindow))]
......@@ -540,7 +541,7 @@ deleteCommunicationMean id
["CommunicationMean","Telephone","VHFRadio","EmailAccount","P2000Receiver"]]
@! ()
updatePosition :: ContactPosition String (Shared Contact) -> Task Contact
updatePosition :: ContactPosition String (sds () Contact Contact) -> Task Contact | RWShared sds
updatePosition newposition src contact
= upd (update newposition src) contact
where
......@@ -552,9 +553,9 @@ verifyContactCredentials credentials
= get (sdsFocus credentials contactByCredentials)
@ fmap contactUser
viewContactsOnMap :: (ReadWriteShared [ContactGeo] w) (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | iTask w
viewContactsOnMap :: (sds1 () [ContactGeo] w) (sds2 () (Maybe (Either ContactNo MMSI)) (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | iTask w & RWShared sds1 & RWShared sds2
viewContactsOnMap sharedContacts sel
= get (standardMapLayers |+| standardPerspective)
= get (standardMapLayers |*| standardPerspective)
>>- \(baseLayers,perspective) ->
withShared (False,perspective)
\localState ->
......@@ -565,11 +566,11 @@ viewContactsOnMap sharedContacts sel
]
@? selection
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) | iTask w
mapState local contacts sel = sdsSequence "mapState" id (\_ r -> r) (\_ _ -> Right read) writel writer (local >+< sel) mapContacts
mapState :: (sds1 () (Bool,ContactMapPerspective) (Bool,ContactMapPerspective))
(sds2 () [ContactGeo] w)
(sds3 () (Maybe (Either ContactNo MMSI)) (Maybe (Either ContactNo MMSI))) ->
SDSSequence () ([(Bool,ContactGeo)], Maybe (Either ContactNo MMSI), ContactMapPerspective) (Maybe (Either ContactNo MMSI), ContactMapPerspective) | iTask w & RWShared sds1 & RWShared sds2 & RWShared sds3
mapState local contacts sel = sdsSequence "mapState" id (\_ r -> r) (\_ _ -> Right read) writel writer (local >*< sel) mapContacts
where
mapContacts = sdsSelect "mapContacts" choose (SDSNotifyConst (\_ _ _ _-> False)) (SDSNotifyConst (\_ _ _ _-> False)) withoutAISContacts withAISContacts
where
......@@ -580,7 +581,7 @@ where
aisContacts = mapRead (\cs -> [(True,c)\\c=:{ContactGeo|position=Just position}<-map aisToContactGeo cs]) (toReadOnly boundedAISContacts)
withoutAISContacts = sdsFocus () baseContacts
withAISContacts = mapRead (\(a,b) -> a++b) (aisContacts |+| sdsFocus () baseContacts)
withAISContacts = mapRead (\(a,b) -> a++b) (aisContacts |*| sdsFocus () baseContacts)
read (((showAis,perspective),mbSel),contacts) = (contacts,mbSel,perspective)
writel = SDSWrite (\_ ((showAis,_),_) (mbSel,perspective) -> Ok (Just ((showAis,perspective),mbSel)))
......
......@@ -12,7 +12,7 @@ manageIncidentLog :: IncidentNo -> Task ()
viewIncidentDetails :: IncidentNo -> Task ()
//Reusable task fragments
updateSharedIncidentRefList :: d Bool (RWShared () [IncidentNo] [IncidentNo]) -> Task [IncidentNo] | toPrompt d
updateSharedIncidentRefList :: d Bool (sds () [IncidentNo] [IncidentNo]) -> Task [IncidentNo] | toPrompt d & RWShared sds
selectKnownOrDefineNewIncident :: Task (Either IncidentNo NewIncident)
createIncidentIfNew :: (Either IncidentNo NewIncident) -> Task IncidentNo
......
......@@ -39,7 +39,7 @@ manageIncidentSituationInfo incidentNo
,OnAction (Action "/Close incident") (always (confirmCloseIncident incidentNo <<@ InWindow))
]
where
situation = mapReadWrite (toPrj,fromPrj) (sdsFocus incidentNo incidentByNo)
situation = mapReadWrite (toPrj,fromPrj) (Just \_ w. Ok (toPrj w)) (sdsFocus incidentNo incidentByNo)
where
toPrj {Incident|title,summary,type,phase}
= {IncidentBasic|title,summary,type,phase}
......@@ -164,7 +164,7 @@ viewIncidentDetails incidentNo
where
incident = sdsFocus incidentNo incidentByNo
updateSharedIncidentRefList :: d Bool (RWShared () [IncidentNo] [IncidentNo]) -> Task [IncidentNo] | toPrompt d
updateSharedIncidentRefList :: d Bool (sds () [IncidentNo] [IncidentNo]) -> Task [IncidentNo] | toPrompt d & RWShared sds
updateSharedIncidentRefList d compact refs
= manageCurrentItems
>^* [OnAction (Action "Add") (always (addItem <<@ InWindow))]
......
......@@ -56,12 +56,12 @@ 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 & TC r & TC w
(>++>) infixl 6 :: (sds1 () SQLDatabaseDef SQLDatabaseDef) (sds2 (SQLDatabaseDef,p) r w) -> SDSSequence p r w | iTask p & TC r & TC w & RWShared sds1 & RWShared sds2
sqlReadSDS :: String -> ROShared (SQLDatabaseDef,QueryDef) [r] | mbFromSQL r
sqlReadWriteOneSDS :: String -> RWShared (SQLDatabaseDef,QueryDef) r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
sqlLinkSDS :: String String String String-> RWShared (SQLDatabaseDef,Maybe [Int]) [(Int,Int)] [(Int,Int)]
sqlReadSDS :: String -> SDSSource (SQLDatabaseDef,QueryDef) [r] () | mbFromSQL r
sqlReadWriteOneSDS :: String -> SDSSource (SQLDatabaseDef,QueryDef) r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
sqlLinkSDS :: String String String String-> SDSSource (SQLDatabaseDef,Maybe [Int]) [(Int,Int)] [(Int,Int)]
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 & TC r
roMaybe :: (sds p (Maybe r) ()) -> SDSSelect (Maybe p) (Maybe r) () | iTask p & TC r & RWShared sds
......@@ -147,10 +147,10 @@ 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 & TC r & TC w
(>++>) infixl 6 :: (sds1 () SQLDatabaseDef SQLDatabaseDef) (sds2 (SQLDatabaseDef,p) r w) -> SDSSequence p r w | iTask p & TC r & TC w & RWShared sds1 & RWShared sds2
(>++>) 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 :: String -> SDSSource (SQLDatabaseDef,QueryDef) [r] () | mbFromSQL r
sqlReadSDS notifyId = sqlShare notifyId readFun writeFun
where
readFun query cur
......@@ -163,7 +163,7 @@ where
writeFun _ _ cur = (Ok (), cur)
sqlReadWriteOneSDS :: String -> RWShared (SQLDatabaseDef,QueryDef) r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
sqlReadWriteOneSDS :: String -> SDSSource (SQLDatabaseDef,QueryDef) r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
sqlReadWriteOneSDS notifyId = sqlShare notifyId readFun writeFun
where
readFun query cur
......@@ -197,7 +197,7 @@ where
= (Ok (), cur)
*/
sqlLinkSDS :: String String String String-> RWShared (SQLDatabaseDef,Maybe [Int]) [(Int,Int)] [(Int,Int)]
sqlLinkSDS :: String String String String-> SDSSource (SQLDatabaseDef,Maybe [Int]) [(Int,Int)] [(Int,Int)]
sqlLinkSDS notifyId table col1 col2 = sqlShare notifyId readFun writeFun
where
query match
......@@ -231,7 +231,7 @@ 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 & TC r
roMaybe :: (sds p (Maybe r) ()) -> SDSSelect (Maybe p) (Maybe r) () | iTask p & TC r & RWShared sds
roMaybe sds = sdsSelect "roMaybe" choose (SDSNotifyConst (\_ _ _ _ -> False)) (SDSNotifyConst (\_ _ _ _-> False)) (constShare Nothing) sds
where
choose Nothing = Left ()
......
......@@ -13,20 +13,20 @@ import qualified Data.Map
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]) | iTask p & TC a & TC b & TC c & TC x
indexedStore :: String v -> SDSLens k v v | Eq k & Ord k & iTask k & iTask v
sdsDeref :: (sds1 p [a] [a]) (a -> Int) (sds2 [Int] [b] x) ([a] [b] -> [c]) -> (SDSSequence p [c] [a]) | iTask p & TC a & TC b & TC c & TC x & RWShared sds1 & RWShared sds2
// Information management
viewDetails :: !d (ReadOnlyShared (Maybe i)) (RWShared i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v & iTask c
viewDetails :: !d (sds1 () (Maybe i) ()) (sds2 i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v & iTask c & RWShared sds1 & RWShared sds2
optionalNewOrOpen :: (String,Task ()) (String,i -> Task ()) Workspace (ReadOnlyShared (Maybe i)) -> Task () | iTask i
optionalNewOrOpen :: (String,Task ()) (String,i -> Task ()) Workspace (sds () (Maybe i) ()) -> Task () | iTask i & RWShared sds
doAddRemoveOpen :: (Task a) (r -> Task b) (r -> Task c) Workspace (ReadWriteShared (Maybe r) w) -> Task () | iTask a & iTask b & iTask c & iTask r
doAddRemoveOpen :: (Task a) (r -> Task b) (r -> Task c) Workspace (sds () (Maybe r) w) -> Task () | iTask a & iTask b & iTask c & iTask r & RWShared sds & TC w
// Utility
viewAndEdit :: (Task a) (Task b) -> Task b | iTask a & iTask b
viewOrEdit :: d (Shared a) (a a -> Task ()) -> Task () | toPrompt d & iTask a
viewOrEdit :: d (sds () a a) (a a -> Task ()) -> Task () | toPrompt d & iTask a & RWShared sds
doOrClose :: (Task a) -> Task (Maybe a) | iTask a
doOrCancel :: (Task a) -> Task (Maybe a) | iTask a
......@@ -43,7 +43,7 @@ oneOrAnother :: !d (String,Task a) (String,Task b) -> Task (Either a b) | toProm
enterMultiple :: !String !Int (Task a) -> Task [a] | iTask a
//Work on multiple items from a shared list and add
manageSharedListWithDetails :: (Int -> Task ()) (Task Int) (Shared [Int]) -> Task ()
manageSharedListWithDetails :: (Int -> Task ()) (Task Int) (sds () [Int] [Int]) -> Task () | RWShared sds
//Ok/Cancel transition
(>>?) infixl 1 :: !(Task a) !(a -> Task b) -> Task (Maybe b) | iTask a & iTask b
......@@ -53,6 +53,6 @@ manageSharedListWithDetails :: (Int -> Task ()) (Task Int) (Shared [Int]) -> Tas
manageBackgroundTask :: !d !String !String (Task a) -> Task () | toPrompt d & iTask a
//Reading network streams
syncNetworkChannel :: String Int String (String -> m) (m -> String) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
syncNetworkChannel :: String Int String (String -> m) (m -> String) (sds () ([m],Bool,[m],Bool) ([m],Bool,[m],Bool)) -> Task () | iTask m & RWShared sds
consumeNetworkStream :: ([m] -> Task ()) (sds () ([m],Bool,[m],Bool) ([m],Bool,[m],Bool)) -> Task () | iTask m & RWShared sds
......@@ -29,13 +29,13 @@ createNewContact
= enterInformation ("New contact","Enter the basic information of the new contact") []
>>? createContact
indexedStore :: String v -> RWShared k v v | Eq k & Ord k & iTask k & iTask v
indexedStore name def = sdsSplit "indexedStore" (\p -> ((),p)) read write (sharedStore name 'DM'.newMap)
indexedStore :: String v -> SDSLens k v v | Eq k & Ord k & iTask k & iTask v
indexedStore name def = sdsSplit "indexedStore" (\p -> ((),p)) read write (Just \p mapping. Ok (fromMaybe def ('DM'.get p mapping))) (sharedStore name 'DM'.newMap)
where
read p mapping = fromMaybe def ('DM'.get p mapping)
write p mapping v = ('DM'.put p v mapping,const ((==) p))
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 p [a] [a]) (a -> Int) (sds2