From 180645e9734928d286600d4149871243999931ea Mon Sep 17 00:00:00 2001 From: Ignat Insarov Date: Fri, 12 Apr 2024 13:36:08 +0700 Subject: [PATCH 1/5] Add benchmarks for semigroup methods. --- benchmarks/haskell/Benchmarks/Pure.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/benchmarks/haskell/Benchmarks/Pure.hs b/benchmarks/haskell/Benchmarks/Pure.hs index b5a31fe8..1a9dad12 100644 --- a/benchmarks/haskell/Benchmarks/Pure.hs +++ b/benchmarks/haskell/Benchmarks/Pure.hs @@ -26,6 +26,8 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import qualified Data.Text.Lazy.Encoding as TL +import Data.Semigroup +import Data.List.NonEmpty (NonEmpty((:|))) data Env = Env { bsa :: !BS.ByteString @@ -83,6 +85,14 @@ benchmark kind ~Env{..} = [ benchT $ nf T.concat tl , benchTL $ nf TL.concat tll ] + , bgroup "sconcat" + [ benchT $ nf sconcat (T.empty :| tl) + , benchTL $ nf sconcat (TL.empty :| tll) + ] + , bgroup "stimes" + [ benchT $ nf (stimes (10 :: Int)) ta + , benchTL $ nf (stimes (10 :: Int)) tla + ] , bgroup "cons" [ benchT $ nf (T.cons c) ta , benchTL $ nf (TL.cons c) tla From bf0c3433158ffe18be693efed86c4519dc6a9e7f Mon Sep 17 00:00:00 2001 From: Ignat Insarov Date: Fri, 12 Apr 2024 13:36:32 +0700 Subject: [PATCH 2/5] Add specialized implementation of semigroup methods. --- src/Data/Text.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Data/Text.hs b/src/Data/Text.hs index c14abf6e..eeb40ec2 100644 --- a/src/Data/Text.hs +++ b/src/Data/Text.hs @@ -361,6 +361,8 @@ instance Read Text where -- | @since 1.2.2.0 instance Semigroup Text where (<>) = append + stimes = replicate . P.fromIntegral + sconcat = concat . NonEmptyList.toList instance Monoid Text where mempty = empty From 40ff68dba1f5a7ad9297d0dbcbb3ecb6cba356b8 Mon Sep 17 00:00:00 2001 From: Ignat Insarov Date: Sat, 13 Apr 2024 15:56:20 +0700 Subject: [PATCH 3/5] Check that `stimes` works right in corner cases. --- tests/Tests/Properties.hs | 2 ++ tests/Tests/Properties/CornerCases.hs | 35 +++++++++++++++++++++++++++ text.cabal | 1 + 3 files changed, 38 insertions(+) create mode 100644 tests/Tests/Properties/CornerCases.hs diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs index a01f4058..095e33f1 100644 --- a/tests/Tests/Properties.hs +++ b/tests/Tests/Properties.hs @@ -17,6 +17,7 @@ import Tests.Properties.Read (testRead) import Tests.Properties.Text (testText) import Tests.Properties.Transcoding (testTranscoding) import Tests.Properties.Validate (testValidate) +import Tests.Properties.CornerCases (testCornerCases) tests :: TestTree tests = @@ -30,5 +31,6 @@ tests = testBuilder, testLowLevel, testRead, + testCornerCases, testValidate ] diff --git a/tests/Tests/Properties/CornerCases.hs b/tests/Tests/Properties/CornerCases.hs new file mode 100644 index 00000000..a6ea48b3 --- /dev/null +++ b/tests/Tests/Properties/CornerCases.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +-- | Check that the definitions that are partial crash in the expected ways or +-- return sensible defaults. +module Tests.Properties.CornerCases (testCornerCases) where + +import Control.Exception +import Data.Either +import Data.Semigroup +import Data.Text +import Test.QuickCheck +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) +import Tests.QuickCheckUtils () + +testCornerCases :: TestTree +testCornerCases = + testGroup + "corner cases" + [ testGroup + "stimes" + $ let specimen = stimes :: Integer -> Text -> Text + in [ testProperty + "given a negative number, return empty text" + $ \(Negative number) text -> specimen number text == "" + , testProperty + "given a number that does not fit into Int, evaluate to error call" + $ \(NonNegative number) text -> + (ioProperty . fmap isLeft . try @ErrorCall . evaluate) $ + specimen + (fromIntegral (number :: Int) + fromIntegral (maxBound :: Int) + 1) + text + ] + ] diff --git a/text.cabal b/text.cabal index 9b10c97c..2e953f4f 100644 --- a/text.cabal +++ b/text.cabal @@ -275,6 +275,7 @@ test-suite tests Tests.Properties.Substrings Tests.Properties.Text Tests.Properties.Transcoding + Tests.Properties.CornerCases Tests.Properties.Validate Tests.QuickCheckUtils Tests.RebindableSyntaxTest From 3c475cb58d030b6d903383274b47c357d3025272 Mon Sep 17 00:00:00 2001 From: Ignat Insarov Date: Sat, 13 Apr 2024 16:03:27 +0700 Subject: [PATCH 4/5] Make sure `stimes` works right in corner cases. --- src/Data/Text.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/Data/Text.hs b/src/Data/Text.hs index eeb40ec2..5b70f130 100644 --- a/src/Data/Text.hs +++ b/src/Data/Text.hs @@ -261,7 +261,8 @@ import Data.Word (Word8) import Foreign.C.Types import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt) import qualified GHC.Exts as Exts -import GHC.Int (Int8) +import GHC.Int (Int8, Int (I#)) +import GHC.Num.Integer (Integer(IS, IP, IN)) import GHC.Stack (HasCallStack) import qualified Language.Haskell.TH.Lib as TH import qualified Language.Haskell.TH.Syntax as TH @@ -361,7 +362,14 @@ instance Read Text where -- | @since 1.2.2.0 instance Semigroup Text where (<>) = append - stimes = replicate . P.fromIntegral + + -- | Beware: this function will evaluate to error if the given number does + -- not fit into an @Int@. + stimes howManyTimes = case P.toInteger howManyTimes of + IS howManyTimesInt# -> replicate (I# howManyTimesInt#) + IP _ -> P.error "Data.Text.stimes: given number does not fit into an Int!" + IN _ -> P.const empty + sconcat = concat . NonEmptyList.toList instance Monoid Text where From c314ce25e093195073bd9f79b2e1fc98909a6486 Mon Sep 17 00:00:00 2001 From: Ignat Insarov Date: Sat, 13 Apr 2024 16:33:32 +0700 Subject: [PATCH 5/5] Be abstract of the implementation of `Integer`. The constructors of `Integer` and the module they are exported from all changed between GHC 8 and 9. --- src/Data/Text.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Data/Text.hs b/src/Data/Text.hs index 5b70f130..b5981e2a 100644 --- a/src/Data/Text.hs +++ b/src/Data/Text.hs @@ -261,8 +261,7 @@ import Data.Word (Word8) import Foreign.C.Types import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt) import qualified GHC.Exts as Exts -import GHC.Int (Int8, Int (I#)) -import GHC.Num.Integer (Integer(IS, IP, IN)) +import GHC.Int (Int8) import GHC.Stack (HasCallStack) import qualified Language.Haskell.TH.Lib as TH import qualified Language.Haskell.TH.Syntax as TH @@ -365,10 +364,11 @@ instance Semigroup Text where -- | Beware: this function will evaluate to error if the given number does -- not fit into an @Int@. - stimes howManyTimes = case P.toInteger howManyTimes of - IS howManyTimesInt# -> replicate (I# howManyTimesInt#) - IP _ -> P.error "Data.Text.stimes: given number does not fit into an Int!" - IN _ -> P.const empty + stimes howManyTimes = + let howManyTimesInt = P.fromIntegral howManyTimes :: Int + in if P.fromIntegral howManyTimesInt == howManyTimes + then replicate howManyTimesInt + else P.error "Data.Text.stimes: given number does not fit into an Int!" sconcat = concat . NonEmptyList.toList