packages feed

snap-core 0.4.0.2 → 0.4.1

raw patch · 7 files changed

+311/−270 lines, 7 filesdep ~enumerator

Dependency ranges changed: enumerator

Files

snap-core.cabal view
@@ -1,5 +1,5 @@ name:           snap-core-version:        0.4.0.2+version:        0.4.1 synopsis:       Snap: A Haskell Web Framework (Core)  description:@@ -122,7 +122,7 @@    other-modules:     Snap.Internal.Instances,-    Snap.Internal.Iteratee.KnuthMorrisPratt,+    Snap.Internal.Iteratee.BoyerMooreHorspool,     Snap.Internal.Routing,     Snap.Internal.Types @@ -138,7 +138,7 @@     deepseq >= 1.1 && <1.2,     directory,     dlist >= 0.5 && < 0.6,-    enumerator >= 0.4.5 && < 0.5,+    enumerator >= 0.4.7 && < 0.5,     filepath,     MonadCatchIO-transformers >= 0.2.1 && < 0.3,     mtl == 2.0.*,
+ src/Snap/Internal/Iteratee/BoyerMooreHorspool.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}++module Snap.Internal.Iteratee.BoyerMooreHorspool+  ( bmhEnumeratee+  , MatchInfo(..) )+  where++import           Control.Monad.State+import qualified Data.ByteString as S+import           Data.ByteString (ByteString)+import           Data.ByteString.Unsafe as S+import           Data.Enumerator hiding (head, filter, last, map)+import qualified Data.Enumerator.List as EL+import           Data.Int+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Unboxed.Mutable  as MV+import           Prelude               hiding (head, last)+++{-# INLINE debug #-}+debug :: MonadIO m => String -> m ()+--debug s = liftIO $ putStrLn s+debug _ = return ()++------------------------------------------------------------------------------+data MatchInfo = Match !ByteString+               | NoMatch !ByteString+  deriving (Show)+++-- We return strict bytestring because we always expect a chunk to be bigger+-- than the needle+lookahead :: (MonadIO m) =>+             Int+          -> Iteratee ByteString m (Either ByteString ByteString)+lookahead n = go id n+  where+    go !dlist !k = do+        EL.head >>= maybe+                        (do+                            let !ls = S.concat $ dlist []+                            debug $ "lookahead " ++ show n+                             ++ " failing, returning " ++ show ls++                            return $ Left ls)+                        (\x -> do+                             let !l  = S.length x+                             let !r  = k - l+                             let !d' = dlist . (x:)++                             if r <= 0+                               then do+                                   let !ls = S.concat $ d' []+                                   debug $ "lookahead " ++ show n+                                    ++ " successfully returning "+                                    ++ show ls+                                   return $ Right $ ls+                               else go d' r)+{-# INLINE lookahead #-}++matches :: ByteString     -- ^ needle+        -> Int            -- ^ needle start+        -> Int            -- ^ needle end (inclusive)+        -> ByteString     -- ^ haystack+        -> Int            -- ^ haystack start+        -> Int            -- ^ haystack end (inclusive)+        -> Bool+matches !needle !nstart !nend' !haystack !hstart !hend' =+    go nend' hend'+  where+    go !nend !hend =+        if nend < nstart || hend < hstart+          then True+          else let !nc = S.index needle nend -- FIXME: use unsafeIndex+                   !hc = S.index haystack hend+               in if nc /= hc+                    then False+                    else go (nend-1) (hend-1)+{-# INLINE matches #-}+++bmhEnumeratee :: (MonadIO m) =>+                 ByteString+              -> Step MatchInfo m a+              -> Iteratee ByteString m (Step MatchInfo m a)+bmhEnumeratee needle _step = do+    debug $ "boyermoore: needle=" ++ show needle+    cDone _step iter+  where+    {-# INLINE cDone #-}+    cDone (Continue k) f = f k+    cDone step _ = yield step (Chunks [])+++    iter !k = {-# SCC "bmh/iter" #-} do+        lookahead nlen >>= either (finishAndEOF k . (:[]))+                                  (startSearch k)++    finishAndEOF k xs = {-# SCC "finishAndEOF" #-} do+        debug $ "finishAndEOF, returning NoMatch for " ++ show xs+        step <- lift $ runIteratee $ k $+                Chunks (map NoMatch $ filter (not . S.null) xs)+        cDone step (\k' -> lift $ runIteratee $ k' EOF)+++    startSearch !k !haystack = {-# SCC "startSearch" #-} do+        debug $ "startsearch: " ++ show haystack+        if S.null haystack+           then lookahead nlen >>=+                either (\s -> finishAndEOF k [s])+                       (startSearch k)+           else go 0+      where+        !hlen = S.length haystack++        go !hidx+          | hend >= hlen = crossBound hidx+          | otherwise = {-# SCC "go" #-} do+              let match = matches needle 0 last haystack hidx hend+              debug $ "go " ++ show hidx ++ ", hend=" ++ show hend+                        ++ ", match was " ++ show match+              if match+                then {-# SCC "go/match" #-} do+                  let !nomatch = S.take hidx haystack+                  let !aftermatch = S.drop (hend+1) haystack++                  step <- if not $ S.null nomatch+                            then lift $ runIteratee $ k $ Chunks [NoMatch nomatch]+                            else return $ Continue k++                  cDone step $ \k' -> do+                      step' <- lift $ runIteratee $ k' $ Chunks [Match needle]+                      cDone step' $ \k'' -> startSearch k'' aftermatch+                else {-# SCC "go/nomatch" #-} do+                  -- skip ahead+                  let c = S.index haystack hend+                  let !skip = V.unsafeIndex table $ fromEnum c+                  go (hidx + skip)+          where+            !hend = hidx + nlen - 1+                                        +        crossBound !hidx = {-# SCC "crossBound" #-} do+            let !leftLen = hlen - hidx+            let !needMore = nlen - leftLen+            debug $ "crossbound " ++ show hidx ++ ", leftlen=" ++ show leftLen+                      ++ ", needmore=" ++ show needMore                            +            lookahead needMore >>=+             either+              (\s -> finishAndEOF k [haystack, s])+              (\nextHaystack -> do+                   let match1 = matches needle leftLen last+                                        nextHaystack 0 (needMore-1)+                   let match2 = matches needle 0 (leftLen-1)+                                        haystack hidx (hlen-1)++                   debug $ "crossbound match1=" ++ show match1+                             ++ " match2=" ++ show match2++                   if match1 && match2+                     then {-# SCC "crossBound/match" #-} do+                       let !nomatch = S.take hidx haystack+                       let !aftermatch = S.drop needMore nextHaystack++                       -- FIXME: merge this code w/ above+                       step <- if not $ S.null nomatch+                                 then lift $ runIteratee $ k $+                                      Chunks [NoMatch nomatch]+                                 else return $ Continue k++                       debug $ "matching"+                       cDone step $ \k' -> do+                           step' <- lift $ runIteratee $ k' $+                                    Chunks [Match needle]+                           cDone step' $ \k'' ->+                               startSearch k'' aftermatch++                     else {-# SCC "crossBound/nomatch" #-} do+                       let c = S.index nextHaystack $ needMore-1+                       let p = V.unsafeIndex table (fromEnum c)++                       debug $ "p was " ++ show p ++ ", ll=" ++ show leftLen+                       if p < leftLen+                         then do+                           let (!nomatch, !crumb) = S.splitAt (hidx + p)+                                                              haystack+                           let !rest = S.append crumb nextHaystack+                           step <- lift $ runIteratee $ k $+                                   Chunks $ map NoMatch $+                                   filter (not . S.null) [nomatch]++                           cDone step $ flip startSearch rest++                         else do+                           let sidx = p - leftLen+                           let (!crumb, !rest) = S.splitAt sidx nextHaystack+                           step <- lift $ runIteratee $ k $+                                   Chunks $ map NoMatch $+                                   filter (not . S.null) [haystack, crumb]++                           cDone step $ flip startSearch rest+              )++++    !nlen = S.length needle++    !last = nlen - 1++    !table = V.create $ do+        t <- MV.replicate 256 nlen+        go t++      where+        go !t = go' 0+          where+            go' !i | i >= last  = return t+                   | otherwise = do+                let c = fromEnum $ S.unsafeIndex needle i+                MV.unsafeWrite t c (last - i)+                go' $! i+1++{-+testIt :: ByteString -> [ByteString] -> IO [MatchInfo]+testIt needle haystack = do+    consumeStep <- runIteratee EL.consume+    eteeStep    <- runIteratee $ etee consumeStep+    -- iter :: Iteratee ByteString m (Step MatchInfo m [MatchInfo])+    let iter = enumList 1 haystack eteeStep+    finalInnerStep <- run_ iter+    run_ $ returnI finalInnerStep++  where+    etee = bmhEnumeratee needle+-}
− src/Snap/Internal/Iteratee/KnuthMorrisPratt.hs
@@ -1,203 +0,0 @@-{-# LANGUAGE BangPatterns      #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-}--module Snap.Internal.Iteratee.KnuthMorrisPratt-  ( kmpEnumeratee-  , MatchInfo(..) )-  where--import           Control.Monad.Trans-import qualified Data.ByteString.Char8 as S-import           Data.ByteString.Char8 (ByteString)-import           Data.ByteString.Unsafe as S-import           Data.Enumerator hiding (head)-import qualified Data.Enumerator.List as EL-import qualified Data.Vector           as V-import           Data.Vector           (Vector)-import qualified Data.Vector.Mutable   as MV-import           Prelude               hiding (head)---------------------------------------------------------------------------------data MatchInfo = Match !ByteString-               | NoMatch !ByteString-  deriving (Show)----------------------------------------------------------------------------------- FIXME: s/MonadIO/Monad/-kmpEnumeratee :: (MonadIO m) =>-                 ByteString                         -- ^ needle-              -> Enumeratee ByteString MatchInfo m a-kmpEnumeratee needle = checkDone (iter "" 0)-  where-    needleLen = S.length needle-    table     = buildKmpTable needle--    ---------------------------------------------------------------------------    iter :: (MonadIO m) =>-            ByteString-         -- ^ num bytes left over from previous match-         -> Int  -- ^ needle index-         -> (Stream MatchInfo -> Iteratee MatchInfo m a)-         -- ^ iteratee continuation-         -> Iteratee ByteString m (Step MatchInfo m a)-    iter !leftOver !needleIndex !k = do-        EL.head >>= maybe (finish leftOver k)-                          (processChunk leftOver needleIndex k)--    ---------------------------------------------------------------------------    finish :: (MonadIO m) =>-              ByteString-           -> (Stream MatchInfo -> Iteratee MatchInfo m a)-           -> Iteratee ByteString m (Step MatchInfo m a)-    finish !leftOver !k-        | S.null leftOver = lift $ runIteratee $ k EOF-        | otherwise = do-            step <- lift $ runIteratee $ k $ Chunks [NoMatch leftOver]-            checkDone (\k' -> lift $ runIteratee $ k' EOF) step--    ---------------------------------------------------------------------------    processChunk :: (MonadIO m) =>-                    ByteString-                 -> Int-                 -> (Stream MatchInfo -> Iteratee MatchInfo m a)-                 -> ByteString-                 -> Iteratee ByteString m (Step MatchInfo m a)-    processChunk !leftOver !needleIndex !k !input = go 0 needleIndex--      where-        !inputLen    = S.length input-        !leftOverLen = S.length leftOver-        !totalLen    = inputLen + leftOverLen--        -- m = start of match in leftOver + index-        -- i = needle index-        go !m !i-           | (m+i >= totalLen) = finalize m i-           | (S.unsafeIndex needle i == S.unsafeIndex input ii) =-                 if i == needleLen - 1-                   then yieldMatch m-                   else go m (i+1)-           | otherwise = go m' i'--          where-            ii = i + m - leftOverLen-            ti = V.unsafeIndex table i-            m' = m + i - ti-            i' = max 0 ti--           -        -----------------------------------------------------------------------        -- here we've reached the end of the input chunk. A couple of things-        -- we know:-        ---        -- * the input from [0..m) doesn't match the needle and we should-        --   yield it to the inner iteratee. However if m == 0 then the whole-        --   input string was a match and we need to feed our previous-        --   leftovers forward plus our entire input string.-        ---        -- * the input from [m..ilen) is a partial match that we need to feed-        --   forward-        finalize m i-            | m == 0 = iter (S.append leftOver input) i k--            | m < leftOverLen = do-                -- here part of the leftover is the no match and we carry the-                -- rest forward along with the input-                let (nomatch, restLeftOver) = S.splitAt m leftOver-                let rest = S.append restLeftOver input-                let chunk = Chunks [NoMatch nomatch]-                step <- lift $ runIteratee $ k chunk-                checkDone (iter rest i) step--            | otherwise = do-                -- the whole leftOver part was garbage.-                let m' = m - leftOverLen-                let (nomatchInput, rest) = S.splitAt m' input-                let nomatch = S.append leftOver nomatchInput-                let chunk = Chunks [NoMatch nomatch]-                step <- lift $ runIteratee $ k chunk-                checkDone (iter rest i) step-            --        -----------------------------------------------------------------------        -- we got a match! We need to yield [0..m) to the inner iteratee as a-        -- nomatch, then yield the needle, then go back to processing the rest-        -- of the input from scratch. Same caveats re: m==0 apply here.-        yieldMatch m -            | m == 0 = do-                 -- we have no garbage and just advance by the size of the needle-                 step <- lift $ runIteratee $ k $ Chunks [Match needle]-                 -- we also can be sure here that the needle crosses the-                 -- leftOver..input boundary (otherwise we would have yielded-                 -- it earlier)-                 let m' = needleLen - leftOverLen-                 let rest = S.drop m' input-                 checkDone (\k' -> processChunk "" 0 k' rest) step--            | otherwise = do-                 let (garbage,rest) =-                         if m < leftOverLen-                           then let (a,b) = S.splitAt m leftOver-                                in (a, S.drop needleLen $ S.append b input)-                           else let m'    = m - leftOverLen-                                    (a,b) = S.splitAt m' input-                                in (S.append leftOver a, S.drop needleLen b)-                 -                 step <- lift $ runIteratee $ k $ Chunks [NoMatch garbage]-                 flip checkDone step $ \k' -> do-                     step' <- lift $ runIteratee $ k' $ Chunks [Match needle]-                     flip checkDone step' $ \k'' -> processChunk "" 0 k'' rest----------------------------------------------------------------------------------buildKmpTable :: ByteString -> Vector Int-buildKmpTable needle = V.create $ do-    t <- MV.new (max 2 needleLen)-    MV.write t 0 (-1)-    MV.write t 1 0-    f 2 0 t--  where-    needleLen = S.length needle--    f !pos !cnd t =-        -- are we finished? return the vector.-        if pos >= needleLen-          then return t-          else do-            let wPos1 = S.unsafeIndex needle (pos-1)-            let wCnd  = S.unsafeIndex needle cnd--            if wPos1 == wCnd-              then do-                -- first case: the substring continues-                let cnd' = cnd+1-                MV.write t pos cnd'-                f (pos+1) cnd' t--              else if cnd > 0-                     then do-                       -- second case: it doesn't, but we can fall back-                       cnd' <- MV.read t cnd-                       f pos cnd' t-                     else do-                       -- we have run out of candidates.-                       MV.write t pos 0-                       f (pos+1) cnd t---{--testIt :: ByteString -> [ByteString] -> IO [MatchInfo]-testIt needle haystack = do-    consumeStep <- runIteratee consume-    eteeStep    <- runIteratee $ etee consumeStep-    -- iter :: Iteratee ByteString m (Step MatchInfo m [MatchInfo])-    let iter = enumList 1 haystack eteeStep-    finalInnerStep <- run_ iter-    run_ $ returnI finalInnerStep--  where-    etee = kmpEnumeratee needle---}
src/Snap/Iteratee.hs view
@@ -134,17 +134,20 @@ instance (Functor m, MonadCatchIO m) =>          MonadCatchIO (Iteratee s m) where     --catch  :: Exception  e => m a -> (e -> m a) -> m a-    catch m handler = Iteratee $ do-        ee <- try $ runIteratee (m `catchError` h)-        case ee of-          -- if we got an async exception here then the iteratee workflow is-          -- all messed up, we have no reasonable choice but to send EOF to the-          -- handler, because the unparsed input got lost. If the enumerator-          -- sends more chunks we can possibly recover later.-          (Left e)  -> runIteratee (enumEOF $$ handler e)-          (Right v) -> step v+    catch m handler = insideCatch (m `catchError` h)       where-        step (Continue k)  = return $ Continue (\s -> k s `catch` handler)+        insideCatch !mm = Iteratee $ do+            ee <- try $ runIteratee mm+            case ee of +                -- if we got an async exception here then the iteratee workflow is+                -- all messed up, we have no reasonable choice but to send EOF to the+                -- handler, because the unparsed input got lost. If the enumerator+                -- sends more chunks we can possibly recover later.+                (Left e)  -> runIteratee (enumEOF $$ handler e)+                (Right v) -> step v++        step (Continue !k)  = do+            return $ Continue (\s -> insideCatch $ k s)         -- don't worry about Error here because the error had to come from the         -- handler (because of 'catchError' above)         step y             = return y@@ -481,7 +484,7 @@  takeExactly !n  y@(Yield _ _ ) = drop' n >> return y takeExactly _     (Error e   ) = throwError e-takeExactly !n st@(Continue k) = do+takeExactly !n st@(Continue !k) = do     if n == 0       then lift $ runIteratee $ k EOF       else do@@ -491,22 +494,22 @@               mbX    where-    check x | S.null x   = takeExactly n st-            | strlen < n = do-                  newStep <- lift $ runIteratee $ k $ Chunks [x]-                  takeExactly (n-strlen) newStep-            | otherwise = do-                  step1 <- lift $ runIteratee $ k $ Chunks [s1]-                  step2 <- lift $ runIteratee $ enumEOF step1+    check !x | S.null x   = takeExactly n st+             | strlen < n = do+                   newStep <- lift $ runIteratee $ k $ Chunks [x]+                   takeExactly (n-strlen) newStep+             | otherwise = do+                   let (s1,s2) = S.splitAt (fromEnum n) x+                   !step1 <- lift $ runIteratee $ k $ Chunks [s1]+                   !step2 <- lift $ runIteratee $ enumEOF step1 -                  case step2 of-                    (Continue _) -> error "divergent iteratee"-                    (Error e)    -> throwError e-                    (Yield v _)  -> yield (Yield v EOF) (Chunks [s2])+                   case step2 of+                     (Continue _) -> error "divergent iteratee"+                     (Error e)    -> throwError e+                     (Yield v _)  -> yield (Yield v EOF) (Chunks [s2])        where-        strlen  = toEnum $ S.length x-        (s1,s2) = S.splitAt (fromEnum n) x+        !strlen  = toEnum $ S.length x   ------------------------------------------------------------------------------@@ -701,7 +704,7 @@                                           -- the iteratee run for               -> Iteratee ByteString m a  -- ^ iteratee consumer to wrap               -> Iteratee ByteString m a-killIfTooSlow bump minRate minSeconds' inputIter = do+killIfTooSlow !bump !minRate !minSeconds' !inputIter = do     !_ <- lift bump     startTime <- liftIO getTime     step <- lift $ runIteratee inputIter@@ -709,24 +712,25 @@    where     minSeconds = fromIntegral minSeconds'-    wrap startTime nBytesRead = step++    wrap !startTime = proc       where-        step (Continue k) = continue $ cont k-        step z            = returnI z+        proc !nb (Continue !k) = continue $ cont nb k+        proc _ !z              = returnI z -        cont k EOF = k EOF-        cont k stream = do-            let slen = toEnum $ streamLength stream+        cont !nBytesRead !k EOF = k EOF+        cont !nBytesRead !k !stream = do+            let !slen = toEnum $ streamLength stream             now <- liftIO getTime-            let delta = now - startTime-            let newBytes = nBytesRead + slen+            let !delta = now - startTime+            let !newBytes = nBytesRead + slen             when (delta > minSeconds+1 &&                   fromIntegral newBytes / (delta-minSeconds) < minRate) $               throw RateTooSlowException              -- otherwise bump the timeout and continue running the iteratee             !_ <- lift bump-            lift (runIteratee $ k stream) >>= wrap startTime newBytes+            lift (runIteratee $! k stream) >>= proc newBytes   ------------------------------------------------------------------------------
src/Snap/Util/FileUploads.hs view
@@ -95,7 +95,7 @@ import qualified Snap.Iteratee as I import           Snap.Internal.Debug import           Snap.Internal.Iteratee.Debug-import           Snap.Internal.Iteratee.KnuthMorrisPratt+import           Snap.Internal.Iteratee.BoyerMooreHorspool import           Snap.Internal.Parsing import           Snap.Types @@ -598,8 +598,8 @@     go = do         -- swallow the first boundary         _ <- iterParser $ parseFirstBoundary boundary-        step <- iterateeDebugWrapper "kmp" $-                (kmpEnumeratee (fullBoundary boundary) $$ processParts iter)+        step <- iterateeDebugWrapper "boyer-moore" $+                (bmhEnumeratee (fullBoundary boundary) $$ processParts iter)         liftM concat $ lift $ run_ $ returnI step      --------------------------------------------------------------------------@@ -653,8 +653,8 @@     processMixed fieldName mixedBoundary = do         -- swallow the first boundary         _ <- iterParser $ parseFirstBoundary mixedBoundary-        step <- iterateeDebugWrapper "kmp" $-                (kmpEnumeratee (fullBoundary mixedBoundary) $$+        step <- iterateeDebugWrapper "boyer-moore" $+                (bmhEnumeratee (fullBoundary mixedBoundary) $$                  processParts (mixedIter fieldName))         lift $ run_ $ returnI step @@ -711,38 +711,41 @@ -- up until the next boundary and send all of the chunks into the wrapped -- iteratee processPart :: (Monad m) => Enumeratee MatchInfo ByteString m a-processPart = checkDone go+processPart st = {-# SCC "pPart/outer" #-}+                   case st of+                     (Continue k) -> go k+                     _            -> yield st (Chunks [])   where     go :: (Monad m) => (Stream ByteString -> Iteratee ByteString m a)                     -> Iteratee MatchInfo m (Step ByteString m a)-    go k = I.head >>= maybe (finish k) (process k)--    -- called when outer stream is EOF-    finish :: (Monad m) => (Stream ByteString -> Iteratee ByteString m a)-                        -> Iteratee MatchInfo m (Step ByteString m a)-    finish k = lift $ runIteratee $ k EOF+    go !k = {-# SCC "pPart/go" #-}+            I.head >>= maybe finish process+      where+        -- called when outer stream is EOF+        finish = {-# SCC "pPart/finish" #-}+                 lift $ runIteratee $ k EOF -    -- no match ==> pass the stream chunk along-    process :: (Monad m) => (Stream ByteString -> Iteratee ByteString m a)-                         -> MatchInfo-                         -> Iteratee MatchInfo m (Step ByteString m a)-    process k (NoMatch s) = do-      step <- lift $ runIteratee $ k $ Chunks [s]-      checkDone go step+        -- no match ==> pass the stream chunk along+        process (NoMatch !s) = {-# SCC "pPart/noMatch" #-} do+          !step <- lift $ runIteratee $ k $ Chunks [s]+          case step of+            (Continue k') -> go k'+            _             -> yield step (Chunks []) -    process k (Match _) = lift $ runIteratee $ k EOF+        process (Match _) = {-# SCC "pPart/match" #-}+                            lift $ runIteratee $ k EOF   ------------------------------------------------------------------------------ -- | Assuming we've already identified the boundary value and run--- 'kmpEnumeratee' to split the input up into parts which match and parts+-- 'bmhEnumeratee' to split the input up into parts which match and parts -- which don't, run the given 'ByteString' iteratee over each part and grab a -- list of the resulting values. processParts :: Iteratee ByteString IO a              -> Iteratee MatchInfo IO [a] processParts partIter = iterateeDebugWrapper "processParts" $ go D.empty   where-    iter = do+    iter = {-# SCC "processParts/iter" #-} do         isLast <- bParser         if isLast           then return Nothing@@ -751,7 +754,7 @@             skipToEof             return $ Just x -    go soFar = do+    go soFar = {-# SCC "processParts/go" #-} do       b <- isEOF        if b@@ -859,7 +862,8 @@         cleanupUploadedFiles ufs         throw $ GenericFileUploadException alreadyOpenMsg -    fph <- openTempFile tmpdir "snap-"+    fph@(_,h) <- openBinaryTempFile tmpdir "snap-"+    hSetBuffering h NoBuffering      writeIORef stateRef $ state { _currentFile = Just fph }     return fph
test/snap-core-testsuite.cabal view
@@ -35,7 +35,7 @@     dlist >= 0.5 && < 0.6,     filepath,     HUnit >= 1.2 && < 2,-    enumerator == 0.4.*,+    enumerator >= 0.4.7 && <0.5,     MonadCatchIO-transformers >= 0.2 && < 0.3,     mtl >= 2 && <3,     old-locale,
test/suite/Snap/Iteratee/Tests.hs view
@@ -31,7 +31,7 @@ import qualified Test.HUnit as H  import           Snap.Iteratee-import           Snap.Internal.Iteratee.KnuthMorrisPratt+import           Snap.Internal.Iteratee.BoyerMooreHorspool import           Snap.Test.Common ()  import Snap.Internal.Iteratee.Debug@@ -78,7 +78,7 @@         , testCountBytes2         , testKillIfTooSlow1         , testKillIfTooSlow2-        , testKMP+        , testBMH         , testCatchIO         ] @@ -430,8 +430,8 @@   -------------------------------------------------------------------------------testKMP :: Test-testKMP = testProperty "iteratee/KnuthMorrisPratt" $+testBMH :: Test+testBMH = testProperty "iteratee/BoyerMooreHorspool" $           monadicIO $ forAllM arbitrary prop   where     prop :: (ByteString, [ByteString]) -> PropertyM IO ()@@ -453,7 +453,7 @@         let stream = L.concat [lneedle, lhay]          -- there should be exactly three Matches-        let iter = enumLBS stream $$ joinI (kmpEnumeratee needle $$ consume)+        let iter = enumLBS stream $$ joinI (bmhEnumeratee needle $$ consume)         outp <- QC.run $ run_ iter          let nMatches = length $ filter isMatch outp