@@ -22,15 +22,15 @@ import Control.Monad (unless)
2222import Control.Exception (throwIO)
2323import Data.Function (fix)
2424import qualified Data.ByteString as S
25−import Blaze.ByteString.Builder (fromByteString, Builder, flush)
26−import qualified Blaze.ByteString.Builder as Blaze
25+import Data.ByteString.Builder (Builder, byteString)
26+import qualified Data.ByteString.Builder.Extra as Builder (flush)
2727#if WINDOWS
2828import Foreign
2929import Foreign.C.String
3030#else
3131import System.Process (rawSystem)
3232#endif
33−import Data.Streaming.Blaze (newBlazeRecv, defaultStrategy)
33+import Data.Streaming.ByteString.Builder as B (newBuilderRecv, defaultStrategy)
3434import qualified Data.Streaming.Zlib as Z
3535
3636ping :: IORef Bool -> Middleware
@@ -60,7 +60,7 @@ decode :: (Builder -> IO ()) -> IO ()
6060 -> StreamingBody
6161 -> IO ()
6262decode sendInner flushInner streamingBody = do
63− (blazeRecv, blazeFinish) <- newBlazeRecv defaultStrategy
63+ (blazeRecv, blazeFinish) <- newBuilderRecv defaultStrategy
6464 inflate <- Z.initInflate $ Z.WindowBits 31
6565 let send builder = blazeRecv builder >>= goBuilderPopper
6666 goBuilderPopper popper = fix $ \loop -> do
@@ -73,15 +73,15 @@ decode sendInner flushInner streamingBody = do
7373 case res of
7474 Z.PRDone -> return ()
7575 Z.PRNext bs -> do
76− sendInner $ fromByteString bs
76+ sendInner $ byteString bs
7777 loop
7878 Z.PRError e -> throwIO e
79− streamingBody send (send flush)
79+ streamingBody send (send Builder.flush)
8080 mbs <- blazeFinish
8181 case mbs of
8282 Nothing -> return ()
8383 Just bs -> Z.feedInflate inflate bs >>= goZlibPopper
84− Z.finishInflate inflate >>= sendInner . fromByteString
84+ Z.finishInflate inflate >>= sendInner . byteString
8585
8686toInsert :: S.ByteString
8787toInsert = "<script>setInterval(function(){var x;if(window.XMLHttpRequest){x=new XMLHttpRequest();}else{x=new ActiveXObject(\"Microsoft.XMLHTTP\");}x.open(\"GET\",\"/_ping?\" + (new Date()).getTime(),true);x.send();},60000)</script>"
@@ -91,7 +91,7 @@ addInsideHead :: (Builder -> IO ())
9191 -> StreamingBody
9292 -> IO ()
9393addInsideHead sendInner flushInner streamingBody = do
94− (blazeRecv, blazeFinish) <- newBlazeRecv defaultStrategy
94+ (blazeRecv, blazeFinish) <- newBuilderRecv defaultStrategy
9595 ref <- newIORef $ Just (S.empty, whole)
9696 streamingBody (inner blazeRecv ref) (flush blazeRecv ref)
9797 state <- readIORef ref
@@ -101,11 +101,11 @@ addInsideHead sendInner flushInner streamingBody = do
101101 Just bs -> push state bs
102102 case state of
103103 Nothing -> return ()
104− Just (held, _) -> sendInner $ fromByteString held `mappend` fromByteString toInsert
104+ Just (held, _) -> sendInner $ byteString held `mappend` byteString toInsert
105105 where
106106 whole = "<head>"
107107
108− flush blazeRecv ref = inner blazeRecv ref Blaze.flush
108+ flush blazeRecv ref = inner blazeRecv ref Builder.flush
109109
110110 inner blazeRecv ref builder = do
111111 state0 <- readIORef ref
@@ -117,23 +117,23 @@ addInsideHead sendInner flushInner streamingBody = do
117117 else push state bs >>= loop
118118 loop state0
119119
120− push Nothing x = sendInner (fromByteString x) >> return Nothing
120+ push Nothing x = sendInner (byteString x) >> return Nothing
121121 push (Just (held, atFront)) x
122122 | atFront `S.isPrefixOf` x = do
123123 let y = S.drop (S.length atFront) x
124− sendInner $ fromByteString held
125− `mappend` fromByteString atFront
126− `mappend` fromByteString toInsert
127− `mappend` fromByteString y
124+ sendInner $ byteString held
125+ `mappend` byteString atFront
126+ `mappend` byteString toInsert
127+ `mappend` byteString y
128128 return Nothing
129129 | whole `S.isInfixOf` x = do
130130 let (before, rest) = S.breakSubstring whole x
131131 let after = S.drop (S.length whole) rest
132− sendInner $ fromByteString held
133− `mappend` fromByteString before
134− `mappend` fromByteString whole
135− `mappend` fromByteString toInsert
136− `mappend` fromByteString after
132+ sendInner $ byteString held
133+ `mappend` byteString before
134+ `mappend` byteString whole
135+ `mappend` byteString toInsert
136+ `mappend` byteString after
137137 return Nothing
138138 | x `S.isPrefixOf` atFront = do
139139 let held' = held `S.append` x
@@ -141,7 +141,7 @@ addInsideHead sendInner flushInner streamingBody = do
141141 return $ Just (held', atFront')
142142 | otherwise = do
143143 let (held', atFront', x') = getOverlap whole x
144− sendInner $ fromByteString held `mappend` fromByteString x'
144+ sendInner $ byteString held `mappend` byteString x'
145145 return $ Just (held', atFront')
146146
147147getOverlap :: S.ByteString -> S.ByteString -> (S.ByteString, S.ByteString, S.ByteString)
@@ -204,6 +204,7 @@ runHostPortUrl host port url app = do
204204 Warp.setHost (fromString host) $
205205 Warp.setBeforeMainLoop (putMVar ready ()) $
206206 Warp.defaultSettings
207+ -}
207208 -- Run these threads concurrently; when either one terminates or
208209 -- raises an exception, the same happens to the other.
209210 fmap (either id id) $ race