From bb2fd984302920b1578405ed5b3bf0f6e4c2fad8 Mon Sep 17 00:00:00 2001 From: Nathan Waivio Date: Mon, 5 Jul 2021 16:36:24 -0700 Subject: [PATCH 1/3] Semigroup-Monoid compatibility LTS-12.14 (GHC-8.4) that is changed the previously internal (<>) that had a funkey right assoc to (<~>), and added a Semigroup instance. Added the exitsing benchmark to the 'text-format.cabal' file to ease testing. Added CHANGELOG.md to record changes. --- .gitignore | 1 + Data/Text/Buildable.hs | 8 ++++---- Data/Text/Format.hs | 4 ++-- Data/Text/Format/Functions.hs | 10 +++++----- Data/Text/Format/Int.hs | 20 ++++++++++---------- Data/Text/Format/Types/Internal.hs | 3 +++ stack.yaml | 2 +- text-format.cabal | 14 +++++++++++++- 8 files changed, 39 insertions(+), 23 deletions(-) diff --git a/.gitignore b/.gitignore index 2856f6d..ec3259f 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ dist cabal.sandbox.config .cabal-sandbox .stack-work +stack.yaml.lock diff --git a/Data/Text/Buildable.hs b/Data/Text/Buildable.hs index 4888eb4..63714ee 100644 --- a/Data/Text/Buildable.hs +++ b/Data/Text/Buildable.hs @@ -24,7 +24,7 @@ import Data.Monoid (mempty) import Data.Int (Int8, Int16, Int32, Int64) import Data.Fixed (Fixed, HasResolution, showFixed) import Data.Ratio (Ratio, denominator, numerator) -import Data.Text.Format.Functions ((<>)) +import Data.Text.Format.Functions ((<~>)) import Data.Text.Format.Int (decimal, hexadecimal) import Data.Text.Format.Types (Hex(..), Shown(..)) import Data.Text.Lazy.Builder @@ -120,7 +120,7 @@ instance Buildable Word64 where instance (Integral a, Buildable a) => Buildable (Ratio a) where {-# SPECIALIZE instance Buildable (Ratio Integer) #-} - build a = build (numerator a) <> singleton '/' <> build (denominator a) + build a = build (numerator a) <~> singleton '/' <~> build (denominator a) instance Buildable Float where build = fromText . C.toPrecision 6 . realToFrac @@ -176,10 +176,10 @@ instance Buildable ZonedTime where {-# INLINE build #-} instance Buildable IntPtr where - build p = fromText "0x" <> hexadecimal p + build p = fromText "0x" <~> hexadecimal p instance Buildable WordPtr where - build p = fromText "0x" <> hexadecimal p + build p = fromText "0x" <~> hexadecimal p instance Buildable (Ptr a) where build = build . ptrToWordPtr diff --git a/Data/Text/Format.hs b/Data/Text/Format.hs index 7a7f725..626cba5 100644 --- a/Data/Text/Format.hs +++ b/Data/Text/Format.hs @@ -36,7 +36,7 @@ module Data.Text.Format ) where import Control.Monad.IO.Class (MonadIO(liftIO)) -import Data.Text.Format.Functions ((<>)) +import Data.Text.Format.Functions ((<~>)) import Data.Text.Format.Params (Params(..)) import Data.Text.Format.Types.Internal (Format(..), Only(..), Shown(..)) import Data.Text.Format.Types.Internal (Hex(..)) @@ -65,7 +65,7 @@ build fmt ps = zipParams (crack fmt) (buildParams ps) zipParams :: [Builder] -> [Builder] -> Builder zipParams fragments params = go fragments params - where go (f:fs) (y:ys) = f <> y <> go fs ys + where go (f:fs) (y:ys) = f <~> y <~> go fs ys go [f] [] = f go _ _ = error . LT.unpack $ format "Data.Text.Format.build: {} sites, but {} parameters" diff --git a/Data/Text/Format/Functions.hs b/Data/Text/Format/Functions.hs index f10dd77..19a5455 100644 --- a/Data/Text/Format/Functions.hs +++ b/Data/Text/Format/Functions.hs @@ -13,7 +13,7 @@ module Data.Text.Format.Functions ( - (<>) + (<~>) , i2d ) where @@ -28,8 +28,8 @@ i2d (I# i#) = C# (chr# (ord# '0'# +# i#)) -- | The normal 'mappend' function with right associativity instead of -- left. -(<>) :: Builder -> Builder -> Builder -(<>) = mappend -{-# INLINE (<>) #-} +(<~>) :: Builder -> Builder -> Builder +(<~>) = mappend +{-# INLINE (<~>) #-} -infixr 4 <> +infixr 4 <~> diff --git a/Data/Text/Format/Int.hs b/Data/Text/Format/Int.hs index 37858c9..c17462e 100644 --- a/Data/Text/Format/Int.hs +++ b/Data/Text/Format/Int.hs @@ -18,7 +18,7 @@ module Data.Text.Format.Int import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid (mempty) -import Data.Text.Format.Functions ((<>), i2d) +import Data.Text.Format.Functions ((<~>), i2d) import Data.Text.Lazy.Builder import Data.Word (Word, Word8, Word16, Word32, Word64) import GHC.Base (quotInt, remInt) @@ -52,11 +52,11 @@ decimal :: Integral a => a -> Builder {-# SPECIALIZE decimal :: Word64 -> Builder #-} {-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-} decimal i - | i < 0 = minus <> go (-i) + | i < 0 = minus <~> go (-i) | otherwise = go i where go n | n < 10 = digit n - | otherwise = go (n `quot` 10) <> digit (n `rem` 10) + | otherwise = go (n `quot` 10) <~> digit (n `rem` 10) {-# NOINLINE[0] decimal #-} hexadecimal :: Integral a => a -> Builder @@ -72,11 +72,11 @@ hexadecimal :: Integral a => a -> Builder {-# SPECIALIZE hexadecimal :: Word64 -> Builder #-} {-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-} hexadecimal i - | i < 0 = minus <> go (-i) + | i < 0 = minus <~> go (-i) | otherwise = go i where go n | n < 16 = hexDigit n - | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16) + | otherwise = go (n `quot` 16) <~> hexDigit (n `rem` 16) {-# NOINLINE[0] hexadecimal #-} digit :: Integral a => a -> Builder @@ -102,7 +102,7 @@ integer :: Int -> Integer -> Builder integer 10 (S# i#) = decimal (I# i#) integer 16 (S# i#) = hexadecimal (I# i#) integer base i - | i < 0 = minus <> go (-i) + | i < 0 = minus <~> go (-i) | otherwise = go i where go n | n < maxInt = int (fromInteger n) @@ -137,14 +137,14 @@ integer base i putH (n:ns) = case n `quotRemInteger` maxInt of PAIR(x,y) - | q > 0 -> int q <> pblock r <> putB ns - | otherwise -> int r <> putB ns + | q > 0 -> int q <~> pblock r <~> putB ns + | otherwise -> int r <~> putB ns where q = fromInteger x r = fromInteger y putH _ = error "putH: the impossible happened" putB (n:ns) = case n `quotRemInteger` maxInt of - PAIR(x,y) -> pblock q <> pblock r <> putB ns + PAIR(x,y) -> pblock q <~> pblock r <~> putB ns where q = fromInteger x r = fromInteger y putB _ = mempty @@ -153,6 +153,6 @@ integer base i where loop !d !n | d == 1 = digit n - | otherwise = loop (d-1) q <> digit r + | otherwise = loop (d-1) q <~> digit r where q = n `quotInt` base r = n `remInt` base diff --git a/Data/Text/Format/Types/Internal.hs b/Data/Text/Format/Types/Internal.hs index 2eaccb2..7b14794 100644 --- a/Data/Text/Format/Types/Internal.hs +++ b/Data/Text/Format/Types/Internal.hs @@ -46,6 +46,9 @@ import Data.Typeable (Typeable) newtype Format = Format { fromFormat :: Text } deriving (Eq, Ord, Typeable, Show) +instance Semigroup Format where + Format a <> Format b = Format (a <> b) + instance Monoid Format where Format a `mappend` Format b = Format (a `mappend` b) mempty = Format mempty diff --git a/stack.yaml b/stack.yaml index 3a4ea0b..da6753f 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,4 +4,4 @@ flags: packages: - '.' extra-deps: [] -resolver: lts-3.0 +resolver: lts-12.14 # 11.22 # 9.21 # 7.24 # 6.35 # 3.22 # 3.0 diff --git a/text-format.cabal b/text-format.cabal index 78bc4b5..1f81c5b 100644 --- a/text-format.cabal +++ b/text-format.cabal @@ -1,5 +1,5 @@ name: text-format -version: 0.3.1.1 +version: 0.4.0.0 license: BSD3 license-file: LICENSE homepage: https://github.com/bos/text-format @@ -70,3 +70,15 @@ source-repository head source-repository head type: mercurial location: https://bitbucket.org/bos/text-format + +benchmark bench-text-format + type: exitcode-stdio-1.0 + hs-source-dirs: benchmarks + main-is: Benchmarks.hs + ghc-options: -Wall -O2 + build-depends: + text-format, + text, + criterion, + base >=4.7 && <5 + default-language: Haskell2010 From 37d2cd030e9c2eb17b48b3b29494073ec78b6ebf Mon Sep 17 00:00:00 2001 From: Nathan Waivio Date: Mon, 5 Jul 2021 16:37:49 -0700 Subject: [PATCH 2/3] New Change Log --- CHANGELOG.md | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 CHANGELOG.md diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..9cc1c19 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,15 @@ + + + + + +# 0.4.0.0 + + * Semigroup-Monoid compatibility LTS-12.14 (GHC-8.4), that is, changed + the previously internal (<>) that had a funkey right assoc to (<~>), + and added a Semigroup instance. + * Added the exitsing benchmark to the 'text-format.cabal' file to ease + testing. + * Added CHANGELOG.md to record changes. + + From 6651ff2127ce74deef3b81af896fc1e43f84b3c3 Mon Sep 17 00:00:00 2001 From: Nathan Waivio Date: Mon, 5 Jul 2021 20:42:46 -0700 Subject: [PATCH 3/3] Added GHC-9.0 support and a few backward compatability changes --- CHANGELOG.md | 5 ++-- Data/Text/Format/Int.hs | 38 ++++++++++++++++++++++++++---- Data/Text/Format/Types/Internal.hs | 4 +++- stack.yaml | 16 ++++++++++++- text-format.cabal | 1 - 5 files changed, 55 insertions(+), 9 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9cc1c19..173bcc2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,7 +9,8 @@ the previously internal (<>) that had a funkey right assoc to (<~>), and added a Semigroup instance. * Added the exitsing benchmark to the 'text-format.cabal' file to ease - testing. + testing. Use: 'stack bench text-format:bench-text-format' to run. * Added CHANGELOG.md to record changes. - + * Updated for GHC 9.0 Big Integer changes, changed 'quotRemInteger' to + 'integerQuotRem#' and 'S#' to 'IS'. diff --git a/Data/Text/Format/Int.hs b/Data/Text/Format/Int.hs index c17462e..d950e43 100644 --- a/Data/Text/Format/Int.hs +++ b/Data/Text/Format/Int.hs @@ -22,15 +22,24 @@ import Data.Text.Format.Functions ((<~>), i2d) import Data.Text.Lazy.Builder import Data.Word (Word, Word8, Word16, Word32, Word64) import GHC.Base (quotInt, remInt) -import GHC.Num (quotRemInteger) import GHC.Types (Int(..)) + #ifdef __GLASGOW_HASKELL__ -# if __GLASGOW_HASKELL__ < 611 +#if __GLASGOW_HASKELL__ < 900 +import GHC.Num (quotRemInteger) +#else +import GHC.Num (integerQuotRem#, Integer( IS )) +#endif + +#if __GLASGOW_HASKELL__ < 611 import GHC.Integer.Internals -# else +#endif +#if __GLASGOW_HASKELL__ < 900 import GHC.Integer.GMP.Internals -# endif +#else + +#endif #endif #ifdef INTEGER_GMP @@ -99,8 +108,13 @@ int = decimal data T = T !Integer !Int integer :: Int -> Integer -> Builder +#if __GLASGOW_HASKELL__ < 900 integer 10 (S# i#) = decimal (I# i#) integer 16 (S# i#) = hexadecimal (I# i#) +#else +integer 10 (IS i#) = decimal (I# i#) +integer 16 (IS i#) = hexadecimal (I# i#) +#endif integer base i | i < 0 = minus <~> go (-i) | otherwise = go i @@ -112,12 +126,20 @@ integer base i | p > n = [n] | otherwise = splith p (splitf (p*p) n) +#if __GLASGOW_HASKELL__ < 900 splith p (n:ns) = case n `quotRemInteger` p of +#else + splith p (n:ns) = case n `integerQuotRem#` p of +#endif PAIR(q,r) | q > 0 -> q : r : splitb p ns | otherwise -> r : splitb p ns splith _ _ = error "splith: the impossible happened." +#if __GLASGOW_HASKELL__ < 900 splitb p (n:ns) = case n `quotRemInteger` p of +#else + splitb p (n:ns) = case n `integerQuotRem#` p of +#endif PAIR(q,r) -> q : r : splitb p ns splitb _ _ = [] @@ -135,7 +157,11 @@ integer base i maxDigits | base == 10 = maxDigits10 | otherwise = maxDigits16 +#if __GLASGOW_HASKELL__ < 900 putH (n:ns) = case n `quotRemInteger` maxInt of +#else + putH (n:ns) = case n `integerQuotRem#` maxInt of +#endif PAIR(x,y) | q > 0 -> int q <~> pblock r <~> putB ns | otherwise -> int r <~> putB ns @@ -143,7 +169,11 @@ integer base i r = fromInteger y putH _ = error "putH: the impossible happened" +#if __GLASGOW_HASKELL__ < 900 putB (n:ns) = case n `quotRemInteger` maxInt of +#else + putB (n:ns) = case n `integerQuotRem#` maxInt of +#endif PAIR(x,y) -> pblock q <~> pblock r <~> putB ns where q = fromInteger x r = fromInteger y diff --git a/Data/Text/Format/Types/Internal.hs b/Data/Text/Format/Types/Internal.hs index 7b14794..9d59708 100644 --- a/Data/Text/Format/Types/Internal.hs +++ b/Data/Text/Format/Types/Internal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving #-} -- | -- Module : Data.Text.Format.Types.Internal @@ -46,8 +46,10 @@ import Data.Typeable (Typeable) newtype Format = Format { fromFormat :: Text } deriving (Eq, Ord, Typeable, Show) +#if __GLASGOW_HASKELL__ > 840 instance Semigroup Format where Format a <> Format b = Format (a <> b) +#endif instance Monoid Format where Format a `mappend` Format b = Format (a `mappend` b) diff --git a/stack.yaml b/stack.yaml index da6753f..5c5beaf 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,4 +4,18 @@ flags: packages: - '.' extra-deps: [] -resolver: lts-12.14 # 11.22 # 9.21 # 7.24 # 6.35 # 3.22 # 3.0 +#resolver: nightly-2021-07-04 +#resolver: lts-17.2 +#resolver: lts-16.31 #(skipped because of GHC panic) +#resolver: lts-16.11 +#reslover: lts-15.3 +#resolver: lts-14.27 +#resolver: lts-13.19 +#resolver: lts-13.11 +#resolver: lts-12.26 +#resolver: lts-12.14 +resolver: lts-11.22 +#resolver: lts-9.21 +#resolver: lts-7.24 +#resolver: lts-6.35 +#resolver: lts-3.22 diff --git a/text-format.cabal b/text-format.cabal index 1f81c5b..3088475 100644 --- a/text-format.cabal +++ b/text-format.cabal @@ -81,4 +81,3 @@ benchmark bench-text-format text, criterion, base >=4.7 && <5 - default-language: Haskell2010