SDSs.icl 49.6 KB
Newer Older
1 2
implementation module Incidone.OP.SDSs

3
import iTasks, iTasks.Extensions.SQLDatabase
4
import qualified Data.Map as DM
5
import Data.Map.GenJSON
6 7 8
import Incidone.Configuration
import Incidone.OP.Concepts, Incidone.OP.Conversions
import Incidone.Util.SQLSDS
9
import Data.Functor, Data.Either, Data.Tuple, Data.Func
10 11 12

derive class iTask ContactFilter

13
dbReadSDS :: String -> SDSSequence QueryDef [r] () | mbFromSQL r & TC r
14 15
dbReadSDS notifyId = databaseDef >++> sqlReadSDS notifyId

16
dbReadWriteOneSDS :: String -> SDSSequence QueryDef r r | mbFromSQL, mbToSQL r & gDefault{|*|} r & TC r
17 18
dbReadWriteOneSDS notifyId = databaseDef >++> sqlReadWriteOneSDS notifyId

19
dbLinkSDS :: String String String String -> SDSSequence (Maybe [Int]) [(Int,Int)] [(Int,Int)]
20 21 22 23
dbLinkSDS notifyId table col1 col2 = databaseDef >++> sqlLinkSDS notifyId table col1 col2

//ACCESS SDS

24
//TODO: Also store in database
25
allContactPhotos :: SimpleSDSLens (Map ContactNo [ContactPhoto])
26 27
allContactPhotos = sharedStore "ContactPhotos" 'DM'.newMap

28
lastAISImport :: SimpleSDSLens (Maybe (DateTime,String,Int))
29 30
lastAISImport = sharedStore "lastAISImport" Nothing

31
allCommunications :: SDSLens () [CommunicationDetails] ()
32 33
allCommunications = sdsFocus Nothing filteredCommunications

34
filteredCommunications :: SDSLens (Maybe RowFilterDef) [CommunicationDetails] ()
35 36
filteredCommunications
    = mapRead (\(communication,aboutIncidents) -> map (addAboutIncidentsToCommunication aboutIncidents) communication)
37
                        (filteredCommunicationsBase |*| sdsFocus () communicationAboutIncidentsIndexed)
38 39 40 41 42 43 44
where
    addAboutIncidentsToCommunication aboutIncidents communication=:{CommunicationDetails|communicationNo}
        = {CommunicationDetails|communication
          &aboutIncidents= fromMaybe [] ('DM'.get communicationNo aboutIncidents)
          }
    communicationAboutIncidentsIndexed = mapRead groupByFst communicationAboutIncidents

45
filteredCommunicationsBase :: SDSLens (Maybe RowFilterDef) [CommunicationDetails] ()
46 47 48 49
filteredCommunicationsBase = sdsTranslate "filteredCommunicationsBase" query (dbReadSDS "filteredCommunicationsBase")
where
    query rows = {columns = columnsCommunicationDetails, rows = rows , order = Just [OrderDesc ("Communication","communicationNo")]}

50
communicationAboutIncidents :: SDSLens () [(CommunicationNo,IncidentShort)] ()
51 52 53 54 55 56 57 58 59 60
communicationAboutIncidents = mapRead (map fromSQLWithId) (sdsFocus query (dbReadSDS "communicationAboutIncidents"))
where
 query =
    { columns    = InnerJoin columnsIncidentShort
                    {name="communications_aboutIncidents",alias="communications_aboutIncidents",columns=["aboutIncidents"]}
                    ("Incident","incidentNo") ("communications_aboutIncidents","communications")
    , rows       = Nothing
    , order      = Nothing
    }

61 62
communicationByNo :: SDSLens CommunicationNo Communication Communication
communicationByNo = mapReadWrite (readPrj,writePrj) (Just \p w. Ok (readPrj w))
63
    (communicationByNoBase
64
     >*< sdsTranslate "communicationByNoIncidents" (\p -> Just [p]) incidentNosByCommunicationNosIndexed)
65 66 67 68 69 70 71 72 73 74
where
	readPrj (communication=:{Communication|communicationNo},ilinks)
        = {Communication
          |communication
          & aboutIncidents = fromMaybe [] ('DM'.get communicationNo ilinks)
          }
	writePrj communication=:{Communication|communicationNo,aboutIncidents} (_,ilinks)
		= Just (communication,'DM'.put communicationNo aboutIncidents ilinks)
	writePrj _ _ = Nothing

75
communicationByNoBase :: SDSSequence CommunicationNo Communication Communication
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
communicationByNoBase = databaseDef >++> sqlShare "communicationByNo" readFun writeFun
where
    query communicationNo
        = {columns=columnsCommunication,rows=Just (EqualsValue ("Communication","communicationNo") (toSQL communicationNo)), order = Nothing}

	readFun communicationNo cur
        # (sql,vals)        = toReadSQL (query communicationNo)
        # (err,cur)         = execute sql vals cur
		| isJust err		= (Error (toString (fromJust err)),cur)
		# (err,mbRow,cur)	= fetchOne cur
		| isJust err		= (Error (toString (fromJust err)),cur)
        | isNothing mbRow   = (Error ("Could not find communication number " +++ toString communicationNo),cur)
		= (Ok (fromSQL (fromJust mbRow)), cur)

	writeFun communicationNo {Communication|time,type,direction,status,handledBy,withContact} cur
		//Update Contact table
		# (err,cur) = execute "UPDATE Communication SET `time` = ?, `type` = ?, `direction` = ?, `status` = ?, `handledBy` = ?, `withContact` = ? WHERE `communicationNo` = ?"
				(flatten
                [toSQL time
				,toSQL type
                ,toSQL direction
                ,mbToSQL status
                ,mbToSQL handledBy
				,mbToSQL withContact
				,toSQL   communicationNo
				]) cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		                = (Ok (), cur)

105
communicationDetailsByNo :: SDSParallel CommunicationNo CommunicationDetails CommunicationDetails
106 107 108 109 110 111 112
communicationDetailsByNo = sdsParallel "communicationDetailsByNo" param read (SDSWriteConst writel) (SDSWriteConst writer) communicationDetailsByNoBase incidentsByCommunicationShort
where
    param p = (p,p)
    read (communication,aboutIncidents) = {CommunicationDetails|communication & aboutIncidents = aboutIncidents}
    writel _ communication = Ok (Just communication)
    writer _ communication = Ok (Just [incidentNo \\ {IncidentShort|incidentNo} <- communication.CommunicationDetails.aboutIncidents])

113
communicationDetailsByNoBase ::  SDSSequence CommunicationNo CommunicationDetails CommunicationDetails
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
communicationDetailsByNoBase = databaseDef >++> sqlShare "communicationByNo" readFun writeFun
where
    //TODO use a write query that does multiple table updates
    query communicationNo = {columns=columnsCommunicationDetails,rows=Just (EqualsValue ("Communication","communicationNo") [SQLVInteger communicationNo]),order=Nothing}

	readFun communicationNo cur
        # (sql,vals)        = toReadSQL (query communicationNo)
        # (err,cur)         = execute sql vals cur
		| isJust err		= (Error (toString (fromJust err)),cur)
		# (err,mbRow,cur)	= fetchOne cur
		| isJust err		= (Error (toString (fromJust err)),cur)
        | isNothing mbRow   = (Error ("Communication number " <+++ communicationNo <+++ " could not be found"),cur)
	                    	= (Ok (fromSQL (fromJust mbRow)), cur)

	writeFun communicationNo (communication=:{CommunicationDetails|time,type,direction,status,withContact,handledBy,externalNo}) cur
		//Update Contact table
		# (err,cur) = execute "UPDATE Communication SET time = ?, type = ?, direction = ?, status = ?, withContact = ?, handledBy = ? WHERE communicationNo = ?"
				(flatten
                [toSQL time
				,toSQL type
				,toSQL direction
				,mbToSQL status
				,mbToSQL (fmap (\{ContactShort|contactNo}->contactNo) withContact)
				,mbToSQL (fmap (\{ContactShort|contactNo}->contactNo) handledBy)
				,toSQL communicationNo
				]) cur
		| isJust err = (Error (toString (fromJust err)),cur)
        = case type of
            PhoneCall
		//Brute force upsert, try insert, if it fails, try update
                //# (err,cur) = execute "INSERT INTO PhoneCall (communicationNo,externalNo) VALUES (?,?) ON DUPLICATE KEY UPDATE externalNo = VALUES(externalNo)"
                # (err,cur) = execute "INSERT INTO PhoneCall (communicationNo,externalNo) VALUES (?,?)"
                    (flatten [toSQL communicationNo,mbToSQL externalNo]) cur
				| isJust err
