Fix isInfixOf and breakSubString in Word16

Fixes #195

System/OsPath/Data/ByteString/Short/Word16.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing -fexpose-all-unfoldings #-}
 
@@ -143,10 +144,11 @@ module System.OsPath.Data.ByteString.Short.Word16 (
     useAsCWStringLen
   )
 where
-import System.OsPath.Data.ByteString.Short ( append, intercalate, concat, stripSuffix, stripPrefix, isInfixOf, isPrefixOf, isSuffixOf, breakSubstring, length, empty, null, ShortByteString(..), fromShort, toShort )
+import System.OsPath.Data.ByteString.Short ( append, intercalate, concat, stripSuffix, stripPrefix, isPrefixOf, isSuffixOf, length, empty, null, ShortByteString(..), fromShort, toShort )
 import System.OsPath.Data.ByteString.Short.Internal
 import Data.Bits
-    ( shiftR )
+    ( shiftR
+    )
 import Data.Word
 import Prelude hiding
     ( Foldable(..)
@@ -172,6 +174,7 @@ import Prelude hiding
 import qualified Data.Foldable as Foldable
 import GHC.ST ( ST )
 import GHC.Stack ( HasCallStack )
+import GHC.Exts ( inline )
 
 import qualified Data.ByteString.Short.Internal as BS
 import qualified Data.List as List
@@ -647,6 +650,23 @@ splitWith p = \(assertEven -> sbs) -> if
               | otherwise -> a : go (tail b)
 
 
+-- | Check whether one string is a substring of another.
+isInfixOf :: ShortByteString -> ShortByteString -> Bool
+isInfixOf sbs = \s -> null sbs || not (null $ snd $ GHC.Exts.inline breakSubstring sbs s)
+
+
+breakSubstring :: ShortByteString -- ^ String to search for
+               -> ShortByteString -- ^ String to search in
+               -> (ShortByteString, ShortByteString) -- ^ Head and tail of string broken at substring
+breakSubstring pat inp = go 0 inp
+ where
+    go prefix s = let (h, t)  = GHC.Exts.inline BS.breakSubstring pat s
+                      hl      = BS.length h
+                  in if | even hl   -> (BS.take (hl + prefix) inp, t)
+                        | otherwise -> let (p, s') = BS.splitAt (BS.length h + 1) s
+                                       in go (prefix + BS.length p) s'
+
+
 -- ---------------------------------------------------------------------
 -- Reducing 'ByteString's
 

tests/bytestring-tests/Properties/Common.hs

@@ -21,6 +21,7 @@
 module Properties.ShortByteString.Word16 (tests) where
 import System.OsPath.Data.ByteString.Short.Internal (_nul, isSpace)
 import qualified System.OsPath.Data.ByteString.Short.Word16 as B
+import qualified System.OsPath.Data.ByteString.Short as BS
 #else
 module Properties.ShortByteString (tests) where
 import qualified System.OsPath.Data.ByteString.Short as B
@@ -148,6 +149,28 @@ tests =
   , ("mempty []",
     once $ B.unpack mempty === [])
 
+#ifdef WORD16
+  , ("isInfixOf works correctly under UTF16",
+    once $
+      let foo    = BS.pack [0xbb, 0x03]
+          foo'   = BS.pack [0xd2, 0xbb]
+          bar    = BS.pack [0xd2, 0xbb, 0x03, 0xad]
+          bar'   = BS.pack [0xd2, 0xbb, 0x03, 0xad, 0xd2, 0xbb, 0x03, 0xad, 0xbb, 0x03, 0x00, 0x00]
+      in [B.isInfixOf foo bar, B.isInfixOf foo' bar, B.isInfixOf foo bar'] === [False, True, True]
+    )
+#endif
+  , ("break breakSubstring",
+    property $ \(toElem -> c) x -> B.break (== c) x === B.breakSubstring (B.singleton c) x
+    )
+  , ("breakSubstring",
+    property $ \x y -> not (B.null x) ==> B.null (snd (B.breakSubstring x y)) === not (B.isInfixOf x y)
+    )
+  , ("breakSubstring empty",
+    property $ \x -> B.breakSubstring B.empty x === (B.empty, x)
+    )
+  , ("isInfixOf",
+    property $ \x y -> B.isInfixOf x y === L.isInfixOf (B.unpack x) (B.unpack y))
+
   , ("mconcat" ,
    property $ \xs -> B.unpack (mconcat xs) === mconcat (map B.unpack xs))
   , ("mconcat [x,x]" ,