Import webserver.rhope

_Key Value Map[list,index,newlist,worker:out]
{
	newval,newkey <- [worker]Call[[list]Index[index], index]
	
	next <- [newlist]Set[newkey, newval]
	
	[list]Next[index]
	{
		out <- _Key Value Map[list, ~, next, worker]
	}{
		out <- Val[next]
	}
}

Key Value Map[list,worker:out]
{
	[list]First
	{
		out <- _Key Value Map[list, ~, New Like[list], worker]
	}{
		out <- New Like[list]
	}
}

Framework Handler[con,path,request type,queryvars,headers,handler,title,use session]
{
	page <- Page[title, path, use session, queryvars, headers]
	hstart <- time[0i64]
	{ handler page <- [handler]Call[page,path]
	{
		hend <- time[0i64]
		Print[["Handler took: "]Append[String[[hend]-[hstart]]]]
	}}
	If[[request type] = ["POST"]]
	{
		final page,ncon <- Process POST[handler page, con, headers]
	}{
		final page <- Val[handler page]
		ncon <- Val[con]
	}
	Val[final page]
	{ rstart <- time[0i64]
	{ string,out headers <- [final page]Render
	{
		rend <- time[0i64]
		Print[["Render took: "]Append[String[[rend]-[rstart]]]]
	}}}
	
	[[string]Write to File[HTTP OK[ncon, Get Content Type[".html"], [string]Byte Length, out headers]]]Close
}

Handler Fixer[handler:out]
{
	[(List(),List Leaf())]Find[=[?,Blueprint Of[handler]]]
	{
		out <- Val[Framework Handler[?, ?, ?, ?, ?, [handler]Index[0], [handler]Index[1], [handler]Index[2]]]
	}{
		out <- handler
	}
}

Start Web[handlers,port]
{
	Print["Starting Rhope Web Server"]
	workaround <- Init Sessions[]
	Val[workaround]
	{ Listen on Port[port,Connection Start[?, ?, 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[[Blueprint Of[child]] = [Web Text()]]
	{
		out <- [child]Preformatted <<[val]
	}{
		If[[Blueprint Of[child]] = [Web Container()]]
		{
			out <- [child]Preformatted[val]
		}{
			out <- child
		}
	}
}

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

Set Session@Web Container[container,session:out]
{
	out <- [
				[
					[container]Use Session <<[Yes]
				]Session <<[session]
			]Children <<[ Map[ [container]Children >>, Set Session[?, 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[?], "", [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 >>]
	{
		//The original version, you had to populate the container output
		//and optionally populate the new event output, but that won't work
		//now. None of my existing code really needs to populate both so I've
		//made them mutually exclusive.
		new container <- [~]Call[container,event]
		{
			out events <- Val[result events]
		}{
			out events <- [result events]Append[~]
			new container <- Val[container]
		}
	}{
		new container <- Val[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[?], "", [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]
	decoded <- String[[Array[]]Append[Trunc UInt8[Abs UInt[Hex Int32[code]]]]]
	newlist <- [destlist]Set[index, [decoded]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,ncon]
{
	,ncon <- [con]Read[Int32[[headers]Index["Content-Length"]]]
	{
		post string <- [String[~]]Replace["+"," "]
	}
	post data <- Key Value Map[Dict Split[post string, "=", "&"], Decode Pair[?]]
	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;","&lt;","&gt;")]
}
	
Render@Web Text[text:out,headers]
{
	If[[text]Preformatted >>]
	{
		processed text <- Escape HTML Text[[text]Text >>]
	}{
		processed text <- [[text]Text >>]Replace[("&","<",">","\n"),("&amp;","&lt;","&gt;","<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
}

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

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

Postback@String Cat[in,post data:out,events]
{
 	out <- in
 	events <- List[]
}

Set Session@String Cat[in,session:out]
{
	out <- in
}

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

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

Postback@String Slice[in,post data:out,events]
{
 	out <- in
 	events <- List[]
}

Set Session@String Slice[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 Counter[:out] uses Session
{
	out <- Val[Session::ID]
	{ Session::ID <- [~]+[1] }
}

Get Unique ID[:out]
{
	out <- [[String[_Get Counter[]]]Append["_"]]Append[String[Random[]]]												
}

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

_Load Session[queryvars,headers:out,makenew] uses Session
{
	,checkquery <- [headers]Index["Cookie"]
	{
		parts <- Dict Split[~, "=", "; "]
		,checkquery <- [parts]Index["session_id"]
		{
			,checkquery <- [Session::Sessions]Index[~]
			{
				out <- [~]Use Cookies <<[Yes]
			}
		}
	}
	
	
	Val[checkquery]
	{
		,makenew <- [queryvars]Index["session_id"]
		{
			out, makenew <- [Session::Sessions]Index[~]
		}
	}
}

Load Session[queryvars,headers:out]
{
	out <- _Load Session[queryvars,headers] {}
	{
		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
{
	Session::Sessions <- Dictionary[]
	out <- Yes
}

Globals Session
{
	ID <- 1
	Sessions <- No
	out <- 0
}

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

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[?], "\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]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[?], "", [table]Data >>] ]
			]Append["\t</table>\n"]
}

Blueprint Web Image
{
	Source
	Alt
}

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