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)