Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-text-builder-dev for
openSUSE:Factory checked in at 2023-10-18 21:26:06
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-text-builder-dev (Old)
and /work/SRC/openSUSE:Factory/.ghc-text-builder-dev.new.31755 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-text-builder-dev"
Wed Oct 18 21:26:06 2023 rev:2 rq:1118491 version:0.3.4.1
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-text-builder-dev/ghc-text-builder-dev.changes
2023-09-21 22:24:05.559139021 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-text-builder-dev.new.31755/ghc-text-builder-dev.changes
2023-10-18 21:26:25.706262577 +0200
@@ -1,0 +2,6 @@
+Sun Oct 15 09:59:16 UTC 2023 - Peter Simons <psim...@suse.com>
+
+- Update text-builder-dev to version 0.3.4.1.
+ Upstream does not provide a change log file.
+
+-------------------------------------------------------------------
Old:
----
text-builder-dev-0.3.3.2.tar.gz
New:
----
text-builder-dev-0.3.4.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-text-builder-dev.spec ++++++
--- /var/tmp/diff_new_pack.29uDr5/_old 2023-10-18 21:26:26.326285037 +0200
+++ /var/tmp/diff_new_pack.29uDr5/_new 2023-10-18 21:26:26.326285037 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-text-builder-dev
#
-# Copyright (c) 2022 SUSE LLC
+# Copyright (c) 2023 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -20,13 +20,15 @@
%global pkgver %{pkg_name}-%{version}
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.3.3.2
+Version: 0.3.4.1
Release: 0
Summary: Edge of developments for "text-builder"
License: MIT
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRequires: ghc-Cabal-devel
+BuildRequires: ghc-QuickCheck-devel
+BuildRequires: ghc-QuickCheck-prof
BuildRequires: ghc-base-devel
BuildRequires: ghc-base-prof
BuildRequires: ghc-bytestring-devel
@@ -35,19 +37,23 @@
BuildRequires: ghc-deferred-folds-prof
BuildRequires: ghc-isomorphism-class-devel
BuildRequires: ghc-isomorphism-class-prof
+BuildRequires: ghc-quickcheck-instances-devel
+BuildRequires: ghc-quickcheck-instances-prof
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-split-devel
BuildRequires: ghc-split-prof
BuildRequires: ghc-text-devel
BuildRequires: ghc-text-prof
+BuildRequires: ghc-time-devel
+BuildRequires: ghc-time-prof
BuildRequires: ghc-transformers-devel
BuildRequires: ghc-transformers-prof
ExcludeArch: %{ix86}
%if %{with tests}
-BuildRequires: ghc-QuickCheck-devel
-BuildRequires: ghc-QuickCheck-prof
-BuildRequires: ghc-quickcheck-instances-devel
-BuildRequires: ghc-quickcheck-instances-prof
+BuildRequires: ghc-base-compat-devel
+BuildRequires: ghc-base-compat-prof
+BuildRequires: ghc-quickcheck-classes-devel
+BuildRequires: ghc-quickcheck-classes-prof
BuildRequires: ghc-rerebase-devel
BuildRequires: ghc-rerebase-prof
BuildRequires: ghc-tasty-devel
++++++ text-builder-dev-0.3.3.2.tar.gz -> text-builder-dev-0.3.4.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/text-builder-dev-0.3.3.2/benchmark-char/Main.hs
new/text-builder-dev-0.3.4.1/benchmark-char/Main.hs
--- old/text-builder-dev-0.3.3.2/benchmark-char/Main.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/text-builder-dev-0.3.4.1/benchmark-char/Main.hs 2001-09-09
03:46:40.000000000 +0200
@@ -7,20 +7,21 @@
import qualified TextBuilderDev as A
import Prelude
+main :: IO ()
main =
- defaultMain $
- [ subjectBenchmark "builderSubject" builderSubject,
- subjectBenchmark "lazyTextBuilderDevSubject" lazyTextBuilderDevSubject,
- subjectBenchmark "plainTextPackingSubject" plainTextPackingSubject
- ]
+ defaultMain
+ $ [ subjectBenchmark "builderSubject" builderSubject,
+ subjectBenchmark "lazyTextBuilderDevSubject" lazyTextBuilderDevSubject,
+ subjectBenchmark "plainTextPackingSubject" plainTextPackingSubject
+ ]
subjectBenchmark :: String -> Subject -> Benchmark
subjectBenchmark title subject =
- bgroup title $
- [ benchmark "Small input" smallInput subject,
- benchmark "Medium input" mediumInput subject,
- benchmark "Large input" largeInput subject
- ]
+ bgroup title
+ $ [ benchmark "Small input" smallInput subject,
+ benchmark "Medium input" mediumInput subject,
+ benchmark "Large input" largeInput subject
+ ]
benchmark :: String -> [Int] -> Subject -> Benchmark
benchmark title input subject =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/text-builder-dev-0.3.3.2/benchmark-text/Main.hs
new/text-builder-dev-0.3.4.1/benchmark-text/Main.hs
--- old/text-builder-dev-0.3.3.2/benchmark-text/Main.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/text-builder-dev-0.3.4.1/benchmark-text/Main.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,24 +1,24 @@
module Main where
import Criterion.Main
-import qualified Data.Text as D
import qualified Data.Text.Lazy as C
import qualified Data.Text.Lazy.Builder as B
import qualified TextBuilderDev as A
import Prelude
+main :: IO ()
main =
- defaultMain $
- [ subjectBenchmark "builderSubject" builderSubject,
- subjectBenchmark "lazyTextBuilderDevSubject" lazyTextBuilderDevSubject
- ]
+ defaultMain
+ $ [ subjectBenchmark "builderSubject" builderSubject,
+ subjectBenchmark "lazyTextBuilderDevSubject" lazyTextBuilderDevSubject
+ ]
subjectBenchmark :: String -> Subject -> Benchmark
subjectBenchmark title subject =
- bgroup title $
- [ benchmark "Small input" smallSample subject,
- benchmark "Large input" largeSample subject
- ]
+ bgroup title
+ $ [ benchmark "Small input" smallSample subject,
+ benchmark "Large input" largeSample subject
+ ]
benchmark :: String -> Sample -> Subject -> Benchmark
benchmark title sample subject =
@@ -41,13 +41,17 @@
{-# NOINLINE smallSample #-}
smallSample :: Sample
smallSample (Subject text (<>) mempty run) =
- run $
- text "abcd" <> (text "ABCD" <> text "ФÑваолдж") <> text "æ¼¢"
+ run
+ $ text "abcd"
+ <> (text "ABCD" <> text "ФÑваолдж")
+ <> text "æ¼¢"
{-# NOINLINE largeSample #-}
largeSample :: Sample
largeSample (Subject text (<>) mempty run) =
- run $
- foldl' (<>) mempty $
- replicate 100000 $
- text "abcd" <> (text "ABCD" <> text "ФÑваолдж") <> text "æ¼¢"
+ run
+ $ foldl' (<>) mempty
+ $ replicate 100000
+ $ text "abcd"
+ <> (text "ABCD" <> text "ФÑваолдж")
+ <> text "æ¼¢"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/text-builder-dev-0.3.3.2/library/TextBuilderDev/Allocator.hs
new/text-builder-dev-0.3.4.1/library/TextBuilderDev/Allocator.hs
--- old/text-builder-dev-0.3.3.2/library/TextBuilderDev/Allocator.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/text-builder-dev-0.3.4.1/library/TextBuilderDev/Allocator.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,8 +1,10 @@
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
module TextBuilderDev.Allocator
( -- * Execution
allocate,
+ sizeBound,
-- * Definition
Allocator,
@@ -17,6 +19,8 @@
utf8CodeUnits4,
utf16CodeUnits1,
utf16CodeUnits2,
+ finiteBitsUnsignedBinary,
+ fixedUnsignedDecimal,
)
where
@@ -42,6 +46,15 @@
ArrayWriter $ \array offset -> do
offsetAfter1 <- writeL array offset
writeR array offsetAfter1
+ stimes n (ArrayWriter write) =
+ ArrayWriter $ \array ->
+ let go n offset =
+ if n > 0
+ then do
+ offset <- write array offset
+ go (pred n) offset
+ else return offset
+ in go n
instance Monoid ArrayWriter where
{-# INLINE mempty #-}
@@ -58,6 +71,9 @@
frozenArray <- TextArray.unsafeFreeze array
return $ TextInternal.text frozenArray 0 offsetAfter
+sizeBound :: Allocator -> Int
+sizeBound (Allocator _ sizeBound) = sizeBound
+
-- |
-- Specification of how to efficiently construct strict 'Text'.
-- Provides instances of 'Semigroup' and 'Monoid', which have complexity of
/O(1)/.
@@ -73,6 +89,10 @@
where
writer = writer1 <> writer2
estimatedArraySize = estimatedArraySize1 + estimatedArraySize2
+ stimes n (Allocator writer sizeBound) =
+ Allocator
+ (stimes n writer)
+ (sizeBound * fromIntegral n)
instance Monoid Allocator where
{-# INLINE mempty #-}
@@ -88,6 +108,11 @@
force :: Allocator -> Allocator
force = text . allocate
+{-# INLINE sizedWriter #-}
+sizedWriter :: Int -> (forall s. TextArray.MArray s -> Int -> ST s Int) ->
Allocator
+sizedWriter size write =
+ Allocator (ArrayWriter write) size
+
-- | Strict text.
{-# INLINEABLE text #-}
text :: Text -> Allocator
@@ -243,3 +268,48 @@
TextArray.unsafeWrite array (succ offset) unit2
return $ offset + 2
#endif
+
+-- | A less general but faster alternative to 'unsignedBinary'.
+finiteBitsUnsignedBinary :: (FiniteBits a) => a -> Allocator
+finiteBitsUnsignedBinary val =
+ Allocator writer size
+ where
+ writer =
+ ArrayWriter $ \array arrayStartIndex ->
+ let go val arrayIndex =
+ if arrayIndex >= arrayStartIndex
+ then do
+ TextArray.unsafeWrite array arrayIndex
+ $ if testBit val 0 then 49 else 48
+ go (unsafeShiftR val 1) (pred arrayIndex)
+ else return indexAfter
+ indexAfter =
+ arrayStartIndex + size
+ in go val (pred indexAfter)
+ size =
+ max 1 (finiteBitSize val - countLeadingZeros val)
+
+-- | Fixed-length decimal.
+-- Padded with zeros or trimmed depending on whether it's shorter or longer
+-- than specified.
+fixedUnsignedDecimal :: (Integral a) => Int -> a -> Allocator
+fixedUnsignedDecimal size val =
+ sizedWriter size $ \array startOffset ->
+ let offsetAfter = startOffset + size
+ writeValue val offset =
+ if offset >= startOffset
+ then
+ if val /= 0
+ then case divMod val 10 of
+ (val, digit) -> do
+ TextArray.unsafeWrite array offset $ 48 + fromIntegral
digit
+ writeValue val (pred offset)
+ else writePadding offset
+ else return offsetAfter
+ writePadding offset =
+ if offset >= startOffset
+ then do
+ TextArray.unsafeWrite array offset 48
+ writePadding (pred offset)
+ else return offsetAfter
+ in writeValue val (pred offsetAfter)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/text-builder-dev-0.3.3.2/library/TextBuilderDev/Prelude.hs
new/text-builder-dev-0.3.4.1/library/TextBuilderDev/Prelude.hs
--- old/text-builder-dev-0.3.3.2/library/TextBuilderDev/Prelude.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/text-builder-dev-0.3.4.1/library/TextBuilderDev/Prelude.hs
2001-09-09 03:46:40.000000000 +0200
@@ -30,7 +30,7 @@
import Data.Fixed as Exports
import Data.Foldable as Exports
import Data.Function as Exports hiding (id, (.))
-import Data.Functor as Exports
+import Data.Functor as Exports hiding (unzip)
import Data.Functor.Identity as Exports
import Data.IORef as Exports
import Data.Int as Exports
@@ -45,6 +45,7 @@
import Data.Semigroup as Exports
import Data.String as Exports
import Data.Text as Exports (Text)
+import Data.Time as Exports
import Data.Traversable as Exports
import Data.Tuple as Exports
import Data.Unique as Exports
@@ -63,6 +64,7 @@
import GHC.IO.Exception as Exports
import IsomorphismClass as Exports
import Numeric as Exports
+import Numeric.Natural as Exports (Natural)
import System.Environment as Exports
import System.Exit as Exports
import System.IO as Exports
@@ -71,8 +73,8 @@
import System.Mem as Exports
import System.Mem.StableName as Exports
import System.Timeout as Exports
-import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S,
readS_to_P)
-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec,
readPrec_to_P, readPrec_to_S, readS_to_Prec)
+import Test.QuickCheck.Arbitrary as Exports
+import Test.QuickCheck.Instances ()
import Text.Printf as Exports (hPrintf, printf)
import Text.Read as Exports (Read (..), readEither, readMaybe)
import Unsafe.Coerce as Exports
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/text-builder-dev-0.3.3.2/library/TextBuilderDev.hs
new/text-builder-dev-0.3.4.1/library/TextBuilderDev.hs
--- old/text-builder-dev-0.3.3.2/library/TextBuilderDev.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/text-builder-dev-0.3.4.1/library/TextBuilderDev.hs 2001-09-09
03:46:40.000000000 +0200
@@ -45,6 +45,7 @@
-- *** Decimal
decimal,
unsignedDecimal,
+ fixedUnsignedDecimal,
thousandSeparatedDecimal,
thousandSeparatedUnsignedDecimal,
dataSizeInBytesInDecimal,
@@ -52,6 +53,7 @@
-- *** Binary
unsignedBinary,
unsignedPaddedBinary,
+ finiteBitsUnsignedBinary,
-- *** Hexadecimal
hexadecimal,
@@ -66,6 +68,7 @@
doublePercent,
-- ** Time
+ utcTimeInIso8601,
utcTimestampInIso8601,
intervalInSeconds,
@@ -81,6 +84,7 @@
import qualified Data.Text.Lazy as TextLazy
import qualified Data.Text.Lazy.Builder as TextLazyBuilder
import qualified DeferredFolds.Unfoldr as Unfoldr
+import qualified Test.QuickCheck.Gen as QcGen
import qualified TextBuilderDev.Allocator as Allocator
import TextBuilderDev.Prelude hiding (intercalate, length, null)
@@ -149,6 +153,8 @@
TextBuilder
(allocator1 <> allocator2)
(sizeInChars1 + sizeInChars2)
+ stimes n (TextBuilder allocator size) =
+ TextBuilder (stimes n allocator) (size * fromIntegral n)
instance Monoid TextBuilder where
{-# INLINE mempty #-}
@@ -163,6 +169,41 @@
instance Eq TextBuilder where
(==) = on (==) buildText
+instance Arbitrary TextBuilder where
+ arbitrary =
+ QcGen.oneof
+ [ QcGen.scale (flip div 2)
+ $ QcGen.oneof
+ [ (<>) <$> arbitrary <*> arbitrary,
+ sconcat <$> arbitrary,
+ stimes <$> arbitrary @Word8 <*> arbitrary,
+ pure mempty,
+ mconcat <$> arbitrary
+ ],
+ text <$> arbitrary,
+ lazyText <$> arbitrary,
+ string <$> arbitrary,
+ asciiByteString . ByteString.filter (< 128) <$> arbitrary,
+ hexData <$> arbitrary,
+ char <$> arbitrary,
+ decimal @Integer <$> arbitrary,
+ unsignedDecimal @Natural <$> arbitrary,
+ thousandSeparatedDecimal @Integer <$> arbitrary <*> arbitrary,
+ thousandSeparatedUnsignedDecimal @Natural <$> arbitrary <*> arbitrary,
+ dataSizeInBytesInDecimal @Natural <$> arbitrary <*> arbitrary,
+ unsignedBinary @Natural <$> arbitrary,
+ unsignedPaddedBinary @Word <$> arbitrary,
+ finiteBitsUnsignedBinary @Word <$> arbitrary,
+ hexadecimal @Integer <$> arbitrary,
+ unsignedHexadecimal @Natural <$> arbitrary,
+ decimalDigit <$> QcGen.choose @Int (0, 9),
+ hexadecimalDigit <$> QcGen.choose @Int (0, 15),
+ fixedDouble <$> QcGen.choose (0, 19) <*> arbitrary,
+ doublePercent <$> QcGen.choose (0, 19) <*> arbitrary,
+ utcTimestampInIso8601 <$> arbitrary <*> arbitrary <*> arbitrary <*>
arbitrary <*> arbitrary <*> arbitrary,
+ intervalInSeconds @Double <$> arbitrary
+ ]
+
instance IsomorphicTo TextBuilder TextBuilder where
to = id
@@ -315,7 +356,7 @@
-- | Decimal representation of an integral value.
{-# INLINEABLE decimal #-}
-decimal :: Integral a => a -> TextBuilder
+decimal :: (Integral a) => a -> TextBuilder
decimal i =
if i >= 0
then unsignedDecimal i
@@ -323,13 +364,17 @@
-- | Decimal representation of an unsigned integral value.
{-# INLINEABLE unsignedDecimal #-}
-unsignedDecimal :: Integral a => a -> TextBuilder
+unsignedDecimal :: (Integral a) => a -> TextBuilder
unsignedDecimal =
- foldMap decimalDigit . Unfoldr.decimalDigits
+ foldMap (decimalDigit . fromIntegral) . Unfoldr.decimalDigits
+
+fixedUnsignedDecimal :: (Integral a) => Int -> a -> TextBuilder
+fixedUnsignedDecimal size val =
+ TextBuilder (Allocator.fixedUnsignedDecimal size val) size
-- | Decimal representation of an integral value with thousands separated by
the specified character.
{-# INLINEABLE thousandSeparatedDecimal #-}
-thousandSeparatedDecimal :: Integral a => Char -> a -> TextBuilder
+thousandSeparatedDecimal :: (Integral a) => Char -> a -> TextBuilder
thousandSeparatedDecimal separatorChar a =
if a >= 0
then thousandSeparatedUnsignedDecimal separatorChar a
@@ -337,14 +382,14 @@
-- | Decimal representation of an unsigned integral value with thousands
separated by the specified character.
{-# INLINEABLE thousandSeparatedUnsignedDecimal #-}
-thousandSeparatedUnsignedDecimal :: Integral a => Char -> a -> TextBuilder
+thousandSeparatedUnsignedDecimal :: (Integral a) => Char -> a -> TextBuilder
thousandSeparatedUnsignedDecimal separatorChar =
processRightmostDigit
where
processRightmostDigit value =
case divMod value 10 of
(value, digit) ->
- processAnotherDigit [decimalDigit digit] 1 value
+ processAnotherDigit [decimalDigit (fromIntegral digit)] 1 value
processAnotherDigit builders index value =
if value == 0
then mconcat builders
@@ -353,18 +398,18 @@
if mod index 3 == 0
then
processAnotherDigit
- (decimalDigit digit : char separatorChar : builders)
+ (decimalDigit (fromIntegral digit) : char separatorChar :
builders)
(succ index)
value
else
processAnotherDigit
- (decimalDigit digit : builders)
+ (decimalDigit (fromIntegral digit) : builders)
(succ index)
value
-- | Data size in decimal notation over amount of bytes.
{-# INLINEABLE dataSizeInBytesInDecimal #-}
-dataSizeInBytesInDecimal :: Integral a => Char -> a -> TextBuilder
+dataSizeInBytesInDecimal :: (Integral a) => Char -> a -> TextBuilder
dataSizeInBytesInDecimal separatorChar amount =
if amount < 1000
then unsignedDecimal amount <> "B"
@@ -391,30 +436,38 @@
then dividedDecimal separatorChar
100000000000000000000 amount <> "ZB"
else dividedDecimal separatorChar
100000000000000000000000 amount <> "YB"
-dividedDecimal :: Integral a => Char -> a -> a -> TextBuilder
+dividedDecimal :: (Integral a) => Char -> a -> a -> TextBuilder
dividedDecimal separatorChar divisor n =
let byDivisor = div n divisor
byExtraTen = div byDivisor 10
remainder = byDivisor - byExtraTen * 10
in if remainder == 0 || byExtraTen >= 10
then thousandSeparatedDecimal separatorChar byExtraTen
- else thousandSeparatedDecimal separatorChar byExtraTen <> "." <>
decimalDigit remainder
+ else thousandSeparatedDecimal separatorChar byExtraTen <> "." <>
decimalDigit (fromIntegral remainder)
-- | Unsigned binary number.
{-# INLINE unsignedBinary #-}
-unsignedBinary :: Integral a => a -> TextBuilder
+unsignedBinary :: (Integral a) => a -> TextBuilder
unsignedBinary =
- foldMap decimalDigit . Unfoldr.binaryDigits
+ foldMap (decimalDigit . fromIntegral) . Unfoldr.binaryDigits
+
+-- | A less general but faster alternative to 'unsignedBinary'.
+finiteBitsUnsignedBinary :: (FiniteBits a) => a -> TextBuilder
+finiteBitsUnsignedBinary a =
+ TextBuilder allocator size
+ where
+ allocator = Allocator.finiteBitsUnsignedBinary a
+ size = Allocator.sizeBound allocator
-- | Unsigned binary number.
{-# INLINE unsignedPaddedBinary #-}
unsignedPaddedBinary :: (Integral a, FiniteBits a) => a -> TextBuilder
unsignedPaddedBinary a =
- padFromLeft (finiteBitSize a) '0' $ foldMap decimalDigit $
Unfoldr.binaryDigits a
+ padFromLeft (finiteBitSize a) '0' $ foldMap (decimalDigit . fromIntegral) $
Unfoldr.binaryDigits a
-- | Hexadecimal representation of an integral value.
{-# INLINE hexadecimal #-}
-hexadecimal :: Integral a => a -> TextBuilder
+hexadecimal :: (Integral a) => a -> TextBuilder
hexadecimal i =
if i >= 0
then unsignedHexadecimal i
@@ -422,40 +475,40 @@
-- | Unsigned hexadecimal representation of an integral value.
{-# INLINE unsignedHexadecimal #-}
-unsignedHexadecimal :: Integral a => a -> TextBuilder
+unsignedHexadecimal :: (Integral a) => a -> TextBuilder
unsignedHexadecimal =
- foldMap hexadecimalDigit . Unfoldr.hexadecimalDigits
+ foldMap (hexadecimalDigit . fromIntegral) . Unfoldr.hexadecimalDigits
-- | Decimal digit.
{-# INLINE decimalDigit #-}
-decimalDigit :: Integral a => a -> TextBuilder
-decimalDigit n =
- unicodeCodePoint (fromIntegral n + 48)
+decimalDigit :: (Integral a) => a -> TextBuilder
+decimalDigit (fromIntegral -> n) =
+ unicodeCodePoint (n + 48)
-- | Hexadecimal digit.
{-# INLINE hexadecimalDigit #-}
-hexadecimalDigit :: Integral a => a -> TextBuilder
-hexadecimalDigit n =
+hexadecimalDigit :: (Integral a) => a -> TextBuilder
+hexadecimalDigit (fromIntegral -> n) =
if n <= 9
- then unicodeCodePoint (fromIntegral n + 48)
- else unicodeCodePoint (fromIntegral n + 87)
+ then unicodeCodePoint (n + 48)
+ else unicodeCodePoint (n + 87)
-- | Intercalate builders.
{-# INLINE intercalate #-}
-intercalate :: Foldable f => TextBuilder -> f TextBuilder -> TextBuilder
+intercalate :: (Foldable f) => TextBuilder -> f TextBuilder -> TextBuilder
intercalate separator = extract . foldl' step init
where
init = Product2 False mempty
step (Product2 isNotFirst builder) element =
- Product2 True $
- if isNotFirst
+ Product2 True
+ $ if isNotFirst
then builder <> separator <> element
else element
extract (Product2 _ builder) = builder
-- | Intercalate projecting values to builder.
{-# INLINE intercalateMap #-}
-intercalateMap :: Foldable f => TextBuilder -> (a -> TextBuilder) -> f a ->
TextBuilder
+intercalateMap :: (Foldable f) => TextBuilder -> (a -> TextBuilder) -> f a ->
TextBuilder
intercalateMap separator mapper = extract . foldl' step init
where
init = Nothing
@@ -483,6 +536,14 @@
then builder
else builder <> foldMap char (replicate (paddedLength - builderLength)
paddingChar)
+utcTimeInIso8601 :: UTCTime -> TextBuilder
+utcTimeInIso8601 UTCTime {..} =
+ let (year, month, day) = toGregorian utctDay
+ daySeconds = round utctDayTime
+ (dayMinutes, second) = divMod daySeconds 60
+ (hour, minute) = divMod dayMinutes 60
+ in utcTimestampInIso8601 (fromIntegral year) month day hour minute second
+
-- |
-- General template for formatting date values according to the ISO8601
standard.
-- The format is the following:
@@ -506,17 +567,17 @@
TextBuilder
utcTimestampInIso8601 y mo d h mi s =
mconcat
- [ padFromLeft 4 '0' $ decimal y,
+ [ fixedUnsignedDecimal 4 y,
"-",
- padFromLeft 2 '0' $ decimal mo,
+ fixedUnsignedDecimal 2 mo,
"-",
- padFromLeft 2 '0' $ decimal d,
+ fixedUnsignedDecimal 2 d,
"T",
- padFromLeft 2 '0' $ decimal h,
+ fixedUnsignedDecimal 2 h,
":",
- padFromLeft 2 '0' $ decimal mi,
+ fixedUnsignedDecimal 2 mi,
":",
- padFromLeft 2 '0' $ decimal s,
+ fixedUnsignedDecimal 2 s,
"Z"
]
@@ -524,20 +585,20 @@
-- Time interval in seconds.
-- Directly applicable to 'DiffTime' and 'NominalDiffTime'.
{-# INLINEABLE intervalInSeconds #-}
-intervalInSeconds :: RealFrac seconds => seconds -> TextBuilder
+intervalInSeconds :: (RealFrac seconds) => seconds -> TextBuilder
intervalInSeconds interval = flip evalState (round interval) $ do
seconds <- state (swap . flip divMod 60)
minutes <- state (swap . flip divMod 60)
hours <- state (swap . flip divMod 24)
days <- get
- return $
- padFromLeft 2 '0' (decimal days)
- <> ":"
- <> padFromLeft 2 '0' (decimal hours)
- <> ":"
- <> padFromLeft 2 '0' (decimal minutes)
- <> ":"
- <> padFromLeft 2 '0' (decimal seconds)
+ return
+ $ padFromLeft 2 '0' (decimal days)
+ <> ":"
+ <> padFromLeft 2 '0' (decimal hours)
+ <> ":"
+ <> padFromLeft 2 '0' (decimal minutes)
+ <> ":"
+ <> padFromLeft 2 '0' (decimal seconds)
-- | Double with a fixed number of decimal places.
{-# INLINE fixedDouble #-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/text-builder-dev-0.3.3.2/test/Main.hs
new/text-builder-dev-0.3.4.1/test/Main.hs
--- old/text-builder-dev-0.3.3.2/test/Main.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/text-builder-dev-0.3.4.1/test/Main.hs 2001-09-09 03:46:40.000000000
+0200
@@ -3,151 +3,202 @@
import qualified Data.ByteString as ByteString
import qualified Data.Char as Char
import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as TextLazy
import qualified Data.Text.Lazy.Builder as TextLazyBuilder
-import Test.QuickCheck.Instances
+import Numeric.Compat
+import Test.QuickCheck.Classes
+import Test.QuickCheck.Instances ()
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck hiding ((.&.))
import qualified TextBuilderDev as B
import qualified TextBuilderDev.TastyExtras as Extras
-import Prelude hiding (choose)
+import Prelude hiding (choose, showBin)
+main :: IO ()
main =
- defaultMain $
- testGroup "All tests" $
- [ testProperty "ASCII ByteString" $
- let gen = listOf $ do
- list <- listOf (choose (0, 127))
- return (ByteString.pack list)
- in forAll gen $ \chunks ->
- mconcat chunks
- === Text.encodeUtf8 (B.buildText (foldMap B.asciiByteString
chunks)),
- testProperty "Intercalation has the same effect as in Text" $
- \separator texts ->
+ defaultMain
+ $ testGroup "All tests"
+ $ [ testProperty "ASCII ByteString"
+ $ let gen = listOf $ do
+ list <- listOf (choose (0, 127))
+ return (ByteString.pack list)
+ in forAll gen $ \chunks ->
+ mconcat chunks
+ === Text.encodeUtf8 (B.buildText (foldMap
B.asciiByteString chunks)),
+ testProperty "Intercalation has the same effect as in Text"
+ $ \separator texts ->
Text.intercalate separator texts
=== B.buildText (B.intercalate (B.text separator) (fmap B.text
texts)),
- testProperty "intercalateMap sep mapper == intercalate sep . fmap
mapper" $
- \separator ints ->
+ testProperty "intercalateMap sep mapper == intercalate sep . fmap
mapper"
+ $ \separator ints ->
Text.intercalate separator (fmap (fromString . show @Int) ints)
=== B.buildText (B.intercalateMap (B.text separator) B.decimal
ints),
- testProperty "Packing a list of chars is isomorphic to appending a
list of builders" $
- \chars ->
+ testProperty "Packing a list of chars is isomorphic to appending a
list of builders"
+ $ \chars ->
Text.pack chars
=== B.buildText (foldMap B.char chars),
- testProperty "Concatting a list of texts is isomorphic to fold-mapping
with builders" $
- \texts ->
+ testProperty "Concatting a list of texts is isomorphic to fold-mapping
with builders"
+ $ \texts ->
mconcat texts
=== B.buildText (foldMap B.text texts),
- testProperty "Concatting a list of texts is isomorphic to concatting a
list of builders" $
- \texts ->
+ testProperty "Concatting a list of texts is isomorphic to concatting a
list of builders"
+ $ \texts ->
mconcat texts
=== B.buildText (mconcat (map B.text texts)),
- testProperty "Concatting a list of trimmed texts is isomorphic to
concatting a list of builders" $
- \texts ->
+ testProperty "Concatting a list of trimmed texts is isomorphic to
concatting a list of builders"
+ $ \texts ->
let trimmedTexts = fmap (Text.drop 3) texts
in mconcat trimmedTexts
=== B.buildText (mconcat (map B.text trimmedTexts)),
- testProperty "Decimal" $ \(x :: Integer) ->
- (fromString . show) x === (B.buildText (B.decimal x)),
- testProperty "Hexadecimal vs std show" $ \(x :: Integer) ->
- x >= 0 ==>
- (fromString . showHex x) "" === (B.buildText . B.hexadecimal) x,
testProperty "TextBuilderDev.null is isomorphic to Text.null" $ \(text
:: Text) ->
B.null (B.toTextBuilder text) === Text.null text,
- testProperty "(TextBuilderDev.unicodeCodePoint <>) is isomorphic to
Text.cons" $
- withMaxSuccess bigTest $ \(text :: Text) (c :: Char) ->
+ testProperty "(TextBuilderDev.unicodeCodePoint <>) is isomorphic to
Text.cons"
+ $ withMaxSuccess bigTest
+ $ \(text :: Text) (c :: Char) ->
B.buildText (B.unicodeCodePoint (Char.ord c) <> B.text text) ===
Text.cons c text,
- testProperty "(TextBuilderDev.utf8CodeUnitsN <>) is isomorphic to
Text.cons" $
- withMaxSuccess bigTest $ \(text :: Text) (c :: Char) ->
- let cp = Char.ord c
- cuBuilder
- | cp < 0x80 = B.utf8CodeUnits1 (cuAt 0)
- | cp < 0x800 = B.utf8CodeUnits2 (cuAt 0) (cuAt 1)
- | cp < 0x10000 = B.utf8CodeUnits3 (cuAt 0) (cuAt 1) (cuAt 2)
- | otherwise = B.utf8CodeUnits4 (cuAt 0) (cuAt 1) (cuAt 2)
(cuAt 3)
- where
- -- Use Data.Text.Encoding for comparison
- codeUnits = Text.encodeUtf8 $ Text.singleton c
- cuAt = (codeUnits `ByteString.index`)
- in B.buildText (cuBuilder <> B.text text) === Text.cons c text,
- testProperty "TextBuilderDev.utf8CodeUnitsN is isomorphic to
Text.singleton" $
- withMaxSuccess bigTest $ \(c :: Char) ->
- let text = Text.singleton c
- codeUnits = Text.encodeUtf8 text
- cp = Char.ord c
- cuBuilder
- | cp < 0x80 = B.utf8CodeUnits1 (cuAt 0)
- | cp < 0x800 = B.utf8CodeUnits2 (cuAt 0) (cuAt 1)
- | cp < 0x10000 = B.utf8CodeUnits3 (cuAt 0) (cuAt 1) (cuAt 2)
- | otherwise = B.utf8CodeUnits4 (cuAt 0) (cuAt 1) (cuAt 2)
(cuAt 3)
- where
- cuAt = ByteString.index codeUnits
- in B.buildText cuBuilder === text,
- testProperty "(TextBuilderDev.utf16CodeUnitsN <>) is isomorphic to
Text.cons" $
- withMaxSuccess bigTest $ \(text :: Text) (c :: Char) ->
- let cp = Char.ord c
- cuBuilder
- | cp < 0x10000 = B.utf16CodeUnits1 (cuAt 0)
- | otherwise = B.utf16CodeUnits2 (cuAt 0) (cuAt 1)
- where
- -- Use Data.Text.Encoding for comparison
- codeUnits = Text.encodeUtf16LE $ Text.singleton c
- cuAt i =
- (fromIntegral $ codeUnits `ByteString.index` (2 * i))
- .|. ((fromIntegral $ codeUnits `ByteString.index` (2 *
i + 1)) `shiftL` 8)
- in B.buildText (cuBuilder <> B.text text) === Text.cons c text,
- testCase "Separated thousands" $ do
- assertEqual "" "0" (B.buildText (B.thousandSeparatedUnsignedDecimal
',' 0))
- assertEqual "" "123" (B.buildText
(B.thousandSeparatedUnsignedDecimal ',' 123))
- assertEqual "" "1,234" (B.buildText
(B.thousandSeparatedUnsignedDecimal ',' 1234))
- assertEqual "" "1,234,567" (B.buildText
(B.thousandSeparatedUnsignedDecimal ',' 1234567)),
- testCase "Pad from left" $ do
- assertEqual "" "00" (B.buildText (B.padFromLeft 2 '0' ""))
- assertEqual "" "00" (B.buildText (B.padFromLeft 2 '0' "0"))
- assertEqual "" "01" (B.buildText (B.padFromLeft 2 '0' "1"))
- assertEqual "" "12" (B.buildText (B.padFromLeft 2 '0' "12"))
- assertEqual "" "123" (B.buildText (B.padFromLeft 2 '0' "123")),
- testCase "Pad from right" $ do
- assertEqual "" "00" (B.buildText (B.padFromRight 2 '0' ""))
- assertEqual "" "00" (B.buildText (B.padFromRight 2 '0' "0"))
- assertEqual "" "10" (B.buildText (B.padFromRight 2 '0' "1"))
- assertEqual "" "12" (B.buildText (B.padFromRight 2 '0' "12"))
- assertEqual "" "123" (B.buildText (B.padFromRight 2 '0' "123"))
- assertEqual "" "1 " (B.buildText (B.padFromRight 3 ' ' "1")),
- testCase "Hexadecimal" $
- assertEqual "" "1f23" (B.buildText (B.hexadecimal 0x01f23)),
- testCase "Negative Hexadecimal" $
- assertEqual "" "-1f23" (B.buildText (B.hexadecimal (-0x01f23))),
- testGroup "Time interval" $
- [ testCase "59s" $ assertEqual "" "00:00:00:59" $ B.buildText $
B.intervalInSeconds 59,
- testCase "minute" $ assertEqual "" "00:00:01:00" $ B.buildText $
B.intervalInSeconds 60,
- testCase "90s" $ assertEqual "" "00:00:01:30" $ B.buildText $
B.intervalInSeconds 90,
- testCase "hour" $ assertEqual "" "00:01:00:00" $ B.buildText $
B.intervalInSeconds 3600,
- testCase "day" $ assertEqual "" "01:00:00:00" $ B.buildText $
B.intervalInSeconds 86400
- ],
- testCase "dataSizeInBytesInDecimal" $ do
- assertEqual "" "999B" (B.buildText (B.dataSizeInBytesInDecimal ','
999))
- assertEqual "" "1kB" (B.buildText (B.dataSizeInBytesInDecimal ','
1000))
- assertEqual "" "1.1kB" (B.buildText (B.dataSizeInBytesInDecimal ','
1100))
- assertEqual "" "1.1MB" (B.buildText (B.dataSizeInBytesInDecimal ','
1150000))
- assertEqual "" "9.9MB" (B.buildText (B.dataSizeInBytesInDecimal ','
9990000))
- assertEqual "" "10MB" (B.buildText (B.dataSizeInBytesInDecimal ','
10100000))
- assertEqual "" "1,000YB" (B.buildText (B.dataSizeInBytesInDecimal
',' 1000000000000000000000000000)),
- testCase "fixedDouble" $ do
- assertEqual "" "0.0" (B.buildText (B.fixedDouble 1 0.05))
- assertEqual "" "0.1" (B.buildText (B.fixedDouble 1 0.06))
- assertEqual "" "10.0000" (B.buildText (B.fixedDouble 4 10))
- assertEqual "" "0.9000" (B.buildText (B.fixedDouble 4 0.9)),
- testCase "doublePercent" $ do
- assertEqual "" "90.4%" (B.buildText (B.doublePercent 1 0.904)),
- testGroup "IsomorphicToTextBuilder" $
- [ Extras.isomorphismLaws "Text" $ Proxy @Text,
- Extras.isomorphismLaws "Lazy Text" $ Proxy @TextLazy.Text,
- Extras.isomorphismLaws "Lazy Text Builder" $ Proxy
@TextLazyBuilder.Builder,
- Extras.isomorphismLaws "String" $ Proxy @String
- ]
+ testGroup "Time interval"
+ $ [ testCase "59s" $ assertEqual "" "00:00:00:59" $ B.buildText $
B.intervalInSeconds 59,
+ testCase "minute" $ assertEqual "" "00:00:01:00" $ B.buildText $
B.intervalInSeconds 60,
+ testCase "90s" $ assertEqual "" "00:00:01:30" $ B.buildText $
B.intervalInSeconds 90,
+ testCase "hour" $ assertEqual "" "00:01:00:00" $ B.buildText $
B.intervalInSeconds 3600,
+ testCase "day" $ assertEqual "" "01:00:00:00" $ B.buildText $
B.intervalInSeconds 86400
+ ],
+ testGroup "By function name"
+ $ [ testGroup "utf8CodeUnitsN"
+ $ [ testProperty "Text.cons isomporphism"
+ $ withMaxSuccess bigTest
+ $ \(text :: Text) (c :: Char) ->
+ let cp = Char.ord c
+ cuBuilder
+ | cp < 0x80 = B.utf8CodeUnits1 (cuAt 0)
+ | cp < 0x800 = B.utf8CodeUnits2 (cuAt 0) (cuAt 1)
+ | cp < 0x10000 = B.utf8CodeUnits3 (cuAt 0) (cuAt
1) (cuAt 2)
+ | otherwise = B.utf8CodeUnits4 (cuAt 0) (cuAt 1)
(cuAt 2) (cuAt 3)
+ where
+ -- Use Data.Text.Encoding for comparison
+ codeUnits = Text.encodeUtf8 $ Text.singleton c
+ cuAt = (codeUnits `ByteString.index`)
+ in B.buildText (cuBuilder <> B.text text) ===
Text.cons c text,
+ testProperty "Text.singleton isomorphism"
+ $ withMaxSuccess bigTest
+ $ \(c :: Char) ->
+ let text = Text.singleton c
+ codeUnits = Text.encodeUtf8 text
+ cp = Char.ord c
+ cuBuilder
+ | cp < 0x80 = B.utf8CodeUnits1 (cuAt 0)
+ | cp < 0x800 = B.utf8CodeUnits2 (cuAt 0) (cuAt 1)
+ | cp < 0x10000 = B.utf8CodeUnits3 (cuAt 0) (cuAt
1) (cuAt 2)
+ | otherwise = B.utf8CodeUnits4 (cuAt 0) (cuAt 1)
(cuAt 2) (cuAt 3)
+ where
+ cuAt = ByteString.index codeUnits
+ in B.buildText cuBuilder === text
+ ],
+ testGroup "utf16CodeUnitsN"
+ $ [ testProperty "is isomorphic to Text.cons"
+ $ withMaxSuccess bigTest
+ $ \(text :: Text) (c :: Char) ->
+ let cp = Char.ord c
+ cuBuilder
+ | cp < 0x10000 = B.utf16CodeUnits1 (cuAt 0)
+ | otherwise = B.utf16CodeUnits2 (cuAt 0) (cuAt 1)
+ where
+ -- Use Data.Text.Encoding for comparison
+ codeUnits = Text.encodeUtf16LE $
Text.singleton c
+ cuAt i =
+ (fromIntegral $ codeUnits `ByteString.index`
(2 * i))
+ .|. ((fromIntegral $ codeUnits
`ByteString.index` (2 * i + 1)) `shiftL` 8)
+ in B.buildText (cuBuilder <> B.text text) ===
Text.cons c text
+ ],
+ testCase "thousandSeparatedUnsignedDecimal" $ do
+ assertEqual "" "0" (B.buildText
(B.thousandSeparatedUnsignedDecimal ',' 0))
+ assertEqual "" "123" (B.buildText
(B.thousandSeparatedUnsignedDecimal ',' 123))
+ assertEqual "" "1,234" (B.buildText
(B.thousandSeparatedUnsignedDecimal ',' 1234))
+ assertEqual "" "1,234,567" (B.buildText
(B.thousandSeparatedUnsignedDecimal ',' 1234567)),
+ testCase "padFromLeft" $ do
+ assertEqual "" "00" (B.buildText (B.padFromLeft 2 '0' ""))
+ assertEqual "" "00" (B.buildText (B.padFromLeft 2 '0' "0"))
+ assertEqual "" "01" (B.buildText (B.padFromLeft 2 '0' "1"))
+ assertEqual "" "12" (B.buildText (B.padFromLeft 2 '0' "12"))
+ assertEqual "" "123" (B.buildText (B.padFromLeft 2 '0' "123")),
+ testCase "padFromRight" $ do
+ assertEqual "" "00" (B.buildText (B.padFromRight 2 '0' ""))
+ assertEqual "" "00" (B.buildText (B.padFromRight 2 '0' "0"))
+ assertEqual "" "10" (B.buildText (B.padFromRight 2 '0' "1"))
+ assertEqual "" "12" (B.buildText (B.padFromRight 2 '0' "12"))
+ assertEqual "" "123" (B.buildText (B.padFromRight 2 '0' "123"))
+ assertEqual "" "1 " (B.buildText (B.padFromRight 3 ' ' "1")),
+ testProperty "decimal" $ \(x :: Integer) ->
+ (fromString . show) x === (B.buildText (B.decimal x)),
+ testGroup "hexadecimal"
+ $ [ testProperty "show isomorphism" $ \(x :: Integer) ->
+ x >= 0 ==>
+ (fromString . showHex x) "" === (B.buildText .
B.hexadecimal) x,
+ testCase "Positive"
+ $ assertEqual "" "1f23" (B.buildText (B.hexadecimal
0x01f23)),
+ testCase "Negative"
+ $ assertEqual "" "-1f23" (B.buildText (B.hexadecimal
(-0x01f23)))
+ ],
+ testCase "dataSizeInBytesInDecimal" $ do
+ assertEqual "" "999B" (B.buildText (B.dataSizeInBytesInDecimal
',' 999))
+ assertEqual "" "1kB" (B.buildText (B.dataSizeInBytesInDecimal
',' 1000))
+ assertEqual "" "1.1kB" (B.buildText
(B.dataSizeInBytesInDecimal ',' 1100))
+ assertEqual "" "1.1MB" (B.buildText
(B.dataSizeInBytesInDecimal ',' 1150000))
+ assertEqual "" "9.9MB" (B.buildText
(B.dataSizeInBytesInDecimal ',' 9990000))
+ assertEqual "" "10MB" (B.buildText (B.dataSizeInBytesInDecimal
',' 10100000))
+ assertEqual "" "1,000YB" (B.buildText
(B.dataSizeInBytesInDecimal ',' 1000000000000000000000000000)),
+ testCase "fixedDouble" $ do
+ assertEqual "" "0.0" (B.buildText (B.fixedDouble 1 0.05))
+ assertEqual "" "0.1" (B.buildText (B.fixedDouble 1 0.06))
+ assertEqual "" "10.0000" (B.buildText (B.fixedDouble 4 10))
+ assertEqual "" "0.9000" (B.buildText (B.fixedDouble 4 0.9)),
+ testCase "doublePercent" $ do
+ assertEqual "" "90.4%" (B.buildText (B.doublePercent 1 0.904)),
+ testGroup "unsignedBinary"
+ $ [ testProperty "Produces the same output as showBin" $ \(x
:: Natural) ->
+ fromString (showBin x "")
+ === B.buildText (B.unsignedBinary x)
+ ],
+ testGroup "finiteBitsUnsignedBinary"
+ $ [ testProperty "Produces the same output as showBin" $ \(x
:: Word) ->
+ fromString (showBin x "")
+ === B.buildText (B.finiteBitsUnsignedBinary x)
+ ],
+ testGroup "fixedUnsignedDecimal"
+ $ [ testProperty "Same as printf" $ \(size :: Word8, val ::
Natural) ->
+ let rendered = show val
+ renderedLength = length rendered
+ intSize = fromIntegral size
+ padded =
+ if renderedLength > intSize
+ then drop (renderedLength - intSize) rendered
+ else replicate (intSize - renderedLength) '0' <>
rendered
+ in fromString padded
+ === B.buildText (B.fixedUnsignedDecimal
(fromIntegral size) val)
+ ],
+ testGroup "utcTimeInIso8601"
+ $ [ testProperty "Same as iso8601Show" $ \x ->
+ let roundedToSecondsTime =
+ x {utctDayTime = (fromIntegral . round .
utctDayTime) x}
+ in (fromString . flip mappend "Z" . take 19 .
iso8601Show) roundedToSecondsTime
+ === B.buildText (B.utcTimeInIso8601
roundedToSecondsTime)
+ ]
+ ],
+ testGroup "IsomorphicToTextBuilder instances"
+ $ [ Extras.isomorphismLaws "Text" $ Proxy @Text,
+ Extras.isomorphismLaws "Lazy Text" $ Proxy @TextLazy.Text,
+ Extras.isomorphismLaws "Lazy Text Builder" $ Proxy
@TextLazyBuilder.Builder,
+ Extras.isomorphismLaws "String" $ Proxy @String
+ ],
+ testLaws $ showLaws (Proxy @B.TextBuilder),
+ testLaws $ eqLaws (Proxy @B.TextBuilder),
+ testLaws $ semigroupLaws (Proxy @B.TextBuilder),
+ testLaws $ monoidLaws (Proxy @B.TextBuilder)
]
where
bigTest = 10000
+
+testLaws :: Laws -> TestTree
+testLaws Laws {..} =
+ testProperties lawsTypeclass lawsProperties
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/text-builder-dev-0.3.3.2/test/TextBuilderDev/TastyExtras.hs
new/text-builder-dev-0.3.4.1/test/TextBuilderDev/TastyExtras.hs
--- old/text-builder-dev-0.3.3.2/test/TextBuilderDev/TastyExtras.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/text-builder-dev-0.3.4.1/test/TextBuilderDev/TastyExtras.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,10 +1,9 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
module TextBuilderDev.TastyExtras where
-import qualified Data.Text as Text
import qualified Data.Text.Lazy.Builder as TextLazyBuilder
-import Test.QuickCheck.Instances
import Test.Tasty
-import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import qualified TextBuilderDev as B
import Prelude hiding (choose)
@@ -15,10 +14,6 @@
arbitrary =
TextLazyBuilder.fromLazyText <$> arbitrary
-instance Arbitrary B.TextBuilder where
- arbitrary =
- B.lazyText <$> arbitrary
-
-- * --
isomorphismLaws ::
@@ -27,13 +22,16 @@
Proxy a ->
TestTree
isomorphismLaws subject proxy =
- testGroup subject $
- [ testProperty "fromTextBuilder . toTextBuilder == id" $
- (===)
- <$> B.fromTextBuilder . B.toTextBuilder
+ testGroup subject
+ $ [ testProperty "fromTextBuilder . toTextBuilder == id"
+ $ (===)
+ <$> B.fromTextBuilder
+ . B.toTextBuilder
<*> flip asProxyTypeOf proxy,
- testProperty "toTextBuilder . fromTextBuilder == id" $
- (===)
- <$> B.toTextBuilder . flip asProxyTypeOf proxy . B.fromTextBuilder
+ testProperty "toTextBuilder . fromTextBuilder == id"
+ $ (===)
+ <$> B.toTextBuilder
+ . flip asProxyTypeOf proxy
+ . B.fromTextBuilder
<*> id
- ]
+ ]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/text-builder-dev-0.3.3.2/text-builder-dev.cabal
new/text-builder-dev-0.3.4.1/text-builder-dev.cabal
--- old/text-builder-dev-0.3.3.2/text-builder-dev.cabal 2001-09-09
03:46:40.000000000 +0200
+++ new/text-builder-dev-0.3.4.1/text-builder-dev.cabal 2001-09-09
03:46:40.000000000 +0200
@@ -1,85 +1,126 @@
cabal-version: 3.0
-
-name: text-builder-dev
-version: 0.3.3.2
-category: Text
-synopsis: Edge of developments for "text-builder"
+name: text-builder-dev
+version: 0.3.4.1
+category: Text, Builders
+synopsis: Edge of developments for "text-builder"
description:
This is a development version of \"text-builder\".
All experimentation and feature development happens here.
The API can change drastically.
For a more stable API use \"text-builder\",
which is now just a wrapper over this package.
-homepage: https://github.com/nikita-volkov/text-builder-dev
-bug-reports: https://github.com/nikita-volkov/text-builder-dev/issues
-author: Nikita Volkov <nikita.y.vol...@mail.ru>
-maintainer: Nikita Volkov <nikita.y.vol...@mail.ru>
-copyright: (c) 2022, Nikita Volkov
-license: MIT
-license-file: LICENSE
+
+homepage: https://github.com/nikita-volkov/text-builder-dev
+bug-reports: https://github.com/nikita-volkov/text-builder-dev/issues
+author: Nikita Volkov <nikita.y.vol...@mail.ru>
+maintainer: Nikita Volkov <nikita.y.vol...@mail.ru>
+copyright: (c) 2022, Nikita Volkov
+license: MIT
+license-file: LICENSE
source-repository head
- type: git
+ type: git
location: git://github.com/nikita-volkov/text-builder-dev.git
common base-settings
- default-extensions: BangPatterns, ConstraintKinds, DataKinds,
DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor,
DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts,
FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving,
InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash,
MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude,
NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp,
QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables,
StandaloneDeriving, TemplateHaskell, TupleSections, TypeApplications,
TypeFamilies, TypeOperators, ViewPatterns
- default-language: Haskell2010
+ default-extensions:
+ NoImplicitPrelude
+ NoMonomorphismRestriction
+ BangPatterns
+ ConstraintKinds
+ DataKinds
+ DefaultSignatures
+ DeriveDataTypeable
+ DeriveFoldable
+ DeriveFunctor
+ DeriveGeneric
+ DeriveTraversable
+ EmptyDataDecls
+ FlexibleContexts
+ FlexibleInstances
+ FunctionalDependencies
+ GADTs
+ GeneralizedNewtypeDeriving
+ InstanceSigs
+ LambdaCase
+ LiberalTypeSynonyms
+ MagicHash
+ MultiParamTypeClasses
+ MultiWayIf
+ OverloadedStrings
+ ParallelListComp
+ PatternGuards
+ QuasiQuotes
+ RankNTypes
+ RecordWildCards
+ ScopedTypeVariables
+ StandaloneDeriving
+ TemplateHaskell
+ TupleSections
+ TypeApplications
+ TypeFamilies
+ TypeOperators
+ ViewPatterns
+
+ default-language: Haskell2010
library
- import: base-settings
- hs-source-dirs: library
- exposed-modules:
- TextBuilderDev
+ import: base-settings
+ hs-source-dirs: library
+ exposed-modules: TextBuilderDev
other-modules:
TextBuilderDev.Allocator
+ TextBuilderDev.Prelude
TextBuilderDev.Unicode
TextBuilderDev.Utf16View
TextBuilderDev.Utf8View
- TextBuilderDev.Prelude
+
build-depends:
- base >=4.11 && <5,
- bytestring >=0.10 && <0.12,
- deferred-folds >=0.9.10.1 && <0.10,
- isomorphism-class >=0.1.0.1 && <0.2,
- split >=0.2.3.4 && <0.3,
- text >=1.0 && <3,
- transformers >=0.5 && <0.7,
+ , base >=4.11 && <5
+ , bytestring >=0.10 && <0.12
+ , deferred-folds >=0.9.10.1 && <0.10
+ , isomorphism-class >=0.1.0.1 && <0.2
+ , QuickCheck >=2.14 && <3
+ , quickcheck-instances >=0.3.28 && <0.4
+ , split >=0.2.3.4 && <0.3
+ , text >=1.0 && <3
+ , time >=1.12 && <2
+ , transformers >=0.5 && <0.7
test-suite test
- import: base-settings
- type: exitcode-stdio-1.0
+ import: base-settings
+ type: exitcode-stdio-1.0
hs-source-dirs: test
- main-is: Main.hs
- other-modules:
- TextBuilderDev.TastyExtras
+ main-is: Main.hs
+ other-modules: TextBuilderDev.TastyExtras
build-depends:
- QuickCheck >=2.13 && <3,
- quickcheck-instances >=0.3.22 && <0.4,
- rerebase <2,
- tasty >=1.2.3 && <2,
- tasty-hunit >=0.10.0.2 && <0.11,
- tasty-quickcheck >=0.10.1 && <0.11,
- text-builder-dev,
+ , base-compat ^>=0.13.1
+ , quickcheck-classes >=0.6.5 && <0.7
+ , quickcheck-instances >=0.3.28 && <0.4
+ , rerebase <2
+ , tasty >=1.2.3 && <2
+ , tasty-hunit >=0.10.0.2 && <0.11
+ , tasty-quickcheck >=0.10.1 && <0.11
+ , text-builder-dev
benchmark benchmark-text
- import: base-settings
- type: exitcode-stdio-1.0
- ghc-options: -O2
+ import: base-settings
+ type: exitcode-stdio-1.0
+ ghc-options: -O2
hs-source-dirs: benchmark-text
- main-is: Main.hs
+ main-is: Main.hs
build-depends:
- criterion >=1.5.13.0 && <2,
- rerebase ==1.*,
- text-builder-dev,
+ , criterion >=1.5.13.0 && <2
+ , rerebase >=1 && <2
+ , text-builder-dev
benchmark benchmark-char
- import: base-settings
- type: exitcode-stdio-1.0
- ghc-options: -O2
+ import: base-settings
+ type: exitcode-stdio-1.0
+ ghc-options: -O2
hs-source-dirs: benchmark-char
- main-is: Main.hs
+ main-is: Main.hs
build-depends:
- criterion >=1.5.13.0 && <2,
- rerebase ==1.*,
- text-builder-dev,
+ , criterion >=1.5.13.0 && <2
+ , rerebase >=1 && <2
+ , text-builder-dev
