Implement is{Pref,Suff}ixOf & strip{Suff,Pref}ix

IowaFP · Jan 18, 2018 · fc4b1a3 · fc4b1a3
1 parent d228266
commit fc4b1a3
Show file tree

Hide file tree

Showing 3 changed files with 70 additions and 0 deletions.
diff --git a/src-test/Tests.hs b/src-test/Tests.hs
@@ -40,6 +40,16 @@ qcProps = testGroup "Properties"
   , QC.testProperty "splitAt" $ \t -> let t' = IUT.fromText t
                                           mapBoth f (x,y) = (f x, f y)
                                       in and [ mapBoth IUT.toText (IUT.splitAt i t') == T.splitAt i t | i <- [-5 .. 5+T.length t ] ]
+
+  , QC.testProperty "isSuffixOf" $ \t1 t2 -> IUT.fromText t1 `IUT.isSuffixOf` IUT.fromText t2  == t1 `T.isSuffixOf` t2
+  , QC.testProperty "isPrefixOf" $ \t1 t2 -> IUT.fromText t1 `IUT.isPrefixOf` IUT.fromText t2  == t1 `T.isPrefixOf` t2
+
+  , QC.testProperty "splitAt/isPrefixOf" $ \t ->
+      let t' = IUT.fromText t
+      in and [ IUT.isPrefixOf (fst (IUT.splitAt i t')) t' | i <- [-5 .. 5+T.length t ] ]
+  , QC.testProperty "splitAt/isSuffixOf" $ \t ->
+      let t' = IUT.fromText t
+      in and [ IUT.isSuffixOf (snd (IUT.splitAt i t')) t' | i <- [-5 .. 5+T.length t ] ]
   ]
 
 unitTests = testGroup "Unit-tests"

diff --git a/src/Data/Text/Short.hs b/src/Data/Text/Short.hs
@@ -18,6 +18,10 @@ module Data.Text.Short
     , isAscii
     , (!?)
     , splitAt
+    , isPrefixOf
+    , stripPrefix
+    , isSuffixOf
+    , stripSuffix
 
       -- * Conversions
       -- ** 'String'

diff --git a/src/Data/Text/Short/Internal.hs b/src/Data/Text/Short/Internal.hs
@@ -26,6 +26,10 @@ module Data.Text.Short.Internal
     , Data.Text.Short.Internal.isAscii
     , Data.Text.Short.Internal.splitAt
     , (!?)
+    , isPrefixOf
+    , stripPrefix
+    , isSuffixOf
+    , stripSuffix
 
       -- * Conversions
       -- ** 'String'
@@ -325,6 +329,58 @@ splitAt i st
 
 foreign import ccall unsafe "hs_text_short_index_ofs" c_text_short_index_ofs :: ByteArray# -> CSize -> CSize -> IO CSize
 
+
+-- | \(\mathcal{O}(n)\) Tests whether the first 'ShortText' is a prefix of the second 'ShortText'
+--
+-- @since TBD
+isPrefixOf :: ShortText -> ShortText -> Bool
+isPrefixOf x y
+  | lx > ly = False
+  | lx == 0 = True
+  | otherwise = case PrimOps.compareByteArrays# (toByteArray# x) 0# (toByteArray# y) 0# n# of
+                  0# -> True
+                  _  -> False
+  where
+    !lx@(I# n#) = toLength x
+    !ly = toLength y
+
+-- | \(\mathcal{O}(n)\) Strip prefix from second 'ShortText' argument.
+--
+-- Returns 'Nothing' if first argument is not a prefix of the second argument.
+--
+-- @since TBD
+stripPrefix :: ShortText -> ShortText -> Maybe ShortText
+stripPrefix pfx t
+  | isPrefixOf pfx t = Just $! snd (Data.Text.Short.Internal.splitAt (toLength pfx) t)
+  | otherwise        = Nothing
+
+-- | \(\mathcal{O}(n)\) Tests whether the first 'ShortText' is a suffix of the second 'ShortText'
+--
+-- @since TBD
+isSuffixOf :: ShortText -> ShortText -> Bool
+isSuffixOf x y
+  | lx > ly = False
+  | lx == 0 = True
+  | otherwise = case PrimOps.compareByteArrays# (toByteArray# x) 0# (toByteArray# y) ofs2# n# of
+                  0# -> True
+                  _  -> False
+  where
+    !(I# ofs2#) = ly - lx
+    !lx@(I# n#) = toLength x
+    !ly = toLength y
+
+-- | \(\mathcal{O}(n)\) Strip suffix from second 'ShortText' argument.
+--
+-- Returns 'Nothing' if first argument is not a suffix of the second argument.
+--
+-- @since TBD
+stripSuffix :: ShortText -> ShortText -> Maybe ShortText
+stripSuffix sfx t
+  | isSuffixOf sfx t = Just $! fst (Data.Text.Short.Internal.splitAt pfxLen t)
+  | otherwise        = Nothing
+  where
+    pfxLen = toLength t - toLength sfx
+
 ----------------------------------------------------------------------------
 
 -- | Construct a new 'ShortText' from an existing one by slicing