148
                	# (err,cur) = execute "UPDATE PhoneCall SET externalNo = ? WHERE communicationNo = ?"
149 150 151 152 153 154 155
                    	(flatten [mbToSQL externalNo,toSQL communicationNo]) cur
			        | isJust err  = (Error (toString (fromJust err)),cur)
			        = (Ok (), cur)
			    = (Ok (), cur)
            _
		        = (Ok (), cur)

156
phoneCallByNo :: SDSLens CommunicationNo PhoneCall PhoneCall
157 158 159 160
phoneCallByNo = sdsTranslate "phoneCallByNo" query (dbReadWriteOneSDS "phoneCallByNo")
where
    query communicationNo = {columns=columnsPhoneCall,rows=Just (EqualsValue ("PhoneCall","communicationNo") [SQLVInteger communicationNo]),order=Nothing}

161
phoneCallByReference :: SDSLens PhoneCallReference PhoneCall PhoneCall
162 163 164 165
phoneCallByReference = sdsTranslate "phoneCallByReference" query (dbReadWriteOneSDS "phoneCallByReference")
where
    query ref = {columns=columnsPhoneCall,rows=Just (EqualsValue ("PhoneCall","externalRef") [SQLVText ref]),order=Nothing}

166
radioCallByNo :: SDSLens CommunicationNo RadioCall RadioCall
167 168 169 170
radioCallByNo = sdsTranslate "radioCallByNo" query (dbReadWriteOneSDS "radioCallByNo")
where
    query communicationNo = {columns=columnsRadioCall,rows=Just (EqualsValue ("RadioCall","communicationNo") [SQLVInteger communicationNo]),order=Nothing}

171
emailMessageByNo :: SDSLens CommunicationNo EmailMessage EmailMessage
172 173 174 175
emailMessageByNo = sdsTranslate "emailMessageByNo" query (dbReadWriteOneSDS "emailMessageByNo")
where
    query communicationNo = {columns=columnsEmailMessage,rows=Just (EqualsValue ("EmailMessage","communicationNo") [SQLVInteger communicationNo]),order=Nothing}

176
p2000MessageByNo :: SDSLens CommunicationNo P2000Message P2000Message
177 178 179 180
p2000MessageByNo = sdsTranslate "p2000MessageByNo" query (dbReadWriteOneSDS "P2000MessageByNo")
where
    query communicationNo = {columns=columnsP2000Message,rows=Just (EqualsValue ("P2000Message","communicationNo") [SQLVInteger communicationNo]),order=Nothing}

181
allIncidents :: SDSLens () [Incident] ()
182 183
allIncidents = filteredIncidents Nothing

184 185 186 187
filteredIncidents :: (Maybe RowFilterDef) -> SDSLens () [Incident] ()
filteredIncidents mbWhere = mapRead prj (baseIncidents mbWhere 
	|*| sdsFocus Nothing contactNosByIncidentNosIndexed
	|*| sdsFocus Nothing communicationNosByIncidentNosIndexed)
188 189 190 191 192 193 194 195 196 197
where
	prj ((incidents,cnlinks),cmlinks) = map (addLinks cnlinks cmlinks) incidents

	addLinks cnlinks cmlinks incident=:{Incident|incidentNo}
		= {Incident
		  | incident
		  & contacts = fromMaybe [] ('DM'.get incidentNo cnlinks)
		  , communications = fromMaybe [] ('DM'.get incidentNo cmlinks)
		  }

198
detailsIncidents :: (Maybe RowFilterDef) -> SDSLens () [IncidentDetails] ()
199
detailsIncidents mbWhere = mapRead (map prj) (baseIncidents mbWhere)
200
where
201 202 203
    prj {Incident|incidentNo,title,summary,type,phase}
      = {IncidentDetails|incidentNo=incidentNo,title=title,summary=summary,type=type,phase=phase}

204
baseIncidents :: (Maybe RowFilterDef) -> SDSLens () [Incident] ()
205 206 207 208
baseIncidents rows = sdsFocus query (dbReadSDS "allIncidents")
where
 query = {columns = columnsIncident, rows = rows, order = Nothing}

209
filteredIncidentsShort :: SDSLens (Maybe RowFilterDef) [IncidentShort] ()
210 211 212 213
filteredIncidentsShort = sdsTranslate "filteredIncidentsShort" query (dbReadSDS "allIncidents")
where
    query rows = {columns = columnsIncidentShort, rows = rows, order = Nothing}

214
allIncidentsShort :: SDSLens () [IncidentShort] ()
215 216
allIncidentsShort = sdsFocus Nothing filteredIncidentsShort

217
openIncidents :: SDSLens () [Incident] ()
218 219
openIncidents =	filteredIncidents (Just openIncidentsCond)

220
openIncidentsShort :: SDSLens () [IncidentShort] ()
221 222
openIncidentsShort = sdsFocus (Just openIncidentsCond) filteredIncidentsShort

223
openIncidentsDetails ::	SDSLens () [IncidentDetails] ()
224 225 226 227 228 229 230 231
openIncidentsDetails = detailsIncidents (Just openIncidentsCond)

openIncidentsCond :: RowFilterDef
openIncidentsCond = OrCondition (EqualsValue ("Incident","closed") [SQLVInteger 0]) (EqualsNull ("Incident","closed"))

closedIncidentsCond :: RowFilterDef
closedIncidentsCond = EqualsValue ("Incident","closed") [SQLVInteger 1]

232
recentIncidents :: SDSLens () [Incident] ()
233 234
recentIncidents = filteredIncidents (Just closedIncidentsCond)

235
recentIncidentsDetails :: SDSLens () [IncidentDetails] ()
236 237
recentIncidentsDetails = detailsIncidents (Just closedIncidentsCond)

238 239
incidentsByContactShort	:: SDSSequence ContactNo [IncidentShort] [IncidentNo]
incidentsByContactShort = databaseDef >++> sqlShare "incidentsByContact" readFun writeFun
240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262
where
    query contactNo =
        {columns = InnerJoin columnsIncidentShort {name="contacts_incidents",alias="contacts_incidents",columns=[]} ("Incident","incidentNo") ("contacts_incidents","contacts")
        ,rows    = Just (EqualsValue ("contacts_incidents","incidents") [SQLVInteger contactNo])
        ,order = Nothing}

	readFun contactNo cur
        # (sql,vals) = toReadSQL (query contactNo)
        # (res,cur) = execSelect sql vals cur
		= case res of
			Error e	= (Error e,cur)
			Ok rows = (Ok (map fromSQL rows),cur)

	writeFun contactNo links cur
		//Unlink old
		# (err,cur) 	= execute "DELETE FROM contacts_incidents WHERE incidents = ? " (toSQL contactNo) cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		//Relink new
		# (err,cur)		= executeMany "INSERT INTO contacts_incidents (contacts,incidents) VALUES (?,?)"
							[toSQL incidentNo ++ toSQL contactNo \\ incidentNo <- links] cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		= (Ok (),cur)

