diff --git a/base-compat-batteries/base-compat-batteries.cabal b/base-compat-batteries/base-compat-batteries.cabal index 32b2a78..d44703d 100644 --- a/base-compat-batteries/base-compat-batteries.cabal +++ b/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: diff --git a/base-compat-batteries/src/Text/Read/Lex/Compat.hs b/base-compat-batteries/src/Text/Read/Lex/Compat.hs new file mode 100644 index 0000000..204655b --- /dev/null +++ b/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 diff --git a/base-compat-batteries/src/Text/Read/Lex/Compat/Repl/Batteries.hs b/base-compat-batteries/src/Text/Read/Lex/Compat/Repl/Batteries.hs new file mode 100644 index 0000000..0471dfb --- /dev/null +++ b/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 diff --git a/base-compat-batteries/test/Numeric/CompatSpec.hs b/base-compat-batteries/test/Numeric/CompatSpec.hs index 824bb1a..34f1f0f 100644 --- a/base-compat-batteries/test/Numeric/CompatSpec.hs +++ b/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 diff --git a/base-compat-batteries/test/SafeHaskellSpec.hs b/base-compat-batteries/test/SafeHaskellSpec.hs index 01d770e..262da1f 100644 --- a/base-compat-batteries/test/SafeHaskellSpec.hs +++ b/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 () diff --git a/base-compat/CHANGES.markdown b/base-compat/CHANGES.markdown index 41a4a93..aa36e5e 100644 --- a/base-compat/CHANGES.markdown +++ b/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 diff --git a/base-compat/README.markdown b/base-compat/README.markdown index 4614127..9a3eea7 100644 --- a/base-compat/README.markdown +++ b/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.*` diff --git a/base-compat/base-compat.cabal b/base-compat/base-compat.cabal index 9981259..a4bfc30 100644 --- a/base-compat/base-compat.cabal +++ b/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 diff --git a/base-compat/src/Numeric/Compat.hs b/base-compat/src/Numeric/Compat.hs index 60bf98e..a66684e 100644 --- a/base-compat/src/Numeric/Compat.hs +++ b/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 diff --git a/base-compat/src/Text/Read/Lex/Compat.hs b/base-compat/src/Text/Read/Lex/Compat.hs new file mode 100644 index 0000000..efa63e9 --- /dev/null +++ b/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 diff --git a/base-compat/src/Text/Read/Lex/Compat/Repl.hs b/base-compat/src/Text/Read/Lex/Compat/Repl.hs new file mode 100644 index 0000000..1e724c0 --- /dev/null +++ b/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