Commit 66f9d674 authored by Bas Lijnse's avatar Bas Lijnse

Various cleanup

git-svn-id: https://svn.cs.ru.nl/repos/clean-platform/trunk@42 2afc29ad-3112-4e41-907a-9359c7e6e986
parent 713fb676
all:
clm -I `cat "../env/Clean Platform.dirs"` -nt WebDemo -o WebDemo
clm -I `cat "../env/Clean Platform.dirs"` -nt IPLookup -o IPLookup
clm -I "../env/all-libraries" -nt MapDemo -o MapDemo
clm -I "../env/all-libraries" -nt -nr WebDemo -o WebDemo
clm -I "../env/all-libraries" -nt IPLookup -o IPLookup
......@@ -3,9 +3,9 @@ module WebDemo
* Simple CGI application built solely on clean-platform libs
*/
import StdEnv
import Html //Text.Html
import Http //Internet.Http
import Cgi //Internet.Http.Cgi
import HTML //Text.Html
import HTTP //Internet.Http
import CGI //Internet.Http.Cgi
page = HtmlTag [] [head,body]
head = HeadTag [] [TitleTag [] [Text "Hello World!"]]
......
definition module HashTable
import StdOverloaded
import Maybe
:: HashTable k v
class hash k where
hash :: k -> Int
instance hash Int
instance hash String
newHashTable :: HashTable k v | == k & hash k
get :: !k (HashTable k v) -> Maybe v | == k & hash k
put :: !k !v (HashTable k v) -> HashTable k v | == k & hash k
del :: !k (HashTable k v) -> HashTable k v | == k & hash k
keys :: !(HashTable k v) -> [k]
containsKey :: !k (HashTable k v) -> Bool | == k & hash k
containsValue :: !v (HashTable k v) -> Bool | == v
toList :: !(HashTable k v) -> [(k,v)]
fromList :: ![(k,v)] -> HashTable k v
implementation module HashTable
/**
* THIS IMPLEMENTATION IS NOT A REAL HASHTABLE!!!
*
* It is just a stub implemented with a list of pairs and O(n) search.
* This module allows the use of the HashTable interface already, until
* someone finds the time to implement a nice efficient hashtable.
*/
import StdOverloaded, StdInt, StdString, StdList
import Maybe
:: HashTable k v = HashTable [(k,v)]
class hash k
where
hash :: k -> Int
instance hash Int
where
hash _ = 0
instance hash String
where
hash _ = 0
newHashTable :: HashTable k v | == k & hash k
newHashTable = HashTable []
get :: !k (HashTable k v) -> Maybe v | == k & hash k
get k (HashTable []) = Nothing
get k (HashTable [(xk,xv):xs])
| k == xk = Just xv
= get k (HashTable xs)
put :: !k !v (HashTable k v) -> HashTable k v | == k & hash k
put k v (HashTable []) = (HashTable [(k,v)])
put k v (HashTable [(xk,xv):xs])
| k == xk = (HashTable [(k,v):xs])
= case put k v (HashTable xs) of (HashTable ps) = HashTable [(xk,xv):ps]
del :: !k (HashTable k v) -> HashTable k v | == k & hash k
del k (HashTable []) = (HashTable [])
del k (HashTable [(xk,xv):xs])
| k == xk = HashTable xs
= case del k (HashTable xs) of (HashTable ds) = HashTable [(xk,xv):ds]
keys :: !(HashTable k v) -> [k]
keys (HashTable []) = []
keys (HashTable [(xk,xv):xs]) = [xk:keys (HashTable xs)]
containsKey :: !k (HashTable k v) -> Bool | == k & hash k
containsKey k (HashTable []) = False
containsKey k (HashTable [(xk,xv):xs])
| k == xk = True
= containsKey k (HashTable xs)
containsValue :: !v (HashTable k v) -> Bool | == v
containsValue v (HashTable []) = False
containsValue v (HashTable [(xk,xv):xs])
| v == xv = True
= containsValue v (HashTable xs)
toList :: !(HashTable k v) -> [(k,v)]
toList (HashTable xs) = xs
fromList :: ![(k,v)] -> HashTable k v
fromList xs = HashTable xs
......@@ -25,7 +25,7 @@ from StdOverloaded import class ==, class <
*
* @return An empty map
*/
empty :: w:(Map k u:v), [ w <= u]
newMap :: w:(Map k u:v), [ w <= u]
/**
* Adds or replaces the value for a given key.
*
......
......@@ -7,8 +7,8 @@ import Maybe
| MLeaf
//Create function
empty :: w:(Map k u:v), [ w <= u]
empty = MLeaf
newMap :: w:(Map k u:v), [ w <= u]
newMap = MLeaf
//Insert function
put :: k u:v w:(Map k u:v) -> x:(Map k u:v) | Eq k & Ord k, [w x <= u, w <= x]
......@@ -118,7 +118,7 @@ where
fromList :: w:[x:(k,u:v)] -> y:(Map k u:v) | Eq k & Ord k, [x y <= u, w <= x, w <= y]
//fromList :: [(k,v)] -> (Map k v) | Eq k & Ord k
fromList [] = empty
fromList [] = newMap
fromList [(k,v):xs] = put k v (fromList xs)
//Helper functions
......
......@@ -2,34 +2,34 @@ definition module HTTP
// This library defines HTTP related types and functions
import StdString
import HashTable, Maybe
:: HTTPRequest = { req_method :: String // The HTTP request method (eg. GET, POST, HEAD)
, req_path :: String // The requested location (eg. /foo)
, req_query :: String // The query part of a location (eg. ?foo=bar&baz=42)
, req_version :: String // The http version (eg. HTTP/1.0 or HTTP/1.1)
, req_protocol :: HTTPProtocol // Protocol info, http or https
, req_headers :: HashTable String String // The headers sent with the request parsed into name/value pairs
, req_data :: String // The raw data of the request (without the headers)
, arg_get :: HashTable String String // The arguments passed in the url
, arg_post :: HashTable String String // The arguments passed via the POST method
, arg_cookies :: HashTable String String // The cookies in the set-cookie header
, arg_uploads :: HashTable String HTTPUpload // Uploads that are sent via the POST method
, server_name :: String // Server host name or ip address
, server_port :: Int // Server port
, client_name :: String // Client host name or ip address
import Maybe, Map
:: HTTPRequest = { req_method :: String // The HTTP request method (eg. GET, POST, HEAD)
, req_path :: String // The requested location (eg. /foo)
, req_query :: String // The query part of a location (eg. ?foo=bar&baz=42)
, req_version :: String // The http version (eg. HTTP/1.0 or HTTP/1.1)
, req_protocol :: HTTPProtocol // Protocol info, http or https
, req_headers :: Map String String // The headers sent with the request parsed into name/value pairs
, req_data :: String // The raw data of the request (without the headers)
, arg_get :: Map String String // The arguments passed in the url
, arg_post :: Map String String // The arguments passed via the POST method
, arg_cookies :: Map String String // The cookies in the set-cookie header
, arg_uploads :: Map String HTTPUpload // Uploads that are sent via the POST method
, server_name :: String // Server host name or ip address
, server_port :: Int // Server port
, client_name :: String // Client host name or ip address
}
:: HTTPProtocol = HTTPProtoHTTP | HTTPProtoHTTPS // The protocol used for a request
:: HTTPProtocol = HTTPProtoHTTP | HTTPProtoHTTPS // The protocol used for a request
:: HTTPResponse = { rsp_headers :: HashTable String String // Extra return headers that should be sent (eg. ("Content-Type","text/plain"))
, rsp_data :: String // The body of the response. (eg. html code or file data)
:: HTTPResponse = { rsp_headers :: Map String String // Extra return headers that should be sent (eg. ("Content-Type","text/plain"))
, rsp_data :: String // The body of the response. (eg. html code or file data)
}
:: HTTPUpload = { upl_name :: String // The name of the file input in the form
, upl_filename :: String // The filename of the uploaded file
, upl_mimetype :: String // The MIME content type of the file
, upl_content :: String // The actual content of the file.
:: HTTPUpload = { upl_name :: String // The name of the file input in the form
, upl_filename :: String // The filename of the uploaded file
, upl_mimetype :: String // The MIME content type of the file
, upl_content :: String // The actual content of the file.
}
//Construction functions
......
implementation module HTTP
import StdOverloaded, StdString, StdList, StdArray, StdFile, StdBool
import HashTable, Maybe, Text, UrlEncoding, Mime
import Maybe, Map, Text, UrlEncoding, MIME
newHTTPRequest :: HTTPRequest
newHTTPRequest = { req_method = ""
......@@ -9,19 +9,19 @@ newHTTPRequest = { req_method = ""
, req_query = ""
, req_version = ""
, req_protocol = HTTPProtoHTTP
, req_headers = newHashTable
, req_headers = newMap
, req_data = ""
, arg_get = newHashTable
, arg_post = newHashTable
, arg_cookies = newHashTable
, arg_uploads = newHashTable
, arg_get = newMap
, arg_post = newMap
, arg_cookies = newMap
, arg_uploads = newMap
, server_name = ""
, server_port = 0
, client_name = ""
}
newHTTPResponse :: HTTPResponse
newHTTPResponse = { rsp_headers = newHashTable
newHTTPResponse = { rsp_headers = newMap
, rsp_data = ""
}
......@@ -110,12 +110,12 @@ parseRequest req
= {req & arg_post = fromList post, arg_uploads = fromList uploads} //Parse post arguments + uploads
| otherwise = req
where
parseGetArguments :: !HTTPRequest -> HashTable String String
parseGetArguments :: !HTTPRequest -> Map String String
parseGetArguments req
| req.req_query == "" = newHashTable
| req.req_query == "" = newMap
= fromList (urlDecodePairs req.req_query)
parsePostArguments :: !HTTPRequest -> HashTable String String
parsePostArguments :: !HTTPRequest -> Map String String
parsePostArguments req = fromList (urlDecodePairs req.req_data)
parseMultiPartPostArguments :: !HTTPRequest -> ([(String,String)],[(String,HTTPUpload)])
......@@ -222,7 +222,7 @@ encodeResponse withreply {rsp_headers = headers, rsp_data = data} world
# reply = if withreply
("HTTP/1.0 " +++ (default "200 OK" (get "Status" headers)) +++ "\r\n")
("Status: " +++ (default "200 OK" (get "Status" headers)) +++ "\r\n")
# reply = reply +++ ("Server: " +++ (default "Clean Http tools" (get "Server" headers)) +++ "\r\n") //Server identifier
# reply = reply +++ ("Server: " +++ (default "Clean HTTP tools" (get "Server" headers)) +++ "\r\n") //Server identifier
# reply = reply +++ ("Content-Type: " +++ (default "text/html" (get "Content-Type" headers)) +++ "\r\n") //Content type header
# reply = reply +++ ("Content-Length: " +++ (toString (size data)) +++ "\r\n") //Content length header
# reply = reply +++ (foldr (+++) "" [(n +++ ": " +++ v +++ "\r\n") \\ (n,v) <- toList headers | not (skipHeader n)]) //Additional headers
......@@ -233,4 +233,4 @@ where
default def mbval = case mbval of
Nothing = def
(Just val) = val
skipHeader s = isMember s ["Status","Date","Server","Content-Type","Content-Lenght","Last-Modified"]
skipHeader s = isMember s ["Status","Date","Server","Content-Type","Content-Length","Last-Modified"]
......@@ -71,7 +71,7 @@ getClientName world
| name == "" = getFromEnv "REMOTE_ADDR" world
= (name,world)
makeHeaders :: [(String,String)] *World -> (HashTable String String, *World)
makeHeaders :: [(String,String)] *World -> (Map String String, *World)
makeHeaders cgihdrs world = case makeHeaders` cgihdrs world of (hdrs,world) = (fromList hdrs, world)
where
makeHeaders` [] world = ([],world)
......
#!/usr/bin/python
import os, os.path
#Check if a directory is ok
def okLibDir(dir):
return (dir.find(".svn") == -1 and dir.find("Clean System Files") == -1 and dir.find("OS-Windows") == -1)
#Create dirs file
print ("Creating env/Clean Platform.dirs...")
dirlist = ""
for (dir,subdirs,files) in os.walk("libraries"):
if okLibDir(dir):
dirlist = dirlist + os.path.realpath(dir) + ":"
dirlist = dirlist + "."
dirfile = open("env/Clean Platform.dirs","w")
dirfile.write(dirlist)
dirfile.close()
#Create aggregated libs
print("Creating env/all-libraries...")
os.system("mkdir -p env/all-libraries")
for (dir,subdirs,files) in os.walk("libraries"):
if okLibDir(dir):
for file in files:
os.system("ln -f -s ../../%s/%s env/all-libraries/%s" % (dir,file,file))
#!/bin/sh
echo "Setting up the Clean Platform library collection"
echo "==="
echo "Creating 'Clean Platform.dirs'..."
find libraries -type d | grep -v "Clean System Files" | grep -v "\.svn" | grep -v "OS-[Windows|MacOS]" | xargs printf "$PWD/%s:" | xargs printf "%s." > "env/Clean Platform.dirs"
echo "==="
echo "You can now include the Clean platform libraries by adding \"-I \`cat \"env/Clean Platform.dirs\"\`\" to your clm options."
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment