moduleWASH.CGI.AbstractSelector-- the public interface-- ( as_rows, as_cols, table_io, getText, selectionGroup, selectionButton, selectionDisplay)whereimportWASH.CGI.BaseCombinators(unsafe_io,once)importWASH.CGI.CGIInternals(HTMLField,INVALID,ValidationError(..))importWASH.CGI.CGIMonadhiding(lift)importWASH.CGI.HTMLWrapperimportWASH.CGI.RawCGIInternalhiding(CGIEnv(..))importWASH.Utility.JavaScriptimportCharimportList((\\))importMaybe-- |abstract table (twodimensional)dataAT=AT{as_raw::[[String]],as_rows::Int,as_cols::Int}instanceShowATwhereshowsPrecias=showsPreci(as_rowsas,as_colsas)instanceReadATwherereadsPreciinp=[(AT{as_raw=[],as_rows=r,as_cols=c},str')|((r,c),str')<-readsPreciinp]-- |abstract rowdataAR=AR[String]deriving(Eq,Show)instanceReadARwherereadsPreciinp=casedropWhileisSpaceinpof'A':'R':xs->[(ARxss,rest)|(xss,rest)<-readsxs]_->[]readListinp=casedropWhileisSpaceinpof'+':xs->[(ar:ars,xs2)|(ar,xs1)<-readsxs,(ars,xs2)<-readListxs1]'-':xs->[(ars\\[ar],xs2)|(ar,xs1)<-readsxs,(ars,xs2)<-readListxs1]""->[([],[])]_->[]getAR::AT->Int->ARgetARatr=AR(getRow(as_rawat)r)unAR::AR->[String]unAR(ARx)=x-- |Transform an IO action that produces a table in list form into a CGI action-- that returns an abstract table. table_io::IO[[String]]->CGIATtable_ioio=once$doraw<-unsafe_ioioletr=lengthrawc=length(Prelude.headraw)return(AT{as_raw=raw,as_rows=r,as_cols=c})-- |Access abstract table by row and column. Produces a test node in the-- document monad.getText::Monadm=>AT->Int->Int->WithHTMLxm()getTextasrc=text(getEntry(as_rawas)rc)getRowxssr|0<=r&&r<lengthxss=xss!!r|otherwise=[]getColxsc|0<=c&&c<lengthxs=xs!!c|otherwise=""getEntryxssrc=getCol(getRowxssr)c-- |a selection group is a virtual field that never appears on the screen, but-- gives rise to a hidden input field!dataSelectionGroupax=SelectionGroup{selectionName::String,selectionToken::CGIFieldName,selectionString::MaybeString,selectionValue::Maybea,selectionBound::Bool}validateSelectionGrouprg=caseselectionValuergofNothing|selectionBoundrg->Left[ValidationError(selectionNamerg)(selectionTokenrg)(selectionStringrg)]_->RightSelectionGroup{selectionName=selectionNamerg,selectionToken=selectionTokenrg,selectionString=selectionStringrg,selectionValue=selectionValuerg,selectionBound=selectionBoundrg}valueSelectionGrouprg=caseselectionValuergofNothing->error("SelectionGroup { "++"selectionName = "++show(selectionNamerg)++", "++"selectionString = "++show(selectionStringrg)++", "++"selectionBound = "++show(selectionBoundrg)++" }")Justvl->vl-- |Create a selection group for a table. Selects one row.selectionGroup::(CGIMonadcgi)=>WithHTMLycgi(SelectionGroupARINVALID)selectionGroup=dotoken<-liftnextNameletfieldName=showtokeninfo<-liftgetInfolift$addFieldfieldNameFalseletbds=bindingsinfomaybeString=bds>>=assocParmfieldName-- experimentalisBound=fromMaybeFalse(do"UNSET"<-maybeStringreturnTrue)maybeVal=maybeString>>=(g.reads)g((a,""):_)=Justag_=Nothinginput(doattr"type""hidden"attr"name"fieldNameattr"value""UNSET")return$SelectionGroup{selectionName=fieldName,selectionToken=token,selectionString=maybeString,selectionValue=maybeVal,selectionBound=isBound}-- |Create a selection button for an abstract tableselectionButton::(CGIMonadcgi)=>SelectionGroupARINVALID->AT->Int->HTMLFieldcgixy()selectionButtonsgatrowbuttonAttrs=input(doattr"type""radio"attr"name"(fieldName++"_")attr"onclick"("var ff=this.form."++fieldName++";ff.value="++jsShow(show(getARatrow))++";if(ff.getAttribute('onchange'))"++"{WASHSubmit(ff.name);"++"};")buttonAttrs)wherefieldName=selectionNamesg-- |Create a labelled selection display for an abstract table. The display-- function takes the button element and a list of text nodes corresponding to-- the selected row and is expected to perform the layout.selectionDisplay::(CGIMonadcgi)=>SelectionGroupARINVALID->AT->Int->(WithHTMLxcgi()->[WithHTMLxcgi()]->WithHTMLxcgia)->WithHTMLxcgiaselectionDisplaysgatrowdisplayFun=displayFun(selectionButtonsgatrowempty)(Prelude.maptext$getRow(as_rawat)row)-- |Create a choice group for a table (0-*).choiceGroup::(CGIMonadcgi)=>WithHTMLxcgi(SelectionGroup[AR]INVALID)choiceGroup=dotoken<-liftnextNameletfieldName=showtokeninfo<-liftgetInfolift$addFieldfieldNameFalseletbds=bindingsinfomaybeString=bds>>=assocParmfieldNamemaybeVal=maybeString>>=(g.reads)g((a,""):_)=Justag_=Nothinginput(doattr"type""hidden"attr"name"fieldNameattr"value""")return$SelectionGroup{selectionName=fieldName,selectionToken=token,selectionString=maybeString,selectionValue=maybeVal,selectionBound=isJustbds}-- |Create one choice button for an abstract tablechoiceButton::(CGIMonadcgi)=>SelectionGroup[AR]INVALID->AT->Int->HTMLFieldcgixy()choiceButtonsgatrowbuttonAttrs=doscript_T(rawtext$"SubmitAction[SubmitAction.length]="++"function(){"++"var f=document.forms[0];"++"if(f."++buttonFieldName++".checked){"++"f."++fieldName++".value="++jsShow('+':show(getARatrow))++"+f."++fieldName++".value;"++"};return true};")input_T(doattr"type""checkbox"attr"name"buttonFieldNamebuttonAttrs)wherefieldName=selectionNamesgbuttonFieldName=fieldName++'_':showrow-- |Create a labelled choice display for an abstract table. The display-- function takes the button element and a list of text nodes corresponding to-- the selected row and is expected to perform the layout.choiceDisplay::(CGIMonadcgi)=>SelectionGroup[AR]INVALID->AT->Int->(WithHTMLxcgi()->[WithHTMLxcgi()]->WithHTMLxcgia)->WithHTMLxcgiachoiceDisplaysgatrowdisplayFun=displayFun(choiceButtonsgatrowempty)(Prelude.maptext$getRow(as_rawat)row)