Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Feature: sconcat and stimes. #580

Draft
wants to merge 5 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
10 changes: 10 additions & 0 deletions benchmarks/haskell/Benchmarks/Pure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
10 changes: 10 additions & 0 deletions src/Data/Text.hs
Original file line number Diff line number Diff line change
Expand Up @@ -362,6 +362,16 @@ instance Read Text where
instance Semigroup Text where
(<>) = append

-- | Beware: this function will evaluate to error if the given number does
-- not fit into an @Int@.
Comment on lines +365 to +366
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sadly it turns out Haddock does not see comments to instance methods. I looked at the documentation generated by cabal haddock — this comment is not rendered. This also seems to be confirmed on the Internet.

I am going to move this comment to the instance.

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

instance Monoid Text where
mempty = empty
mappend = (<>)
Expand Down
2 changes: 2 additions & 0 deletions tests/Tests/Properties.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand All @@ -30,5 +31,6 @@ tests =
testBuilder,
testLowLevel,
testRead,
testCornerCases,
testValidate
]
35 changes: 35 additions & 0 deletions tests/Tests/Properties/CornerCases.hs
Original file line number Diff line number Diff line change
@@ -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
]
]
1 change: 1 addition & 0 deletions text.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down