diff --git a/chu2.cabal b/chu2.cabal --- a/chu2.cabal +++ b/chu2.cabal @@ -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 diff --git a/src/Chu2.agda b/src/Chu2.agda --- a/src/Chu2.agda +++ b/src/Chu2.agda @@ -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 diff --git a/src/Chu2/ByteString.agda b/src/Chu2/ByteString.agda deleted file mode 100644 --- a/src/Chu2/ByteString.agda +++ /dev/null @@ -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 #-} diff --git a/src/Chu2/FFI.hs b/src/Chu2/FFI.hs --- a/src/Chu2/FFI.hs +++ b/src/Chu2/FFI.hs @@ -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) diff --git a/src/Chu2/Interface/Hack2.hs b/src/Chu2/Interface/Hack2.hs --- a/src/Chu2/Interface/Hack2.hs +++ b/src/Chu2/Interface/Hack2.hs @@ -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 } diff --git a/src/Hello.agda b/src/Hello.agda --- a/src/Hello.agda +++ b/src/Hello.agda @@ -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