Mercurial > repos > rhope
diff framework.rhope @ 0:76568becd6d6
Rhope Alpha 2a source import
author | Mike Pavone <pavone@retrodev.com> |
---|---|
date | Tue, 28 Apr 2009 23:06:07 +0000 |
parents | |
children | b3f71490858c |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/framework.rhope Tue Apr 28 23:06:07 2009 +0000 @@ -0,0 +1,750 @@ +Import webserver.rhope + +Framework Handler[con,path,request type,queryvars,headers,handler,title,use session] +{ + page <- New@Page[title, path, use session, queryvars, headers] + out list <- [handler]Do[ [[New@List[]]Append[page]]Append[path] ] + handler page <- [out list]Index[0] + If[[request type] = ["POST"]] + { + final page <- Process POST[handler page, con, headers] + }{ + final page <- Val[handler page] + } + string,out headers <- [final page]Render + + [HTTP OK[con, Get Content Type[".html"], [string]Length, out headers] + ]Put String[string] +} + +Handler Fixer[handler:out] +{ + If[[Type Of[handler]] = ["List"]] + { + out <- [[["Framework Handler"]Set Input[5, [handler]Index[0]]]Set Input[6, [handler]Index[1]]]Set Input[7, [handler]Index[2]] + }{ + out <- handler + } +} + +Start Web[handlers] +{ + Print["Starting Rhope Web Server"] + Init Sessions[] + { Listen on Port[80,["Connection Start"]Set Input[1, Map[handlers,"Handler Fixer"]]] } + Wait Forever[] +} + +Get Class[container:class] +{ + If[[[[container]Class >>]Length] > [0]] + { + class <- [[" class=\""]Append[[container]Class >>]]Append["\""] + }{ + class <- "" + } +} + +Blueprint Web Event +{ + Event Name + Origin + Data +} + +New@Web Event[name,origin,data:out] +{ + out <- [[[Build["Web Event"]]Event Name <<[name]]Origin <<[origin]]Data <<[data] +} + +Blueprint Web Container +{ + Tag Name + Class + Propagate Events + Children + Handlers + Named Children + Session + Use Session +} + +New@Web Container[class:out] +{ + out <- [[[[[[[Build["Web Container"] + ]Tag Name <<["div"] + ]Class <<[class] + ]Propagate Events <<[No] + ]Children <<[New@List[]] + ]Named Children <<[New@Dictionary[]] + ]Handlers <<[New@Dictionary[]] + ]Use Session <<[No] +} + +Name@Web Container[cont:out,none] +{ + none <- cont +} + +Render Child[start,container:out] +{ + out <- [start]Append[[container]Render] +} + +Set Session@Web Container[container,session:out] +{ + out <- [ + [ + [container]Use Session <<[Yes] + ]Session <<[session] + ]Children <<[ Map[ [container]Children >>, ["Set Session"]Set Input[1, session] ] ] +} + +Set Handler@Web Container[container,event name,handler:out] +{ + out <- [container]Handlers <<[ [[container]Handlers >> ]Set[event name, handler] ] +} + +Render@Web Container[container:out,headers] +{ + out <- [[[[[[["<"]Append[ [container]Tag Name >> ] + ]Append[Get Class[container]] + ]Append[">\n\t"] + ]Append[Fold[["Render Child"]<String@Worker, "", [container]Children >>]] + ]Append["\n</"] + ]Append[ [container]Tag Name >> ] + ]Append[">\n"] +} + +Container Event Handler[container,events,index:cont,out events] +{ + event <- [events]Index[index] + [[container]Handlers >>]Index[ [event]Event Name >>] + { + result list <- [~]Do[ + [[New@List[]]Append[container]]Append[event] + ] + new container <- [result list]Index[0] + [result list]Index[1] + { + out events <- [result events]Append[~] + }{ + out events <- Val[result events] + } + }{ + new container <- container + out events <- Val[result events] + } + + [events]Next[index] + { + cont, result events <- Container Event Handler[new container, events, ~] + }{ + cont <- Val[new container] + result events <- New@List[] + } +} + +Container Postback Helper[container,post data,index,events:out,out events] +{ + ,current events <- [[[container]Children >>]Index[index]]Postback[post data] + { + new container <- [container]Children <<[[[container]Children >>]Set[index, ~]] + } + combined events <- Concatenate[events, current events] + [[new container]Children >>]Next[index] + { + out, out events <- Container Postback Helper[new container, post data, ~, combined events] + }{ + [combined events]First + { + out, newevents <- Container Event Handler[new container, combined events, ~] + out events <- Concatenate[combined events, newevents] + }{ + out <- Val[new container] + out events <- Val[combined events] + } + } +} + +Postback@Web Container[container,post data:out,events] +{ + [[container]Children >>]First + { + out, postback events <- Container Postback Helper[container, post data, ~, New@List[]] + If[[container]Propagate Events >>] + { + events <- Val[postback events] + }{ + events <- New@List[] + } + }{ + out <- container + events <- New@List[] + } +} + +Add Child[cont,child:out] +{ + If[[cont]Use Session >>] + { + prepped child <- [child]Set Session[[cont]Session >>] + }{ + prepped child <- Val[child] + } + with child <- [cont]Children <<[ [[cont]Children >>]Append[prepped child] ] + + [prepped child]Name + { + out <- [with child]Named Children <<[ [[with child]Named Children >>]Set[~, [[[with child]Children >>]Length] - [1]] ] + }{ + out <- Val[with child] + } +} + +Get Child By Name[container,name:out,not found] +{ + ,not found <- [[container]Named Children >>]Index[name] + { + out <- [[container]Children >>]Index[~] + } +} + +Blueprint Page +{ + Title + URL + CSS + Children + Named Children + Handlers + Use Session + Session + Session ID +} + +Set Handler@Page[container,event name,handler:out] +{ + out <- [container]Handlers <<[ [[container]Handlers >> ]Set[event name, handler] ] +} + +New@Page[title,url,use session,queryvars,headers:out] +{ + page <- [[[[[[[Build["Page"] + ]Title <<[title] + ]URL <<[url] + ]CSS <<[[New@List[]]Append["/default.css"]] + ]Children <<[New@List[]] + ]Named Children <<[New@Dictionary[]] + ]Handlers <<[New@Dictionary[]] + ]Use Session <<[use session] + + If[use session] + { + Load@Session[queryvars, headers] + { + out <- [[page]Session <<[~]]Session ID <<[ [~]Session ID>>] + } + }{ + out <- Val[page] + } +} + +Get Action@Page[page:out] +{ + If[[page]Use Session>>] + { + [[page]Session >>]Get Link Params + { + out <- [[[page]URL >>]Append["?"]]Append[~] + }{ + out <- [page]URL >> + } + }{ + out <- [page]URL >> + } +} + +Render@Page[page:out,headers] +{ + out <- [[[[[[["<html>\n\t<head>\n\t\t<title>"]Append[[page]Title >>] + ]Append["</title>\n\t\t<link rel=\"stylesheet\" href=\""] + ]Append[[[page]CSS >>]Join["\">\n\t\t<link rel=\"stylesheet\" href=\""]] + ]Append["\">\n\t</head>\n\t<body>\n\t<form method=\"POST\" action=\""] + ]Append[[[page]Get Action]Append["\">\n"]] + ]Append[Fold[["Render Child"]<String@Worker, "", [page]Children >>]] + ]Append["\t</form>\n\t</body>\n</html>"] + If[[page]Use Session>>] + { + headers <- [[page]Session >>]Finalize[New@Dictionary[]] + }{ + headers <- New@Dictionary[] + } +} + +Clear Children[page:out] +{ + out <- [[page]Children <<[New@List[]]]Named Children <<[New@Dictionary[]] +} + +Set@Page[page,key,val:out] +{ + out <- [page]Session <<[ [[page]Session >>]Set[key, val] ] +} + +Index@Page[page,key:out,not found] +{ + out,not found <- [[page]Session >>]Index[key] +} + +First@Page[page:first,not found] +{ + first,not found <- [[page]Session >>]First +} + +Next@Page[page,last:next,not found] +{ + next,not found <- [[page]Session >>]Next[last] +} + +Add CSS@Page[page,css:out] +{ + out <- [page]CSS <<[ [[page]CSS >>]Append[css] ] +} + +Clear CSS@Page[page:out] +{ + out <- [page]CSS <<[New@List[]] +} + +Decode Helper Decode[list,destlist,index:out] +{ + code,rest <- [[list]Index[index]]Slice[2] + newlist <- [destlist]Set[index, [[""]Put Byte[From Hex@Whole Number[code]]]Append[rest]] + [list]Next[index] + { + out <- Decode Helper Straight[list, newlist, ~] + }{ + out <- Val[newlist] + } +} + +Decode Helper Straight[list,destlist,index:out] +{ + newlist <- [destlist]Set[index, [list]Index[index]] + [list]Next[index] + { + out <- Decode Helper Decode[list, newlist, ~] + }{ + out <- Val[newlist] + } +} + +URL Decode[val:out] +{ + parts <- [val]Split["%"] + [parts]First + { + out <- [Decode Helper Straight[parts, New@List[], ~]]Join[""] + }{ + out <- val + } +} + +URL Encode Path[string:out] +{ + out <- [[[[string]Replace["%","%25"]]Replace[" ","%20"]]Replace["/","%2F"]]Replace["?","%3F"] +} + +Decode Pair[val,key:oval,okey] +{ + oval <- URL Decode[val] + okey <- URL Decode[key] +} + +Process POST[page,con,headers:out] +{ + [con]Get FString[[headers]Index["Content-Length"]] {} + { + post string <- [~]Replace["+"," "] + } + post data <- Key Value Map[Dict Split[post string, "=", "&"], ["Decode Pair"]<String@Worker] + out <- [page]Postback[post data] +} + +Postback@Page[page,post data:out,events] +{ + [[page]Children >>]First + { + out, events <- Container Postback Helper[page, post data, ~, New@List[]] + }{ + out <- page + } + events <- New@List[] +} + +Blueprint Web Text +{ + Text + Enclosing Tag +} + +New@Web Text[text,tag:out] +{ + out <- [[Build["Web Text"]]Text <<[text]]Enclosing Tag <<[tag] +} + +Name@Web Text[text:out,none] +{ + none <- text +} + +Escape HTML Text[string:out] +{ + out <- [[[string]Replace["&","&"]]Replace["<", "<"]]Replace[">", ">"] +} + +Render@Web Text[text:out,headers] +{ + processed text <- [Escape HTML Text[[text]Text >>]]Replace["\n","<br>\n\t"] + If[[[[text]Enclosing Tag >>]Length] = [0]] + { + out <- Val[processed text] + }{ + out <- [[[["<"]Append[[text]Enclosing Tag >>]]Append[">"]]Append[processed text]]Append[[["</"]Append[[text]Enclosing Tag >>]]Append[">"]] + } +} + +Postback@Web Text[text,post data:out,events] +{ + out <- text + events <- New@List[] +} + +Set Session@Web Text[text,session:out] +{ + out <- session +} + +Render@String[string:out,headers] +{ + out <- [New@Web Text[string,""]]Render +} + +Name@String[string:out,none] +{ + none <- string +} + +Postback@String[in,post data:out,events] +{ + out <- in + events <- New@List[] +} + +Set Session@String[in,session:out] +{ + out <- in +} + +Blueprint Web Field +{ + Name + Value + Type + Class +} + +Name@Web Field[field:name,none] +{ + name <- [field]Name >> +} + +New@Web Field[name,value,type:out] +{ + out <- [[[[Build["Web Field"]]Name <<[name]]Value <<[value]]Type <<[type]]Class <<[""] +} + +Set Session@Web Field[in,session:out] +{ + out <- in +} + +Render@Web Field[field:out,headers] +{ + If[[[field]Type >>] = ["multiline"]] + { + out <- [[[[[["<textarea name=\""]Append[[field]Name >>]]Append["\""]]Append[Get Class[field]]]Append[">"]]Append[[field]Value >>]]Append["</textarea>"] + }{ + out <- [[[[[[[["<input type=\""]Append[[field]Type >>]]Append["\" name=\""]]Append[[field]Name >>]]Append["\""]]Append[Get Class[field]]]Append[" value=\""]]Append[[field]Value >>]]Append["\">"] + } + +} + +Postback@Web Field[field,post data:out,event] +{ + [post data]Index[[field]Name >>] + { + out <- [field]Value <<[~] + + If[[[field]Value >>] = [~]] + { + event <- New@List[] + }{ + event <- [New@List[]]Append[ New@Web Event["change", [field]Name >>, [field]Value >>] ] + } + }{ + out <- field + event <- New@List[] + } +} + +Blueprint Web Button +{ + Name + Label + Class +} + +New@Web Button[name,label:out] +{ + out <- [[[Build["Web Button"]]Name <<[name]]Label <<[label]]Class <<[""] +} + +Name@Web Button[button:name,none] +{ + name <- [button]Name >> +} + +Set Session@Web Button[in,session:out] +{ + out <- in +} + +Postback@Web Button[button,post data:out,events] +{ + out <- button + [post data]Index[[button]Name >>] + { + events <- [New@List[]]Append[ New@Web Event["click", [button]Name >>, 0] ] + }{ + events <- New@List[] + } +} + +Render@Web Button[button:out,headers] +{ + out <- [[[[[["<input type=\"submit\" name=\""]Append[[button]Name >>]]Append["\""]]Append[Get Class[button]]]Append[" value=\""]]Append[[button]Label >>]]Append["\">"] +} + +Blueprint Session +{ + Session ID + IP Address + Use Cookies + Data +} + +Get Unique ID[:out] uses Session +{ + out <- [[[::ID]<Whole Number@String]Append["_"]]Append[Random[]] + ::ID <- [::ID]+[1] +} + +New@Session[:out] +{ + out <- [[[Build["Session"]]Session ID <<[Get Unique ID[]]]Use Cookies <<[No]]Data <<[New@Dictionary[]] +} + +Load@Session[queryvars,headers:out] uses Session +{ + ,checkquery <- [headers]Index["Cookie"] + { + parts <- Dict Split[~, "=", "; "] + ,checkquery <- [parts]Index["session_id"] + { + ,checkquery <- [::Sessions]Index[~] + { + out <- [~]Use Cookies <<[Yes] + } + } + } + + + Val[checkquery] + { + ,makenew <- [queryvars]Index["session_id"] + { + out, makenew <- [::Sessions]Index[~] + } + } + + Val[makenew] + { + out <- New@Session[] + } +} + +Get Link Params@Session[session:out,no params] +{ + If[[session]Use Cookies >>] + { + no params <- No + }{ + out <- ["session_id="]Append[[session]Session ID >>] + } +} + +Set@Session[session,key,val:out] +{ + out <- [session]Data <<[ [[session]Data >>]Set[key, val] ] +} + +Index@Session[session,key:out,not found] +{ + out,not found <- [[session]Data >>]Index[key] +} + +First@Session[session:first,not found] +{ + first,not found <- [[session]Data >>]First +} + +Next@Session[session,last:next,not found] +{ + next,not found <- [[session]Data >>]Next[last] +} + +Init Sessions[:out] uses Session +{ + ::ID <- 1 + ::Sessions <- New@Dictionary[] + out <- 0 +} + +Finalize@Session[session,headers:out headers] uses Session +{ + ::Sessions <- [::Sessions]Set[[session]Session ID >>, session] + out headers <- [headers]Set["Set-Cookie", ["session_id="]Append[[session]Session ID >>]] +} + +Blueprint Web Link +{ + Text + Target + Class + Query Params +} + +New@Web Link[text,target:out] +{ + out <- [[[[Build["Web Link"]]Text <<[text]]Target <<[target]]Class <<[""]]Query Params <<[New@Dictionary[]] +} + + +With Session@Web Link[text,target,session:out] +{ + New@Web Link[text, target] + { + out <- [~]Query Params <<[[[~]Query Params >>]Set["session_id", [session]Session ID >>]] + } +} + +Render@Web Link[link:out,headers] +{ + [[link]Query Params>>]First + { + queryvars <- ["?"]Append[Key Value Join[[link]Query Params>>, "=","&"]] + }{ + queryvars <- "" + } + out <- [[[[[[["<a href=\""]Append[[link]Target>>]]Append[queryvars]]Append["\""] + ]Append[Get Class[link]]]Append[">"]]Append[Escape HTML Text[[link]Text>>]]]Append["</a>"] +} + +Postback@Web Link[in,post data:out,events] +{ + out <- in + events <- New@List[] +} + +Name@Web Link[link:name,none] +{ + none <- link +} + +Set Session@Web Link[link,session:out] +{ + If[[[[link]Target >>]Slice[7]] = ["http://"]] + { + out <- link + }{ + If[[session]Use Cookies >>] + { + out <- link + }{ + out <- [link]Query Params <<[[[link]Query Params >>]Set["session_id", [session]Session ID>>]] + } + } +} + +Blueprint Web Table +{ + Headers + Data +} + +New@Web Table[headers,data:out] +{ + out <- [[Build["Web Table"]]Headers <<[headers]]Data <<[data] +} + +Name@Web Table[link:name,none] +{ + none <- link +} + +Set Session@Web Table[in,session:out] +{ + out <- in +} + +Postback@Web Table[table,post data:out,events] +{ + out <- table + events <- () +} + +Make Header Row[string,header:out] +{ + out <- [[[string]Append["\t\t\t<th>"]]Append[header]]Append["</th>\n"] +} + +Get Header Row@Web Table[table:out] +{ + If[[[[table]Headers >>]Length] > [0]] + { + out <- [Fold[["Make Header Row"]<String@Worker, "\t\t<tr>\n", [table]Headers >>]]Append["\t\t</tr>\n"] + }{ + out <- "" + } +} + +Make Table Cell[string,cell:out] +{ + out <- [[[string]Append["\t\t\t<td>"]]Append[[cell]Render]]Append["</td>\n"] +} + +Make Table Row[string,row:out] +{ + out <- [Fold[["Make Table Cell"]<String@Worker, [string]Append["\t\t<tr>\n"], row]]Append["\t\t</tr>"] +} + +Render@Web Table[table:out,headers] +{ + out <- [ + [ + ["\t<table>\n"]Append[[table]Get Header Row] + ]Append[ Fold[["Make Table Row"]<String@Worker, "", [table]Data >>] ] + ]Append["\t</table>\n"] +}