Commit 322166f2 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 0af681ed
......@@ -20,7 +20,7 @@ mainEntrance hst
loginhandling :: *HSt -> ([BodyTag],*HSt)
loginhandling hst
# (accounts,hst) = AccountsDB Init [initManagerAccount initManagerLogin] hst // read out all accounts read only
# (mblogin,loginBody,hst) = loginPage accounts hst // set up a login page
# (mblogin,loginBody,hst) = loginHandlingPage accounts hst // set up a login page
= case mblogin of // check result of login procedure
Nothing = (loginBody,hst) // show login page when (still) not logged in
Just login = doConfPortal login accounts hst // show member page otherwise
......@@ -39,9 +39,12 @@ loginhandling hst
| ListPapers // referees + root
| ListReports
| DiscussPapers
| RefereeForm
| RefereeHomePage // referees
| GuestHomePage // guests
derive gForm CurrPage
derive gUpd CurrPage
derive gPrint CurrPage
......@@ -50,6 +53,38 @@ derive gParse CurrPage
homePage (ConfManager info) = RootHomePage
homePage (Referee info) = RefereeHomePage
homePage (Authors info) = AuthorsHomePage
homePage (Guest info) = GuestHomePage
navigationButtons state hst = ListFuncBut (Init, sFormId "navigation" (navButtons state)) hst
where
navButtons (ConfManager info) =
[ (LButton defpixel "RootHome", \_.RootHomePage)
, (LButton defpixel "ModStates", \_.ModifyStates)
, (LButton defpixel "ListPapers", \_.ListPapers)
, (LButton defpixel "AssignPapers", \_.AssignPapers)
, (LButton defpixel "ListReports", \_.ListReports)
, (LButton defpixel "DiscussPapers", \_.DiscussPapers)
, (LButton defpixel "ChangeInfo", \_.ChangeInfo)
, (LButton defpixel "ChangePsswrd", \_.ChangePassword)
]
navButtons (Referee info) =
[ (LButton defpixel "Home", \_.RefereeHomePage)
, (LButton defpixel "ListPapers", \_.ListPapers)
, (LButton defpixel "RefereeForm", \_.RefereeForm)
, (LButton defpixel "ListReports", \_.ListReports)
, (LButton defpixel "DiscussPapers", \_.DiscussPapers)
, (LButton defpixel "ChangeInfo", \_.ChangeInfo)
, (LButton defpixel "ChangePsswrd", \_.ChangePassword)
]
navButtons (Authors info) =
[ (LButton defpixel "Home", \_.AuthorsHomePage)
, (LButton defpixel "SubmitPaper", \_.SubmitPaper)
, (LButton defpixel "ChangeInfo", \_.ChangeInfo)
, (LButton defpixel "ChangePsswrd", \_.ChangePassword)
]
navButtons (Guest info) =
[
]
// you are in, determine what to do
......@@ -65,32 +100,6 @@ doConfPortal account accounts hst
] // for debugging ++ [Txt (printToString accounts)]
, hst)
where
navigationButtons state hst = ListFuncBut (Init, sFormId "navigation" (navButtons state)) hst
where
navButtons (ConfManager info) =
[ (LButton defpixel "RootHome", \_.RootHomePage)
, (LButton defpixel "ChangePsswrd", \_.ChangePassword)
, (LButton defpixel "ChangeInfo", \_.ChangeInfo)
, (LButton defpixel "ListPapers", \_.ListPapers)
, (LButton defpixel "ListReports", \_.ListReports)
, (LButton defpixel "RefereeForm", \_.RefereeForm)
, (LButton defpixel "AssignPapers", \_.AssignPapers)
, (LButton defpixel "ModStates", \_.ModifyStates)
]
navButtons (Referee info) =
[ (LButton defpixel "Home", \_.RefereeHomePage)
, (LButton defpixel "ChangePsswrd", \_.ChangePassword)
, (LButton defpixel "ChangeInfo", \_.ChangeInfo)
, (LButton defpixel "ListPapers", \_.ListPapers)
, (LButton defpixel "ListReports", \_.ListReports)
, (LButton defpixel "RefereeForm", \_.RefereeForm)
]
navButtons (Authors info) =
[ (LButton defpixel "Home", \_.AuthorsHomePage)
, (LButton defpixel "SubmitPaper", \_.SubmitPaper)
, (LButton defpixel "ChangePsswrd", \_.ChangePassword)
, (LButton defpixel "ChangeInfo", \_.ChangeInfo)
]
mkSTable2 :: [[BodyTag]] -> BodyTag
mkSTable2 table
......@@ -108,36 +117,34 @@ where
currPageStore :: !CurrPage !(CurrPage -> CurrPage) *HSt -> (!Form CurrPage,!*HSt) // current page to display
currPageStore currpage cbf hst = mkStoreForm (Init, sFormId "cf_currPage" currpage) cbf hst
handleCurrPage :: CurrPage ConfAccount ConfAccounts *HSt -> ([BodyTag],*HSt)
handleCurrPage currPage account accounts hst
= case currPage of
RootHomePage -> rootHomePage hst
RefereeHomePage -> refereeHomePage hst
AuthorsHomePage -> authorsHomePage hst
ChangePassword -> changePasswrdPage account accounts hst
ModifyStates -> modifyStatesPage accounts hst
AssignPapers -> assignPapersConflictsPage accounts hst
ListPapers -> showPapersPage accounts hst
ListReports -> showReportsPage account accounts hst
ChangeInfo -> changeInfo account hst
SubmitPaper -> submitPaperPage account hst
RefereeForm -> submitReportPage account accounts hst
_ -> ([],hst)
where
changePasswrdPage account accounts hst
# (mbaccount,body,hst) = changePasswordPage account hst
= case mbaccount of
Nothing -> (body, hst)
Just naccount
# accounts = changeAccount naccount accounts // replace changed account in accounts
# (accounts,hst) = AccountsDB Set accounts hst // store accounts in database administration
-> handleCurrPage (homePage account.state) naccount accounts hst
handleCurrPage :: CurrPage ConfAccount ConfAccounts *HSt -> ([BodyTag],*HSt)
handleCurrPage currPage account accounts hst
= case currPage of
RootHomePage -> rootHomePage hst
RefereeHomePage -> refereeHomePage hst
AuthorsHomePage -> authorsHomePage hst
GuestHomePage -> guestHomePage account accounts hst
ModifyStates -> modifyStatesPage accounts hst
AssignPapers -> assignPapersConflictsPage accounts hst
SubmitPaper -> submitPaperPage account hst
ListPapers -> showPapersPage accounts hst
RefereeForm -> submitReportPage account accounts hst
ListReports -> showReportsPage account accounts hst
DiscussPapers -> discussPapersPage account accounts hst
ChangeInfo -> changeInfo account hst
ChangePassword -> changePasswrdPage account accounts hst
_ -> ([],hst)
where
changePasswrdPage account accounts hst
# (mbaccount,body,hst) = changePasswordPage account hst
= case mbaccount of
Nothing -> (body, hst)
Just naccount
# accounts = changeAccount naccount accounts // replace changed account in accounts
# (accounts,hst) = AccountsDB Set accounts hst // store accounts in database administration
-> handleCurrPage (homePage account.state) naccount accounts hst
// the different pages the super user can choose from
......@@ -157,4 +164,70 @@ authorsHomePage hst =
]
, hst )
:: GuestPages = GuestSubmitPaper
| GuestPerson
| GuestMakeLogin
derive gForm GuestPages
derive gUpd GuestPages
derive gParse GuestPages
derive gPrint GuestPages
guestHomePage account accounts hst
# (subpagef,hst) = guestSubPages Init id hst
= case subpagef.value of
GuestMakeLogin -> guestMakeLogin hst
GuestPerson -> guestPerson hst
GuestSubmitPaper -> guestSubmitPaper hst
where
guestSubPages :: Init (GuestPages -> GuestPages) !*HSt -> (Form GuestPages,!*HSt)
guestSubPages init fgst hst = mkStoreForm (init,nFormId "cmg_guest_page" createDefault) fgst hst
guestMakeLogin hst // 1. make a new login
# (mbaccount,loginb,hst)= mkLoginPage (Guest createDefault) accounts hst
| isNothing mbaccount = ([Txt "1. First we make an account for you.",Br,Txt "Please fill in the form.",Br,Br] ++ loginb,hst)
# (_,hst) = guestSubPages Set (\_ -> GuestPerson) hst
# (Just newaccount) = mbaccount
# (_,hst) = guestAccountStore (\(_,guest) -> (True,newaccount)) hst // update guest account
= guestHomePage newaccount accounts hst
guestPerson hst // 2. administrate personel administration
# (personf,hst) = mkEditForm (Init,nFormId "cms_guest_person" createDefault) hst
# (exception,hst) = ExceptionStore ((+) (invariantPerson account.login.loginName personf.value)) hst
| isJust exception = ([Txt "2. Please fill in your personal data such that we can inform you.",Br,Br ] ++ personf.form,hst)
# (_,hst) = guestSubPages Set (\_ -> GuestSubmitPaper) hst
# account = {account & state = Guest personf.value}
# (_,hst) = guestAccountStore (\(_,guest) -> (True,{guest & state = Guest personf.value})) hst // update guest account
= guestHomePage account accounts hst
guestSubmitPaper hst // 3. handle paper submission
# (paperf,hst) = mkEditForm (Init,nFormId "cms_guest_paper" createDefault) hst
# (exception,hst) = ExceptionStore ((+) (invariantPaper account.login.loginName paperf.value)) hst
| isJust exception = ([Txt "3. Now submit your paper.", Br, Br] ++ paperf.form,hst)
# (paperNr,hst) = PaperNrStore inc hst // now all iformation is there, make it all persistent
# (guestf,hst) = guestAccountStore id hst // retrieve guest account
# (Guest person) = (snd guestf.value).state
# uniquename = uniquePerson (snd guestf.value).login.loginName
# uniquepaper = uniquePaper paperNr uniquename
# uniquediscussion = uniqueDiscussion paperNr uniquename
# account = {login = (snd guestf.value).login
, state = Authors { person = RefPerson (Refto uniquename)
, nr = paperNr
, paper = RefPaper (Refto uniquepaper)
, status = Submitted
, discussion = RefDiscussion (Refto uniquediscussion)
}}
# (_,hst) = adjustLogin account hst
# accounts = addAccount account accounts
# (_,hst) = AccountsDB Set accounts hst // store accounts
# (exception,hst) = ExceptionStore id hst
| isJust exception
= ([Txt "Sorry, an exception occured, something went wrong, you have to try again"],hst)
# (_,hst) = mkEditForm (Set,pFormId uniquename (0,person)) hst // store person info
# (_,hst) = mkEditForm (Set,pFormId uniquepaper (0,paperf.value)) hst // store paper info
# (_,hst) = guestAccountStore (\(_,guest) -> (False,account)) hst // kick out guest
= ([B [] "Paper submitted.",Br, Txt "You have a login account you can use to update the provided information.",Br,Br],hst)
definition module confIData
// In this module editors are derived or specialized for all types used
// In this module basic editors are either derived or specialized for all types used
import htmlFormData, loginAdmin, stateHandling
......@@ -13,38 +13,41 @@ derive gForm
Login, Account, Member, ManagerInfo, RefereeInfo, Conflicts,
RefPerson, Person,
Reports, RefReport, Report, Recommendation, Familiarity,
RefPaper, Paper, PaperInfo
RefPaper, Paper, PaperInfo, Co_authors, RefDiscussion, PaperStatus, Discussion
derive gUpd
Login, Account, Member, ManagerInfo, RefereeInfo, Conflicts,
RefPerson, Person,
Reports, RefReport, Report, Recommendation, Familiarity,
RefPaper, Paper, PaperInfo
RefPaper, Paper, PaperInfo, Co_authors, RefDiscussion, PaperStatus, Discussion
derive gPrint
Login, Account, Member, ManagerInfo, RefereeInfo, Conflicts,
RefPerson, Person,
Reports, RefReport, Report, Recommendation, Familiarity,
RefPaper, Paper, PaperInfo
RefPaper, Paper, PaperInfo, Co_authors, RefDiscussion, PaperStatus, Discussion
derive gParse
Login, Account, Member, ManagerInfo, RefereeInfo, Conflicts,
RefPerson, Person,
Reports, RefReport, Report, Recommendation, Familiarity,
RefPaper, Paper, PaperInfo
RefPaper, Paper, PaperInfo, Co_authors, RefDiscussion, PaperStatus, Discussion
// Naming convention of shared persistent information
uniqueDBname :== "conferenceDBS" // accounts database
uniquePerson name :== name // personnel information
uniqueReport int name :== name +++ ".report." +++ toString int // report of paper
uniquePaper int name :== name +++ ".paper." +++ toString int // submitted paper information
uniqueDBname :== "conferenceDBS" // accounts database
uniquePerson name :== name // personnel information
uniqueReport int name :== name +++ ".report." +++ toString int // report of paper submiited by referee
uniquePaper int name :== name +++ ".paper." +++ toString int // submitted paper
uniqueDiscussion int name :== "discuss." +++ (uniquePaper int name) // discussion about submitted paper
// Persistent conf account database
AccountsDB :: !Init !ConfAccounts *HSt -> (ConfAccounts,!*HSt)
AccountsDB :: !Init !ConfAccounts *HSt -> (ConfAccounts,!*HSt) // confaccounts db
PaperNrStore :: !(Int -> Int) *HSt -> (Int,!*HSt) // paper counter
// editors for referenced types
editorRefPerson :: !(InIDataId RefPerson) !*HSt -> (Form Person,!*HSt)
editorRefPaper :: !(InIDataId RefPaper) !*HSt -> (Form Paper,!*HSt)
editorRefReport :: !(InIDataId RefReport) !*HSt -> (Form (Maybe Report),!*HSt)
editorRefPerson :: !(InIDataId RefPerson) !*HSt -> (Form Person,!*HSt)
editorRefPaper :: !(InIDataId RefPaper) !*HSt -> (Form Paper,!*HSt)
editorRefReport :: !(InIDataId RefReport) !*HSt -> (Form (Maybe Report),!*HSt)
editorRefDiscussion :: !(InIDataId RefDiscussion) !*HSt -> (Form Discussion,!*HSt)
......@@ -13,6 +13,11 @@ AccountsDB init accounts hst
= universalDB init (\s a -> invariantLogAccounts s a + invariantConfAccounts s a)
uniqueDBname accounts hst
PaperNrStore :: !(Int -> Int) *HSt -> (Int,!*HSt) // paper counter
PaperNrStore fun hst
# (intf,hst) = mkStoreForm (Init,{pFormId "LastPaperNr" 1 & mode = NoForm}) fun hst
= (intf.value,hst)
editorRefPerson :: !(InIDataId RefPerson) !*HSt -> (Form Person,!*HSt)
editorRefPerson (init,formid) hst
# (RefPerson refperson) = formid.ival
......@@ -34,6 +39,11 @@ where
invariant name Nothing = Ok
invariant name (Just report) = invariantReport name report
editorRefDiscussion :: !(InIDataId RefDiscussion) !*HSt -> (Form Discussion,!*HSt)
editorRefDiscussion (init,formid) hst
# (RefDiscussion refdiscus) = formid.ival
= universalRefEditor formid.mode (\_ -> Ok) refdiscus hst
// specialized forms
gForm {|RefPerson|} iniformid hst = specialize (invokeRefEditor editorRefPerson) iniformid hst
......@@ -42,6 +52,8 @@ gForm {|RefPaper|} iniformid hst = specialize (invokeRefEditor editorRefPaper)
gForm {|RefReport|} iniformid hst = specialize (invokeRefEditor editorRefReport) iniformid hst
gForm {|RefDiscussion|} iniformid hst = specialize (invokeRefEditor editorRefDiscussion) iniformid hst
gForm {|Reports|} informid hst = specialize myeditor informid hst
where
myeditor (init,formid) hst
......@@ -63,6 +75,16 @@ where
# (authorsf,hst) = vertlistFormButs 10 True (init,subsFormId formid "authors" authors) hst
= ({authorsf & value = Co_authors authorsf.value},hst)
gForm {|Discussion|} informid hst = specialize myeditor informid hst
where
myeditor (init,formid) hst
# (Discussion list) = formid.ival
= ({changed = False, form = showDiscussion list, value = (Discussion list)},hst)
where
showDiscussion [] = []
showDiscussion [(name,content):more] = [ Br, B [] (name +++ ":"), Br, Txt content, Br, Hr []] ++ showDiscussion more
gForm {|[]|} gHa (init,formid) hst
= case formid.ival of
[x:xs]
......@@ -83,20 +105,20 @@ derive gForm
Login, Account, Member, ManagerInfo, RefereeInfo, /*Conflicts, */
/*RefPerson, */Person,
/*Reports, *//*RefReport, */ Report, Recommendation, Familiarity,
/*RefPaper, */Paper, PaperInfo
/*RefPaper, */Paper, PaperInfo,/* RefDiscussion,*/ PaperStatus/*, Discussion */
derive gUpd
Login, Account, Member, ManagerInfo, RefereeInfo, Conflicts,
RefPerson, Person,
Reports, RefReport, Report, Recommendation, Familiarity,
RefPaper, Paper, PaperInfo, Co_authors
RefPaper, Paper, PaperInfo, Co_authors, RefDiscussion, PaperStatus, Discussion
derive gPrint
Login, Account, Member, ManagerInfo, RefereeInfo, Conflicts,
RefPerson, Person,
Reports, RefReport, Report, Recommendation, Familiarity,
RefPaper, Paper, PaperInfo, Co_authors
RefPaper, Paper, PaperInfo, Co_authors, RefDiscussion, PaperStatus, Discussion
derive gParse
Login, Account, Member, ManagerInfo, RefereeInfo, Conflicts,
RefPerson, Person,
Reports, RefReport, Report, Recommendation, Familiarity,
RefPaper, Paper, PaperInfo, Co_authors
RefPaper, Paper, PaperInfo, Co_authors, RefDiscussion, PaperStatus, Discussion
......@@ -3,10 +3,12 @@ definition module loginAdminIData
import loginAdmin, htmlHandler
// login page: returns account if user is adminstrated
// mkLoginPage: returns a new account if new login not yet taken
// changePasswordPage: returns new account if changed password has been approved
// adjustLogin: adjust login using given (new) login account
loginPage :: !(Accounts s) !*HSt -> (Maybe (Account s),[BodyTag],!*HSt)
// changePasswordPage: returns new account if changed password has been approved
mkLoginPage :: s !(Accounts s) !*HSt -> (Maybe (Account s),[BodyTag],!*HSt)
changePasswordPage :: !(Account s) !*HSt -> (Maybe (Account s),[BodyTag],!*HSt)
adjustLogin :: !(Account s) !*HSt -> (Maybe (Account s),!*HSt)
......@@ -8,12 +8,24 @@ derive gUpd Login
derive gPrint Login
derive gParse Login
// this session login form can be used at every event to check whether the end user is indeed administrated
// this session login form will be used at every event to check whether the end user is indeed administrated
loginForm :: !(Init,Login) !*HSt -> (Form Login,!*HSt)
loginForm (init,login) hst = mkEditForm (init,sFormId "adminID_login" login) hst
// a login page
// scratch form
textForm :: !String !*HSt -> (Form String,!*HSt)
textForm fid hst = mkEditForm (Init, nFormId fid "") hst
// program controlled logins
adjustLogin :: !(Account s) !*HSt -> (Maybe (Account s),!*HSt)
adjustLogin account hst
# (_,hst) = loginForm (Set,account.login) hst
= (Just account,hst)
// pages
loginPage :: !(Accounts s) !*HSt -> (Maybe (Account s),[BodyTag],!*HSt)
loginPage accounts hst
......@@ -25,12 +37,35 @@ loginPage accounts hst
, BodyTag login.form
]
, hst)
mkLoginPage :: s !(Accounts s) !*HSt -> (Maybe (Account s),[BodyTag],!*HSt)
mkLoginPage state accounts hst
# (namef,hst) = textForm "mk_name" hst
# (passwd1,hst) = textForm "mk_passwd1" hst
# (passwd2,hst) = textForm "mk_passwd2" hst
# ok = passwd1.value == passwd2.value &&
passwd1.value <> "" &&
namef.value <> ""
| not ok = (Nothing, dolog namef.form passwd1.form passwd2.form ++ [Br,Txt "Please check supplied login information"],hst)
# newlogin = {loginName = namef.value, password = passwd1.value}
# (exception,hst) = ExceptionStore ((+) (invariantLogins namef.value [newlogin:map (\acc -> acc.login) accounts])) hst
| isJust exception = (Nothing, dolog namef.form passwd1.form passwd2.form,hst)
# (_,hst) = loginForm (Set,newlogin) hst // password approved
# newaccount = {login = newlogin, state = state}
= (Just newaccount, [Br,Txt "New login accepted",Br], hst)
where
dolog name pass1 pass2 =
[ mkTable [ [Txt "Enter desired login name: ",BodyTag name]
, [Txt "Enter your password: ", BodyTag pass1]
, [Txt "Re-enter your password: ", BodyTag pass2]
]
]
changePasswordPage :: !(Account s) !*HSt -> (Maybe (Account s),[BodyTag],!*HSt)
changePasswordPage account hst
# (oldpasswrd,hst) = passwordForm "oldpasswrd" hst
# (newpasswrd1,hst) = passwordForm "newpasswrd1" hst
# (newpasswrd2,hst) = passwordForm "newpasswrd2" hst
# (oldpasswrd,hst) = textForm "oldpasswrd" hst
# (newpasswrd1,hst) = textForm "newpasswrd1" hst
# (newpasswrd2,hst) = textForm "newpasswrd2" hst
# ok = oldpasswrd.value == account.login.password &&
newpasswrd1.value == newpasswrd2.value &&
newpasswrd1.value <> ""
......@@ -61,6 +96,4 @@ where
[]
]
passwordForm :: !String !*HSt -> (Form String,!*HSt)
passwordForm fid hst = mkEditForm (Init, nFormId fid "") hst
......@@ -9,22 +9,33 @@ import loginAdmin, htmlFormlib
// Shared Information:
:: RefPerson = RefPerson (Refto Person)
:: RefPaper = RefPaper (Refto Paper)
:: RefReport = RefReport (Refto MaybeReport)
:: RefPerson = RefPerson (Refto Person)
:: RefPaper = RefPaper (Refto Paper)
:: RefReport = RefReport (Refto MaybeReport)
:: RefDiscussion= RefDiscussion (Refto Discussion)
// Information maintained by the Conference Manager
:: Member = ConfManager ManagerInfo
| Authors PaperInfo
| Referee RefereeInfo
| Guest Person
:: ManagerInfo = { person :: RefPerson
}
:: PaperInfo = { person :: RefPerson
, nr :: PaperNr
, paper :: RefPaper
, status :: PaperStatus
, discussion :: RefDiscussion
}
:: PaperNr :== Int
:: PaperStatus = Accepted
| CondAccepted
| Rejected
| UnderDiscussion
| Submitted
:: RefereeInfo = { person :: RefPerson
, conflicts :: Conflicts
, reports :: Reports
......@@ -63,6 +74,10 @@ import loginAdmin, htmlFormlib
, emailAddress :: String
}
// Information maintained by the Conference Manager *or* a Referee *or* an Author
:: Discussion = Discussion [(String,String)]
// Information submitted by an author
:: Paper = { title :: String
......@@ -81,8 +96,9 @@ initManagerAccount :: Login -> ConfAccount
isConfManager :: ConfAccount -> Bool
isReferee :: ConfAccount -> Bool
isAuthor :: ConfAccount -> Bool
isGuest :: ConfAccount -> Bool
getRefPerson :: Member -> RefPerson
getRefPerson :: Member -> (Maybe RefPerson)
getPaperNumbers :: ConfAccounts -> [Int]
getRefPapers :: ConfAccounts -> [(Int,RefPaper)]
getAssignments :: ConfAccounts -> [(RefPerson,[Int])]
......@@ -109,6 +125,7 @@ instance == RefPerson, RefPaper, RefReport
invariantConfAccounts :: String ConfAccounts -> Judgement
invariantPerson :: String Person -> Judgement
invariantPersons :: String [Person] -> Judgement
invariantPaper :: String Paper -> Judgement
invariantReport :: String Report -> Judgement
......
......@@ -43,10 +43,17 @@ isAuthor account
Authors _ -> True
_ -> False
getRefPerson :: Member -> RefPerson
getRefPerson (ConfManager managerInfo) = managerInfo.ManagerInfo.person
getRefPerson (Referee refereeInfo) = refereeInfo.RefereeInfo.person
getRefPerson (Authors paperInfo) = paperInfo.PaperInfo.person
isGuest:: ConfAccount -> Bool
isGuest account
= case account.state of
Guest _ -> True
_ -> False
getRefPerson :: Member -> (Maybe RefPerson)