263
incidentsByContactDetails :: SDSSequence ContactNo [IncidentDetails] [IncidentNo]
264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288
incidentsByContactDetails = databaseDef  >++> sqlShare "incidentsByContact" readFun writeFun
where
    query contactNo =
        {columns = InnerJoin columnsIncidentDetails {name="contacts_incidents",alias="contacts_incidents",columns=[]}
                ("Incident","incidentNo") ("contacts_incidents","contacts")
        ,rows = Just (EqualsValue ("contacts_incidents","incidents") [SQLVInteger contactNo])
        ,order = Nothing
        }
    readFun contactNo cur
        # (sql,vals) = toReadSQL (query contactNo)
        # (res,cur) = execSelect sql vals cur
		= case res of
			Error e	= (Error e,cur)
			Ok rows = (Ok (map fromSQL rows),cur)

	writeFun contactNo links cur
		//Unlink old
		# (err,cur) 	= execute "DELETE FROM contacts_incidents WHERE incidents = ? " (toSQL contactNo) cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		//Relink new
		# (err,cur)		= executeMany "INSERT INTO contacts_incidents (contacts,incidents) VALUES (?,?)"
							[toSQL incidentNo ++ toSQL contactNo \\ incidentNo <- links] cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		= (Ok (),cur)

289
incidentsByCommunicationShort :: SDSSequence CommunicationNo [IncidentShort] [IncidentNo]
290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313
incidentsByCommunicationShort = databaseDef >++> sqlShare "incidentsByCommunication" readFun writeFun
where
    columns = InnerJoin columnsIncidentShort {name="communications_aboutIncidents",alias="communications_aboutIncidents",columns=[]}
                ("Incident","incidentNo") ("communications_aboutIncidents","communications")
    rows communicationNo
            = Just (EqualsValue ("communications_aboutIncidents","aboutIncidents") [SQLVInteger communicationNo])

	readFun communicationNo cur
        # (sql,vals) = toReadSQL {columns=columns,rows=rows communicationNo,order=Nothing}
        # (res,cur) = execSelect sql vals cur
		= case res of
			Error e	= (Error e,cur)
			Ok rows = (Ok (map fromSQL rows),cur)

	writeFun communicationNo links cur
		//Unlink old
		# (err,cur) 	= execute "DELETE FROM communications_aboutIncidents WHERE aboutIncidents = ? " (toSQL communicationNo) cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		//Relink new
		# (err,cur)		= executeMany "INSERT INTO communications_aboutIncidents (communications,aboutIncidents) VALUES (?,?)"
							[toSQL incidentNo ++ toSQL communicationNo \\ incidentNo <- links] cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		= (Ok (),cur)

314
incidentsByNosShort :: SDSLens [IncidentNo] [IncidentShort] ()
315 316 317 318 319
incidentsByNosShort = sdsTranslate "incidentsByNosShort" cond filteredIncidentsShort
where
    cond []  = Just (EqualsValue ("Incident","incidentNo") [SQLVInteger 0]) //Don't match anythig
    cond nos = Just (EqualsValue ("Incident","incidentNo") (map SQLVInteger nos))

320 321
incidentByNo :: SDSLens IncidentNo Incident Incident
incidentByNo = mapReadWrite (readPrj,writePrj) (Just \p ((w, _), _). Ok w)
322
    (incidentByNoBase
323 324 325
     >*< (sdsTranslate "incidentByNoContacts" (\p -> Just [p]) contactNosByIncidentNosIndexed)
     >*< (sdsTranslate "incidentByNoCommunications" (\p -> Just [p]) communicationNosByIncidentNosIndexed)
     >*| incidentLog)
326 327 328 329 330 331 332 333
where
	readPrj (((incident,cnlinks),cmlinks),log)
        = {Incident
		  | incident
		  & contacts = fromMaybe [] ('DM'.get incident.Incident.incidentNo cnlinks)
		  , communications = fromMaybe [] ('DM'.get incident.Incident.incidentNo cmlinks)
          , log = log
		  }
334

335 336 337 338
	writePrj (incident=:{Incident|incidentNo,contacts,communications}) (((_,cnlinks),cmlinks),_)
		= Just ((incident,'DM'.put incidentNo contacts cnlinks),'DM'.put incidentNo communications cmlinks)
	writePrj _ _ = Nothing

339
incidentByNoBase :: SDSSequence IncidentNo Incident Incident
340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366
incidentByNoBase = databaseDef >++> sqlShare "incidentByNo" readFun writeFun
where
    query incidentNo = {columns=columnsIncident,rows=Just (EqualsValue ("Incident","incidentNo") [SQLVInteger incidentNo]),order=Nothing}

	readFun incidentNo cur
        # (sql,vals)        = toReadSQL (query incidentNo)
		# (err,cur)			= execute sql vals cur
		| isJust err		= (Error (toString (fromJust err)),cur)
		# (err,mbRow,cur)	= fetchOne cur
		| isJust err		= (Error (toString (fromJust err)),cur)
		| isNothing mbRow   = (Error ("Could not find incident number " +++ toString incidentNo),cur)
		= (Ok (fromSQL (fromJust mbRow)), cur)

	writeFun incidentNo incident=:{Incident|title,summary,type,phase,closed} cur
		//Update Incident table
		# (err,cur) = execute "UPDATE Incident SET title = ?, summary = ?, type = ?, phase = ?, closed = ? WHERE incidentNo = ?"
			(flatten
            [mbToSQL title
			,mbToSQL summary
			,mbToSQL type
			,mbToSQL phase
			,toSQL closed
			,toSQL incidentNo
			]) cur
		| isJust err	= (Error (toString (fromJust err)),cur)
						= (Ok (),cur)

367
incidentTitleByNo :: SDSLens IncidentNo String String
368 369 370 371 372
incidentTitleByNo = sdsTranslate "incidentTitleByNo" query (dbReadWriteOneSDS "incidentTitleByNo")
where
    query incidentNo = {columns=columnsIncidentTitle,rows=Just (EqualsValue ("Incident","incidentNo") [SQLVInteger incidentNo]),order=Nothing}
    columnsIncidentTitle = BaseTable {name="Incident",alias="Incident",columns=["title"]}

373
incidentWeather :: SDSLens IncidentNo WeatherData WeatherData
374 375 376 377
incidentWeather = sdsTranslate "incidentWeather" query (dbReadWriteOneSDS "incidentByWeather")
where
    query incidentNo = {columns=columnsWeatherData,rows=Just (EqualsValue ("WeatherData","incidentNo") [SQLVInteger incidentNo]),order=Nothing}

378
incidentLog :: SDSParallel IncidentNo [LogEntry] LogEntry
379 380 381 382 383 384
incidentLog = sdsParallel "incidentLog" param read (SDSWriteConst (\_ w -> Ok (Just w))) (SDSWriteConst (\_ _ -> Ok Nothing)) incidentLogBase allContactPhotos
where
    param p = (p,())
    read (logEntries,photos) = [{LogEntry|e & loggedBy = fmap (addAvatarPhotos photos) e.LogEntry.loggedBy} \\ e <- logEntries]
    addAvatarPhotos photos a=:{ContactAvatar|contactNo} = {ContactAvatar|a & photos = fromMaybe [] ('DM'.get contactNo photos)}

