hack2-interface-wai 2012.5.25 → 2017.1.4
raw patch · 6 files changed
+77/−101 lines, 6 filesdep −airdep −mtldep ~basePVP ok
version bump matches the API change (PVP)
Dependencies removed: air, mtl
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- LICENSE +2/−2
- Nemesis +0/−36
- changelog.md +5/−0
- hack2-interface-wai.cabal +15/−17
- readme.md +1/−2
- src/Hack2/Interface/Wai.hs +54/−44
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2011, Jinjing Wang+Copyright (c) 2017, Jinjing Wang All rights reserved. @@ -14,7 +14,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Jinjing Wang nor the names of other+ * Neither the name of the copyright holder nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission.
− Nemesis
@@ -1,36 +0,0 @@-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"
changelog.md view
@@ -0,0 +1,5 @@+# 2017.1.3++* make it compatible with the latest wai+* get rid of the stupid air dependency+
hack2-interface-wai.cabal view
@@ -1,35 +1,33 @@-Name: hack2-interface-wai-Version: 2012.5.25-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+name: hack2-interface-wai+version: 2017.1.4+build-type: Simple+synopsis: Hack2 interface to WAI+description: Convert a Hack2 App to a WAI app+license: BSD3+license-file: LICENSE+author: Jinjing Wang+maintainer: Jinjing Wang <nfjinjing@gmail.com>+cabal-version: >= 1.10 category: Web+extra-doc-files: readme.md, changelog.md+ homepage: https://github.com/nfjinjing/hack2-interface-wai-data-files: readme.md, changelog.md, Nemesis library- build-depends: - base >= 4.0 && <= 100+ base >= 4.8 && < 5 , network , bytestring , data-default >= 0.2 , hack2 >= 2011.6.20 , containers- , mtl , wai , http-types , case-insensitive- , air , safe - hs-source-dirs: src/+ hs-source-dirs: src/ exposed-modules: Hack2.Interface.Wai + default-language: Haskell2010
readme.md view
@@ -1,5 +1,5 @@ Interfacing Hack2 and Wai-+-------------------------- Example: `test/hello` @@ -20,4 +20,3 @@ main = do putStrLn $ "http://localhost:3000/" run 3000 (hackAppToWaiApp app)-
src/Hack2/Interface/Wai.hs view
@@ -1,25 +1,22 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE ScopedTypeVariables #-} -module Hack2.Interface.Wai +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 Control.Monad.IO.Class (liftIO)+import Data.ByteString.Char8 (ByteString, pack) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as Lazy-+import qualified Data.CaseInsensitive as CaseInsensitive+import Data.Char (toUpper)+import Data.Default (def, Default)+import Data.Maybe (fromMaybe)+import Hack2+import qualified Network.HTTP.Types as HTTPTypes+import qualified Network.Wai as Wai+import Prelude hiding ((-), (.)) import qualified Safe as Safe {-@@ -38,25 +35,45 @@ , 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)]- }- +infixr 0 -+{-# INLINE (-) #-}+(-) :: (a -> b) -> a -> b+f - x = f x++infixl 9 .+{-# INLINE (.) #-}+(.) :: a -> (a -> b) -> b+a . f = f a++requestToEnv :: Wai.Request -> IO Env+requestToEnv request = do+ requestBody <- request.Wai.strictRequestBody++ let+ (serverName:serverPort:_) = request.Wai.remoteHost.show.B.pack.B.split ':' ++ [mempty, mempty]++ return -+ def+ {+ requestMethod = request.Wai.requestMethod.show.map toUpper.Safe.readDef GET+ , pathInfo = request.Wai.rawPathInfo+ , queryString = request.Wai.rawQueryString.B.dropWhile (== '?')+ , serverName = serverName+ , serverPort = Safe.readMay (show serverPort).fromMaybe 0+ , httpHeaders = request.Wai.requestHeaders.map caseInsensitiveHeaderToHeader+ , hackUrlScheme = if request.Wai.isSecure then HTTPS else HTTP+ , hackHeaders = [("RemoteHost", request.Wai.remoteHost.show.pack)]+ , hackInput = Lazy.toStrict requestBody+ }+++ caseInsensitiveHeaderToHeader :: (CaseInsensitive.CI ByteString, ByteString) -> (ByteString, ByteString)-caseInsensitiveHeaderToHeader (x, y) = (x.CaseInsensitive.original, y) +caseInsensitiveHeaderToHeader (x, y) = (x.CaseInsensitive.original, y) headerToCaseInsensitiveHeader :: (ByteString, ByteString) -> (CaseInsensitive.CI ByteString, ByteString)-headerToCaseInsensitiveHeader (x, y) = (x.CaseInsensitive.mk, y) +headerToCaseInsensitiveHeader (x, y) = (x.CaseInsensitive.mk, y) statusToStatusHeader :: Int -> HTTPTypes.Status statusToStatusHeader 200 = HTTPTypes.status200@@ -82,25 +99,18 @@ statusToStatusHeader _ = HTTPTypes.status505 hackAppToWaiApp :: Application -> Wai.Application-hackAppToWaiApp app request = do- response <- io - app - requestToEnv request- - let wai_response = hackResponseToWaiResponse response - - return - wai_response- - - +hackAppToWaiApp app request respond = do+ response <- liftIO - app =<< requestToEnv request+ let wai_response = hackResponseToWaiResponse response+ respond wai_response hackResponseToWaiResponse :: Response -> Wai.Response-hackResponseToWaiResponse response = +hackResponseToWaiResponse response = let s = response.status.statusToStatusHeader h = response.headers.map headerToCaseInsensitiveHeader- + b = Lazy.fromChunks [response.body]- + in- + Wai.responseLBS s h b- -