diff --git a/Data/Text.hs b/Data/Text.hs --- a/Data/Text.hs +++ b/Data/Text.hs @@ -689,10 +689,14 @@ -- -- In (unlikely) bad cases, this function's time complexity degrades -- towards /O(n*m)/. -replace :: Text -- ^ @needle@ to search for - -> Text -- ^ @replacement@ to replace @needle@ with - -> Text -- ^ @haystack@ in which to search +replace :: Text + -- ^ @needle@ to search for. If this string is empty, an + -- error will occur. -> Text + -- ^ @replacement@ to replace @needle@ with. + -> Text + -- ^ @haystack@ in which to search. + -> Text replace needle@(Text _ _ neeLen) (Text repArr repOff repLen) haystack@(Text hayArr hayOff hayLen) @@ -1299,9 +1303,9 @@ -- copies to create substrings; they just construct new 'Text's that -- are slices of the original. --- | /O(m+n)/ Break a 'Text' into pieces separated by the first --- 'Text' argument, consuming the delimiter. An empty delimiter is --- invalid, and will cause an error to be raised. +-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text' +-- argument (which cannot be empty), consuming the delimiter. An empty +-- delimiter is invalid, and will cause an error to be raised. -- -- Examples: -- @@ -1314,9 +1318,16 @@ -- > intercalate s . splitOn s == id -- > splitOn (singleton c) == split (==c) -- +-- (Note: the string @s@ to split on above cannot be empty.) +-- -- In (unlikely) bad cases, this function's time complexity degrades -- towards /O(n*m)/. -splitOn :: Text -> Text -> [Text] +splitOn :: Text + -- ^ String to split on. If this string is empty, an error + -- will occur. + -> Text + -- ^ Input text. + -> [Text] splitOn pat@(Text _ _ l) src@(Text arr off len) | l <= 0 = emptyError "splitOn" | isSingleton pat = split (== unsafeHead pat) src diff --git a/Data/Text/Internal/Builder/RealFloat/Functions.hs b/Data/Text/Internal/Builder/RealFloat/Functions.hs --- a/Data/Text/Internal/Builder/RealFloat/Functions.hs +++ b/Data/Text/Internal/Builder/RealFloat/Functions.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- | -- Module: Data.Text.Internal.Builder.RealFloat.Functions -- Copyright: (c) The University of Glasgow 1994-2002 @@ -13,7 +15,31 @@ ) where roundTo :: Int -> [Int] -> (Int,[Int]) + +#if MIN_VERSION_base(4,6,0) + roundTo d is = + case f d True is of + x@(0,_) -> x + (1,xs) -> (1, 1:xs) + _ -> error "roundTo: bad Value" + where + b2 = base `quot` 2 + + f n _ [] = (0, replicate n 0) + f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, []) -- Round to even when at exactly half the base + | otherwise = (if x >= b2 then 1 else 0, []) + f n _ (i:xs) + | i' == base = (1,0:ds) + | otherwise = (0,i':ds) + where + (c,ds) = f (n-1) (even i) xs + i' = c + i + base = 10 + +#else + +roundTo d is = case f d is of x@(0,_) -> x (1,xs) -> (1, 1:xs) @@ -27,3 +53,5 @@ where (c,ds) = f (n-1) xs i' = c + i + +#endif diff --git a/Data/Text/Lazy.hs b/Data/Text/Lazy.hs --- a/Data/Text/Lazy.hs +++ b/Data/Text/Lazy.hs @@ -686,10 +686,14 @@ -- -- In (unlikely) bad cases, this function's time complexity degrades -- towards /O(n*m)/. -replace :: Text -- ^ Text to search for - -> Text -- ^ Replacement text - -> Text -- ^ Input text +replace :: Text + -- ^ @needle@ to search for. If this string is empty, an + -- error will occur. -> Text + -- ^ @replacement@ to replace @needle@ with. + -> Text + -- ^ @haystack@ in which to search. + -> Text replace s d = intercalate d . splitOn s {-# INLINE replace #-} @@ -1299,9 +1303,10 @@ -- copies to create substrings; they just construct new 'Text's that -- are slices of the original. --- | /O(m+n)/ Break a 'Text' into pieces separated by the first --- 'Text' argument, consuming the delimiter. An empty delimiter is --- invalid, and will cause an error to be raised. +-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text' +-- argument (which cannot be an empty string), consuming the +-- delimiter. An empty delimiter is invalid, and will cause an error +-- to be raised. -- -- Examples: -- @@ -1314,13 +1319,18 @@ -- > intercalate s . splitOn s == id -- > splitOn (singleton c) == split (==c) -- +-- (Note: the string @s@ to split on above cannot be empty.) +-- -- This function is strict in its first argument, and lazy in its -- second. -- -- In (unlikely) bad cases, this function's time complexity degrades -- towards /O(n*m)/. -splitOn :: Text -- ^ Text to split on - -> Text -- ^ Input text +splitOn :: Text + -- ^ String to split on. If this string is empty, an error + -- will occur. + -> Text + -- ^ Input text. -> [Text] splitOn pat src | null pat = emptyError "splitOn" diff --git a/Data/Text/Lazy/Encoding.hs b/Data/Text/Lazy/Encoding.hs --- a/Data/Text/Lazy/Encoding.hs +++ b/Data/Text/Lazy/Encoding.hs @@ -89,8 +89,6 @@ -- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII -- encoded text. --- --- This function is deprecated. Use 'decodeLatin1' instead. decodeASCII :: B.ByteString -> Text decodeASCII = decodeUtf8 {-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-} diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +1.2.0.3 + +* Update formatRealFloat to correspond to the definition in versions + of base newer than 4.5 (https://github.com/bos/text/issues/105) + 1.2.0.2 * Bumped lower bound on deepseq to 1.4 for compatibility with the diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs --- a/tests/Tests/Properties.hs +++ b/tests/Tests/Properties.hs @@ -24,7 +24,7 @@ import Data.Text.Lazy.Read as TL import Data.Text.Read as T import Data.Word (Word, Word8, Word16, Word32, Word64) -import Numeric (showHex) +import Numeric (showEFloat, showFFloat, showGFloat, showHex) import Prelude hiding (replicate) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) @@ -779,6 +779,20 @@ tb_realfloat_float (a::Float) = tb_realfloat a tb_realfloat_double (a::Double) = tb_realfloat a +showFloat :: (RealFloat a) => TB.FPFormat -> Maybe Int -> a -> ShowS +showFloat TB.Exponent = showEFloat +showFloat TB.Fixed = showFFloat +showFloat TB.Generic = showGFloat + +tb_formatRealFloat :: (RealFloat a, Show a) => a -> TB.FPFormat -> Precision a -> Property +tb_formatRealFloat a fmt prec = + TB.formatRealFloat fmt p a === + TB.fromString (showFloat fmt p a "") + where p = precision a prec + +tb_formatRealFloat_float (a::Float) = tb_formatRealFloat a +tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a + -- Reading. t_decimal (n::Int) s = @@ -1284,7 +1298,9 @@ ], testGroup "realfloat" [ testProperty "tb_realfloat_double" tb_realfloat_double, - testProperty "tb_realfloat_float" tb_realfloat_float + testProperty "tb_realfloat_float" tb_realfloat_float, + testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float, + testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double ], testProperty "tb_fromText" tb_fromText, testProperty "tb_singleton" tb_singleton diff --git a/tests/Tests/QuickCheckUtils.hs b/tests/Tests/QuickCheckUtils.hs --- a/tests/Tests/QuickCheckUtils.hs +++ b/tests/Tests/QuickCheckUtils.hs @@ -17,6 +17,9 @@ , Small (..) , small + , Precision(..) + , precision + , integralRandomR , DecodeErr (..) @@ -37,10 +40,11 @@ import Control.Exception (bracket) import Data.String (IsString, fromString) import Data.Text.Foreign (I16) +import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) import Data.Word (Word8, Word16) import Debug.Trace (trace) import System.Random (Random (..), RandomGen) -import Test.QuickCheck hiding (Small (..), (.&.)) +import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.)) import Test.QuickCheck.Monadic (assert, monadicIO, run) import Test.QuickCheck.Unicode (string) import Tests.Utils @@ -262,6 +266,30 @@ eql d a b | a =^= b = True | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False + +instance Arbitrary FPFormat where + arbitrary = elements [Exponent, Fixed, Generic] + +newtype Precision a = Precision (Maybe Int) + deriving (Eq, Show) + +precision :: a -> Precision a -> Maybe Int +precision _ (Precision prec) = prec + +arbitraryPrecision :: Int -> Gen (Precision a) +arbitraryPrecision maxDigits = Precision <$> do + n <- choose (-1,maxDigits) + return $ if n == -1 + then Nothing + else Just n + +instance Arbitrary (Precision Float) where + arbitrary = arbitraryPrecision 11 + shrink = map Precision . shrink . precision undefined + +instance Arbitrary (Precision Double) where + arbitrary = arbitraryPrecision 22 + shrink = map Precision . shrink . precision undefined -- Work around lack of Show instance for TextEncoding. data Encoding = E String IO.TextEncoding diff --git a/text.cabal b/text.cabal --- a/text.cabal +++ b/text.cabal @@ -1,5 +1,5 @@ name: text -version: 1.2.0.2 +version: 1.2.0.3 homepage: https://github.com/bos/text bug-reports: https://github.com/bos/text/issues synopsis: An efficient packed Unicode text type.