385
incidentLogBase :: SDSSequence IncidentNo [LogEntry] LogEntry
386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401
incidentLogBase = databaseDef >++> sqlShare "incidentLog" readFun writeFun
where
    query incidentNo = {columns=columnsLogEntry,rows=Just (EqualsValue ("LogEntry","incident") [SQLVInteger incidentNo]),order = Just [OrderDesc ("LogEntry","loggedAt")]}

    readFun incidentNo cur
        # (sql,vals) = toReadSQL (query incidentNo)
        # (res,cur) = execSelect sql vals cur
        = case res of
            Error e	= (Error e, cur)
            Ok rows = (Ok (map fromSQL rows),cur)

    writeFun incidentNo entry=:{LogEntry|eventAt,loggedAt,loggedBy,message} cur
        # (_,cur) = execInsert "INSERT INTO LogEntry (incident,eventAt,loggedAt,loggedBy,message) VALUES (?,?,?,?,?)"
            (take 5 (toSQL entry)) cur
        = (Ok (),cur)

402 403
incidentOverview :: SDSLens IncidentNo IncidentOverview ()
incidentOverview = mapRead prj (incidentByNo |*| contactsByIncident)
404 405 406 407 408 409
where
    prj ({Incident|title,summary,type},contacts)
        = {IncidentOverview|title=title,summary=summary,type=type
          ,contactsNeedingHelp=[{ContactNameTypePosition|name=name,type=type,position=position} \\ {Contact|name,type,position,needsHelp} <- contacts | needsHelp]
        }

410 411
contactNosByIncidentNosIndexed :: SDSLens (Maybe [IncidentNo]) (Map IncidentNo [ContactNo]) (Map IncidentNo [ContactNo])
contactNosByIncidentNosIndexed = mapReadWrite (groupByFst,\w _ -> Just (ungroupByFst w)) (Just \p ws. Ok (groupByFst ws)) contactNosByIncidentNos
412

413
contactNosByIncidentNos :: SDSSequence (Maybe [IncidentNo]) [(IncidentNo,ContactNo)] [(IncidentNo,ContactNo)]
414 415
contactNosByIncidentNos = dbLinkSDS "contactNosByIncidentNos" "contacts_incidents" "contacts" "incidents"

416 417
communicationNosByIncidentNosIndexed :: SDSLens (Maybe [IncidentNo]) (Map IncidentNo [CommunicationNo]) (Map IncidentNo [CommunicationNo])
communicationNosByIncidentNosIndexed = mapReadWrite (groupByFst,\w _ -> Just (ungroupByFst w)) (Just \p ws. Ok (groupByFst ws)) communicationNosByIncidentNos
418

419
communicationNosByIncidentNos :: SDSSequence (Maybe [IncidentNo]) [(IncidentNo,CommunicationNo)] [(IncidentNo,CommunicationNo)]
420 421
communicationNosByIncidentNos = dbLinkSDS "communicationNosByIncidentNos" "communications_aboutIncidents" "communications" "aboutIncidents"

422
allContacts :: SDSLens () [Contact] ()
423 424
allContacts = sdsFocus Nothing filteredContacts

425
filteredContacts :: SDSLens (Maybe RowFilterDef) [Contact] ()
426 427
filteredContacts = mapRead prj
    (    allContactsBase
428 429 430
     |*| sdsFocus Nothing incidentNosByContactNosIndexed
     |*| sdsFocus Nothing communicationNosByContactNosIndexed
     |*| sdsFocus () allContactPhotos)
431 432 433 434 435 436 437 438 439 440 441 442 443 444 445
where
	prj (((contacts,ilinks),clinks),photos) = [addPhotos photos (addLinks ilinks clinks c) \\ c <- contacts]

	addLinks ilinks clinks contact=:{Contact|contactNo}
		= {Contact
		  |contact
		  & incidents			= fromMaybe [] ('DM'.get contactNo ilinks)
		  , communicationsWith	= fromMaybe [] ('DM'.get contactNo clinks)
		  }
    addPhotos photos contact=:{Contact|contactNo}
        = {Contact
          |contact
          & photos              = fromMaybe [] ('DM'.get contactNo photos)
          }

446
allContactsBase :: SDSLens (Maybe RowFilterDef) [Contact] ()
447 448 449 450 451 452 453 454
allContactsBase = sdsTranslate "allContactsBase" query (dbReadSDS "allContacts")
where
    query rows =
       { columns = columnsContact
       , rows = rows
       , order = Just [OrderAsc ("Contact","name")]
       }

455
sqlFilteredContactsShort :: SDSLens (Maybe RowFilterDef) [ContactShort] ()
456 457 458 459 460 461 462 463
sqlFilteredContactsShort = sdsTranslate "sqlFilteredContactsShort" query (dbReadSDS "allContacts")
where
    query rows =
        { columns   = columnsContactShort
        , rows      = rows
        , order     = Just [OrderAsc ("Contact","name")]
        }

464
filteredContactsGeo :: SDSLens (Maybe RowFilterDef) [ContactGeo] ()
465 466 467 468 469 470 471 472
filteredContactsGeo = sdsTranslate "filteredContactsGeo" query (dbReadSDS "allContacts")
where
    query rows =
        { columns   = columnsContactGeo
        , rows      = rows
        , order     = Just [OrderAsc ("Contact","name")]
        }

473
allContactsShort :: SDSLens () [ContactShort] ()
474 475
allContactsShort = sdsFocus Nothing sqlFilteredContactsShort

476
filteredContactsShort :: SDSLens ContactFilter [ContactShort] ()
477 478 479 480 481
filteredContactsShort = sdsTranslate "filteredContactsShort" param sqlFilteredContactsShort
where
    param {filterByName=Just name}  = Just (LikeValue ("Contact","name") (name+++"%"))
    param _                         = Nothing

482
contactsWithGroupShort :: SDSLens String [ContactShort] ()
483 484 485 486
contactsWithGroupShort = sdsTranslate "contactsWithGroupShort" query sqlFilteredContactsShort
where
    query group = Just (EqualsValue ("Contact","group") (toSQL group))

487
contactsOfOpenIncidentsShort :: SDSSequence () [ContactShortWithIncidents] ()
Bas Lijnse's avatar
Bas Lijnse committed
488
contactsOfOpenIncidentsShort = sdsSequence "contactsOfOpenIncidentsShort" id param (\_ _ -> Right read) writel writer contactsOfOpenIncidentsShortBase openIncidentsByContactsShortIndexed
489 490 491 492 493 494 495 496 497
where
    writel = SDSWriteConst (\_ _ -> Ok Nothing)
    writer = SDSWriteConst (\_ _ -> Ok Nothing)
    param _ contacts = [contactNo \\ {ContactShortWithIncidents|contactNo} <- contacts]
    read (contacts,incidents) = [{ContactShortWithIncidents|c & incidents = fromMaybe [] ('DM'.get contactNo incidents)}
                                \\ c=:{ContactShortWithIncidents|contactNo} <- contacts]

    openIncidentsByContactsShortIndexed = mapRead groupByFst openIncidentsByContactsShort

