GHC-9.0 Support and Semigroup-Monoid Compatability

.gitignore

@@ -2,3 +2,4 @@ dist
 cabal.sandbox.config
 .cabal-sandbox
 .stack-work
+stack.yaml.lock

CHANGELOG.md

@@ -0,0 +1,16 @@
+
+
+
+
+
+# 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.  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'.
+

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

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"

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 <~>

Data/Text/Format/Int.hs

@@ -18,19 +18,28 @@ 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)
-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
@@ -52,11 +61,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 +81,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
@@ -99,10 +108,15 @@ 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)
+    | i < 0     = minus <~> go (-i)
     | otherwise = go i
   where
     go n | n < maxInt = int (fromInteger n)
@@ -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,16 +157,24 @@ 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
+                        | 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"
 
+#if __GLASGOW_HASKELL__ < 900
     putB (n:ns) = case n `quotRemInteger` maxInt of
-                    PAIR(x,y) -> pblock q <> pblock r <> putB ns
+#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
     putB _ = mempty
@@ -153,6 +183,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

Data/Text/Format/Types/Internal.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
 
 -- |
 -- Module      : Data.Text.Format.Types.Internal
@@ -46,6 +46,11 @@ 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)
     mempty = Format mempty

stack.yaml

@@ -4,4 +4,18 @@ flags:
 packages:
 - '.'
 extra-deps: []
-resolver: lts-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

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,14 @@ 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