diff --git a/CHANGES.markdown b/CHANGES.markdown index 25550f9..d19b040 100644 --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,13 @@ +## Changes in next + - Backport `bitDefault`, `testBitDefault`, and `popCountDefault` in + `Data.Bits.Compat` to all versions of `base` + - Backport `toIntegralSized` to `base-4.7` + - Backport `nub` and `nubBy` (as well as `union` and `unionBy`, which are + implemented in terms of them) to fix logic error in `Data.List.Compat` + - Backport `byteSwap16`, `byteSwap32`, and `byteSwap64` to `Data.Word.Compat` + - Backport `fillBytes` in `Foreign.Marshal.Utils.Compat` + - Backport `showFFloatAlt` and `showGFloatAlt` to `Numeric.Compat` + ## Changes in 0.8.1.1 - Fixed Windows build diff --git a/README.markdown b/README.markdown index de104d4..024c066 100644 --- a/README.markdown +++ b/README.markdown @@ -89,6 +89,8 @@ So far the following is covered. * `Text.Read.Compat.readMaybe` * `Text.Read.Compat.readEither` * `Data.Monoid.Compat.<>` + * Added `bitDefault`, `testBitDefault`, and `popCountDefault` to `Data.Bits.Compat` + * Added `toIntegralSized` to `Data.Bits.Compat` (if using `base-4.7`) * Added `bool` function to `Data.Bool.Compat` * Added `isLeft` and `isRight` to `Data.Either.Compat` * Added `withMVarMasked` function to `Control.Concurrent.MVar.Compat` @@ -97,11 +99,15 @@ So far the following is covered. * `(&)` function to `Data.Function.Compat` * `($>)` and `void` functions to `Data.Functor.Compat` * `dropWhileEnd`, `isSubsequenceOf`, `sortOn`, and `uncons` functions to `Data.List.Compat` + * Correct versions of `nub`, `nubBy`, `union`, and `unionBy` to `Data.List.Compat` * `makeVersion` function to `Data.Version.Compat` * `traceId`, `traceShowId`, `traceM`, and `traceShowM` functions to `Debug.Trace.Compat` + * `byteSwap16`, `byteSwap32`, and `byteSwap64` to `Data.Word.Compat` * `calloc` and `callocBytes` functions to `Foreign.Marshal.Alloc.Compat` * `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` * `lookupEnv`, `setEnv` and `unsetEnv` to `System.Environment.Compat` ## Supported versions of GHC/base diff --git a/base-compat.cabal b/base-compat.cabal index a0dcafe..4f00a69 100644 --- a/base-compat.cabal +++ b/base-compat.cabal @@ -49,6 +49,7 @@ library exposed-modules: Control.Concurrent.MVar.Compat Control.Monad.Compat + Data.Bits.Compat Data.Bool.Compat Data.Either.Compat Data.Foldable.Compat @@ -57,11 +58,14 @@ library Data.List.Compat Data.Monoid.Compat Data.Version.Compat + Data.Word.Compat Debug.Trace.Compat Foreign.Compat Foreign.Marshal.Alloc.Compat Foreign.Marshal.Array.Compat Foreign.Marshal.Compat + Foreign.Marshal.Utils.Compat + Numeric.Compat Prelude.Compat System.Environment.Compat System.Exit.Compat diff --git a/src/Data/Bits/Compat.hs b/src/Data/Bits/Compat.hs new file mode 100644 index 0000000..783202b --- /dev/null +++ b/src/Data/Bits/Compat.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE BangPatterns, PatternGuards #-} +module Data.Bits.Compat ( + module Base +, bitDefault +, testBitDefault +, popCountDefault +#if MIN_VERSION_base(4,7,0) +, toIntegralSized +#endif +) where + +import Data.Bits as Base + +#if !(MIN_VERSION_base(4,8,0)) +import Prelude +#endif + +#if !(MIN_VERSION_base(4,6,0)) +-- | Default implementation for 'bit'. +-- +-- Note that: @bitDefault i = 1 `shiftL` i@ +-- +-- /Since: 4.6.0.0/ +bitDefault :: (Bits a, Num a) => Int -> a +bitDefault = \i -> 1 `shiftL` i +{-# INLINE bitDefault #-} + +-- | Default implementation for 'testBit'. +-- +-- Note that: @testBitDefault x i = (x .&. bit i) /= 0@ +-- +-- /Since: 4.6.0.0/ +testBitDefault :: (Bits a, Num a) => a -> Int -> Bool +testBitDefault = \x i -> (x .&. bit i) /= 0 +{-# INLINE testBitDefault #-} + +-- | Default implementation for 'popCount'. +-- +-- This implementation is intentionally naive. Instances are expected to provide +-- an optimized implementation for their size. +-- +-- /Since: 4.6.0.0/ +popCountDefault :: (Bits a, Num a) => a -> Int +popCountDefault = go 0 + where + go !c 0 = c + go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant +{-# INLINABLE popCountDefault #-} +#endif + +#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0)) +-- | Attempt to convert an 'Integral' type @a@ to an 'Integral' type @b@ using +-- the size of the types as measured by 'Bits' methods. +-- +-- A simpler version of this function is: +-- +-- > toIntegral :: (Integral a, Integral b) => a -> Maybe b +-- > toIntegral x +-- > | toInteger x == y = Just (fromInteger y) +-- > | otherwise = Nothing +-- > where +-- > y = toInteger x +-- +-- This version requires going through 'Integer', which can be inefficient. +-- However, @toIntegralSized@ is optimized to allow GHC to statically determine +-- the relative type sizes (as measured by 'bitSizeMaybe' and 'isSigned') and +-- avoid going through 'Integer' for many types. (The implementation uses +-- 'fromIntegral', which is itself optimized with rules for @base@ types but may +-- go through 'Integer' for some type pairs.) +-- +-- /Since: 4.8.0.0/ + +toIntegralSized :: (Integral a, Integral b, Bits a, Bits b) => a -> Maybe b +toIntegralSized x -- See Note [toIntegralSized optimization] + | maybe True (<= x) yMinBound + , maybe True (x <=) yMaxBound = Just y + | otherwise = Nothing + where + y = fromIntegral x + + xWidth = bitSizeMaybe x + yWidth = bitSizeMaybe y + + yMinBound + | isBitSubType x y = Nothing + | isSigned x, not (isSigned y) = Just 0 + | isSigned x, isSigned y + , Just yW <- yWidth = Just (negate $ bit (yW-1)) -- Assumes sub-type + | otherwise = Nothing + + yMaxBound + | isBitSubType x y = Nothing + | isSigned x, not (isSigned y) + , Just xW <- xWidth, Just yW <- yWidth + , xW <= yW+1 = Nothing -- Max bound beyond a's domain + | Just yW <- yWidth = if isSigned y + then Just (bit (yW-1)-1) + else Just (bit yW-1) + | otherwise = Nothing +{-# INLINEABLE toIntegralSized #-} + +-- | 'True' if the size of @a@ is @<=@ the size of @b@, where size is measured +-- by 'bitSizeMaybe' and 'isSigned'. +isBitSubType :: (Bits a, Bits b) => a -> b -> Bool +isBitSubType x y + -- Reflexive + | xWidth == yWidth, xSigned == ySigned = True + + -- Every integer is a subset of 'Integer' + | ySigned, Nothing == yWidth = True + | not xSigned, not ySigned, Nothing == yWidth = True + + -- Sub-type relations between fixed-with types + | xSigned == ySigned, Just xW <- xWidth, Just yW <- yWidth = xW <= yW + | not xSigned, ySigned, Just xW <- xWidth, Just yW <- yWidth = xW < yW + + | otherwise = False + where + xWidth = bitSizeMaybe x + xSigned = isSigned x + + yWidth = bitSizeMaybe y + ySigned = isSigned y +{-# INLINE isBitSubType #-} +#endif diff --git a/src/Data/List/Compat.hs b/src/Data/List/Compat.hs index 5f09c29..06db88f 100644 --- a/src/Data/List/Compat.hs +++ b/src/Data/List/Compat.hs @@ -21,10 +21,14 @@ module Data.List.Compat ( , minimum , minimumBy , notElem +, nub +, nubBy , null , or , product , sum +, union +, unionBy , mapAccumL , mapAccumR @@ -61,10 +65,14 @@ import Data.List as Base hiding ( , minimum , minimumBy , notElem + , nub + , nubBy , null , or , product , sum + , union + , unionBy , mapAccumL , mapAccumR ) @@ -141,4 +149,54 @@ scanl' = scanlGo' scanlGo' f !q ls = q : (case ls of [] -> [] x:xs -> scanlGo' f (f q x) xs) + +-- | /O(n^2)/. The 'nub' function removes duplicate elements from a list. +-- In particular, it keeps only the first occurrence of each element. +-- (The name 'nub' means \`essence\'.) +-- It is a special case of 'nubBy', which allows the programmer to supply +-- their own equality test. +nub :: (Eq a) => [a] -> [a] +nub = nubBy (==) + + +-- | The 'nubBy' function behaves just like 'nub', except it uses a +-- user-supplied equality predicate instead of the overloaded '==' +-- function. +nubBy :: (a -> a -> Bool) -> [a] -> [a] +-- stolen from HBC +nubBy eq l = nubBy' l [] + where + nubBy' [] _ = [] + nubBy' (y:ys) xs + | elem_by eq y xs = nubBy' ys xs + | otherwise = y : nubBy' ys (y:xs) + +-- Not exported: +-- Note that we keep the call to `eq` with arguments in the +-- same order as in the reference (prelude) implementation, +-- and that this order is different from how `elem` calls (==). +-- See #2528, #3280 and #7913. +-- 'xs' is the list of things we've seen so far, +-- 'y' is the potential new element +elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool +elem_by _ _ [] = False +elem_by eq y (x:xs) = x `eq` y || elem_by eq y xs + +-- | The 'union' function returns the list union of the two lists. +-- For example, +-- +-- > "dog" `union` "cow" == "dogcw" +-- +-- Duplicates, and elements of the first list, are removed from the +-- the second list, but if the first list contains duplicates, so will +-- the result. +-- It is a special case of 'unionBy', which allows the programmer to supply +-- their own equality test. + +union :: (Eq a) => [a] -> [a] -> [a] +union = unionBy (==) + +-- | The 'unionBy' function is the non-overloaded version of 'union'. +unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] +unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs #endif diff --git a/src/Data/Word/Compat.hs b/src/Data/Word/Compat.hs new file mode 100644 index 0000000..0135e0d --- /dev/null +++ b/src/Data/Word/Compat.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE CPP, NoImplicitPrelude #-} +module Data.Word.Compat ( + module Base +, byteSwap16 +, byteSwap32 +, byteSwap64 +) where + +import Data.Word as Base + +#if !(MIN_VERSION_base(4,7,0)) +import Data.Bits + +-- | Swap bytes in 'Word16'. +-- +-- /Since: 4.7.0.0/ +byteSwap16 :: Word16 -> Word16 +byteSwap16 w = ((w `shiftR` 8) .&. 0x00ff) + .|. ((w .&. 0x00ff) `shiftL` 8) + +-- | Reverse order of bytes in 'Word32'. +-- +-- /Since: 4.7.0.0/ +byteSwap32 :: Word32 -> Word32 +byteSwap32 w = ((w .&. 0xff000000) `shiftR` 24) + .|. ((w .&. 0x00ff0000) `shiftR` 8) + .|. ((w .&. 0x0000ff00) `shiftL` 8) + .|. ((w .&. 0x000000ff) `shiftL` 24) + +-- | Reverse order of bytes in 'Word64'. +-- +-- /Since: 4.7.0.0/ +byteSwap64 :: Word64 -> Word64 +byteSwap64 w = ((w .&. 0xff00000000000000) `shiftR` 56) + .|. ((w .&. 0x00ff000000000000) `shiftR` 40) + .|. ((w .&. 0x0000ff0000000000) `shiftR` 24) + .|. ((w .&. 0x000000ff00000000) `shiftR` 8) + .|. ((w .&. 0x00000000ff000000) `shiftL` 8) + .|. ((w .&. 0x0000000000ff0000) `shiftL` 24) + .|. ((w .&. 0x000000000000ff00) `shiftL` 40) + .|. ((w .&. 0x00000000000000ff) `shiftL` 56) +#endif diff --git a/src/Foreign/Marshal/Compat.hs b/src/Foreign/Marshal/Compat.hs index ce2cf24..8b75f75 100644 --- a/src/Foreign/Marshal/Compat.hs +++ b/src/Foreign/Marshal/Compat.hs @@ -3,8 +3,10 @@ module Foreign.Marshal.Compat ( module Base , module Alloc , module Array +, module Utils ) where import Foreign.Marshal as Base import Foreign.Marshal.Alloc.Compat as Alloc import Foreign.Marshal.Array.Compat as Array +import Foreign.Marshal.Utils.Compat as Utils diff --git a/src/Foreign/Marshal/Utils/Compat.hs b/src/Foreign/Marshal/Utils/Compat.hs new file mode 100644 index 0000000..b1d0b62 --- /dev/null +++ b/src/Foreign/Marshal/Utils/Compat.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE ForeignFunctionInterface #-} +module Foreign.Marshal.Utils.Compat ( + module Base +, fillBytes +) where + +import Foreign.Marshal.Utils as Base + +#if !(MIN_VERSION_base(4,8,0)) +import Data.Word (Word8) +import Foreign.C.Types +import Foreign.Ptr +import Prelude + +-- |Fill a given number of bytes in memory area with a byte value. +-- +-- /Since: 4.8.0.0/ +fillBytes :: Ptr a -> Word8 -> Int -> IO () +fillBytes dest char size = do + _ <- memset dest (fromIntegral char) (fromIntegral size) + return () + +foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO (Ptr a) +#endif diff --git a/src/Numeric/Compat.hs b/src/Numeric/Compat.hs new file mode 100644 index 0000000..bcc7742 --- /dev/null +++ b/src/Numeric/Compat.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE CPP, NoImplicitPrelude #-} +module Numeric.Compat ( + module Base +, showFFloatAlt +, showGFloatAlt +) where + +import Numeric as Base + +#if !(MIN_VERSION_base(4,7,0)) +import Data.Char (intToDigit) +import GHC.Float +import Prelude + +-- | Show a signed 'RealFloat' value +-- using standard decimal notation (e.g. @245000@, @0.0015@). +-- +-- This behaves as 'showFFloat', except that a decimal point +-- is always guaranteed, even if not needed. +-- +-- /Since: 4.7.0.0/ +showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS +showFFloatAlt d x = showString (formatRealFloatAlt FFFixed d True x) + +-- | Show a signed 'RealFloat' value +-- using standard decimal notation for arguments whose absolute value lies +-- between @0.1@ and @9,999,999@, and scientific notation otherwise. +-- +-- This behaves as 'showFFloat', except that a decimal point +-- is always guaranteed, even if not needed. +-- +-- /Since: 4.7.0.0/ +showGFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS +showGFloatAlt d x = showString (formatRealFloatAlt FFGeneric d True x) + +formatRealFloatAlt :: (RealFloat a) => FFFormat -> Maybe Int -> Bool -> a + -> String +formatRealFloatAlt fmt decs alt x + | isNaN x = "NaN" + | isInfinite x = if x < 0 then "-Infinity" else "Infinity" + | x < 0 || isNegativeZero x = '-':doFmt fmt (floatToDigits (toInteger base) (-x)) + | otherwise = doFmt fmt (floatToDigits (toInteger base) x) + where + base = 10 + + doFmt format (is, e) = + let ds = map intToDigit is in + case format of + FFGeneric -> + doFmt (if e < 0 || e > 7 then FFExponent else FFFixed) + (is,e) + FFExponent -> + case decs of + Nothing -> + let show_e' = show (e-1) in + case ds of + "0" -> "0.0e0" + [d] -> d : ".0e" ++ show_e' + (d:ds') -> d : '.' : ds' ++ "e" ++ show_e' + [] -> error "formatRealFloat/doFmt/FFExponent: []" + Just dec -> + let dec' = max dec 1 in + case is of + [0] -> '0' :'.' : take dec' (repeat '0') ++ "e0" + _ -> + let + (ei,is') = roundTo base (dec'+1) is + (d:ds') = map intToDigit (if ei > 0 then init is' else is') + in + d:'.':ds' ++ 'e':show (e-1+ei) + FFFixed -> + let + mk0 ls = case ls of { "" -> "0" ; _ -> ls} + in + case decs of + Nothing + | e <= 0 -> "0." ++ replicate (-e) '0' ++ ds + | otherwise -> + let + f 0 s rs = mk0 (reverse s) ++ '.':mk0 rs + f n s "" = f (n-1) ('0':s) "" + f n s (r:rs) = f (n-1) (r:s) rs + in + f e "" ds + Just dec -> + let dec' = max dec 0 in + if e >= 0 then + let + (ei,is') = roundTo base (dec' + e) is + (ls,rs) = splitAt (e+ei) (map intToDigit is') + in + mk0 ls ++ (if null rs && not alt then "" else '.':rs) + else + let + (ei,is') = roundTo base dec' (replicate (-e) 0 ++ is) + d:ds' = map intToDigit (if ei > 0 then is' else 0:is') + in + d : (if null ds' && not alt then "" else '.':ds') +#endif diff --git a/test/Data/Bits/CompatSpec.hs b/test/Data/Bits/CompatSpec.hs new file mode 100644 index 0000000..17748f1 --- /dev/null +++ b/test/Data/Bits/CompatSpec.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE CPP #-} +module Data.Bits.CompatSpec (main, spec) where + +import Test.Hspec +import Data.Bits.Compat + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "bitDefault" $ + it "sets the ith bit with all other bits clear" $ do + bitDefault 0 `shouldBe` (1 :: Int) + bitDefault 1 `shouldBe` (2 :: Int) + bitDefault 2 `shouldBe` (4 :: Int) + bitDefault 3 `shouldBe` (8 :: Int) + describe "testBitDefault" $ + it "returns True if the nth bit of the argument is 1" $ do + testBitDefault (10 :: Int) 0 `shouldBe` False + testBitDefault (10 :: Int) 1 `shouldBe` True + testBitDefault (10 :: Int) 2 `shouldBe` False + testBitDefault (10 :: Int) 3 `shouldBe` True + describe "popCountDefault" $ + it "returns the number of set bits in the argument" $ do + popCountDefault (0 :: Int) `shouldBe` 0 + popCountDefault (1 :: Int) `shouldBe` 1 + popCountDefault (10 :: Int) `shouldBe` 2 +#if MIN_VERSION_base(4,7,0) + describe "toIntegralSized" $ + it "converts an Integral type to another as measured by bitSizeMaybe" $ do + toIntegralSized (42 :: Integer) `shouldBe` (Just 42 :: Maybe Int) + toIntegralSized (12345678901234567890 :: Integer) `shouldBe` (Nothing :: Maybe Int) +#endif diff --git a/test/Data/List/CompatSpec.hs b/test/Data/List/CompatSpec.hs index b3532b2..71afe14 100644 --- a/test/Data/List/CompatSpec.hs +++ b/test/Data/List/CompatSpec.hs @@ -3,6 +3,12 @@ module Data.List.CompatSpec (main, spec) where import Test.Hspec import Data.List.Compat +data Asymmetric = A | B deriving Show + +instance Eq Asymmetric where + A == _ = True + B == _ = False + main :: IO () main = hspec spec @@ -16,6 +22,12 @@ spec = do it "returns True if the first list is a subsequence of the second list" $ do isSubsequenceOf "GHC" "The Glorious Haskell Compiler" `shouldBe` True isSubsequenceOf "JHC" "The Glorious Haskell Compiler" `shouldBe` False + describe "nub" $ + it "preserves the order of arguments to (==)" $ + nub [A, B] `shouldBe` [A] + describe "nubBy" $ + it "preserves the order of arguments to the equality function" $ + nubBy (<) "12" `shouldBe` "1" describe "sortOn" $ do it "sorts a list by comparing the results of a key function applied to each element" $ do sortOn (>='b') "cba" `shouldBe` "acb" @@ -23,3 +35,9 @@ spec = do it "decomposes a list into its head and tail" $ do uncons "" `shouldBe` Nothing uncons "12" `shouldBe` Just ('1', "2") + describe "union" $ + it "nubs arguments in the same order as (==)" $ do + union [A] [A, B] `shouldBe` [A] + describe "unionBy" $ + it "nubs arguments in the same order as nubBy's equality function" $ do + unionBy (<) "1" "21" `shouldBe` "11" diff --git a/test/Data/Word/CompatSpec.hs b/test/Data/Word/CompatSpec.hs new file mode 100644 index 0000000..e14d7de --- /dev/null +++ b/test/Data/Word/CompatSpec.hs @@ -0,0 +1,22 @@ +module Data.Word.CompatSpec (main, spec) where + +import Test.Hspec +import Data.Word.Compat + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "byteSwap16" $ + it "reverses the order of bytes in a Word16 value" $ do + byteSwap16 0x1100 `shouldBe` 0x0011 + byteSwap16 0x1010 `shouldBe` 0x1010 + describe "byteSwap32" $ + it "reverses the order of bytes in a Word32 value" $ do + byteSwap32 0x11001010 `shouldBe` 0x10100011 + byteSwap32 0x10101111 `shouldBe` 0x11111010 + describe "byteSwap64" $ + it "reverses the order of bytes in a Word64 value" $ do + byteSwap64 0x1010111110101111 `shouldBe` 0x1111101011111010 + byteSwap64 0x1100000000000011 `shouldBe` 0x1100000000000011 diff --git a/test/Foreign/Marshal/Utils/CompatSpec.hs b/test/Foreign/Marshal/Utils/CompatSpec.hs new file mode 100644 index 0000000..23f97c3 --- /dev/null +++ b/test/Foreign/Marshal/Utils/CompatSpec.hs @@ -0,0 +1,20 @@ +module Foreign.Marshal.Utils.CompatSpec (main, spec) where + +import Test.Hspec + +import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils.Compat +import Foreign.Ptr +import Foreign.Storable + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "fillBytes" $ + it "fills a given number of bytes in memory area with a byte value" $ do + alloca $ \ptr -> do + let _ = ptr :: Ptr Int + fillBytes ptr 0 $ sizeOf ptr + peek ptr `shouldReturn` 0 diff --git a/test/Numeric/CompatSpec.hs b/test/Numeric/CompatSpec.hs new file mode 100644 index 0000000..824bb1a --- /dev/null +++ b/test/Numeric/CompatSpec.hs @@ -0,0 +1,24 @@ +module Numeric.CompatSpec (main, spec) where + +import Test.Hspec +import Numeric.Compat + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "showFFloatAlt" $ do + it "shows a RealFloat value, always using decimal notation" $ + showFFloatAlt Nothing (12 :: Double) "" `shouldBe` "12.0" + it "allows to specify the number of decimal places" $ + showFFloatAlt (Just 4) (12 :: Double) "" `shouldBe` "12.0000" + describe "showGFloatAlt" $ do + it "shows a RealFloat value, using decimal notation if the absolute value lies between 0.1 and 9,999,999" $ + showGFloatAlt Nothing (12 :: Double) "" `shouldBe` "12.0" + it "shows a RealFloat value, using decimal notation and specifying the number of decimal places" $ + showGFloatAlt (Just 4) (12 :: Double) "" `shouldBe` "12.0000" + it "shows a RealFloat value, using scientific notation if the absolute value falls outside of the range" $ + 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"