498
contactsOfOpenIncidentsShortBase :: SDSLens () [ContactShortWithIncidents] ()
499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518
contactsOfOpenIncidentsShortBase = sdsFocus query (dbReadSDS "contactsOfOpenIncidentsShort")
where
/*
    query =
        { columns   = LeftJoin (RightJoin columnsContactShortWithIncidents
                        {name="contacts_incidents",alias="contacts_incidents",columns=[]} ("contacts_incidents","incidents") ("Contact","contactNo"))
                        {name="Incident",alias="Incident",columns=[]} ("contacts_incidents","contacts") ("Incident","incidentNo")
        , rows      = Just (OrCondition (EqualsValue ("Incident","closed") [SQLVInteger 0]) (EqualsNull ("Incident","closed")))
        , order     = Nothing
        }
*/
    //PREVENT RIGHT JOIN BECAUSE OF SQLITE
    query
      # (BaseTable tblContactCols) = columnsContactShortWithIncidents
      = { columns   = LeftJoin (LeftJoin (BaseTable {name="Incident",alias="Incident",columns=[]})
                    {name="contacts_incidents",alias="contacts_incidents",columns=[]} ("Incident","incidentNo") ("contacts_incidents","contacts"))
                    tblContactCols ("contacts_incidents","incidents") ("Contact","contactNo")
        , rows      = Just (AndCondition (NotCondition (EqualsNull ("Contact","contactNo"))) (OrCondition (EqualsValue ("Incident","closed") [SQLVInteger 0]) (EqualsNull ("Incident","closed"))))
        , order     = Nothing
        }
519
contactsOfOpenIncidentsGeo :: SDSLens () [ContactGeo] ()
520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540
contactsOfOpenIncidentsGeo = sdsFocus query (dbReadSDS "contactsOfOpenIncidentsGeo")
where
    /*
    query =
        { columns   = LeftJoin (RightJoin columnsContactGeo
                        {name="contacts_incidents",alias="contacts_incidents",columns=[]} ("contacts_incidents","incidents") ("Contact","contactNo"))
                        {name="Incident",alias="Incident",columns=[]} ("contacts_incidents","contacts") ("Incident","incidentNo")
        , rows      = Just (OrCondition (EqualsValue ("Incident","closed") [SQLVInteger 0]) (EqualsNull ("Incident","closed")))
        , order     = Nothing
        }
    */
    //PREVENT RIGHT JOIN BECAUSE OF SQLITE
    query
      # (BaseTable tblContactCols) = columnsContactGeo
      = { columns   = LeftJoin (LeftJoin (BaseTable {name="Incident",alias="Incident",columns=[]})
                    {name="contacts_incidents",alias="contacts_incidents",columns=[]} ("Incident","incidentNo") ("contacts_incidents","contacts"))
                    tblContactCols ("contacts_incidents","incidents") ("Contact","contactNo")
        , rows      = Just (AndCondition (NotCondition (EqualsNull ("Contact","contactNo"))) (OrCondition (EqualsValue ("Incident","closed") [SQLVInteger 0]) (EqualsNull ("Incident","closed"))))
        , order     = Nothing
        }

541
openIncidentsByContactsShort :: SDSSequence [ContactNo] [(ContactNo,IncidentShort)] ()
542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562
openIncidentsByContactsShort = databaseDef >++> sqlShare "openIncidentsByContacts" readFun writeFun
where
    query contactNo =
        {columns = InnerJoin columnsIncidentShort {name="contacts_incidents",alias="contacts_incidents",columns=["incidents"]} ("Incident","incidentNo") ("contacts_incidents","contacts")
        ,rows    = Just (AndCondition
            (EqualsValue ("contacts_incidents","incidents") (map SQLVInteger contactNo))
            (OrCondition (EqualsValue ("Incident","closed") [SQLVInteger 0]) (EqualsNull ("Incident","closed")))
            )
        ,order   = Nothing
        }

	readFun contactNo cur
        # (sql,vals) = toReadSQL (query contactNo)
        # (res,cur) = execSelect sql vals cur
		= case res of
			Error e	= (Error e,cur)
			Ok rows = (Ok (map fromSQLWithId rows),cur)

	writeFun contactNo _ cur
		= (Ok (),cur)

563
contactsOfOpenIncidents :: SDSLens () [Contact] ()
564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584
contactsOfOpenIncidents = sdsFocus query (dbReadSDS "contactsOfOpenIncidents") //TODO: Add incidents and communications fields, and use select distinct
where
 /*
 query =
    { columns   = LeftJoin (RightJoin columnsContact
                    {name="contacts_incidents",alias="contacts_incidents",columns=[]} ("contacts_incidents","incidents") ("Contact","contactNo"))
                    {name="Incident",alias="Incident",columns=[]} ("contacts_incidents","contacts") ("Incident","incidentNo")
    , rows      = Just (OrCondition (EqualsValue ("Incident","closed") [SQLVInteger 0]) (EqualsNull ("Incident","closed")))
    , order     = Just [OrderAsc ("Contact","name")]
    }
*/
    //PREVENT RIGHT JOIN BECAUSE OF SQLITE
    query
      # (BaseTable tblContactCols) = columnsContact
      = { columns   = LeftJoin (LeftJoin (BaseTable {name="Incident",alias="Incident",columns=[]})
                    {name="contacts_incidents",alias="contacts_incidents",columns=[]} ("Incident","incidentNo") ("contacts_incidents","contacts"))
                    tblContactCols ("contacts_incidents","incidents") ("Contact","contactNo")
        , rows      = Just (AndCondition (NotCondition (EqualsNull ("Contact","contactNo"))) (OrCondition (EqualsValue ("Incident","closed") [SQLVInteger 0]) (EqualsNull ("Incident","closed"))))
        , order     = Just [OrderAsc ("Contact","name")]
        }

585
contactsNeedingHelpShort :: SDSLens () [ContactShort] ()
586 587 588 589
contactsNeedingHelpShort = sdsTranslate "contactsNeedingHelpShort" query sqlFilteredContactsShort
where
    query group = Just (EqualsValue ("Contact","needsHelp") (toSQL True))

590
contactsProvidingHelpShort :: SDSLens () [ContactShort] ()
591 592 593 594
contactsProvidingHelpShort = sdsTranslate "contactsProvidingHelpShort" query sqlFilteredContactsShort
where
    query group = Just (EqualsValue ("Contact","providesHelp") (toSQL True))

595
contactsProvidingHelpGeo :: SDSLens () [ContactGeo] ()
596 597 598 599
contactsProvidingHelpGeo = sdsTranslate "contactsProvidingHelpGeo" query filteredContactsGeo
where
    query group = Just (EqualsValue ("Contact","providesHelp") (toSQL True))

600
contactsByNos :: SDSLens [ContactNo] [Contact] ()
601 602 603 604 605
contactsByNos = sdsTranslate "contactsByNos" cond filteredContacts
where
    cond []  = Just (EqualsValue ("Contact","contactNo") [SQLVInteger 0]) //Don't match anythig
    cond nos = Just (EqualsValue ("Contact","contactNo") (map SQLVInteger nos))

606
contactsByNosShort :: SDSLens [ContactNo] [ContactShort] ()
607 608 609 610 611 612
contactsByNosShort = sdsTranslate "contactsByNosShort" cond sqlFilteredContactsShort
where
    cond []  = Just (EqualsValue ("Contact","contactNo") [SQLVInteger 0]) //Don't match anythig
    cond nos = Just (EqualsValue ("Contact","contactNo") (map SQLVInteger nos))


613
contactsByIncident :: SDSSequence IncidentNo [Contact] [ContactNo]
614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638
contactsByIncident = databaseDef >++> sqlShare "allContacts" readFun writeFun
where
    query incidentNo =
        {columns = InnerJoin columnsContact {name="contacts_incidents",alias="contacts_incidents",columns=[]} ("Contact","contactNo") ("contacts_incidents","incidents")
        ,rows    = Just (EqualsValue ("contacts_incidents","contacts") [SQLVInteger incidentNo])
        ,order   = Just [OrderAsc ("Contact","name")]
        }

	readFun incidentNo cur
        # (sql,vals) = toReadSQL (query incidentNo)
        # (res,cur) = execSelect sql vals cur
		= case res of
			Error e	= (Error e,cur)
			Ok rows = (Ok (map fromSQL rows),cur)

	writeFun incidentNo links cur
		//Unlink old
		# (err,cur) 	= execute "DELETE FROM contacts_incidents WHERE contacts = ? " (toSQL incidentNo) cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		//Relink new
		# (err,cur)		= executeMany "INSERT INTO contacts_incidents (contacts,incidents) VALUES (?,?)"
							[toSQL incidentNo ++ toSQL contactNo \\ contactNo <- links] cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		= (Ok (),cur)

