hack2-interface-wai (empty) → 2012.5.24

raw patch · 7 files changed

+241/−0 lines, 7 filesdep +airdep +basedep +blaze-buildersetup-changed

Dependencies added: air, base, blaze-builder, bytestring, case-insensitive, containers, data-default, enumerator, hack2, http-types, mtl, network, safe, wai

Files

LICENSE +31/−0
Nemesis +36/−0
Setup.lhs +4/−0
changelog.md +0/−0
hack2-interface-wai.cabal +37/−0
readme.md +23/−0
src/Hack2/Interface/Wai.hs +110/−0

+ LICENSE view

@@ -0,0 +1,31 @@+Copyright (c) 2011, Jinjing Wang++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jinjing Wang nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Nemesis view

@@ -0,0 +1,36 @@+nemesis = do+  +  clean+    [ "**/*.hi"+    , "**/*.o"+    , "manifest"+    , "main"+    , "nemesis-tmp.*"+    , "Test"+    ]+  ++  desc "prepare cabal dist"+  task "dist" $ do+    sh "cabal clean"+    sh "cabal configure"+    sh "cabal sdist"+++  desc "put all .hs files in manifest"+  task "manifest" $ do+    sh "find . | grep 'hs$' > manifest"+++  desc "start console"+  task "i" (sh "ghci -isrc src/Hack2/Interface/Wai.hs")+++  desc "start hello"+  task "hello" - do+    sh "runghc -isrc test/hello.hs"+    ++  desc "start small app (using wai-devel)"+  task "small-app" - do+    sh "cd test; runghc -i../src runSmallApp.hs"

+ Setup.lhs view

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain

+ changelog.md view

+ hack2-interface-wai.cabal view

@@ -0,0 +1,37 @@+Name:                 hack2-interface-wai+Version:              2012.5.24+Build-type:           Simple+Synopsis:             Hack2 interface of WAI+Description:          Hack2 interface of WAI+License:              BSD3+License-file:         LICENSE+Author:               Jinjing Wang+Maintainer:           Jinjing Wang <nfjinjing@gmail.com>+Build-Depends:        base+Cabal-version:        >= 1.2+category:             Web+homepage:             https://github.com/nfjinjing/hack2-interface-wai+data-files:           readme.md, changelog.md, Nemesis++library++  build-depends: +                      base >= 4.0 && <= 100+                    , network+                    , bytestring+                    , data-default >= 0.2+                    , hack2 >= 2011.6.20+                    , containers+                    , mtl+                    , enumerator+                    , wai+                    , blaze-builder+                    , http-types+                    , case-insensitive+                    , air+                    , safe+                    +  hs-source-dirs: src/+  exposed-modules:  +                    Hack2.Interface.Wai+

+ readme.md view

@@ -0,0 +1,23 @@+Interfacing Hack2 and Wai+++Example: `test/hello`++    {-# LANGUAGE OverloadedStrings #-}++    import Hack2 +    import Hack2.Interface.Wai (hackAppToWaiApp)+    import Data.Default (def)+    import Network.Wai.Handler.Warp (run)++    app :: Application+    app = \env -> +      return $ +          Response 200 [ ("Content-Type", "text/plain") ] "Hello World (Hack2 to Wai)"+++    main :: IO ()+    main = do+        putStrLn $ "http://localhost:3000/"+        run 3000 (hackAppToWaiApp app)+

+ src/Hack2/Interface/Wai.hs view

@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Hack2.Interface.Wai +(+  hackAppToWaiApp+) where++import Prelude ()+import Air.Env hiding (def, Default)++import qualified Network.Wai as Wai+import Hack2+import Data.Default (def, Default)+import qualified Network.HTTP.Types as HTTPTypes+import qualified Data.CaseInsensitive as CaseInsensitive+import Data.ByteString.Char8 (ByteString, pack)+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as Lazy++import Data.Enumerator (Enumerator, Iteratee (..), ($$), joinI, run_, Enumeratee, Step, (=$))+import qualified Data.Enumerator.List as EL+import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString)++import qualified Safe as Safe++{-++{  requestMethod  :: RequestMethod+,  scriptName     :: ByteString+,  pathInfo       :: ByteString+,  queryString    :: ByteString+,  serverName     :: ByteString+,  serverPort     :: Int+,  httpHeaders    :: [(ByteString, ByteString)]+,  hackVersion    :: (Int, Int, Int)+,  hackUrlScheme  :: HackUrlScheme+,  hackInput      :: HackEnumerator+,  hackErrors     :: HackErrors+,  hackHeaders    :: [(ByteString, ByteString)]++-}+requestToEnv :: Wai.Request -> Env+requestToEnv request = def+  {+    requestMethod  = request.Wai.requestMethod.show.upper.Safe.readDef GET+  , pathInfo       = request.Wai.rawPathInfo +  , queryString    = request.Wai.rawQueryString.B.dropWhile (is '?')+  , serverName     = request.Wai.serverName+  , serverPort     = request.Wai.serverPort+  , httpHeaders    = request.Wai.requestHeaders.map caseInsensitiveHeaderToHeader+  , hackUrlScheme  = if request.Wai.isSecure then HTTPS else HTTP+  , hackHeaders    = [("RemoteHost", request.Wai.remoteHost.show.pack)]+  }+  ++caseInsensitiveHeaderToHeader :: (CaseInsensitive.CI ByteString, ByteString) -> (ByteString, ByteString)+caseInsensitiveHeaderToHeader (x, y) = (x.CaseInsensitive.original, y) ++headerToCaseInsensitiveHeader ::  (ByteString, ByteString) -> (CaseInsensitive.CI ByteString, ByteString)+headerToCaseInsensitiveHeader (x, y) = (x.CaseInsensitive.mk, y) ++statusToStatusHeader :: Int -> HTTPTypes.Status+statusToStatusHeader 200 = HTTPTypes.status200+statusToStatusHeader 201 = HTTPTypes.status201+statusToStatusHeader 206 = HTTPTypes.status206+statusToStatusHeader 301 = HTTPTypes.status301+statusToStatusHeader 302 = HTTPTypes.status302+statusToStatusHeader 303 = HTTPTypes.status303+statusToStatusHeader 304 = HTTPTypes.status304+statusToStatusHeader 400 = HTTPTypes.status400+statusToStatusHeader 401 = HTTPTypes.status401+statusToStatusHeader 403 = HTTPTypes.status403+statusToStatusHeader 404 = HTTPTypes.status404+statusToStatusHeader 405 = HTTPTypes.status405+statusToStatusHeader 412 = HTTPTypes.status412+statusToStatusHeader 416 = HTTPTypes.status416+statusToStatusHeader 500 = HTTPTypes.status500+statusToStatusHeader 501 = HTTPTypes.status501+statusToStatusHeader 502 = HTTPTypes.status502+statusToStatusHeader 503 = HTTPTypes.status503+statusToStatusHeader 504 = HTTPTypes.status504+statusToStatusHeader 505 = HTTPTypes.status505+statusToStatusHeader _   = HTTPTypes.status505++hackAppToWaiApp :: Application -> Wai.Application+hackAppToWaiApp app request = do+   response <- io - app - requestToEnv request+   +   let wai_response = hackResponseToWaiResponse response +   +   return - wai_response+   +  +  ++hackResponseToWaiResponse :: Response -> Wai.Response+hackResponseToWaiResponse response = +  let s = response.status.statusToStatusHeader+      h = response.headers.map headerToCaseInsensitiveHeader+  +      b = Lazy.fromChunks [response.body]+      +  in+  +  Wai.responseLBS s h b+  +