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)