639
contactsByIncidentShort	:: SDSSequence IncidentNo [ContactShort] [ContactNo]
640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664
contactsByIncidentShort = databaseDef >++> sqlShare "contactsByIncidentShort" readFun writeFun
where
    query incidentNo =
        {columns = InnerJoin columnsContactShort {name="contacts_incidents",alias="contacts_incidents",columns=[]} ("Contact","contactNo") ("contacts_incidents","incidents")
        ,rows    = Just (EqualsValue ("contacts_incidents","contacts") [SQLVInteger incidentNo])
        ,order   = Just [OrderAsc ("Contact","name")]
        }

	readFun incidentNo cur
        # (sql,vals) = toReadSQL (query incidentNo)
        # (res,cur)  = execSelect sql vals cur
		= case res of
			Error e	= (Error e,cur)
			Ok rows = (Ok (map fromSQL rows),cur)

	writeFun incidentNo links cur
		//Unlink old
		# (err,cur) 	= execute "DELETE FROM contacts_incidents WHERE contacts = ? " (toSQL incidentNo) cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		//Relink new
		# (err,cur)		= executeMany "INSERT INTO contacts_incidents (contacts,incidents) VALUES (?,?)"
							[toSQL incidentNo ++ toSQL contactNo \\ contactNo <- links] cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		= (Ok (),cur)

665
contactsByIncidentGeo :: SDSLens IncidentNo [ContactGeo] ()
666 667 668 669 670 671 672 673
contactsByIncidentGeo = sdsTranslate "contactsByIncidentGeo" query (dbReadSDS "contactsByIncidentShort")
where
    query incidentNo =
        {columns = InnerJoin columnsContactGeo {name="contacts_incidents",alias="contacts_incidents",columns=[]} ("Contact","contactNo") ("contacts_incidents","incidents")
        ,rows    = Just (EqualsValue ("contacts_incidents","contacts") [SQLVInteger incidentNo])
        ,order   = Just [OrderAsc ("Contact","name")]
        }

674 675
contactByNo :: SDSLens ContactNo Contact Contact
contactByNo = mapReadWrite (readPrj,writePrj) (Just \p ((w, _), _). Ok w)
676
    (contactByNoBase
677 678 679
     >*< sdsTranslate "contactByNoIncident" (\p -> Just [p]) incidentNosByContactNosIndexed
     >*< sdsTranslate "contactByNoCommunications" (\p -> Just [p]) communicationNosByContactNosIndexed
     >*| contactPhotos)
680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698
where
	readPrj (((contact,ilinks),clinks),photos) = (addPhotos photos o addLinks ilinks clinks) contact

	addLinks ilinks clinks contact=:{Contact|contactNo}
		= {Contact
		  |contact
		  & incidents			= fromMaybe [] ('DM'.get contactNo ilinks)
		  , communicationsWith	= fromMaybe [] ('DM'.get contactNo clinks)
		  }
    addPhotos photos contact=:{Contact|contactNo}
        = {Contact
          |contact
          & photos              = photos
          }

	writePrj (contact=:{Contact|contactNo,incidents,communicationsWith}) (((_,ilinks),clinks),_)
		= Just ((contact,'DM'.put contactNo incidents ilinks),'DM'.put contactNo communicationsWith clinks)
	writePrj _ _ = Nothing

699
contactByNoBase :: SDSSequence ContactNo Contact Contact
700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735
contactByNoBase = databaseDef >++> sqlShare "contactByNo" readFun writeFun
where
    query contactNo
        = {columns=columnsContact,rows=Just (EqualsValue ("Contact","contactNo") (toSQL contactNo)), order = Nothing}

	readFun contactNo cur
        # (sql,vals)        = toReadSQL (query contactNo)
        # (err,cur)         = execute sql vals cur
		| isJust err		= (Error (toString (fromJust err)),cur)
		# (err,mbRow,cur)	= fetchOne cur
		| isJust err		= (Error (toString (fromJust err)),cur)
        | isNothing mbRow   = (Error ("Could not find contact number " +++ toString contactNo),cur)
		= (Ok (fromSQL (fromJust mbRow)), cur)

	writeFun contactNo {Contact|type,name,group,position,heading,track,positionUpdated,needsHelp,providesHelp,notes,account,access,status} cur
		//Update Contact table
		# (err,cur) = execute "UPDATE Contact SET `type` = ?, `name` = ?, `group` = ?, `position_lat` = ?, `position_lon` = ?, `position_desc` = ?, `heading` = ?, `track` = ?, `positionUpdated` = ?, `needsHelp` = ?, `providesHelp` = ?, `notes` = ?, `account` = ?, `access` = ?, `status` = ? WHERE `contactNo` = ?"
				(flatten
                [mbToSQL type
				,mbToSQL name
                ,mbToSQL group
                ,mbToSQL position
				,mbToSQL heading
				,mbToSQL track
				,mbToSQL positionUpdated
				,toSQL   needsHelp
                ,toSQL   providesHelp
				,mbToSQL notes
                ,mbToSQL account
                ,mbToSQL access
                ,mbToSQL status
				,toSQL   contactNo
				]) cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		                = (Ok (), cur)

736
contactByMMSI :: SDSSequence MMSI (Maybe Contact) (Maybe Contact)
737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764
contactByMMSI = databaseDef >++> sqlShare "contactByMMSI" readFun writeFun
where
    //Find the first contact that has a VHFRadio communication mean with matching mmsi
    /*
    query mmsi =
        { columns = RightJoin (RightJoin columnsContact
            {name="communicationMeans1_communicationMeans2",alias="communicationMeans1_communicationMeans2",columns=[]} ("Contact","contactNo") ("communicationMeans1_communicationMeans2","communicationMeans2"))
            {name="VHFRadio",alias="VHFRadio",columns=[]} ("communicationMeans1_communicationMeans2","communicationMeans1") ("VHFRadio","id")
        , rows = Just (EqualsValue ("VHFRadio","mmsi") [SQLVInteger mmsi])
        , order = Nothing
        }
    */
    //PREVENT RIGHT JOIN BECAUSE OF SQLITE
    query mmsi
      # (BaseTable tblContactCols) = columnsContact
      = { columns   = LeftJoin (LeftJoin (BaseTable {name="VHFRadio",alias="VHFRadio",columns=[]})
                        {name="communicationMeans1_communicationMeans2",alias="communicationMeans1_communicationMeans2",columns=[]} ("communicationMeans1_communicationMeans2","communicationMeans1") ("VHFRadio","id"))
                        tblContactCols ("communicationMeans1_communicationMeans2","communicationMeans2") ("Contact","contactNo")
        , rows      = Just (AndCondition (NotCondition (EqualsNull ("Contact","contactNo"))) (EqualsValue ("VHFRadio","mmsi") [SQLVInteger mmsi]))
        , order     = Nothing
        }
	readFun mmsi cur
        # (sql,vals)        = toReadSQL (query mmsi)
        # (err,cur)         = execute sql vals cur
		| isJust err		= (Error (toString (fromJust err)),cur)
		# (err,mbRow,cur)	= fetchOne cur
		| isJust err		= (Error (toString (fromJust err)),cur)
		= (Ok (fmap fromSQL mbRow), cur)
