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["&","&amp;"]]Replace["<", "&lt;"]]Replace[">", "&gt;"]
+}
+	
+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"]
+}