implementation module iTaskLogin

 

// An example how to handle a login administration

// (c) mjp 2007

 

import StdEnv, iTasks

import loginAdmin, iTaskDB

import iDataTrivial, iDataFormlib

 

derive gForm []

derive gUpd       []

 

derive gForm  Login, Account

derive gUpd   Login, Account, Maybe

derive gParse Login, Account

derive gPrint Login, Account, Maybe

derive gerda  Login, Account

 

assignWork :: !Bool !(Task Void) !(acc -> Task acc) !((String,Int,acc) -> (Task a)) -> (Task [a]) | iData acc & iData a

assignWork traceOn accwelcome acctask workFor

            =                 loginProcedure accwelcome acctask

            =>> \myid    -> readAccountsDB2                           // Order of logins should remain the same !

            =>> \accounts ->  startNewTask myid traceOn

                                    (andTasks   [(acc.login.loginName,acc.uniqueId @:: workFor (acc.login.loginName,acc.uniqueId,acc.state))

                                                \\ acc <- accounts

                                                ] <<@ storageKind)

 

loginProcedure :: !(Task Void) !(acc -> Task acc) -> (Task Int) | iData acc   // be very careful, several users may do this at the same time...

loginProcedure  accwelcome acctask = newTask "loginProcedure" loginProcedure`

where

      loginProcedure`

            =                       accwelcome

                  #>>               (chooseTask [("Login", handleLogin)

                                                ,("New Login", newLogin acctask =>> \account -> return_V (Just account))

                                                ]

                                    -||-

                                    chooseTask [("Cancel", return_V Nothing)]

                  =>> \mbacc ->     case mbacc of

                                          Nothing ->       [Txt "Sorry, you have to try again!",Br,Br]

                                                            ?>> OK

                                                      #>>   loginProcedure accwelcome acctask

                                          (Just acc) ->     finish acc acctask)

 

      finish acc acctask

            = chooseTaskV     [ ("Start Application", return_V acc.uniqueId)

                              , ("Change Login",            changeLogin acc acctask)

                              , ("Change Amin",       changeAccount acc acctask)

                              ]                                        

 

      changeAccount:: !(Account acc) !(acc -> Task acc) -> (Task Int) | iData acc  

      changeAccount acc=:{login,uniqueId,state} acctask = newTask "changeAccount" changeAccount`

      where

            changeAccount`

                  =                       acctask state

                        =>> \nstate ->    readAccountsDB

                        =>> \accounts ->  changeAccountsDB {acc & state = nstate} accounts

                        =>> \_ ->         [Txt ("Your administartion as been changed"),Br,toHtml nstate,Br]

                                          ?>> chooseTask [("OK",return_V uniqueId)]            

 

      changeLogin :: !(Account acc) !(acc -> Task acc) -> (Task Int) | iData acc   

      changeLogin acc=:{login,uniqueId,state} acctask = newTask "changeLogin" changeLogin`

      where

            changeLogin`

                  =                       [Br, Br, Txt "Type in the new name and password you want to use...", Br ,Br]

                                          ?>> editTask "Done" loginForm <<@ Submit

                        =>> \nlogin ->    readAccountsDB

                        =>> \accounts ->  case  (invariantLogins "" [nlogin:[account.login \\ account <- accounts | account.uniqueId <> uniqueId]]) of

                                                (Just (_,error)) -> [Txt error, Br, Br]

                                                                  ?>> changeLogin acc acctask

                                                Nothing ->        let newaccount = {acc & login = nlogin} in

                                                                                    changeAccountsDB newaccount accounts

                                                                        =>> \_ ->   [Txt ("Your login as changed, your id = " <+++ uniqueId)]

                                                                                    ?>> chooseTask [("OK",return_V uniqueId)]                                        

 

      handleLogin :: !(Task (Maybe (Account a))) | iData a

      handleLogin =                       [Txt "Type in your name and password...",Br,Br]

                                          ?>> editTask "Done" loginForm <<@ Submit

                        =>>   \login ->   readAccountsDB

                        =>> \accounts ->  return_V (hasAccount login accounts)                             

 

      newLogin :: !(a -> Task a) -> (Task (Account a)) | iData a

      newLogin acctask =            acctask createDefault         // gather account information

                        =>>   continue                      // make new login

      where

            continue acc =                      [Br, Br, Txt "Type in name and password you want to use...", Br ,Br]

                                                ?>> editTask "Done" loginForm <<@ Submit

                              =>> \login ->     readAccountsDB

                              =>> \accounts ->  case (invariantLogins "" [login:[account.login \\ account <- accounts]]) of

                                                      (Just (_,error)) -> [Txt error, Br, Br]

                                                                        ?>> continue acc

                                                      Nothing ->        let newaccount = {login = login, uniqueId = length accounts, state = acc} in

                                                                                          addAccountsDB newaccount accounts

                                                                              =>> \_ ->      [Txt ("You are administrated, your id = " <+++ length counts)]

                                                                                          ?>> chooseTask [("OK",return_V newaccount)]                                      

 

loginForm :: Login

loginForm = createDefault

 

// utility

 

cancel task = task -||- chooseTask [("Cancel",return_V Nothing)]

 

OK = chooseTask [("OK",return_V Void)]

 

// iData database storage access utility functions

 

accountId :: DBid (Accounts a)

accountId   = mkDBid "loginAccount"

 

readAccountsDB :: (Task (Accounts a)) | iData a

readAccountsDB = readDB accountId

 

readAccountsDB2 :: (Task (Accounts a)) | iData a

readAccountsDB2 = readDB2 accountId

 

addAccountsDB :: (Account a) (Accounts a) -> (Task (Accounts a)) | iData a

addAccountsDB acc accs

= writeDB accountId (addAccount acc accs)

 

changeAccountsDB :: (Account a) (Accounts a) -> (Task (Accounts a)) | iData a

changeAccountsDB acc accounts

= writeDB accountId (changeAccount acc accounts)