Commit 957c43fc authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 322166f2
......@@ -7,7 +7,15 @@ import loginAdminIData, confIData, stateHandlingIData
// Here it starts ....
Start world = doHtmlServer mainEntrance world
//Start world = doHtmlServer test world
test hst
# (body,hst) = mkEditForm (Init,nFormId "xx" (23,try)) hst // a login will be checked on correctness each time a page is requested !
= mkHtml "Conference Manager"
[ BodyTag body.form
] hst
where
try = HTML [Txt "Is dit wel een goed idee ?",B [] "of niet"]
mainEntrance hst
# (body,hst) = loginhandling hst // a login will be checked on correctness each time a page is requested !
......@@ -15,6 +23,7 @@ mainEntrance hst
[ BodyTag body
] hst
// login page handling
loginhandling :: *HSt -> ([BodyTag],*HSt)
......@@ -227,7 +236,8 @@ where
# (_,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)
= ([B [] "Paper submitted.",Br, Txt "You have a login account you can use to update the provided information",Br,
Txt "and keep in touch with us",Br],hst)
......@@ -82,7 +82,7 @@ where
= ({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
showDiscussion [(name,content):more] = [B [] (name +++ ":"), Br, Txt content, Br, Hr []] ++ showDiscussion more
gForm {|[]|} gHa (init,formid) hst
......
......@@ -57,6 +57,7 @@ import loginAdmin, htmlFormlib
= StrongAccept
| Accept
| WeakAccept
| Discuss
| WeakReject
| Reject
| StrongReject
......@@ -99,8 +100,10 @@ isAuthor :: ConfAccount -> Bool
isGuest :: ConfAccount -> Bool
getRefPerson :: Member -> (Maybe RefPerson)
getPaperNumbers :: ConfAccounts -> [Int]
getRefPapers :: ConfAccounts -> [(Int,RefPaper)]
getPaperInfo :: Int ConfAccounts -> Maybe PaperInfo
getAssignments :: ConfAccounts -> [(RefPerson,[Int])]
getConflicts :: ConfAccounts -> [(RefPerson,[Int])]
getConflictsAssign :: ConfAccounts -> [(RefPerson,[Int],[Int])]
......
......@@ -59,6 +59,12 @@ getRefPapers :: ConfAccounts -> [(Int,RefPaper)]
getRefPapers accounts = [(nr,refpapers)
\\ {state = Authors {nr,paper = refpapers}} <- accounts]
getPaperInfo :: Int ConfAccounts -> Maybe PaperInfo
getPaperInfo i accounts = case [info \\ {state = Authors info=:{nr}} <- accounts | i == nr] of
[] -> Nothing
[x:_] -> Just x
getPaperNumbers :: ConfAccounts -> [Int]
getPaperNumbers accounts = sort [nr \\ {state = Authors {nr}} <- accounts]
......@@ -177,8 +183,6 @@ invariantPerson id {firstName,lastName,affiliation,emailAddress}
invariantPersons :: String [Person] -> Judgement
invariantPersons id persons
# unique = allUnique (map (\p -> p.emailAddress) persons)
| not unique = Just (id,"e-mail address has to be unique!")
= Ok
invariantPaper :: String Paper -> Judgement
......
......@@ -5,16 +5,34 @@ import stateHandling
import loginAdminIData, confIData
import StdListExtensions
// Support
// Utility code for DeReferences of pointers
getAllPersons :: !String !ConfAccounts !*HSt -> ([Person],!*HSt)
getAllPersons id accounts hst
getAllPersons :: !ConfAccounts !*HSt -> ([RefPerson],[Person],!*HSt)
getAllPersons accounts hst
# allrefperson = [ refperson \\ acc <- accounts , (Just refperson) <- [getRefPerson acc.state]]
# (allpersonsf,hst) = maplSt editorRefPerson [(Init,xFormId ("pers" <+++ i) pers) \\ i <- [0..] & pers <- allrefperson] hst
# (allpersonsf,hst) = maplSt editorRefPerson [(Init,xtFormId ("shd_coll_pers" <+++ i) pers) \\ i <- [0..] & pers <- allrefperson] hst
# allpersons = map (\v -> v.value) allpersonsf
# (exception,hst) = ExceptionStore ((+) (invariantPersons id allpersons)) hst
| isJust exception = ([],hst)
= (allpersons,hst)
= (allrefperson,allpersons,hst)
getAllMyReports :: !ConfAccount !ConfAccounts !*HSt -> ([(Int,[(Person, Maybe Report)])],!*HSt)
getAllMyReports account accounts hst
# (allrefpersons,allpersons,hst) = getAllPersons accounts hst
# allirefreports = getMyRefReports account accounts
# allrefreports = [refreport \\ (_,refperson_refreports) <- allirefreports
, refreport <- map snd refperson_refreports]
# (allreportsf,hst) = maplSt editorRefReport
[(Init,xtFormId ("shd_coll_rep" <+++ i) refreport) \\ i <- [0..] & refreport <- allrefreports] hst
# allreports = map (\v -> v.value) allreportsf
# allireports = [(nr, [(findperson refperson allrefpersons allpersons,report) \\ (refperson,refreport) <- refperson_refreports
& report <- allreports
])
\\ (nr,refperson_refreports) <- allirefreports
]
= (allireports,hst)
where
findperson refperson refpersons persons = hd [p \\ ref <- refpersons & p <- persons | ref == refperson]
// Entrance
......@@ -47,7 +65,7 @@ passwordForgotten :: !ConfAccounts !*HSt -> ([BodyTag],!*HSt)
passwordForgotten accounts hst
# (emailadres,hst) = mkEditForm (Init,nFormId "email_addr" "") hst
# (mailmebut,hst) = simpleButton "MailMe" id hst
# (persons,hst) = getAllPersons emailadres.value accounts hst
# (_,persons,hst) = getAllPersons accounts hst
# found = search emailadres.value persons accounts
= ( [ B [] "Password / login forgotten ?", Br, Br
, Txt "Type in your e-mail address: "
......@@ -173,7 +191,7 @@ submitReportPage account accounts hst
# myreports = [nr <|> edit \\ nr <- paperlist & edit <- myrefreport]
| todo == [] = ([ Txt "There are no papers for you to referee (yet)" ],hst)
# (reportsf,hst) = vertlistFormButs 5 False (Set,sFormId "cfm_mk_reports" myreports) hst
# (results,hst) = maplSt editorRefReport [(Init,xFormId ("tmp" <+++ i) ref) \\ i <- mypapers & ref <- myrefreport] hst
# (results,hst) = maplSt editorRefReport [(Init,xtFormId ("tmp" <+++ i) ref) \\ i <- mypapers & ref <- myrefreport] hst
# resultvalue = [res.value \\ res <- results]
= (show1 mypapers ++ show2 mypapers resultvalue ++ show3 mypapers resultvalue ++ reportsf.form,hst)
where
......@@ -186,19 +204,41 @@ where
showReportsPage :: !ConfAccount !ConfAccounts !*HSt -> ([BodyTag],!*HSt)
showReportsPage account accounts hst
# allreports = [("paper: " +++ toString nr,map (\(RefPerson (Refto name),report) -> (name,report)) reports)
# allreports = [("paper " +++ toString nr,map (\(RefPerson (Refto name),report) -> (name,report)) reports)
\\ (nr,reports) <- getMyRefReports account accounts]
# (reportsf,hst) = vertlistFormButs 5 False (Set,ndFormId "cfm_shw_reports" allreports) hst
= (reportsf.form,hst)
discussPapersPage :: !ConfAccount !ConfAccounts !*HSt -> ([BodyTag],!*HSt)
discussPapersPage account accounts hst
# allreports = [(nr,map (\(RefPerson (Refto name),report) -> (name,report)) reports)
\\ (nr,reports) <- getMyRefReports account accounts]
# (reportsf,hst) = vertlistFormButs 5 False (Set,ndFormId "cfm_shw_reports" allreports) hst
= (reportsf.form,hst)
# (allreports,hst) = getAllMyReports account accounts hst
# allpapernrs = map fst allreports
# pdmenu = (0, [("Show " +++ toString nr, \_ -> i) \\ i <- [0 .. ] & nr <- allpapernrs])
# (pdfun,hst) = FuncMenu (Init, sFormId "cfm_dpp_pdm" pdmenu) hst
# selected = (fst pdfun.value) 0
# mbpaperrefinfo = getPaperInfo (allpapernrs!!selected) accounts
# (RefDiscussion (Refto name)) = (fromJust mbpaperrefinfo).discussion
# (disclist,hst) = mkEditForm (Init, pFormId name (Discussion [])) hst
# (ok,newdisc,hst) = mkSubStateForm (Init, nFormId "cfm_dpp_adddisc" (TS 80 "")) disclist.value
(\s (Discussion l) -> Discussion [(account.login.loginName,toS s):l]) hst
# (disclist,hst) = if ok (mkEditForm (Set, pFormId name newdisc.value) hst) (disclist,hst)
= ( pdfun.form ++ [Br,Hr [], Br] <|.|>
mkdisplay allreports !! selected ++ [Br,Hr [], Br] <|.|>
newdisc.form <|.|> [Br,Hr [], Br]
++ disclist.form,hst)
where
toS (TS _ s) = s
summarize Nothing = [EmptyBody]
summarize (Just report) = [ toHtml report.recommendation , toHtml report.familiarity]
mkdisplay allrep = [ [B [] ("Paper " +++ toString nr +++ ":")] ++
[mkTable[ [ B [] "Referee: ", Txt (ref.firstName +++ " " +++ ref.lastName)] ++ summarize report
\\ ref <- map fst refs_reports & report <- map snd refs_reports
]]
\\ (nr,refs_reports) <- allrep
]
......
......@@ -81,12 +81,12 @@ showBasket onlytop basket headers database infobuts deletebuts
| onlytop = BodyTag
[ Txt "Last Item put into basket:"
, Br, Br
, mkTable (1,length basket) headers [database!!(hd basket)] infobuts deletebuts
, mkShopTable (1,length basket) headers [database!!(hd basket)] infobuts deletebuts
]
| otherwise = BodyTag
[ Txt "Contents of your basket:"
, Br, Br
, mkTable (1,length basket) headers [database!!itemnr \\ itemnr <- basket] infobuts deletebuts
, mkShopTable (1,length basket) headers [database!!itemnr \\ itemnr <- basket] infobuts deletebuts
, Br, Br
, myTable [[ Txt "Total Prize:"]
, [Txt (showPrize (sum [(database!!itemnr).item.prize \\ itemnr <- basket]))]
......@@ -168,7 +168,7 @@ doShopPage soptions extendedInfo headers database hst
STable [] [shownext.form])
, Br, Br
, mkTable (nindex.value+1,length selection) headers (selection%(nindex.value,nindex.value+step.value)) info.form add.form
, mkShopTable (nindex.value+1,length selection) headers (selection%(nindex.value,nindex.value+step.value)) info.form add.form
, Br, Br
, showBasket True basket.value headers database binfo.form [EmptyBody]
, if (info.value -1 < 0) EmptyBody (doScript extendedInfo (database!!(info.value -1)))
......@@ -262,8 +262,8 @@ scriptName = "openwindow()"
// Function to display contents of selected items, database, basket
mkTable :: (Int,Int) (Headers d) [ItemData d] [BodyTag] [BodyTag] -> BodyTag
mkTable (cnt,max) headers items infobuttons deladdbuttons
mkShopTable :: (Int,Int) (Headers d) [ItemData d] [BodyTag] [BodyTag] -> BodyTag
mkShopTable (cnt,max) headers items infobuttons deladdbuttons
= table
[ empty ++ itemHeader ++ dataHeader ++ empty ++ empty
: [ CntRow i max ++ itemRow item ++ dataRow headers data ++ mkButtonRow infobutton ++ mkButtonRow deladdbutton
......
......@@ -4,10 +4,10 @@ definition module htmlButtons
import htmlHandler
derive gForm (,), (,,), (,,,), (<->), <|>, HtmlDate, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea
derive gUpd (,), (,,), (,,,), (<->), <|>, HtmlDate, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea
derive gPrint (,), (,,), (,,,), (<->), <|>, HtmlDate, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea
derive gParse (,), (,,), (,,,), (<->), <|>, HtmlDate, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea
derive gForm (,), (,,), (,,,), (<->), <|>, HtmlDate, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML
derive gUpd (,), (,,), (,,,), (<->), <|>, HtmlDate, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML
derive gPrint (,), (,,), (,,,), (<->), <|>, HtmlDate, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML
derive gParse (,), (,,), (,,,), (<->), <|>, HtmlDate, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML
instance toBool CheckBox, Button, RadioButton // True if checkbox checked, button pressed
instance toInt PullDownMenu // Current index in pull down list
......@@ -24,6 +24,8 @@ instance toString PullDownMenu // Corresponding element in pull down list
| HideMode a // hiding a
| EmptyMode // nothing to display or hide
:: HTML = HTML [BodyTag] // to print html: NOT Parsed, CANNOT be stored NOR retrieved
// buttons representing classical html buttons
:: Button = Pressed // button pressed
......
......@@ -15,6 +15,24 @@ derive gParse (,), (,,), (,,,), (<->), <|>, HtmlDate, DisplayMode, Button, Chec
// Types that have an effect on lay-out
:: HTML = HTML [BodyTag]
gForm {|HTML|} (init,formid ) hst = specialize myeditor (Set,formid) hst
where
myeditor (init,formid ) hst
# (HTML bodytag) = formid.ival
= ({changed = False, form = bodytag, value = formid.ival},hst)
gUpd {|HTML|} mode v = (mode,v)
gPrint{|HTML|} (HTML x) st = st <<- "XYX"
gParse {|HTML|} st
= case gParse {|*|} st of
Just "XYX" -> Just (HTML [EmptyBody])
_ -> Just (HTML [EmptyBody])
// Tuples are placed next to each other, pairs below each other ...
gForm{|(,)|} gHa gHb (init,formid) hst
......
......@@ -55,31 +55,35 @@ import StdMaybe, StdBool
// **** easy creation of FormId's ****
nFormId :: !String !d -> (FormId d) // page livetime, editable, string format
sFormId :: !String !d -> (FormId d) // session livetime, editable, string format
pFormId :: !String !d -> (FormId d) // persistent livetime, editable, string format
rFormId :: !String !d -> (FormId d) // persistentRO livetime, editable, string format
ndFormId :: !String !d -> (FormId d) // page livetime, displayed non-editable, string format
sdFormId :: !String !d -> (FormId d) // session livetime, displayed non-editable, string format
pdFormId :: !String !d -> (FormId d) // persistent livetime, displayed non-editable, string format
rdFormId :: !String !d -> (FormId d) // persistentRO livetime, displayed non-editable, string format
xFormId :: !String !d -> (FormId d) // temp, noform
xnFormId :: !String !d -> (FormId d) // page livetime, noform, string format
xsFormId :: !String !d -> (FormId d) // session livetime, noform, string format
xpFormId :: !String !d -> (FormId d) // persistent livetime, noform, string format
xrFormId :: !String !d -> (FormId d) // persistentRO livetime, noform, string format
nDFormId :: !String !d -> (FormId d) // page livetime, editable, static dynamic format
sDFormId :: !String !d -> (FormId d) // session livetime, editable, static dynamic format
pDFormId :: !String !d -> (FormId d) // persistent livetime, editable, static dynamic format
rDFormId :: !String !d -> (FormId d) // persistentRO livetime, editable, static dynamic format
ndDFormId :: !String !d -> (FormId d) // page livetime, displayed non-editable, static dynamic format
sdDFormId :: !String !d -> (FormId d) // session livetime, displayed non-editable, static dynamic format
pdDFormId :: !String !d -> (FormId d) // persistent livetime, displayed non-editable, static dynamic format
rdDFormId :: !String !d -> (FormId d) // persistentRO livetime, displayed non-editable, static dynamic format
nFormId :: !String !d -> (FormId d) // page , editable, string format
sFormId :: !String !d -> (FormId d) // session , editable, string format
pFormId :: !String !d -> (FormId d) // persistent , editable, string format
rFormId :: !String !d -> (FormId d) // persistentRO , editable, string format
ndFormId :: !String !d -> (FormId d) // page , displayed non-editable, string format
sdFormId :: !String !d -> (FormId d) // session , displayed non-editable, string format
pdFormId :: !String !d -> (FormId d) // persistent , displayed non-editable, string format
rdFormId :: !String !d -> (FormId d) // persistentRO , displayed non-editable, string format
xtFormId :: !String !d -> (FormId d) // temp , noform
xnFormId :: !String !d -> (FormId d) // page , noform, string format
xsFormId :: !String !d -> (FormId d) // session , noform, string format
xpFormId :: !String !d -> (FormId d) // persistent , noform, string format
xrFormId :: !String !d -> (FormId d) // persistentRO , noform, string format
tFormId :: !String !d -> (FormId d) // temp , editable, string format
tdFormId :: !String !d -> (FormId d) // temp , displayed non-editable, string format
nDFormId :: !String !d -> (FormId d) // page , editable, static dynamic format
sDFormId :: !String !d -> (FormId d) // session , editable, static dynamic format
pDFormId :: !String !d -> (FormId d) // persistent , editable, static dynamic format
rDFormId :: !String !d -> (FormId d) // persistentRO , editable, static dynamic format
ndDFormId :: !String !d -> (FormId d) // page , displayed non-editable, static dynamic format
sdDFormId :: !String !d -> (FormId d) // session , displayed non-editable, static dynamic format
pdDFormId :: !String !d -> (FormId d) // persistent , displayed non-editable, static dynamic format
rdDFormId :: !String !d -> (FormId d) // persistentRO , displayed non-editable, static dynamic format
extidFormId :: !(FormId d) !String -> (FormId d) // make new id by adding sufix
subFormId :: !(FormId a) !String !d -> (FormId d) // make new id af new type by adding suffix
......
......@@ -17,8 +17,14 @@ sFormId s d = {id = s, lifespan = Session, mode = Edit, storage = PlainString, i
nFormId :: !String !d -> (FormId d) // page formid
nFormId s d = {id = s, lifespan = Page, mode = Edit, storage = PlainString, ival = d}
xFormId :: !String !d -> (FormId d) // persitent formid
xFormId s d = {id = s, lifespan = Temp, mode = NoForm, storage = PlainString, ival = d}
xtFormId :: !String !d -> (FormId d) // persitent formid
xtFormId s d = {id = s, lifespan = Temp, mode = NoForm, storage = PlainString, ival = d}
tFormId :: !String !d -> (FormId d) // persitent formid
tFormId s d = {id = s, lifespan = Temp, mode = Edit, storage = PlainString, ival = d}
tdFormId :: !String !d -> (FormId d) // persitent formid
tdFormId s d = {id = s, lifespan = Temp, mode = Display, storage = PlainString, ival = d}
xpFormId :: !String !d -> (FormId d) // persitent formid
xpFormId s d = {id = s, lifespan = Persistent, mode = NoForm, storage = PlainString, ival = d}
......
......@@ -19,6 +19,7 @@ mkRowForm :: [BodyTag] -> BodyTag // place every element in a row next t
(<||>) infixl 4 :: [BodyTag] [BodyTag] -> BodyTag // Place second below first
(<.||.>) infixl 4 :: BodyTag BodyTag -> BodyTag // Place second below first
(<|.|>) infixl 4 :: [BodyTag] [BodyTag] -> [BodyTag] // Place second below first
mkColForm :: [BodyTag] -> BodyTag // Place every element in a column below first
mkSTable :: [[BodyTag]] -> BodyTag // Make a table, default with
......
......@@ -37,6 +37,10 @@ mkHtmlB s attr tags hst = (simpleHtml s attr tags,hst)
(<||>) infixl 4 :: [BodyTag] [BodyTag] -> BodyTag // Place a above b
(<||>) b1 b2 = (BodyTag b1) <.||.> (BodyTag b2)
(<|.|>) infixl 4 :: [BodyTag] [BodyTag] -> [BodyTag] // Place a above b
(<|.|>) b1 b2 = [(BodyTag b1) <.||.> (BodyTag b2)]
(<.||.>) infixl 4 :: BodyTag BodyTag -> BodyTag // Place a above b
(<.||.>) b1 b2 = STable [Tbl_CellPadding (Pixels 0), Tbl_CellSpacing (Pixels 0)] [[b1],[b2]]
......
......@@ -101,15 +101,14 @@ where
calcnextView isupdated view states world
# (changedid,states) = getUpdateId states
# view = toForm init formid.ival view // map value to view domain, given previous view value
# view = toForm init formid.ival view // map value to view domain, given previous view value
# view = updForm {isChanged = isupdated, changedId = changedid} view // apply update function telling user if an update has taken place
# newval = fromForm {isChanged = isupdated, changedId = changedid} view // convert back to data domain
# view = case resetForm of // optionally reset the view herafter for next time
Nothing -> view
Just reset -> reset view
// added
| formid.mode == NoForm // NEW : don't make a form at all
| formid.mode == NoForm // don't make a form at all
# (states,world) = replaceState vformid view states world // store new value into the store of states
= ( {changed = False
, value = newval
......@@ -485,7 +484,7 @@ setCntr :: InputId *HSt -> *HSt
setCntr i hst = {hst & cntr = i}
incrHSt :: Int *HSt -> *HSt
incrHSt i hst = {hst & cntr = i}
incrHSt i hst = {hst & cntr = hst.cntr + i} // BUG ??????
CntrHSt :: *HSt -> (Int,*HSt)
CntrHSt hst=:{cntr} = (cntr,hst)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment