Backport functions introduced in base-4.16

Checks off the `base-4.16.0.0` boxes in #24.

base-compat-batteries/base-compat-batteries.cabal

@@ -136,6 +136,7 @@ library
       System.IO.Error.Compat
       System.IO.Unsafe.Compat
       Text.Read.Compat
+      Text.Read.Lex.Compat
       Type.Reflection.Compat
 
       Control.Concurrent.Compat.Repl.Batteries
@@ -196,6 +197,7 @@ library
       System.IO.Error.Compat.Repl.Batteries
       System.IO.Unsafe.Compat.Repl.Batteries
       Text.Read.Compat.Repl.Batteries
+      Text.Read.Lex.Compat.Repl.Batteries
       Type.Reflection.Compat.Repl.Batteries
 test-suite spec
   type:

base-compat-batteries/src/Text/Read/Lex/Compat.hs

@@ -0,0 +1,6 @@
+{-# LANGUAGE CPP, NoImplicitPrelude, PackageImports #-}
+module Text.Read.Lex.Compat (
+  module Base
+) where
+
+import "base-compat" Text.Read.Lex.Compat as Base

base-compat-batteries/src/Text/Read/Lex/Compat/Repl/Batteries.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE PackageImports #-}
+{-# OPTIONS_GHC -fno-warn-dodgy-exports -fno-warn-unused-imports #-}
+-- | Reexports "Text.Read.Lex.Compat"
+-- from a globally unique namespace.
+module Text.Read.Lex.Compat.Repl.Batteries (
+  module Text.Read.Lex.Compat
+) where
+import "this" Text.Read.Lex.Compat

base-compat-batteries/test/Numeric/CompatSpec.hs

@@ -22,3 +22,24 @@ spec = do
       showGFloatAlt Nothing  (1234567890 :: Double) "" `shouldBe` "1.23456789e9"
     it "shows a RealFloat value, using scientific notation and specifying the number of decimal places" $
       showGFloatAlt (Just 4) (1234567890 :: Double) "" `shouldBe` "1.2346e9"
+  describe "readBin" $ do
+    it "parses an entirely binary Integer" $
+      readBinInteger "00000111" `shouldBe` [(7, "")]
+    it "does not parse a non-binary Integer" $
+      readBinInteger "-24" `shouldBe` []
+    it "parses the binary prefix of an Integer" $
+      readBinInteger "1011784372843778438743" `shouldBe` [(11,"784372843778438743")]
+  describe "showBin" $ do
+    it "shows small Ints in base 2" $
+      map (\ x -> showBinInt x "") [1..32] `shouldBe`
+        [ "1","10","11","100","101","110","111","1000","1001","1010","1011","1100","1101","1110","1111"
+        , "10000","10001","10010","10011","10100","10101","10110","10111","11000"
+        , "11001","11010","11011","11100","11101","11110","11111","100000" ]
+    it "shows a large Int in base 2" $
+      showBinInt 241324784 "" `shouldBe` "1110011000100101001011110000"
+  where
+    readBinInteger :: ReadS Integer
+    readBinInteger = readBin
+
+    showBinInt :: Int -> ShowS
+    showBinInt = showBin

base-compat-batteries/test/SafeHaskellSpec.hs

@@ -59,6 +59,7 @@ import System.Exit.Compat ()
 import System.IO.Compat ()
 import System.IO.Error.Compat ()
 import Text.Read.Compat ()
+import Text.Read.Lex.Compat ()
 import Type.Reflection.Compat ()
 
 main :: IO ()

base-compat/CHANGES.markdown

@@ -2,6 +2,8 @@
  - Sync with `base-4.16`/GHC 9.2
  - `Data.Semigroup.Compat{.Repl}` no longer re-exports the `Option` data type
    or the `option` function, as both have been removed in `base-4.16`.
+ - Backport `readBin` and `showBin` to `Numeric.Compat`
+ - Backport `readBinP` to `Text.Read.Lex.Compat`
 
 ## Changes in 0.11.2 [2020.09.30]
  - Sync with `base-4.15`/GHC 9.0

base-compat/README.markdown

@@ -145,7 +145,7 @@ So far the following is covered.
  * `callocArray` and `callocArray0` functions to `Foreign.Marshal.Array.Compat`
  * `fillBytes` to `Foreign.Marshal.Utils.Compat`
  * Added `Data.List.Compat.scanl'`
- * `showFFloatAlt` and `showGFloatAlt` to `Numeric.Compat`
+ * `showFFloatAlt`, `showGFloatAlt`, `readBin`, and `showBin` to `Numeric.Compat`
  * `lookupEnv`, `setEnv` and `unsetEnv` to `System.Environment.Compat`
  * `unsafeFixIO` and `unsafeDupablePerformIO` to `System.IO.Unsafe.IO`
  * `RuntimeRep`-polymorphic `($!)` to `Prelude.Compat`
@@ -154,6 +154,7 @@ So far the following is covered.
    `isResourceVanishedErrorType` to `System.IO.Error.Compat`
  * `singleton` to `Data.List.Compat` and `Data.List.NonEmpty.Compat`
  * `hGetContents'`, `getContents'`, and `readFile'` to `System.IO.Compat`
+ * `readBinP` to `Text.Read.Lex.Compat`
 
 ## What is not covered
 
@@ -306,6 +307,7 @@ on, paired with the things that each library backports:
 
 ## Supported versions of GHC/`base`
 
+ * `ghc-9.2.*`  / `base-4.16.*`
  * `ghc-9.0.*`  / `base-4.15.*`
  * `ghc-8.10.*` / `base-4.14.*`
  * `ghc-8.8.*`  / `base-4.13.*`

base-compat/base-compat.cabal

@@ -126,6 +126,7 @@ library
       System.IO.Error.Compat
       System.IO.Unsafe.Compat
       Text.Read.Compat
+      Text.Read.Lex.Compat
       Type.Reflection.Compat
 
       Control.Concurrent.Compat.Repl
@@ -186,4 +187,5 @@ library
       System.IO.Error.Compat.Repl
       System.IO.Unsafe.Compat.Repl
       Text.Read.Compat.Repl
+      Text.Read.Lex.Compat.Repl
       Type.Reflection.Compat.Repl

base-compat/src/Numeric/Compat.hs

@@ -1,20 +1,24 @@
 {-# LANGUAGE CPP, NoImplicitPrelude #-}
 module Numeric.Compat (
   module Base
+, showBin
 , showFFloatAlt
 , showGFloatAlt
 , showHFloat
+, readBin
 ) where
 
 import Numeric as Base
 
 #if !(MIN_VERSION_base(4,7,0))
-import Data.Char (intToDigit)
 import GHC.Float
 #endif
 
-#if !(MIN_VERSION_base(4,11,0))
+#if !(MIN_VERSION_base(4,16,0))
+import Data.Char (intToDigit)
 import Prelude
+import Text.ParserCombinators.ReadP (readP_to_S)
+import qualified Text.Read.Lex.Compat as L
 #endif
 
 #if !(MIN_VERSION_base(4,7,0))
@@ -151,3 +155,16 @@ showHFloat = showString . fmt
               x : more -> x == 0 && allZ more
               []       -> True
 #endif
+
+#if !(MIN_VERSION_base(4,16,0))
+-- | Read an unsigned number in binary notation.
+--
+-- >>> readBin "10011"
+-- [(19,"")]
+readBin :: (Eq a, Num a) => ReadS a
+readBin = readP_to_S L.readBinP
+
+-- | Show /non-negative/ 'Integral' numbers in base 2.
+showBin :: (Integral a, Show a) => a -> ShowS
+showBin = showIntAtBase 2  intToDigit
+#endif

base-compat/src/Text/Read/Lex/Compat.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+module Text.Read.Lex.Compat (
+  module Base
+, readBinP
+) where
+
+import Text.Read.Lex as Base
+
+#if !(MIN_VERSION_base(4,16,0))
+import Data.Char (ord)
+import Prelude
+import Text.ParserCombinators.ReadP (ReadP)
+#endif
+
+#if !(MIN_VERSION_base(4,16,0))
+readBinP :: (Eq a, Num a) => ReadP a
+readBinP = readIntP'2
+{-# SPECIALISE readBinP :: ReadP Integer #-}
+
+readIntP'2 :: (Eq a, Num a) => ReadP a
+readIntP'2 = readIntP 2 isDigit valDigit
+ where
+  isDigit  c = maybe False (const True) (valDig2 c)
+  valDigit c = maybe 0     id           (valDig2 c)
+{-# SPECIALISE readIntP'2 :: ReadP Integer #-}
+
+valDig2 :: Char -> Maybe Int
+valDig2 c
+  | '0' <= c && c <= '1' = Just (ord c - ord '0')
+  | otherwise            = Nothing
+#endif

base-compat/src/Text/Read/Lex/Compat/Repl.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE PackageImports #-}
+{-# OPTIONS_GHC -fno-warn-dodgy-exports -fno-warn-unused-imports #-}
+-- | Reexports "Text.Read.Lex.Compat"
+-- from a globally unique namespace.
+module Text.Read.Lex.Compat.Repl (
+  module Text.Read.Lex.Compat
+) where
+import "this" Text.Read.Lex.Compat