765

766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786
	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
	    //Update contact info
	    # (err,cur) = execute "UPDATE Contact SET `type` = ?, `name` = ?, `group` = ?, `position_lat` = ?,`position_lon` = ?, `position_desc` = ?, `heading` = ?, `track` = ?, `positionUpdated` = ?, `needsHelp` = ?, `providesHelp` = ?, `notes` = ?, `status` = ? WHERE `contactNo` = ?"
	        (flatten
            [mbToSQL type
            ,mbToSQL name
            ,mbToSQL group
            ,mbToSQL position
		    ,mbToSQL heading
            ,mbToSQL track
            ,mbToSQL positionUpdated
		    ,toSQL   needsHelp
		    ,toSQL   providesHelp
		    ,mbToSQL notes
            ,mbToSQL status
		    ,toSQL   contactNo
		    ]) cur
		| isJust err	= (Error (toString (fromJust err)),cur)
		    = (Ok (),cur)

787
contactByCredentials :: SDSLens Credentials (Maybe Contact) ()
788 789 790 791 792 793 794 795 796
contactByCredentials = mapRead listToMaybe (sdsTranslate "contactByCredentials" query (dbReadSDS "contactByCredentials"))
where
 query credentials =
    { columns   = columnsContact
    , rows      = Just (EqualsValue ("Contact","account") (toSQL credentials))
    , order     = Nothing
    }


797
contactCommunicationMeans :: SDSLens ContactNo [CommunicationMean] ()
798 799 800 801
contactCommunicationMeans = sdsTranslate "contactCommunicationMeans" query (dbReadSDS "allCommunicationMeans")
where
    query contactNo = {columns=columns,rows=rows contactNo,order = Nothing}
    rows contactNo = Just (EqualsValue ("communicationMeans1_communicationMeans2","communicationMeans2") [SQLVInteger contactNo])
802
    columns = InnerJoin columnsCommunicationMean
803 804 805
                {name="communicationMeans1_communicationMeans2",alias="communicationMeans1_communicationMeans2",columns=[]}
                ("communicationMeans1_communicationMeans2","communicationMeans1") ("CommunicationMean","id")

806
communicationMeanById :: SDSSequence CommunicationMeanId CommunicationMean CommunicationMean
807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826
communicationMeanById = databaseDef >++> sqlShare "communicationMeanById" readFun writeFun
where
    readFun id cur
        # (sql,match)       = toReadSQL {columns=columnsCommunicationMean,rows=Just (EqualsValue ("CommunicationMean","id") [SQLVInteger id]),order=Nothing}
	    # (err,cur)			= execute sql match cur
		| isJust err		= (Error (toString (fromJust err)),cur)
		# (err,mbRow,cur)	= fetchOne cur
		| isJust err		= (Error (toString (fromJust err)),cur)
		                    = (Ok (maybe defaultValue fromSQL mbRow), cur)

    writeFun id mean=:{CommunicationMean|type,phoneNo,callSign,mmsi,emailAddress,capCode} cur
        # (query,args) = case type of
           CMPhone  = ("UPDATE Telephone SET phoneNo = ? WHERE id = ?",mbToSQL phoneNo ++ toSQL id)
           CMVHF    = ("UPDATE VHFRadio SET callSign = ?, mmsi = ? WHERE id = ?",mbToSQL callSign ++ mbToSQL mmsi ++ toSQL id)
           CMEmail  = ("UPDATE EmailAccount SET emailAddress = ? WHERE id = ?",mbToSQL emailAddress ++ toSQL id)
           CMP2000  = ("UPDATE P2000Receiver SET capCode = ? WHERE id = ?",mbToSQL capCode ++ toSQL id)
        = case execute query args cur of
            (Just e, cur) = (Error (toString e), cur)
            (_, cur)      = (Ok (), cur)

827
contactMMSI :: SDSLens ContactNo (Maybe MMSI) ()
828 829 830 831 832 833
contactMMSI = mapRead toPrj contactCommunicationMeans
where
    toPrj means = case [mmsi \\{CommunicationMean|type=CMVHF,mmsi=Just mmsi} <- means] of
        [mmsi:_]    = Just mmsi
        _           = Nothing

834
contactAIS :: SDSSequence ContactNo (Maybe AISContact) ()
Bas Lijnse's avatar
Bas Lijnse committed
835 836
contactAIS = sdsSequence "contactAIS" id (\_ mbMMSI -> mbMMSI) (\_ _ -> Right snd) (SDSWriteConst (\_ _ -> Ok Nothing)) (SDSWriteConst (\_ w -> Ok (Just w)))
	contactMMSI (roMaybe (toReadOnly AISContactByMMSI))
837

838
contactCommunications :: SDSLens ContactNo [CommunicationDetails] ()
839 840 841 842 843
contactCommunications = sdsTranslate "contactCommunications" cond filteredCommunications
where
    cond contactNo = Just (OrCondition (EqualsValue ("Communication","withContact") [SQLVInteger contactNo])
                            (EqualsValue ("Communication","handledBy") [SQLVInteger contactNo]))

844 845
contactPhotos :: SDSLens ContactNo [ContactPhoto] [ContactPhoto]
contactPhotos = sdsSplit "contactPhotos" param read write (Just reducer) allContactPhotos
846 847 848
where
    param p             = ((),p)
    read p all          = fromMaybe [] ('DM'.get p all)
849
    write p all photos  = ('DM'.put p photos all, const ((==) p))
850
    reducer p w 		= Ok (read p w)
851

852 853
contactAccess :: SDSLens ContactNo ContactAccess ContactAccess
contactAccess = mapReadWrite (read,write) (Just reducer) contactByNoBase
854 855 856
where
    read {Contact|account,access} = {ContactAccess|account=account,access=access}
    write {ContactAccess|account,access} contact = Just {Contact|contact & account = account, access=access}
857
    reducer p ws = Ok (read ws) 
858

859
contactAvatar :: SDSLens ContactNo ContactAvatar ()
860 861 862 863
contactAvatar = mapRead toAvatar (toReadOnly contactByNo)
where
    toAvatar {Contact|contactNo,name,type,photos=photos} = {ContactAvatar|contactNo=contactNo,name=name,type=type,photos=photos}

864
personDetailsByNo :: SDSLens ContactNo PersonDetails PersonDetails
865 866 867 868
personDetailsByNo = sdsTranslate "personDetailsByNo" query (dbReadWriteOneSDS "personDetailsByNo")
where
    query contactNo = {columns=columnsPersonDetails,rows=Just (EqualsValue ("Person","contactNo") [SQLVInteger contactNo]), order=Nothing}

869
vesselDetailsByNo :: SDSLens ContactNo VesselDetails VesselDetails
870 871 872 873
vesselDetailsByNo = sdsTranslate "vesselDetailsByNo" query (dbReadWriteOneSDS "vesselDetailsByNo")
where
    query contactNo = {columns=columnsVesselDetails,rows=Just (EqualsValue ("Vessel","contactNo") [SQLVInteger contactNo]), order=Nothing}

874
surferDetailsByNo :: SDSLens ContactNo SurferDetails SurferDetails
875 876 877 878
surferDetailsByNo = sdsTranslate "surferDetailsByNo" query (dbReadWriteOneSDS "surferDetailsByNo")
where
    query contactNo = {columns=columnsDiverDetails,rows=Just (EqualsValue ("Surfer","contactNo") [SQLVInteger contactNo]), order=Nothing}

