Add test for non-duplication; better name.

Author: galenhuntington

Text.hs

@@ -10,7 +10,8 @@ module Text (
     displayWidth, toMaxWidth, toWidth, byteLength,
     fromBS, isLineSafe,
     encodeFS,
-    drawText, setXtermTitle
+    drawText, setXtermTitle,
+    toBS, -- only used in test suite
 ) where
 
 import Base
@@ -35,12 +36,12 @@ newtype SText = SText ByteString
     deriving newtype (Semigroup, Monoid)
 
 -- | Convenient internal combinator.
-unSText :: SText -> ByteString
-unSText (SText bs) = bs
+toBS :: SText -> ByteString
+toBS (SText bs) = bs
 
 -- | Can be used in lieu of 'displayWidth' for known 1-width-character text.
 byteLength :: SText -> Int
-byteLength = P.length . unSText
+byteLength = P.length . toBS
 
 instance IsString SText where
     fromString = SText . UTF8.fromString . toPrintable
@@ -55,7 +56,7 @@ matches s = match' <$> makeRegexOptsM (compIgnoreCase + compExtended + compNoSub
 
 -- | Possible number.
 readIntM :: SText -> Maybe Int
-readIntM = fmap fst . P.readInt . unSText
+readIntM = fmap fst . P.readInt . toBS
 
 showInt :: Int -> SText
 showInt = SText . P.pack . show
@@ -111,7 +112,7 @@ encodeFS str = do
 
 -- | Sum of the column widths of every codepoint.
 displayWidth :: SText -> Int
-displayWidth = UTF8.foldl (\acc c -> acc + charWidth c) 0 . unSText
+displayWidth = UTF8.foldl (\acc c -> acc + charWidth c) 0 . toBS
 
 -- | These functions truncate with ellipses if needed to get width ≤'w'.
 -- 'toWidth' adds padding as needed so the width is exactly 'w'.
@@ -125,7 +126,7 @@ sizer pad w s@(SText bs)
     | True    = walk 0 bs
   where
     dw = displayWidth s
-    byteTake i = SText . P.take i . unSText
+    byteTake i = SText . P.take i . toBS
     walk !l rest
         | l' >= w = byteTake (byteLength s - P.length rest) s
                         <> mconcat (replicate (w-l) "…")
@@ -146,7 +147,7 @@ foreign import ccall unsafe
 -- | Set xterm title with ANSI escape sequence.
 setXtermTitle :: [SText] -> IO ()
 setXtermTitle strs = do
-    traverse_ (P.hPut stderr) (before : map unSText strs ++ [after])
+    traverse_ (P.hPut stderr) (before : map toBS strs ++ [after])
     hFlush stderr
   where
     before = "\ESC]0;"

test/TextSpec.hs

@@ -5,6 +5,7 @@ import Test.Tasty.HUnit
 
 import Text
 import Data.ByteString.UTF8 as UTF8
+import Data.ByteString.Unsafe qualified as P
 
 -- These tests depend on wcwidth's behavior under a UTF-8 locale and on a
 -- handful of codepoints whose canonical widths are well-known:
@@ -90,13 +91,20 @@ tests = testGroup "Text"
         ]
     , testGroup "fromBS"
         [ testCase "Unicode"   $ fromBS (UTF8.fromString "encöde") @?= "encöde"
-        , testCase "bad bytes" $ fromBS ("no\130b\8y")             @?= "no�b�y"
-        , testCase "bad bytes" $ fromBS ("no\130bsy")              @?= "no�bsy"
-        , testCase "control"   $ fromBS ("nob\8dy")                @?= "nob�dy"
+        , testCase "bad bytes" $ fromBS "no\130b\8y"               @?= "no�b�y"
+        , testCase "bad bytes" $ fromBS "no\130bsy"                @?= "no�bsy"
+        , testCase "control"   $ fromBS "nob\8dy"                  @?= "nob�dy"
+        , testCase "no dupe"   $
+            let bs = UTF8.fromString "schőn" in eqRef bs (toBS $ fromBS bs)
         ]
     ]
 
 
 m :: Maybe Bool -> String -> String -> SText -> TestTree
 m b tag pat str = testCase tag $ ($ str) <$> matches (UTF8.fromString pat) @?= b
 
+-- Test memory reuse.
+eqRef :: ByteString -> ByteString -> Assertion
+eqRef a b =
+    P.unsafeUseAsCStringLen a \a' -> P.unsafeUseAsCStringLen b \b' -> a' @?= b'
+