view framework.rhope @ 75:0083b2f7b3c7

Partially working implementation of List. Modified build scripts to allow use of other compilers. Fixed some bugs involving method implementations on different types returning different numbers of outputs. Added Fold to the 'builtins' in the comipler.
author Mike Pavone <pavone@retrodev.com>
date Tue, 06 Jul 2010 07:52:59 -0400
parents 6202b866d72c
children f3686f60985d
line wrap: on
line source

Import webserver.rhope

Framework Handler[con,path,request type,queryvars,headers,handler,title,use session]
{
	page <- Page[title, path, use session, queryvars, headers]
	out list <- [handler]Do[ [[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
}

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
	Preformatted
}

Web Container[class:out]
{
	out <- [[[[[[[[Build["Web Container"]
	]Tag Name <<["div"]
	]Class <<[class]
	]Propagate Events <<[No]
	]Children <<[List[]]
	]Named Children <<[Dictionary[]]
	]Handlers <<[Dictionary[]]
	]Use Session <<[No]
	]Preformatted <<[No]
}

Name@Web Container[cont:out,none]
{
	none <- cont
}
	
Render Child[start,container:out]
{
	out <- [start]Append[[container]Render]
}

_Preformatted[child,val:out]
{
	If[[Type Of[child]] = ["Web Text"]]
	{
		out <- [child]Preformatted <<[val]
	}{
		If[[Type Of[child]] = ["Web Container"]]
		{
			out <- [child]Preformatted[val]
		}{
			out <- child
		}
	}
}

Preformatted@Web Container[cont,preformatted?:out]
{
	out <- [[cont]Children <<[ Map[[cont]Children >>, ["_Preformatted"]Set Input[1, preformatted?]] ]
	]Preformatted <<[preformatted?]
}

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]
{
	If[[container]Preformatted >>]
	{
		newline <- ""
		tab <- ""
	}{
		newline <- "\n"
		tab <- "\t"
	}
	out <- [[[[[[["<"]Append[ [container]Tag Name >> ]
		]Append[Get Class[container]]
		]Append[[[">"]Append[newline]]Append[tab]]
		]Append[Fold[["Render Child"]<String@Worker, "", [container]Children >>]]
		]Append[[newline]Append["</"]]
		]Append[ [container]Tag Name >> ]
		]Append[[">"]Append[newline]]
}

Container Event Handler[container,events,index:cont,out events]
{
	event <- [events]Index[index]
	[[container]Handlers >>]Index[ [event]Event Name >>]
	{
		result list <- [~]Do[
				[[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 <- 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, ~, List[]]
		If[[container]Propagate Events >>]
		{
			events <- Val[postback events]
		}{
			events <- List[]
		}
	}{
		out <- container
		events <- 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] ]
}
	
Page[title,url,use session,queryvars,headers:out]
{
	page <- [[[[[[[Build["Page"]
	]Title <<[title]
	]URL <<[url]
	]CSS <<[[List[]]Append["/default.css"]]
	]Children <<[List[]]
	]Named Children <<[Dictionary[]]
	]Handlers <<[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[Dictionary[]]
	}{
		headers <- Dictionary[]
	}
}

Clear Children[page:out]
{
	out <- [[page]Children <<[List[]]]Named Children <<[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 <<[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 Decode[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, 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, ~, List[]]
	}{
		out <- page
	}
	events <- List[]
}
	
Blueprint Web Text
{
	Text
	Enclosing Tag
	Preformatted
}
	
Web Text[text,tag:out]
{
	out <- [[[Build["Web Text"]]Text <<[text]]Enclosing Tag <<[tag]]Preformatted <<[No]
}

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]
{
	escaped <- Escape HTML Text[[text]Text >>]
	If[[text]Preformatted >>]
	{
		processed text <- Val[escaped]
	}{
		processed text <- [escaped]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 <- List[]
}

Set Session@Web Text[text,session:out]
{
	out <- text
}

Render@String[string:out,headers]
{
	out <- [Web Text[string,""]]Render	
}

Name@String[string:out,none]
{
	none <- string
}

Postback@String[in,post data:out,events]
{
 	out <- in
 	events <- 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 >>	
}

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 <- List[]
		}{
			event <- [List[]]Append[ Web Event["change", [field]Name >>, [field]Value >>] ]
		}
	}{
		out <- field
		event <- List[]
	}
}

Blueprint Web Button
{
	Name
	Label
	Class
}

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 <- [List[]]Append[ Web Event["click", [button]Name >>, 0] ]
	}{
		events <- 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
	Dirty
}

Get Unique ID[:out] uses Session
{
	out <- [[[::ID]<Whole Number@String]Append["_"]]Append[Random[]]
	::ID <- [::ID]+[1]
}

Session[:out]
{
	out <- [[[[Build["Session"]]Session ID <<[Get Unique ID[]]]Use Cookies <<[No]]Data <<[Dictionary[]]]Dirty <<[No]
}

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 <- 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] ]]Dirty <<[Yes]
}

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 <- Dictionary[]
	out <- 0
}

Save@Session[session:out] uses Session
{
	::Sessions <- [::Sessions]Set[[session]Session ID >>, session]
}

Finalize@Session[session,headers:out headers]
{
	If[[session]Dirty >>]
	{
		Save[session]
	}
	out headers <- [headers]Set["Set-Cookie", ["session_id="]Append[[session]Session ID >>]]
}

Blueprint Web Link
{
	Text
	Target
	Class
	Query Params
}

Web Link[text,target:out]
{
	out <- [[[[Build["Web Link"]]Text <<[text]]Target <<[target]]Class <<[""]]Query Params <<[Dictionary[]]	
}
	

With Session@Web Link[text,target,session:out]
{
	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 <- 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
}

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"]
}

Blueprint Web Image
{
	Source
	Alt
}

New@Web Image[source,alt:out]
{
	out <- [[Build["Web Image"]]Source <<[source]]Alt <<[alt]
}

Name@Web Image[image:name,none]
{
	name <- [image]Source >>
}

Set Session@Web Image[in,session:out]
{
	out <- in
}

Postback@Web Image[image,post data:out,events]
{
	out <- image
	events <- ()
}

Render@Web Image[image:out,headers]
{
	out <- [[[["<img src=\""]Append[[image]Source >>]]Append["\" alt=\""]]Append[[image]Alt >>]]Append["\">"]
}