implementation module Incidone.RoleBased.AdministratorTasks

import iTasks, iTasks.API.Extensions.SQLDatabase
import Incidone.OP.Concepts, Incidone.OP.SDSs, Incidone.OP.DemonstrationTasks
import Incidone.OP.ContactManagementTasks
import Incidone.OP.ImportExportTasks
import Incidone.Configuration
import Incidone.Integration.AIS
import Incidone.Integration.Asterisk
import Incidone.ContactPosition
import Incidone.ActionManagementTasks
import Incidone.Util.TaskPatterns
import iTasks.API.Extensions.Admin.ServerAdmin
import iTasks.API.Extensions.Dashboard

:: DatabaseProblem
    = NoDatabaseAccess
    | NoDatabaseTables
    | IncorrectDatabaseTables

derive class iTask DatabaseProblem

configureIncidone :: [Workspace -> Task ()]
configureIncidone = map const [configureDatabase
                              ,manageUsers              <<@ (Title "Users")
                              ,manageDemoData
                              ,configureIntegration
                              ,manageUserActionCatalog
                              ,configureMaps            <<@ (Title "Maps")
                              ,configureWebLinks        <<@ (Title "Web integration")
//                              ,(manageServer @! ())     <<@ (Title "Processes")
                              ]
configureDatabase :: Task ()
configureDatabase
    =   viewDatabaseConfigStatus
    >^* [OnAction (Action "Configure database" []) (always (doOrCancel setupDatabase <<@ InWindow))
        ,OnAction (Action "Manage database" []) (ifValue hasAccess (\_ -> doOrClose manageDatabase <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600)) <<@ InWindow))
        ]
    @! ()
where
    hasAccess (Error NoDatabaseAccess)  = False
    hasAccess _                         = True

    viewDatabaseConfigStatus
        =   whileUnchanged databaseConfig
        \config ->
            checkDatabaseConfig config
        >>- viewInformation (Title "Database configuration") [ViewWith databaseStatusView]

    databaseStatusView (Ok InternalSQLiteDB)            = Row (LightOnGreen, "Incidone is correctly configured to use an internal SQLite database.")
    databaseStatusView (Ok (ExternalMySQLDB _))         = Row (LightOnGreen, "Incidone is correctly configured to use an external MySQL database.")
    databaseStatusView (Error NoDatabaseAccess)         = Row (LightOnRed, "A database is configured, but it can not be accessed. Please reconfigure.")
    databaseStatusView (Error NoDatabaseTables)         = Row (LightOnRed, "A database is configured, but it contains no tables. Please reconfigure.")
    databaseStatusView (Error IncorrectDatabaseTables)  = Row (LightOnRed, "A database is configured, but it contains other tables than Incidone's. Please reconfigure.")

    setupDatabase
        =   get databaseConfig
        >>- editDatabaseConfig
    where
        editDatabaseConfig config
            =   updateInformation ("Database configuration","Please edit settings") [] config
            >>= \newConfig ->
                checkDatabaseConfig newConfig
            >>- \mbError -> case mbError of
                Ok config
                    = set config databaseConfig @! ()
                Error NoDatabaseTables
                    =   set newConfig databaseConfig
                    >>| viewInformation ("Create tables","The database you configured does not have tables set up yet.") [] "Do you want to create them now?"
                    >>* [OnAction ActionYes (always (createIncidoneTables (toDatabaseDef newConfig) @! ()))
                        ,OnAction ActionNo (always (return ()))
                        ]

                Error e
                    =   viewInformation ("Warning","The new configuration appears to have a problem") [ViewWith databaseStatusView] (Error e)
                    >>* [OnAction (Action "Set anyway" []) (always (set config databaseConfig @! ()))
                        ,OnAction (Action "Change and try again" []) (always (editDatabaseConfig newConfig))
                        ]

    checkDatabaseConfig config
        = catchAll
            ( get (sdsFocus (toDatabaseDef config) sqlTables)
             >>- \tables -> if (isEmpty tables)
                (return (Error NoDatabaseTables))
                (if (checkTables tables)
                    (return (Ok config))
                    (return (Error IncorrectDatabaseTables))
                )
            )
            (\e -> return (Error NoDatabaseAccess))
    where
        checkTables tables = foldl (\c t -> c && isMember t.SQLTable.name tables) True IncidoneDB

    manageDatabase
        =   get databaseDef
        >>- \db ->
          (  (enterChoiceWithShared (Title "Tables") [ChooseWith (ChooseFromTree group)] (sdsFocus db sqlTables)
              >^* [OnAction ActionDelete (hasValue (\table -> deleteTable db table <<@ InWindow @! ()))
                  ,OnAction (Action "Empty database" []) (always (emptyDatabase db <<@ InWindow @! ()))
                  ,OnAction (Action "Load Incidone tables" []) (always (createIncidoneTables db <<@ InWindow ))
                  ]
             )
        >&> withSelection viewNoSelection
            \table ->
            catchAll (
                viewSharedInformation (Title ("Schema of"+++ table)) [] (sdsFocus (db,table) sqlTableDefinition) @! ()
            ) (\e -> viewInformation () [] e @! ())
        ) <<@ (ArrangeWithSideBar 0 LeftSide 300 True)
    where
        group items _ = [{ChoiceTree|defaultValue & label=o,value=ChoiceNode i}\\(i,o) <- items]

        deleteTable db table
            =   viewInformation "Are your sure you want to delete this table?" [] table
            >>? \_ -> sqlExecuteDropTable db table
            @! ()

    createIncidoneTables db
        =   (sequence "Creating Incidone tables" [sqlExecuteCreateTable db table \\ table <- IncidoneDB]
        >>- viewInformation "Incidone schema created" []) <<@ Title "Creating Incidone tables..."
        >>* [OnAction ActionOk (always (return ()))]

    emptyDatabase db
        =   viewInformation (Title "Empty database") [] "Are your sure you want fully remove all database tables?"
        >>? \_ ->
            get (sdsFocus db sqlTables)
        >>- \tables ->
            sequence "Deleting all tables" [sqlExecuteDropTable db table \\ table <- tables]
        >>- viewInformation ("Empty database","All data deleted") []
        >>* [OnAction ActionOk (always (return ()))]

