hack2-handler-warp 2011.6.20.1 → 2011.6.21

raw patch · 3 files changed

+71/−9 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hack2-handler-warp.cabal +1/−1
• readme.md +5/−0
• src/Hack2/Handler/Warp.hs +65/−8

@@ -1,5 +1,5 @@ Name:                 hack2-handler-warp-Version:              2011.6.20.1+Version:              2011.6.21 Build-type:           Simple Synopsis:             Hack2 warp handler Description:          Hack2 warp handler

@@ -2,3 +2,8 @@ -----------------------------------------------------  * enumerator enabled, constant memory consumption when enumerator all the way down++Known issue+-----------++* No hackInput is filled for the environment.

@@ -8,6 +8,7 @@    run , runWithConfig+, runWithWarpSettings , ServerConfig(..) , hackAppToWaiApp @@ -23,7 +24,7 @@ import qualified Data.CaseInsensitive as CaseInsensitive import Data.ByteString.Char8 (ByteString, pack) import qualified Data.ByteString.Char8 as B-import Data.Enumerator (Enumerator, Iteratee (..), ($$), joinI, run_)+import Data.Enumerator (Enumerator, Iteratee (..), ($$), joinI, run_, Enumeratee, Step, (=$)) import qualified Data.Enumerator.List as EL import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString) @@ -89,20 +90,71 @@ hackAppToWaiApp app request = do    response <- io - app - requestToEnv request    -   let wai_response = hackResponseToWaiResponseEnumerator response +   let wai_response_enumerator = hackResponseToWaiResponseEnumerator response     -   return - Wai.ResponseEnumerator wai_response+   return - Wai.ResponseEnumerator wai_response_enumerator           -hackResponseToWaiResponseEnumerator :: Response -> (forall a.  Wai.ResponseEnumerator a)+hackResponseToWaiResponseEnumerator :: (forall a. Response -> Wai.ResponseEnumerator a) hackResponseToWaiResponseEnumerator response f =    let s = response.status.statusToStatusHeader       h = response.headers.map headerToCaseInsensitiveHeader+  +      -- wai response enumerator expect the callback (iteratee) to acts on builder.+      -- type ResponseEnumerator a =+      --  (H.Status -> H.ResponseHeaders -> Iteratee Builder IO a) -> IO a+  +      server_iteratee :: Iteratee Builder IO a+      server_iteratee = f s h +      +      -- in Builder, fromByteString :: S.ByteString -> Builder+      -- in Enumerator.List, map :: Monad m => (ao -> ai)+      --  -> Enumeratee ao ai m b+      +      -- type Enumeratee ao ai m b = Step ai m b -> Iteratee ao m (Step ai m b)+      -- builder_enumeratee :: Enumeratee ByteString Builder IO a+      builder_enumeratee :: Step Builder IO a -> Iteratee ByteString IO (Step Builder IO a)+      builder_enumeratee = EL.map fromByteString+      +      +      {-+      -- make fromByteString act as the preprocesser of server_iteratee,+      -- by joining+      -- ($$) :: Monad m+      --      => (Step a m b -> Iteratee a' m b')+      --      -> Iteratee a m b+      --      -> Iteratee a' m b'+      -- ($$) = (==<<)+      -- this is similar to :: readFile >>= putStrLn, in a Monad context+      bytestring_to_builder_layered_iteratee :: Iteratee ByteString IO (Step Builder IO a)+      bytestring_to_builder_layered_iteratee = builder_enumeratee $$ server_iteratee+      +      -- iteratee is needs to be flattened+      -- joinI :: Monad m => Iteratee a m (Step a' m b)+      --       -> Iteratee a m b+      -- joinI outer = outer >>= check where+      --  check (Continue k) = k EOF >>== \s -> case s of+      --    Continue _ -> error "joinI: divergent iteratee"+      --    _ -> check s+      --  check (Yield x _) = return x+      --  check (Error e) = throwError e+      +      flattened_server_iteratee :: Iteratee ByteString IO a+      flattened_server_iteratee = joinI bytestring_to_builder_layered_iteratee+      -}+      +      flattened_server_iteratee :: Iteratee ByteString IO a+      flattened_server_iteratee =  builder_enumeratee =$ server_iteratee+      +      final_iteratee_taking_input_from_hack_enumerator :: Iteratee ByteString IO a+      final_iteratee_taking_input_from_hack_enumerator = response.body.unHackEnumerator $$ flattened_server_iteratee+      +         in-  run_ - response.body.unHackEnumerator $$ joinI - EL.map fromByteString $$ f s h+  run_ final_iteratee_taking_input_from_hack_enumerator   data ServerConfig = ServerConfig@@ -117,11 +169,16 @@       port = 3000     } +runWithWarpSettings :: Warp.Settings -> Application -> IO ()+runWithWarpSettings setting app = do+  Warp.runSettings setting (hackAppToWaiApp app)  runWithConfig :: ServerConfig -> Application -> IO ()-runWithConfig config app = Warp.runSettings-  Warp.defaultSettings {Warp.settingsPort = config.port}-  (hackAppToWaiApp app)+runWithConfig config app = +  let setting = Warp.defaultSettings {Warp.settingsPort = config.port}+  in+  runWithWarpSettings setting app+    run :: Application -> IO () run = runWithConfig def