CrewLists.icl 4.16 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
implementation module Incidone.Extensions.CrewLists
import iTasks
import Incidone.OP.Concepts, Incidone.OP.SDSs, Incidone.OP.Conversions
import Incidone.OP.ContactManagementTasks
import Incidone.ActionManagementTasks
import Incidone.Util.TaskPatterns
import Text
import qualified Data.Map as DM

//This module provides an add-on that keeps track of the deployed crew of a rescue vessel

//Data storage
Haye Böhm's avatar
Haye Böhm committed
13
crewListsStore :: SDSLens ContactNo [ContactNo] [ContactNo]
14 15
crewListsStore = indexedStore "crewLists" []

Haye Böhm's avatar
Haye Böhm committed
16
crewAliasListsStore :: SDSLens ContactNo [(Int,ContactNo)] [(Int,ContactNo)]
17 18 19 20 21
crewAliasListsStore = indexedStore "crewAliasLists" []

//Manage the crew information for a specific contact
manageContactCrew :: ContactNo -> Task ()
manageContactCrew contactNo
22
    =   Hint "Manage crew" @>> updateSharedContactRefList (sdsFocus contactNo crewListsStore)
23
    //Optional Improvements
24
//    -|| forever (addStandardCrewMembers contactNo)
25 26 27 28
    -|| forever (quickAddStandardCrewMembers contactNo)
    @!  ()
where
    addStandardCrewMembers contactNo
29
        =   enterInformation "FIXME" []//editSharedMultipleChoice "Select standard crew members" [ChooseFromCheckGroup view] [] items
Bas Lijnse's avatar
Bas Lijnse committed
30
        >>* [OnAction (Action "Add members") (hasValue (\sel -> addCrewMembers contactNo (map (contactIdentity o snd) sel)))]
31 32 33 34 35 36 37 38 39 40
    where
        view (no,c) = (no,contactTitle c)
        items = sdsDeref (sdsFocus contactNo crewAliasListsStore) snd contactsByNosShort derefAliasList

    addCrewMembers contactNo refs
        = upd (\l -> removeDup (l ++ refs)) (sdsFocus contactNo crewListsStore)

    quickAddStandardCrewMembers contactNo
        =   get (sdsFocus contactNo crewAliasListsStore)
            -&&-
41
            (Hint "Enter the numbers of the crew numbers you want to set (comma separated)" @>> enterInformation [] @ (map (toInt o trim) o (split ",")))
Bas Lijnse's avatar
Bas Lijnse committed
42
        >>* [OnAction (Action "Set members") (hasValue (\(aliasList,enteredNos) ->
43 44 45 46 47 48 49 50 51
                setCrewMembers contactNo (flatten [[cNo \\ (aNo,cNo) <- aliasList | aNo == eNo] \\ eNo <- enteredNos])))]

    setCrewMembers contactNo refs
        = set (removeDup refs) (sdsFocus contactNo crewListsStore)

//Manage the crew alias list for a contact
manageCrewAliasList :: ContactNo -> Task ()
manageCrewAliasList contactNo
    =   manageCurrentItems
Bas Lijnse's avatar
Bas Lijnse committed
52
    >^* [OnAction (Action "Add") (always (addItem <<@ InWindow))]
53 54 55 56 57
    @!  ()
where
    refs = sdsFocus contactNo crewAliasListsStore

    manageCurrentItems
58
        = Hint "Manage crew list" @>> updateSharedInformation [UpdateSharedAs toPrj fromPrj (const o Just)] items
59 60
    where
        items = sdsDeref refs snd contactsByNosShort derefAliasList
Bas Lijnse's avatar
Bas Lijnse committed
61 62
        toPrj l = [(contactIdentity c, aNo, contactTitle c)\\(aNo,c) <-l]
        fromPrj _ items = [(aNo,cNo) \\ (cNo,aNo,_) <- items]
63 64

    addItem
65
        = (Hint "Enter a number to use when refering to this contact" @>> enterInformation  []
66 67
            -&&-
           selectKnownOrDefineNewContact)
68
        >?? (\(aliasNo,def) -> createContactIfNew def >>- \contactNo -> upd (\r -> r++[(aliasNo,contactNo)]) refs)
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
        @!  ()

derefAliasList :: [(Int,ContactNo)] [ContactShort] -> [(Int,ContactShort)]
derefAliasList [] _ = []
derefAliasList [(no,cNo):xs] cs = case [c \\ c <- cs |contactIdentity c == cNo] of
    [c:_]   = [(no,c):derefAliasList xs cs]
    _       = derefAliasList xs cs

//Describe the top-level tasks to make it possible to add them to the
//catalog of standard actions
crewListActions :: [CatalogAction]
crewListActions = [toContactAction (Just "KNRM") manageContactCrewAction
                  ,toContactAction (Just "KNRM") manageCrewAliasListAction
                  ]

manageContactCrewAction :: ActionDefinition ContactNo
manageContactCrewAction =
    {ActionDefinition
    |identity   = "manage-contact-crew"
    ,meta       = {ItemMeta|title="Contact info/Manage Crew list",description=Nothing}
    ,task       = \c s -> manageContactCrew c @? const NoValue
    }

manageCrewAliasListAction :: ActionDefinition ContactNo
manageCrewAliasListAction =
    {ActionDefinition
    |identity   = "manage-crew-aliases"
    ,meta       = {ItemMeta|title="Admin/Manage Crew Alias list",description=Nothing}
    ,task       = \c s -> manageCrewAliasList c @? const NoValue
    }