diff --git a/Network/Wai/Handler/Launch.hs b/Network/Wai/Handler/Launch.hs
--- a/Network/Wai/Handler/Launch.hs
+++ b/Network/Wai/Handler/Launch.hs
@@ -4,6 +4,7 @@
module Network.Wai.Handler.Launch
( run
, runUrl
+ , runUrlPort
) where
import Network.Wai
@@ -13,7 +14,6 @@
import Control.Concurrent
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString as S
-import Data.Enumerator (($$), joinI, Enumeratee, Stream (..), Iteratee (..), Step (..))
import Blaze.ByteString.Builder (fromByteString)
#if WINDOWS
import Foreign
@@ -21,10 +21,10 @@
#else
import System.Cmd (rawSystem)
#endif
-import Codec.Zlib.Enum (ungzip)
-import Blaze.ByteString.Builder.Enumerator (builderToByteString)
-import qualified Data.Enumerator.List as EL
-import Control.Monad.Trans.Class (lift)
+import Data.Conduit.Zlib (ungzip)
+import Data.Conduit.Blaze (builderToByteString)
+import qualified Data.Conduit as C
+import qualified Data.Conduit.List as CL
ping :: IORef Bool -> Middleware
ping var app req
@@ -42,64 +42,45 @@
| not $ isHtml hs -> return res
ResponseBuilder _ hs _
| not $ isHtml hs -> return res
+ ResponseSource _ hs _
+ | not $ isHtml hs -> return res
_ -> do
- let renum = responseEnumerator res
- return $ ResponseEnumerator $ \f -> renum $ \status headers ->
- if isHtml headers
- then do
- let (isEnc, headers') = fixHeaders id headers
- let headers'' = filter (\(x, _) -> x /= "content-length") headers'
- let fixEnc x =
- if isEnc
- then joinI $ ungzip $$ x
- else x
- joinI $ builderToByteString $$ fixEnc $ joinI $ insideHead "" $$ joinI $ EL.map fromByteString $$ f status headers''
- else f status headers
+ let (s, hs, body) = responseSource res
+ let (isEnc, headers') = fixHeaders id hs
+ let headers'' = filter (\(x, _) -> x /= "content-length") headers'
+ let fixEnc src = if isEnc then src C.$= ungzip else src
+ return $ ResponseSource s headers''
+ $ fixEnc (body C.$= builderToByteString)
+ C.$= insideHead
+ C.$= CL.map fromByteString
-insideHead :: S.ByteString -> Enumeratee S.ByteString S.ByteString IO a
-insideHead toInsert =
- go "" whole
+toInsert :: S.ByteString
+toInsert = ""
+
+insideHead :: C.Conduit S.ByteString IO S.ByteString
+insideHead =
+ C.conduitState (Just (S.empty, whole)) push close
where
whole = ""
- go :: S.ByteString -> S.ByteString -> Step S.ByteString IO a -> Iteratee S.ByteString IO (Step S.ByteString IO a)
- go held atFront step = do
- mx <- EL.head
- case mx of
- Nothing -> feedDone $ Chunks [held, toInsert]
- Just x
- | atFront `S.isPrefixOf` x -> do
- let y = S.drop (S.length atFront) x
- let stream = Chunks [held, atFront, toInsert, y]
- feedDone stream
- | whole `S.isInfixOf` x -> do
- let (before, rest) = S.breakSubstring whole x
- let after = S.drop (S.length whole) rest
- feedDone $ Chunks [held, before, whole, toInsert, after]
- | x `S.isPrefixOf` atFront -> go
- (held `S.append` x)
- (S.drop (S.length x) atFront)
- step
- | otherwise -> do
- let (held', atFront', x') = getOverlap whole x
- feedCont held' atFront' $ Chunks [held, x']
- where
- --feedDone :: Stream S.ByteString -> Iteratee S.ByteString IO (Step S.ByteString IO a)
- feedDone stream =
- case step of
- Continue k -> do
- step' <- lift $ runIteratee $ k stream
- EL.map id step'
- Yield b s -> return $ Yield b s
- Error e -> return $ Error e
+ push (Just (held, atFront)) x
+ | atFront `S.isPrefixOf` x = do
+ let y = S.drop (S.length atFront) x
+ return (Nothing, C.Producing [held, atFront, toInsert, y])
+ | whole `S.isInfixOf` x = do
+ let (before, rest) = S.breakSubstring whole x
+ let after = S.drop (S.length whole) rest
+ return (Nothing, C.Producing [held, before, whole, toInsert, after])
+ | x `S.isPrefixOf` atFront = do
+ let held' = held `S.append` x
+ atFront' = S.drop (S.length x) atFront
+ return (Just (held', atFront'), C.Producing [])
+ | otherwise = do
+ let (held', atFront', x') = getOverlap whole x
+ return (Just (held', atFront'), C.Producing [held, x'])
+ push Nothing x = return (Nothing, C.Producing [x])
- --feedCont :: Monad m => S.ByteString -> S.ByteString -> Stream S.ByteString -> Iteratee S.ByteString m (Step S.ByteString m a)
- feedCont held' atFront' stream = do
- case step of
- Continue k -> do
- step' <- lift $ runIteratee $ k stream
- go held' atFront' step'
- Yield b s -> return $ Yield b s
- Error e -> return $ Error e
+ close (Just (held, _)) = return [held, toInsert]
+ close Nothing = return []
getOverlap :: S.ByteString -> S.ByteString -> (S.ByteString, S.ByteString, S.ByteString)
getOverlap whole x =
@@ -125,32 +106,35 @@
launch' :: Int -> CString -> IO ()
#endif
-launch :: String -> IO ()
+launch :: Int -> String -> IO ()
#if WINDOWS
-launch s = withCString s $ launch' 4587
+launch port s = withCString s $ launch' port
#else
-launch s = forkIO (rawSystem
+launch port s = forkIO (rawSystem
#if MAC
"open"
#else
"xdg-open"
#endif
- ["http://127.0.0.1:4587/" ++ s] >> return ()) >> return ()
+ ["http://127.0.0.1:" ++ show port ++ "/" ++ s] >> return ()) >> return ()
#endif
run :: Application -> IO ()
run = runUrl ""
runUrl :: String -> Application -> IO ()
-runUrl url app = do
+runUrl = runUrlPort 4587
+
+runUrlPort :: Int -> String -> Application -> IO ()
+runUrlPort port url app = do
x <- newIORef True
_ <- forkIO $ Warp.runSettings Warp.defaultSettings
- { Warp.settingsPort = 4587
+ { Warp.settingsPort = port
, Warp.settingsOnException = const $ return ()
, Warp.settingsHost = "127.0.0.1"
} $ ping x app
- launch url
+ launch port url
loop x
loop :: IORef Bool -> IO ()
diff --git a/wai-handler-launch.cabal b/wai-handler-launch.cabal
--- a/wai-handler-launch.cabal
+++ b/wai-handler-launch.cabal
@@ -1,5 +1,5 @@
Name: wai-handler-launch
-Version: 0.0.4
+Version: 1.0.0
Synopsis: Launch a web app in the default browser.
Description: This handles cross-platform launching and inserts Javascript code to ping the server. When the server no longer receives pings, it shuts down.
License: BSD3
@@ -13,15 +13,15 @@
Library
Exposed-modules: Network.Wai.Handler.Launch
build-depends: base >= 4 && < 5
- , wai >= 0.4 && < 0.5
- , warp >= 0.4 && < 0.5
+ , wai >= 1.0 && < 1.1
+ , warp >= 1.0 && < 1.1
, http-types >= 0.6 && < 0.7
, transformers >= 0.2.2 && < 0.3
, bytestring >= 0.9.1.4 && < 0.10
, blaze-builder >= 0.2.1.4 && < 0.4
- , enumerator >= 0.4.8 && < 0.5
- , blaze-builder-enumerator >= 0.2 && < 0.3
- , zlib-enum >= 0.2.1 && < 0.3
+ , conduit
+ , blaze-builder-conduit
+ , zlib-conduit
if os(windows)
c-sources: windows.c