chu2 2012.11.18.1 → 2012.11.18.2
raw patch · 6 files changed
+75/−79 lines, 6 files
Files
- chu2.cabal +1/−2
- src/Chu2.agda +12/−12
- src/Chu2/ByteString.agda +0/−21
- src/Chu2/FFI.hs +12/−12
- src/Chu2/Interface/Hack2.hs +49/−30
- src/Hello.agda +1/−2
chu2.cabal view
@@ -1,5 +1,5 @@ Name: chu2-Version: 2012.11.18.1+Version: 2012.11.18.2 Build-type: Simple Synopsis: FFI for Chu2 Agda Web Server Interface Description:@@ -18,7 +18,6 @@ Nemesis Guardfile src/Chu2.agda- src/Chu2/ByteString.agda src/Chu2/Handler/SnapServer.agda src/Hello.agda src/Hello2.agda
src/Chu2.agda view
@@ -1,9 +1,9 @@ module Chu2 where open import Data.List using (List; [_])-open import Chu2.ByteString using (ByteString; pack; empty) open import Foreign.Haskell using (Unit) open import IO.Primitive using (IO)+open import Data.String using (String) data Tuple (A : Set)(B : Set) : Set where _,_ : A → B → Tuple A B@@ -12,7 +12,7 @@ {-# IMPORT Chu2.FFI #-} {-# COMPILED_DATA Tuple (,) (,) #-} -Header = Tuple ByteString ByteString+Header = Tuple String String Headers = List Header @@ -46,14 +46,14 @@ Chu2.FFI.HTTPS #-} -ScriptName = ByteString-PathInfo = ByteString-QueryString = ByteString-ServerName = ByteString-ServerPort = ByteString+ScriptName = String+PathInfo = String+QueryString = String+ServerName = String+ServerPort = String HttpHeaders = Headers-Chu2Input = ByteString-Chu2Errors = ByteString → IO Unit+Chu2Input = String+Chu2Errors = String → IO Unit Chu2Headers = Headers private@@ -201,7 +201,7 @@ Chu2.FFI.ServiceUnavailable #-} -Body = ByteString+Body = String private data ResponseData : Set where@@ -254,8 +254,8 @@ record { status = OK- ; headers = [(pack "Content-Type", pack "text/plain")]- ; body = pack "Chu2!"+ ; headers = [("Content-Type", "text/plain")]+ ; body = "Chu2!" } Application = Env → IO Response
− src/Chu2/ByteString.agda
@@ -1,21 +0,0 @@-module Chu2.ByteString where--open import Data.String-import IO.Primitive as Prim--{-# IMPORT Data.Word #-}-{-# IMPORT Data.ByteString.Internal #-}-{-# IMPORT Data.ByteString.Char8 #-}--postulate- ByteString : Set- pack : String -> ByteString- unpack : ByteString -> String- empty : ByteString- - --{-# COMPILED_TYPE ByteString Data.ByteString.Char8.ByteString #-}-{-# COMPILED pack Data.ByteString.Char8.pack #-}-{-# COMPILED unpack Data.ByteString.Char8.unpack #-}-{-# COMPILED empty Data.ByteString.Char8.empty #-}
src/Chu2/FFI.hs view
@@ -1,10 +1,7 @@ module Chu2.FFI where import Data.ByteString (ByteString)-import Data.ByteString.Char8 (pack) -type Header = (,) ByteString ByteString- data RequestMethod = OPTIONS | GET@@ -43,11 +40,14 @@ | NotImplemented | ServiceUnavailable deriving (Show)- +++type Field = String type Headers = [Header]+type Header = (,) Field Field -type Chu2Errors = ByteString -> IO ()+type Chu2Errors = Field -> IO () data Chu2UrlScheme = HTTP | HTTPS deriving (Show)@@ -55,14 +55,14 @@ data Env = Env { requestMethod :: RequestMethod- , scriptName :: ByteString- , pathInfo :: ByteString- , queryString :: ByteString- , serverName :: ByteString- , serverPort :: ByteString+ , scriptName :: Field+ , pathInfo :: Field+ , queryString :: Field+ , serverName :: Field+ , serverPort :: Field , httpHeaders :: Headers , chu2UrlScheme :: Chu2UrlScheme- , chu2Input :: ByteString+ , chu2Input :: Field , chu2Errors :: Chu2Errors , chu2Headers :: Headers }@@ -72,7 +72,7 @@ data Response = Response { status :: Status , headers :: Headers- , body :: ByteString+ , body :: Field } deriving (Show)
src/Chu2/Interface/Hack2.hs view
@@ -3,9 +3,12 @@ import Data.ByteString (ByteString) import qualified Hack2 as Hack2 import Data.ByteString.Char8 (pack, unpack)+import Data.ByteString.UTF8 (fromString, toString) import Data.Default import Chu2.FFI ++ hack2RequestMethodToChu2RequestMethod :: Hack2.RequestMethod -> RequestMethod hack2RequestMethodToChu2RequestMethod Hack2.OPTIONS = OPTIONS hack2RequestMethodToChu2RequestMethod Hack2.GET = GET@@ -35,43 +38,59 @@ chu2UrlSchemeToHack2UrlScheme HTTPS = Hack2.HTTPS hack2ErrorsToChu2Errors :: Hack2.HackErrors -> Chu2Errors-hack2ErrorsToChu2Errors = Hack2.unHackErrors+hack2ErrorsToChu2Errors io x = Hack2.unHackErrors io (f2b_Utf8Encoding x) chu2ErrorsToHack2Errors :: Chu2Errors -> Hack2.HackErrors-chu2ErrorsToHack2Errors = Hack2.HackErrors+chu2ErrorsToHack2Errors io = Hack2.HackErrors (\x -> io (b2f_Utf8Encoding x)) ++f2b :: Field -> ByteString+f2b = pack+ +b2f :: ByteString -> Field+b2f = unpack++f2b_Utf8Encoding :: Field -> ByteString+f2b_Utf8Encoding = fromString++b2f_Utf8Encoding :: ByteString -> Field+b2f_Utf8Encoding = toString++mapTuple :: (a -> b) -> [(a,a)] -> [(b,b)]+mapTuple f = map (\(x,y) -> (f x, f y))+ hack2EnvToChu2Env :: Hack2.Env -> Env hack2EnvToChu2Env e = Env {- requestMethod = hack2RequestMethodToChu2RequestMethod $ Hack2.requestMethod e- , scriptName = Hack2.scriptName e- , pathInfo = Hack2.pathInfo e- , queryString = Hack2.queryString e- , serverName = Hack2.serverName e- , serverPort = pack $ show $ Hack2.serverPort e- , httpHeaders = Hack2.httpHeaders e- , chu2UrlScheme = hack2UrlSchemeToChu2UrlScheme $ Hack2.hackUrlScheme e- , chu2Input = Hack2.hackInput e- , chu2Errors = hack2ErrorsToChu2Errors $ Hack2.hackErrors e- , chu2Headers = Hack2.hackHeaders e+ requestMethod = hack2RequestMethodToChu2RequestMethod $ Hack2.requestMethod e+ , chu2UrlScheme = hack2UrlSchemeToChu2UrlScheme $ Hack2.hackUrlScheme e+ , chu2Errors = hack2ErrorsToChu2Errors $ Hack2.hackErrors e+ , serverPort = show $ Hack2.serverPort e+ , scriptName = b2f $ Hack2.scriptName e+ , pathInfo = b2f $ Hack2.pathInfo e+ , queryString = b2f $ Hack2.queryString e+ , serverName = b2f $ Hack2.serverName e+ , httpHeaders = mapTuple b2f $ Hack2.httpHeaders e+ , chu2Input = b2f_Utf8Encoding $ Hack2.hackInput e+ , chu2Headers = mapTuple b2f $ Hack2.hackHeaders e } chu2EnvToHack2Env :: Env -> Hack2.Env chu2EnvToHack2Env e = def {- Hack2.requestMethod = chu2RequestMethodToHack2RequestMethod $ requestMethod e- , Hack2.scriptName = scriptName e- , Hack2.pathInfo = pathInfo e- , Hack2.queryString = queryString e- , Hack2.serverName = serverName e- , Hack2.serverPort = read $ unpack $ serverPort e- , Hack2.httpHeaders = httpHeaders e- , Hack2.hackUrlScheme = chu2UrlSchemeToHack2UrlScheme $ chu2UrlScheme e- , Hack2.hackInput = chu2Input e- , Hack2.hackErrors = chu2ErrorsToHack2Errors $ chu2Errors e- , Hack2.hackHeaders = chu2Headers e+ Hack2.requestMethod = chu2RequestMethodToHack2RequestMethod $ requestMethod e+ , Hack2.hackUrlScheme = chu2UrlSchemeToHack2UrlScheme $ chu2UrlScheme e+ , Hack2.hackErrors = chu2ErrorsToHack2Errors $ chu2Errors e+ , Hack2.serverPort = read $ serverPort e+ , Hack2.scriptName = f2b $ scriptName e+ , Hack2.pathInfo = f2b $ pathInfo e+ , Hack2.queryString = f2b $ queryString e+ , Hack2.serverName = f2b $ serverName e+ , Hack2.httpHeaders = mapTuple f2b $ httpHeaders e+ , Hack2.hackInput = f2b_Utf8Encoding $ chu2Input e+ , Hack2.hackHeaders = mapTuple f2b $ chu2Headers e } @@ -133,18 +152,18 @@ chu2ResponseToHack2Response r = Hack2.Response {- Hack2.status = showStatus $ status r- , Hack2.headers = headers r- , Hack2.body = body r+ Hack2.status = showStatus $ status r+ , Hack2.headers = mapTuple f2b $ headers r+ , Hack2.body = f2b_Utf8Encoding $ body r } hack2ResponseToHack2Response :: Hack2.Response -> Response hack2ResponseToHack2Response r = Response {- status = readStatus $ Hack2.status r- , headers = Hack2.headers r- , body = Hack2.body r+ status = readStatus $ Hack2.status r+ , headers = mapTuple b2f $ Hack2.headers r+ , body = b2f_Utf8Encoding $ Hack2.body r }
src/Hello.agda view
@@ -2,11 +2,10 @@ open import IO.Primitive using (return) open import Data.List using ([])-open import Chu2.ByteString using (pack) open import Function using (_$_; const) open import Chu2 using (response; OK; Application) -hello-world-response = response OK [] (pack "Hello Agda!")+hello-world-response = response OK [] ("Hello Agda!") hello-world-app : Application hello-world-app = const $ return hello-world-response