git.iko.soy/typeable/wai
on master help sign in
Proper file part support
commit6de3a32f290ccd4797d3ae249b88cdf9dda2632b authorMichael Snoyman <michael@snoyman.com> dateThu 24 Mar 2011, 00:19 (16 years ago) parent222f1e9
3 files changed+47−4
compare with master
unifiedsplit
Network/Wai.hs+35−2 test.hs+9 wai.cabal+3−2
Network/Wai.hs+35−2
@@ -41,7 +41,11 @@ module Network.Wai
4141import qualified Data.ByteString as B
4242import qualified Data.ByteString.Lazy as L
4343import Data.Typeable (Typeable)
44−import Data.Enumerator (Enumerator, Iteratee, ($$), joinI, run_)
44+import Data.Enumerator
45+ ( Enumerator, Iteratee (..), ($$), joinI, run_, returnI
46+ , Stream (Chunks), (>>==), continue, Step (Continue)
47+ , throwError
48+ )
4549import qualified Data.Enumerator as E
4650import Data.Enumerator.Binary (enumFile)
4751import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString)
@@ -49,6 +53,9 @@ import Network.Socket (SockAddr)
4953import qualified Network.HTTP.Types as H
5054import Data.Text (Text)
5155import Data.ByteString.Lazy.Char8 () -- makes it easier to use responseLBS
56+import qualified System.IO as IO
57+import qualified Control.Exception as Exc
58+import Control.Monad.IO.Class (liftIO)
5259
5360-- | Information on the request sent by the client. This abstracts away the
5461-- details of the underlying implementation.
@@ -102,8 +109,34 @@ responseEnumerator (ResponseBuilder s h b) f = run_ $ do
102109 E.yield () $ E.Chunks [b]
103110 f s h
104111
112+tryStep :: IO t -> (t -> Iteratee a IO b) -> Iteratee a IO b
113+tryStep get io = do
114+ tried <- liftIO $ Exc.try get
115+ case tried of
116+ Right t -> io t
117+ Left err -> throwError (err :: Exc.SomeException)
118+
105119enumFilePart :: FilePart -> FilePath -> Enumerator B.ByteString IO a
106−enumFilePart (FilePart offset count) fp = undefined
120+enumFilePart (FilePart offset count) fp step = withHandle $ \h -> do
121+ liftIO $ IO.hSeek h IO.AbsoluteSeek offset
122+ Iteratee $ Exc.finally
123+ (runIteratee $ enumHandleCount count 4096 h step)
124+ (IO.hClose h)
125+ where
126+ withHandle = tryStep $ IO.openBinaryFile fp IO.ReadMode
127+
128+
129+enumHandleCount :: Integer -> Integer -> IO.Handle -> Enumerator B.ByteString IO a
130+enumHandleCount count buff h (Continue k)
131+ | count <= 0 = continue k
132+ | otherwise = do
133+ let toRead = min count buff
134+ bs <- liftIO $ B.hGet h $ fromInteger toRead
135+ if B.null bs
136+ then continue k
137+ else k (Chunks [bs]) >>==
138+ enumHandleCount (count - fromIntegral (B.length bs)) buff h
139+enumHandleCount _ _ _ step = returnI step
107140
108141responseLBS :: H.Status -> H.ResponseHeaders -> L.ByteString -> Response
109142responseLBS s h = ResponseBuilder s h . fromLazyByteString
test.hsnew file+9
@@ -0,0 +1,9 @@
1+import Network.Wai
2+import Data.Enumerator.List (consume)
3+import Blaze.ByteString.Builder (toByteString)
4+import Data.Monoid (mconcat)
5+import Data.ByteString.Char8 (pack)
6+
7+main = do
8+ b <- responseEnumerator (ResponseFile undefined undefined "test.hs" (Just $ FilePart 7 7)) (const $ const consume)
9+ print $ toByteString (mconcat b) == pack "Network"
wai.cabal+3−2
@@ -19,10 +19,11 @@ Source-repository head
1919Library
2020 Build-Depends: base >= 3 && < 5
2121 , bytestring >= 0.9 && < 0.10
22− , blaze-builder >= 0.2 && < 0.3
22+ , blaze-builder >= 0.2 && < 0.4
2323 , enumerator >= 0.4.7 && < 0.5
2424 , network >= 2.2 && < 2.4
25− , http-types >= 0.5 && < 0.6
25+ , http-types >= 0.6 && < 0.7
2626 , text >= 0.5 && < 1.0
27+ , transformers >= 0.2 && < 0.3
2728 Exposed-modules: Network.Wai
2829 ghc-options: -Wall