jacinda 3.3.0.2 → 3.3.0.3
raw patch · 3 files changed
+20/−30 lines, 3 files
Files
- CHANGELOG.md +4/−0
- jacinda.cabal +1/−1
- src/Jacinda/Regex.hs +15/−29
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 3.3.0.3++ * Fix splitting with `--header` on large inputs+ # 3.3.0.2 * Fix pathological performance using custom record separator on large inputs
jacinda.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: jacinda-version: 3.3.0.2+version: 3.3.0.3 license: AGPL-3.0-only license-file: COPYING maintainer: vamchale@gmail.com
src/Jacinda/Regex.hs view
@@ -37,7 +37,7 @@ defaultRurePtr = unsafePerformIO $ yIO =<< compile genFlags defaultFs genFlags :: RureFlags-genFlags = rureDefaultFlags <> rureFlagDotNL -- in case they want to use a custom record separator+genFlags = rureDefaultFlags <> rureFlagDotNL substr :: BS.ByteString -> Int -> Int -> BS.ByteString substr (BS.BS fp l) begin endϵ | endϵ >= begin = BS.BS (fp `plusForeignPtr` begin) (min l endϵ-begin)@@ -46,9 +46,8 @@ captures' :: RurePtr -> BS.ByteString -> CSize -> [BS.ByteString] captures' re haystack@(BS.BS fp _) ix = unsafeDupablePerformIO $ fmap go <$> captures re haystack ix where go (RureMatch s e) =- let e' = fromIntegral e- s' = fromIntegral s- in BS.BS (fp `plusForeignPtr` s') (e'-s')+ let e' = fromIntegral e; s' = fromIntegral s+ in BS.BS (fp `plusForeignPtr` s') (e'-s') {-# NOINLINE capturesIx #-} capturesIx :: RurePtr -> BS.ByteString -> CSize -> [RureMatch]@@ -86,8 +85,7 @@ case splitH rp c of Just (iss,lss) -> iss<>go (Just lss) cs Nothing -> go Nothing cs- -- FIXME: splitByL discards header?- go (Just c) [] = splitByL rp c+ go (Just c) [] = splitHLast rp c go (Just e) (c:cs) = case splitH rp (e<>c) of Just (iss,lss) -> iss<>go (Just lss) cs@@ -107,26 +105,14 @@ Nothing -> go Nothing cs {-# NOINLINE splitByL #-}-splitByL :: RurePtr- -> BS.ByteString- -> DL.DList BS.ByteString-splitByL _ "" = DL.empty-splitByL re haystack@(BS.BS fp l) = pp<$>slicePairs- where ixes = unsafeDupablePerformIO $ matches' re haystack- slicePairs = case ixes of- (RureMatch 0 i:rms) -> mkMiddle (fromIntegral i) rms- rms -> mkMiddle 0 rms- mkMiddle begin' [] = DL.singleton (begin', l)- mkMiddle begin' (rm0:rms) = (begin', fromIntegral (start rm0)) `DL.cons` mkMiddle (fromIntegral $ end rm0) rms- pp (s,e) = BS.BS (fp `plusForeignPtr` s) (e-s)+splitByL :: RurePtr -> BS.ByteString -> DL.DList BS.ByteString+splitByL rp b = case splitByDL rp b of {Nothing -> DL.empty; Just (as,a) -> as `DL.snoc` a} {-# NOINLINE splitBy #-}-splitBy :: RurePtr- -> BS.ByteString- -> V.Vector BS.ByteString+splitBy :: RurePtr -> BS.ByteString -> V.Vector BS.ByteString splitBy _ "" = [] splitBy re haystack@(BS.BS fp l) =- V.fromList $ map (\(s,e) -> BS.BS (fp `plusForeignPtr` s) (e-s)) slicePairs+ V.fromList [ BS.BS (fp `plusForeignPtr` s) (e-s) | (s,e) <- slicePairs ] where ixes = unsafeDupablePerformIO $ matches' re haystack slicePairs = case ixes of (RureMatch 0 i:rms) -> mkMiddle (fromIntegral i) rms@@ -136,8 +122,7 @@ {-# SCC splitByDL #-} {-# NOINLINE splitByDL #-}-splitByDL :: RurePtr- -> BS.ByteString+splitByDL :: RurePtr -> BS.ByteString -> Maybe (DL.DList (BS.ByteString), BS.ByteString) splitByDL _ "" = Nothing splitByDL re haystack@(BS.BS fp l) = bimap (fmap pp) pp <$> slicePairs@@ -149,18 +134,20 @@ mkMiddle begin' (rm0:rms) = first ((begin', fromIntegral (start rm0)) `DL.cons`) <$> mkMiddle (fromIntegral $ end rm0) rms pp (s,e) = BS.BS (fp `plusForeignPtr` s) (e-s) +{-# NOINLINE splitHLast #-}+splitHLast :: RurePtr -> BS.ByteString -> DL.DList BS.ByteString+splitHLast rp b = case splitH rp b of {Nothing -> DL.empty; Just (as,a) -> as `DL.snoc` a}+ {-# NOINLINE splitH #-} splitH :: RurePtr -> BS.ByteString -> Maybe (DL.DList BS.ByteString, BS.ByteString) splitH _ "" = Nothing splitH re haystack@(BS.BS fp l) = bimap (fmap pp) pp <$> chopAt 0 ixes where ixes = unsafeDupablePerformIO $ matches' re haystack chopAt begin [] = Just (DL.empty, (begin, l))- chopAt begin (RureMatch b _:rms) = first ((begin, fromIntegral b) `DL.cons`) <$> chopAt (fromIntegral b) rms+ chopAt begin (RureMatch b _:rms) = let b'=fromIntegral b in first ((begin, b') `DL.cons`) <$> chopAt b' rms pp (s,e) = BS.BS (fp `plusForeignPtr` s) (e-s) -isMatch' :: RurePtr- -> BS.ByteString- -> Bool+isMatch' :: RurePtr -> BS.ByteString -> Bool isMatch' re haystack = unsafeDupablePerformIO $ isMatch re haystack 0 compileDefault :: BS.ByteString -> RurePtr@@ -169,7 +156,6 @@ newtype RureExe = RegexCompile String instance Show RureExe where show (RegexCompile str) = str- instance Exception RureExe where yIO :: Either String a -> IO a