manageUsers :: Task ()
manageUsers = forever (catchAll (
        manageExistingUsers
    >^* [OnAction (Action "/Add" []) (always (addUser <<@ InWindow))
        ,OnAction (Action "/Import from CSV" []) (always (importUsers <<@ InWindow))
        ,OnAction (Action "/Set admin password" []) (always (setAdminPassword <<@ InWindow))
        ]
      ) (\e -> viewInformation "Error" [] e >>| return ()))
where
    manageExistingUsers
        =   (enterChoiceWithSharedAs () [ChooseWith (ChooseFromGrid id)] allContactsShort contactIdentity 
        >&> withSelection viewNoSelection manageContactAccess
        )<<@ ArrangeWithSideBar 0 LeftSide 200 True

	viewNoSelection = return () //FIXME
    addUser
        =   enterInformation (Title "Add user") []
        >>? \newUser -> (createContact newUser @! ())

    importUsers = doOrClose (
            enterInformation instructions []
        >>= \doc -> catchAll (
                importContactsFromCSVFile doc >>- \_ -> viewInformation () [] "Succesfully imported contacts" >>| return ()
            ) (\_ -> viewInformation "Failed to import contacts" [] ())
        ) <<@ Title "Import contacts"
	where
		instructions = toString (PTag [] [Text "Please select a CSV file to upload.",BrTag []
							,Text "The file needs to be formatted like ",ATag [HrefAttr "/demo-content/contacts.csv",TargetAttr "_blank"] [Text "this example file"]
							])

    setAdminPassword = (
            enterPasswords -&&- get adminPassword
        >>* [OnAction ActionCancel (always (return Nothing))
            ,OnAction (Action "Change" [ActionIcon "ok"]) (hasValue updatePassword)
            ]
        ) <<@ Title "Set admin password"
    where
        enterPasswords
            =    (Label "Old password"           @>> enterInformation () [])
            -&&- (Label "New password"           @>> enterInformation () [])
            -&&- (Label "New password (again)"   @>> enterInformation () [])
            @ \(o,(n1,n2)) -> (o,n1,n2)

        updatePassword ((old,new1,new2),current)
            | old =!= current = viewInformation "Error" [] "You did not enter the correct old password" >>| return Nothing
            | new1 =!= new2   = viewInformation "Error" [] "The new passwords are not the same" >>| return Nothing
                              = set new1 adminPassword
                              >>| viewInformation () [] "The admin password has been updated" >>| return (Just ())

