diff --git a/benchmark-text/Main.hs b/benchmark-text/Main.hs --- a/benchmark-text/Main.hs +++ b/benchmark-text/Main.hs @@ -40,7 +40,7 @@ {-# NOINLINE smallSample #-} smallSample :: Sample -smallSample (Subject text (<>) mempty run) = +smallSample (Subject text (<>) _ run) = run $ text "abcd" <> (text "ABCD" <> text "Фываолдж") diff --git a/library/TextBuilderDev.hs b/library/TextBuilderDev.hs --- a/library/TextBuilderDev.hs +++ b/library/TextBuilderDev.hs @@ -218,33 +218,49 @@ intervalInSeconds @Double <$> arbitrary ] -instance IsomorphicTo TextBuilder TextBuilder where - to = id +instance IsSome TextBuilder Text where + to = TextBuilderDev.text -instance IsomorphicTo TextBuilder String where - to = TextBuilderDev.string +instance IsSome Text TextBuilder where + to = TextBuilderDev.buildText -instance IsomorphicTo TextBuilder Text where - to = TextBuilderDev.text +instance Is Text TextBuilder -instance IsomorphicTo TextBuilder TextLazy.Text where +instance Is TextBuilder Text + +instance IsSome TextBuilder TextLazy.Text where to = TextBuilderDev.lazyText -instance IsomorphicTo TextBuilder TextLazyBuilder.Builder where +instance IsSome TextLazy.Text TextBuilder where + to = to . to @Text + +instance Is TextLazy.Text TextBuilder + +instance Is TextBuilder TextLazy.Text + +instance IsSome TextBuilder TextLazyBuilder.Builder where to = to . to @TextLazy.Text -instance IsomorphicTo String TextBuilder where +instance IsSome TextLazyBuilder.Builder TextBuilder where to = to . to @Text -instance IsomorphicTo Text TextBuilder where - to = TextBuilderDev.buildText +instance Is TextLazyBuilder.Builder TextBuilder -instance IsomorphicTo TextLazy.Text TextBuilder where - to = to . to @Text +instance Is TextBuilder TextLazyBuilder.Builder -instance IsomorphicTo TextLazyBuilder.Builder TextBuilder where - to = to . to @Text +#if MIN_VERSION_text(2,0,2) +instance IsSome TextBuilder TextEncoding.StrictBuilder where + to = to . TextEncoding.strictBuilderToText + +instance IsSome TextEncoding.StrictBuilder TextBuilder where + to = TextEncoding.textToStrictBuilder . to + +instance Is TextBuilder TextEncoding.StrictBuilder + +instance Is TextEncoding.StrictBuilder TextBuilder + +#endif -- * Accessors -- | Get the amount of characters. @@ -380,7 +396,7 @@ {-# INLINEABLE unsignedDecimal #-} unsignedDecimal :: (Integral a) => a -> TextBuilder unsignedDecimal = - foldMap (decimalDigit . fromIntegral) . Unfoldr.decimalDigits + foldMap decimalDigit . Unfoldr.decimalDigits fixedUnsignedDecimal :: (Integral a) => Int -> a -> TextBuilder fixedUnsignedDecimal size val = @@ -403,7 +419,7 @@ processRightmostDigit value = case divMod value 10 of (value, digit) -> - processAnotherDigit [decimalDigit (fromIntegral digit)] 1 value + processAnotherDigit [decimalDigit digit] (1 :: Int) value processAnotherDigit builders index value = if value == 0 then mconcat builders @@ -412,12 +428,12 @@ if mod index 3 == 0 then processAnotherDigit - (decimalDigit (fromIntegral digit) : char separatorChar : builders) + (decimalDigit digit : char separatorChar : builders) (succ index) value else processAnotherDigit - (decimalDigit (fromIntegral digit) : builders) + (decimalDigit digit : builders) (succ index) value @@ -457,13 +473,13 @@ remainder = byDivisor - byExtraTen * 10 in if remainder == 0 || byExtraTen >= 10 then thousandSeparatedDecimal separatorChar byExtraTen - else thousandSeparatedDecimal separatorChar byExtraTen <> "." <> decimalDigit (fromIntegral remainder) + else thousandSeparatedDecimal separatorChar byExtraTen <> "." <> decimalDigit remainder -- | Unsigned binary number. {-# INLINE unsignedBinary #-} unsignedBinary :: (Integral a) => a -> TextBuilder unsignedBinary = - foldMap (decimalDigit . fromIntegral) . Unfoldr.binaryDigits + foldMap decimalDigit . Unfoldr.binaryDigits -- | A less general but faster alternative to 'unsignedBinary'. finiteBitsUnsignedBinary :: (FiniteBits a) => a -> TextBuilder @@ -477,7 +493,7 @@ {-# INLINE unsignedPaddedBinary #-} unsignedPaddedBinary :: (Integral a, FiniteBits a) => a -> TextBuilder unsignedPaddedBinary a = - padFromLeft (finiteBitSize a) '0' $ foldMap (decimalDigit . fromIntegral) $ Unfoldr.binaryDigits a + padFromLeft (finiteBitSize a) '0' $ foldMap decimalDigit $ Unfoldr.binaryDigits a -- | Hexadecimal representation of an integral value. {-# INLINE hexadecimal #-} @@ -491,7 +507,7 @@ {-# INLINE unsignedHexadecimal #-} unsignedHexadecimal :: (Integral a) => a -> TextBuilder unsignedHexadecimal = - foldMap (hexadecimalDigit . fromIntegral) . Unfoldr.hexadecimalDigits + foldMap hexadecimalDigit . Unfoldr.hexadecimalDigits -- | Decimal digit. {-# INLINE decimalDigit #-} @@ -605,7 +621,7 @@ -- Directly applicable to 'DiffTime' and 'NominalDiffTime'. {-# INLINEABLE intervalInSeconds #-} intervalInSeconds :: (RealFrac seconds) => seconds -> TextBuilder -intervalInSeconds interval = flip evalState (round interval) $ do +intervalInSeconds interval = flip evalState (round interval :: Int) $ do seconds <- state (swap . flip divMod 60) minutes <- state (swap . flip divMod 60) hours <- state (swap . flip divMod 24) diff --git a/library/TextBuilderDev/Allocator.hs b/library/TextBuilderDev/Allocator.hs --- a/library/TextBuilderDev/Allocator.hs +++ b/library/TextBuilderDev/Allocator.hs @@ -117,7 +117,7 @@ {-# INLINEABLE text #-} text :: Text -> Allocator #if MIN_VERSION_text(2,0,0) -text text@(TextInternal.Text array offset length) = +text (TextInternal.Text array offset length) = Allocator writer length where writer = @@ -125,7 +125,7 @@ TextArray.copyI length builderArray builderOffset array offset return $ builderOffset + length #else -text text@(TextInternal.Text array offset length) = +text (TextInternal.Text array offset length) = Allocator writer length where writer = diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -58,11 +58,11 @@ $ \(text :: Text) (c :: Char) -> B.buildText (B.unicodeCodePoint (Char.ord c) <> B.text text) === Text.cons c text, 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 "59s" $ assertEqual "" "00:00:00:59" $ B.buildText $ B.intervalInSeconds @Double 59, + testCase "minute" $ assertEqual "" "00:00:01:00" $ B.buildText $ B.intervalInSeconds @Double 60, + testCase "90s" $ assertEqual "" "00:00:01:30" $ B.buildText $ B.intervalInSeconds @Double 90, + testCase "hour" $ assertEqual "" "00:01:00:00" $ B.buildText $ B.intervalInSeconds @Double 3600, + testCase "day" $ assertEqual "" "01:00:00:00" $ B.buildText $ B.intervalInSeconds @Double 86400 ], testGroup "By function name" $ [ testGroup "utf8CodeUnitsN" @@ -112,10 +112,10 @@ 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)), + assertEqual "" "0" (B.buildText (B.thousandSeparatedUnsignedDecimal @Integer ',' 0)) + assertEqual "" "123" (B.buildText (B.thousandSeparatedUnsignedDecimal @Integer ',' 123)) + assertEqual "" "1,234" (B.buildText (B.thousandSeparatedUnsignedDecimal @Integer ',' 1234)) + assertEqual "" "1,234,567" (B.buildText (B.thousandSeparatedUnsignedDecimal @Integer ',' 1234567)), testCase "padFromLeft" $ do assertEqual "" "00" (B.buildText (B.padFromLeft 2 '0' "")) assertEqual "" "00" (B.buildText (B.padFromLeft 2 '0' "0")) @@ -134,20 +134,20 @@ testGroup "hexadecimal" $ [ testProperty "show isomorphism" $ \(x :: Integer) -> x >= 0 ==> - (fromString . showHex x) "" === (B.buildText . B.hexadecimal) x, + (fromString . showHex x) "" === (B.buildText . B.hexadecimal @Integer) x, testCase "Positive" - $ assertEqual "" "1f23" (B.buildText (B.hexadecimal 0x01f23)), + $ assertEqual "" "1f23" (B.buildText (B.hexadecimal @Integer 0x01f23)), testCase "Negative" - $ assertEqual "" "-1f23" (B.buildText (B.hexadecimal (-0x01f23))) + $ assertEqual "" "-1f23" (B.buildText (B.hexadecimal @Integer (-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)), + assertEqual "" "999B" (B.buildText (B.dataSizeInBytesInDecimal @Integer ',' 999)) + assertEqual "" "1kB" (B.buildText (B.dataSizeInBytesInDecimal @Integer ',' 1000)) + assertEqual "" "1.1kB" (B.buildText (B.dataSizeInBytesInDecimal @Integer ',' 1100)) + assertEqual "" "1.1MB" (B.buildText (B.dataSizeInBytesInDecimal @Integer ',' 1150000)) + assertEqual "" "9.9MB" (B.buildText (B.dataSizeInBytesInDecimal @Integer ',' 9990000)) + assertEqual "" "10MB" (B.buildText (B.dataSizeInBytesInDecimal @Integer ',' 10100000)) + assertEqual "" "1,000YB" (B.buildText (B.dataSizeInBytesInDecimal @Integer ',' 1000000000000000000000000000)), testCase "fixedDouble" $ do assertEqual "" "0.0" (B.buildText (B.fixedDouble 1 0.05)) assertEqual "" "0.1" (B.buildText (B.fixedDouble 1 0.06)) @@ -180,7 +180,7 @@ testGroup "utcTimeInIso8601" $ [ testProperty "Same as iso8601Show" $ \x -> let roundedToSecondsTime = - x {utctDayTime = (fromIntegral . round . utctDayTime) x} + x {utctDayTime = (fromIntegral @Int . round . utctDayTime) x} in (fromString . flip mappend "Z" . take 19 . iso8601Show) roundedToSecondsTime === B.buildText (B.utcTimeInIso8601 roundedToSecondsTime) ] diff --git a/text-builder-dev.cabal b/text-builder-dev.cabal --- a/text-builder-dev.cabal +++ b/text-builder-dev.cabal @@ -1,8 +1,8 @@ cabal-version: 3.0 -name: text-builder-dev -version: 0.3.6 -category: Text, Builders -synopsis: Edge of developments for "text-builder" +name: text-builder-dev +version: 0.3.7 +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. @@ -10,22 +10,20 @@ 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 -maintainer: Nikita Volkov -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 +maintainer: Nikita Volkov +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: - NoImplicitPrelude - NoMonomorphismRestriction BangPatterns ConstraintKinds DataKinds @@ -47,6 +45,8 @@ MagicHash MultiParamTypeClasses MultiWayIf + NoImplicitPrelude + NoMonomorphismRestriction NumericUnderscores OverloadedStrings ParallelListComp @@ -63,11 +63,11 @@ TypeOperators ViewPatterns - default-language: Haskell2010 + default-language: Haskell2010 library - import: base-settings - hs-source-dirs: library + import: base-settings + hs-source-dirs: library exposed-modules: TextBuilderDev other-modules: TextBuilderDev.Allocator @@ -77,51 +77,51 @@ TextBuilderDev.Utf8View build-depends: - , base >=4.11 && <5 - , bytestring >=0.10 && <0.13 - , 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 + QuickCheck >=2.14 && <3, + base >=4.11 && <5, + bytestring >=0.10 && <0.13, + deferred-folds >=0.9.10.1 && <0.10, + isomorphism-class >=0.2.1.1 && <0.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: - , base-compat >=0.13 - , 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 + base-compat >=0.13, + 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 && <2 - , 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 && <2 - , text-builder-dev + criterion >=1.5.13.0 && <2, + rerebase >=1 && <2, + text-builder-dev,