879
diverDetailsByNo :: SDSLens ContactNo DiverDetails DiverDetails
880 881 882 883
diverDetailsByNo = sdsTranslate "diverDetailsByNo" query (dbReadWriteOneSDS "diverDetailsByNo")
where
    query contactNo = {columns=columnsDiverDetails,rows=Just (EqualsValue ("Diver","contactNo") [SQLVInteger contactNo]), order=Nothing}

884
airplaneDetailsByNo :: SDSLens ContactNo AirplaneDetails AirplaneDetails
885 886 887 888
airplaneDetailsByNo = sdsTranslate "airplaneDetailsByNo" query (dbReadWriteOneSDS "airplaneDetailsByNo")
where
    query contactNo = {columns=columnsAirplaneDetails,rows=Just (EqualsValue ("Airplane","contactNo") [SQLVInteger contactNo]), order=Nothing}

889
helicopterDetailsByNo :: SDSLens ContactNo HelicopterDetails HelicopterDetails
890 891 892 893
helicopterDetailsByNo = sdsTranslate "helicopterDetailsByNo" query (dbReadWriteOneSDS "helicopterDetailsByNo")
where
    query contactNo = {columns=columnsHelicopterDetails,rows=Just (EqualsValue ("Helicopter","contactNo") [SQLVInteger contactNo]), order=Nothing}

894 895
incidentNosByContactNosIndexed :: SDSLens (Maybe [ContactNo]) (Map ContactNo [IncidentNo]) (Map ContactNo [IncidentNo])
incidentNosByContactNosIndexed = mapReadWrite (groupByFst,\w _ -> Just (ungroupByFst w)) (Just \p w -> Ok (groupByFst w)) incidentNosByContactNos
896

897
incidentNosByContactNos :: SDSSequence (Maybe [ContactNo]) [(ContactNo,IncidentNo)] [(ContactNo,IncidentNo)]
898 899
incidentNosByContactNos = dbLinkSDS "incidentNosByContactNos" "contacts_incidents" "incidents" "contacts"

900 901
incidentNosByCommunicationNosIndexed :: SDSLens (Maybe [CommunicationNo]) (Map CommunicationNo [IncidentNo]) (Map CommunicationNo [IncidentNo])
incidentNosByCommunicationNosIndexed = mapReadWrite (groupByFst,\w _ -> Just (ungroupByFst w)) (Just \p w. Ok (groupByFst w)) incidentNosByCommunicationNos
902

903
incidentNosByCommunicationNos :: SDSSequence (Maybe [CommunicationNo]) [(CommunicationNo,IncidentNo)] [(CommunicationNo,IncidentNo)]
904 905
incidentNosByCommunicationNos = dbLinkSDS "incidentNosByCommunicationNos" "communications_aboutIncidents" "aboutIncidents" "communications"

906 907
communicationNosByContactNosIndexed :: SDSLens (Maybe [ContactNo]) (Map ContactNo [CommunicationNo]) (Map ContactNo [CommunicationNo])
communicationNosByContactNosIndexed = mapReadWrite (groupByFst,\w _ -> Just (ungroupByFst w)) (Just \p w. Ok (groupByFst w)) communicationNosByContactNos
908

909
communicationNosByContactNos :: SDSLens (Maybe [ContactNo]) [(ContactNo,CommunicationNo)] [(ContactNo,CommunicationNo)]
910 911 912 913
communicationNosByContactNos = sdsTranslate "communicationNosByContactNos" (const ()) (sharedStore "FIXME" [])
//communicationNosByContactNos = dbLinkSDS "communicationNosByContactNos" "Communication" "communicationNo" "withContact"
//TODO: This set should be merged with the "handledBy" relation betweeen communications and contacts

914
sqlFilteredAISContacts :: SDSLens (Maybe RowFilterDef) [AISContact] ()
915 916 917 918 919 920 921 922
sqlFilteredAISContacts = sdsTranslate "sqlFilteredAISContacts" query (dbReadSDS "allAISContacts")
where
    query rows =
        { columns   = columnsAISContact
        , rows      = rows
        , order     = Nothing
        }

923
allAISContacts :: SDSLens () [AISContact] ()
924 925
allAISContacts = sdsFocus Nothing sqlFilteredAISContacts

926
boundedAISContacts :: SDSLens ContactBounds [AISContact] ()
927 928 929 930 931 932 933 934 935 936
boundedAISContacts = sdsTranslate "boundedAISContacts" query sqlFilteredAISContacts  //TODO: Filter by bounds
where
    query ((latmin,lonmin),(latmax,lonmax))
        = Just (AndCondition
            (AndCondition (GreaterEqualsValue ("AISContact","position_lat") (SQLVReal latmin))
                             (SmallerEqualsValue ("AISContact","position_lat") (SQLVReal latmax)))
            (AndCondition (GreaterEqualsValue ("AISContact","position_lon") (SQLVReal lonmin))
                             (SmallerEqualsValue ("AISContact","position_lon") (SQLVReal lonmax)))
            )

937
AISContactByMMSI :: SDSSequence MMSI (Maybe AISContact) (Maybe AISContact)
938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955
AISContactByMMSI = databaseDef >++> sqlShare "allAISContacts" readFun writeFun
where
    readFun mmsi cur
        # (sql,match)   = toReadSQL {columns = columnsAISContact, rows = Just (EqualsValue ("AISContact","mmsi") [SQLVInteger mmsi]), order = Nothing}
        # (res,cur)     = execSelect sql match cur
        = case res of
			Error e	    = (Error e,cur)
            Ok []       = (Ok Nothing, cur)
            Ok [row:_]  = (Ok (Just (fromSQL row)),cur)

    writeFun mmsi Nothing cur
        # (res,cur) = execDelete "DELETE FROM AISContact WHERE mmsi = ?" (toSQL mmsi) cur
        = case res of
			Error e	    = (Error e,cur)
            _           = (Ok (), cur)

    writeFun mmsi (Just {AISContact|position,heading,track,lastPositionMsg,lastInfoMsg,positionUpdated,infoUpdated}) cur
		//Brute force upsert, try insert, if it fails, try update
956
        # (res,cur) = execInsert "INSERT INTO AISContact (mmsi,position_lat,position_lon,position_desc,heading,track,lastPositionMsg,lastInfoMsg,positionUpdated,infoUpdated) VALUES (?,?,?,?,?,?,?,?,?,?)"
957 958 959 960 961 962 963 964 965
                        (flatten [toSQL mmsi, mbToSQL position, mbToSQL heading, mbToSQL track, mbToSQL lastPositionMsg, mbToSQL lastInfoMsg,mbToSQL positionUpdated, mbToSQL infoUpdated]) cur

		| res=:(Error _) //Try update
        	# (mbErr,cur) = execute "UPDATE AISContact SET position_lat = ?, position_lon = ?, position_desc = ?, heading = ?, track = ?, lastPositionMsg = ?, lastInfoMsg = ?, positionUpdated = ?, infoUpdated = ? WHERE mmsi = ?"
				(flatten [mbToSQL position, mbToSQL heading, mbToSQL track, mbToSQL lastPositionMsg, mbToSQL lastInfoMsg,mbToSQL positionUpdated, mbToSQL infoUpdated,toSQL mmsi]) cur
		| mbErr=:(Just _) = (Error (toString (fromJust mbErr)),cur)
            	= (Ok (), cur)
        = (Ok (),cur)

966
currentUserAvatar :: SDSSequence () (Maybe ContactAvatar) ()
Bas Lijnse's avatar
Bas Lijnse committed
967
currentUserAvatar = sdsSequence "userContactNo" id (\_ u -> userContactNo u) (\_ _ -> Right snd) writel writer currentUser (roMaybe (mapRead Just (toReadOnly contactAvatar)))
968
where