manageDemoData :: Task ()
manageDemoData
    = allTasks
        [forever generateTestIncidents <<@ Title "Generate demo incidents"
        ] <<@ Title "Demo data"
    @! ()
where
    generateTestIncidents
        =   enterInformation "Enter the number of demo incidents that you would like to create and press continue" []
            -&&-
            enterInformation "Immediate close the incidents?" []
        >>= \(num,closed) ->
            sequence "Generating test incidents" (repeatn num (generateTestIncident closed))
        @! ()

configureIntegration :: Task ()
configureIntegration
    = anyTask [configureAISIntegration,configureAsteriskIntegration,configureEmailIntegration] <<@ ForceLayout <<@ Title "Integration"
    @! ()
where
    configureAISIntegration
        =   updateSharedInformation ("AIS server configuration","Please supply the host and port of the AIS server") [] aisLinkConfig
        ||- manageBackgroundTask "AIS Link Status" "ais-sync" "AIS Synchronisation" syncAISStream

    configureAsteriskIntegration
        = updateSharedInformation ("Asterisk server configuration","Please supply the configuration for your asterisk server") [] asteriskLinkConfig
        ||- manageBackgroundTask "Asterisk Link Status" "asterisk-sync" "Asterisk Synchronisation" syncAsteriskAMI
    configureEmailIntegration
        = updateSharedInformation ("SMTP server configuration","Please supply the configuration for your SMTP server") [] smtpConfig
        @! ()

configureMaps :: Task ()
configureMaps
    =   (viewOrEdit (Title "Default map perspective") standardPerspective (\_ _ -> return ())
         -||-
         viewOrEdit (Title "Map layer definitions") standardMapLayers (\_ _ -> return ())
         <<@ ArrangeVertical
        )
    -|| previewMapLayers
    <<@ (ArrangeSplit Horizontal True) <<@ (Title "Manage map layers")
where
    previewMapLayers :: Task ContactMapPerspective
    previewMapLayers = withShared defaultValue
        \perspective -> updateSharedInformation (Title "Preview") [UpdateWith toPrj fromPrj] (perspective >+| standardMapLayers) <<@ AfterLayout (tweakUI fill)
    where
        toPrj (perspective,layers) = toLeafletMap {ContactMap|defaultValue & perspective=perspective,layers=layers}
        fromPrj _ {LeafletMap|perspective} = fromLeafletPerspective perspective

configureWebLinks :: Task ()
configureWebLinks
    = viewAndEdit (viewSharedInformation "Web integration configuration" [] webLinksConfig)
                  (get webLinksConfig >>- updateInformation () [] >>? \updated -> set updated webLinksConfig)
    >^* [OnAction (Action "/Export" []) (always (exportConfig <<@ InWindow))
        ,OnAction (Action "/Import" []) (always (importConfig <<@ InWindow))]
    @! ()
where
    exportConfig
        =   doOrClose (
                get (webLinksConfig |+| currentDateTime)
            >>- \(config,now) -> createJSONFile ("Incidone-weblinks-" +++ paddedDateTimeString now +++ ".json") config
            >>- viewInformation "An export file has been created" []
            @!  ()
            ) <<@ Title "Export web links"

    importConfig
        =   doOrClose (
            enterInformation instructions []
            >>= \doc -> catchAll (
                    importJSONDocument doc
                >>- \config ->
                    set config webLinksConfig
                >>- \_ -> viewInformation () [] "Succesfully imported web links" @! ()
                ) (\e -> viewInformation "Failed import of web links" [] e @! ())
            ) <<@ Title "Import web links"
    where
        instructions = toString 
            (PTag [] [Text "Please select a JSON export file to upload.",BrTag []
                     ,Text "The file needs to be formatted like ",ATag [HrefAttr "/demo-content/weblinks.json",TargetAttr "_blank"] [Text "weblinks.json"]
                     ])