hack-handler-happstack 2009.4.52 → 2009.5.19

raw patch · 3 files changed

+38/−19 lines, 3 filesdep ~hack

Dependency ranges changed: hack

Files

• changelog.md +14/−0
• hack-handler-happstack.cabal +2/−2
• src/Hack/Handler/Happstack.hs +22/−17

@@ -1,3 +1,17 @@+2009.5.19+---------++### Feature++* Compatible with hack 5.19++2009.4.52.1+-----------++### Fix++* Export ServerConf data constructor, thanks to Stefan's patch+ 2009.4.52 --------- 

@@ -1,5 +1,5 @@ Name:                 hack-handler-happstack-Version:              2009.4.52+Version:              2009.5.19 Build-type:           Simple Synopsis:             Hack Happstack server handler Description:          Hack Happstack server handler@@ -15,7 +15,7 @@  library   ghc-options: -Wall-  build-depends: base, cgi, network, bytestring, data-default >= 0.2, hack >= 2009.4.52, happstack-server >= 0.2.1, containers, mtl+  build-depends: base, cgi, network, bytestring, data-default >= 0.2, hack >= 2009.5.19, happstack-server >= 0.2.1, containers, mtl   hs-source-dirs: src/   exposed-modules:                       Hack.Handler.Happstack

@@ -1,8 +1,12 @@+-- code structure is written by John MacFarlane, +-- I filled in some missing pieces and make it compile.+ {-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable #-} -module Hack.Handler.Happstack (run, runWithConfig, ServerConf) where+module Hack.Handler.Happstack (run, runWithConfig, ServerConf(..)) where -import Hack as Hack+import qualified Hack as Hack+import Hack hiding (serverName) import Happstack.Server.SimpleHTTP as Happstack hiding (port) import qualified Happstack.Server.SimpleHTTP as H @@ -14,7 +18,6 @@ import Data.Maybe  import qualified Data.Map as M-import qualified Data.ByteString.Lazy.Char8 as C import qualified Data.ByteString as L import qualified Data.ByteString.Internal as I @@ -38,14 +41,14 @@    where     reqToEnv conf' req =-      def { request_method = convertRequestMethod $ rqMethod req-          , script_name    = ""-          , path_info      = "/" ++ (intercalate "/" $ rqPaths req)-          , query_string   = remove_question_mark $ rqQuery req-          , server_name    = serverName conf' -- (fst $ rqPeer req) is supposed to work, but does not-          , server_port    = port conf'+      def { requestMethod = convertRequestMethod $ rqMethod req+          , scriptName    = ""+          , pathInfo      = "/" ++ (intercalate "/" $ rqPaths req)+          , queryString   = remove_question_mark $ rqQuery req+          , Hack.serverName    = serverName conf' -- (fst $ rqPeer req) is supposed to work, but does not+          , serverPort    = port conf'           , http           = toHttp (rqHeaders req)-          , hack_input     = (\(Body x) -> C.unpack x) (rqBody req)+          , hackInput     = (\(Body x) -> x) (rqBody req)           }     remove_question_mark = dropWhile (== '?')     @@ -69,19 +72,21 @@   where b2s x = map I.w2c $ L.unpack x  toHappstackResponse :: Hack.Response -> Happstack.Response-toHappstackResponse resp =- Happstack.Response { rsCode = Hack.status resp-                    , rsHeaders = convertHeaders $ Hack.headers resp-                    , rsFlags = RsFlags {rsfContentLength = False}-                    , rsBody = C.pack $ Hack.body resp-                    , rsValidator = Nothing }+toHappstackResponse resp = Happstack.Response +  {  rsCode      = Hack.status resp+  ,  rsHeaders   = convertHeaders $ Hack.headers resp+  ,  rsFlags     = RsFlags {rsfContentLength = False}+  ,  rsBody      = Hack.body resp+  ,  rsValidator = Nothing }  + convertHeaders :: [(String, String)] -> Happstack.Headers convertHeaders = map pairToHeader >>> M.fromList   where      pairToHeader (k,v) = ((c2b $ map toLower k), HeaderPair (c2b k) [c2b v])-    c2b x = L.pack $ map I.c2w x+    c2b x              = L.pack $ map I.c2w x+     -- happstack converts all request header to lowercase ...