on master help sign in
wai-extra: followup to making the Parse module API more readable
commitd669dda957feff1c6e28f6f1cf74eb9e22eb833a authorAntoine Latter <aslatter@gmail.com> dateTue 24 Jan 2012, 22:13 (15 years ago) parentfa8e0b5
2 files changed+44−30
wai-extra/Network/Wai/Middleware/RequestLogger.hs+2−2 wai-extra/Network/Wai/Parse.hs+42−28
wai-extra/Network/Wai/Middleware/RequestLogger.hs+2−2
@@ -17,7 +17,7 @@ import Network.Wai (Request(..), Middleware)
1717import System.Log.FastLogger
1818import Network.HTTP.Types as H
1919
20−import Network.Wai.Parse (parseRequestBody, lbsSink, fileName, Param, File)
20+import Network.Wai.Parse (parseRequestBody, lbsBackEnd, fileName, Param, File)
2121import qualified Data.ByteString.Lazy as LBS
2222
2323import qualified Data.Conduit as C
@@ -99,7 +99,7 @@ logCallbackDev cb app req = do
9999 if null params then ""
100100 else BS.concat ["\n", prefix, pack (show params)]
101101
102− allPostParams req' body = C.runResourceT $ CL.sourceList body C.$$ parseRequestBody lbsSink req'
102+ allPostParams req' body = C.runResourceT $ CL.sourceList body C.$$ parseRequestBody lbsBackEnd req'
103103
104104 emptyGetParam :: (BS.ByteString, Maybe BS.ByteString) -> (BS.ByteString, BS.ByteString)
105105 emptyGetParam (k, Just v) = (k,v)
wai-extra/Network/Wai/Parse.hs+42−28
@@ -7,12 +7,15 @@ module Network.Wai.Parse
77 ( parseHttpAccept
88 , parseRequestBody
99 , conduitRequestBody
10− , lbsSink
11− , tempFileSink
10+ , lbsBackEnd
11+ , tempFileBackEnd
1212 , BackEnd (..)
1313 , Param
1414 , File
1515 , FileInfo (..)
16+ -- ** Deprecated
17+ , lbsSink
18+ , tempFileSink
1619#if TEST
1720 , Bound (..)
1821 , findBound
@@ -90,37 +93,48 @@ parseHttpAccept = map fst
9093 _ -> 1.0
9194 trimWhite = S.dropWhile (== 32) -- space
9295
93−-- | A destination for data, with concrete implemtations
94−-- provided by 'lbsSink' and 'tempFileSink'
96+-- | A destination for file data, with concrete implemtations
97+-- provided by 'lbsBackEnd' and 'tempFileBackEnd'
9598data BackEnd y = forall x . BackEnd
96− { sinkInit :: IO x
97− , sinkAppend :: x -> S.ByteString -> IO x
98− , sinkClose :: x -> IO y
99− , sinkFinalize :: y -> IO ()
99+ { initialize :: IO x
100+ , append :: x -> S.ByteString -> IO x
101+ , close :: x -> IO y
102+ , finalize :: y -> IO ()
100103 }
101104
102105-- | Store uploaded files in memory
103−lbsSink :: BackEnd L.ByteString
104−lbsSink = BackEnd
105− { sinkInit = return id
106− , sinkAppend = \front bs -> return $ front . (:) bs
107− , sinkClose = \front -> return $ L.fromChunks $ front []
108− , sinkFinalize = \_ -> return ()
106+lbsBackEnd :: BackEnd L.ByteString
107+lbsBackEnd = BackEnd
108+ { initialize = return id
109+ , append = \front bs -> return $ front . (:) bs
110+ , close = \front -> return $ L.fromChunks $ front []
111+ , finalize = \_ -> return ()
109112 }
110113
111114-- | Save uploaded files on disk as temporary files
112−tempFileSink :: BackEnd FilePath
113−tempFileSink = BackEnd
114− { sinkInit = do
115+tempFileBackEnd :: BackEnd FilePath
116+tempFileBackEnd = BackEnd
117+ { initialize = do
115118 tempDir <- getTemporaryDirectory
116119 openBinaryTempFile tempDir "webenc.buf"
117− , sinkAppend = \(fp, h) bs -> S.hPut h bs >> return (fp, h)
118− , sinkClose = \(fp, h) -> do
120+ , append = \(fp, h) bs -> S.hPut h bs >> return (fp, h)
121+ , close = \(fp, h) -> do
119122 hClose h
120123 return fp
121− , sinkFinalize = \fp -> removeFile fp
124+ , finalize = \fp -> removeFile fp
122125 }
123126
127+-- | This function has been renamed to 'lbsBackEnd'
128+lbsSink :: BackEnd L.ByteString
129+lbsSink = lbsBackEnd
130+
131+-- | This function has been renamed to 'tempFileBackEnd'
132+tempFileSink :: BackEnd FilePath
133+tempFileSink = tempFileBackEnd
134+
135+{-# DEPRECATED lbsSink "Please use 'lbsBackEnd'" #-}
136+{-# DEPRECATED tempFileSink "Please use 'tempFileBackEnd'" #-}
137+
124138-- | Information on an uploaded file.
125139data FileInfo c = FileInfo
126140 { fileName :: S.ByteString
@@ -177,9 +191,9 @@ conduitRequestBody sink req = do
177191
178192takeLine :: C.Sink S.ByteString IO (Maybe S.ByteString)
179193takeLine =
180− C.sinkState id push close
194+ C.sinkState id push close'
181195 where
182− close _ = return Nothing
196+ close' _ = return Nothing
183197 push front bs = do
184198 let (x, y) = S.break (== 10) $ front bs -- LF
185199 in if S.null y
@@ -207,7 +221,7 @@ parsePiecesSink :: BackEnd y
207221 -> S.ByteString
208222 -> C.SequencedSink Bool S.ByteString IO (Either Param (File y))
209223parsePiecesSink _ _ False = return C.Stop
210−parsePiecesSink BackEnd{sinkInit=init,sinkAppend=append,sinkClose=close}
224+parsePiecesSink BackEnd{initialize=initialize',append=append',close=close'}
211225 bound True = do
212226 _boundLine <- takeLine
213227 res' <- takeLines
@@ -224,10 +238,10 @@ parsePiecesSink BackEnd{sinkInit=init,sinkAppend=append,sinkClose=close}
224238 case x of
225239 Just (mct, name, Just filename) -> do
226240 let ct = fromMaybe "application/octet-stream" mct
227− seed <- liftIO init
241+ seed <- liftIO initialize'
228242 (seed', wasFound) <-
229− sinkTillBound bound append seed
230− y <- liftIO $ close seed'
243+ sinkTillBound bound append' seed
244+ y <- liftIO $ close' seed'
231245 let fi = FileInfo filename ct y
232246 let y' = (name, fi)
233247 return $ C.Emit wasFound [Right y']
@@ -281,9 +295,9 @@ sinkTillBound :: S.ByteString
281295sinkTillBound bound iter seed0 = C.sinkState
282296 (id, seed0)
283297 push
284− close
298+ close'
285299 where
286− close (front, seed) = do
300+ close' (front, seed) = do
287301 seed' <- liftIO $ iter seed $ front S.empty
288302 return (seed', False)
289303 push (front, seed) bs' = do