diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,24 @@ Unreleased ===== +1.6.0 +===== + +* [#207](https://github.com/serokell/universum/pull/207): + Remove various monad transformer combinators, `flipfoldl'`, and `<<$>>` + from the list of changes suggested in `.hlint.yaml`. +* [#214](https://github.com/serokell/universum/issues/214): + Update supported GHC versions (replace 7.10.3 with 8.6.5). + +* [#212](https://github.com/serokell/universum/issues/212) + Added rewrite rule for `toString . toText` case. + This may change semantics in some corner cases + (because `toString . toText` is not strictly the identity function). + +* [#215](https://github.com/serokell/universum/pull/215): + Fix docstrings in `Universum.Lifted.File` to mention correct module when + referencing related functions. + 1.5.0 ===== @@ -57,7 +75,7 @@ _Migration guide:_ use `liftIO` directly with functions from `Control.Monad.ST` instead. * [#181](https://github.com/serokell/universum/issues/181): - `list` has removed. + `list` has been removed. 1.3.0 ===== diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,7 +13,7 @@ 1. **Excellent documentation**: tutorial, migration guide from `Prelude`, Haddock with examples for (almost) every function, all examples are tested with [`doctest`](http://hackage.haskell.org/package/doctest), - documenation regarding internal module structure. + documentation regarding internal module structure. 2. `universum`-specific [HLint](http://hackage.haskell.org/package/hlint) rules: [`.hlint.yaml`](https://github.com/serokell/universum/blob/master/.hlint.yaml) 3. Only a few LiquidHaskell properties right now, but LiquidHaskell is on Travis @@ -160,6 +160,7 @@ * As a consequence of previous point, some functions like `traverse_`, `forM_`, `sequenceA_`, etc. are generalized over `Container` type classes. * `error` takes `Text`. +* We are exporting a rewrite rule which replaces `toString . toText :: Text -> Text` with `id`. Note that this changes semantics in some corner cases. Things that you were already using, but now you don't have to import them explicitly [↑](#structure-of-this-tutorial) diff --git a/benchmark/Main.hs b/benchmark/Main.hs --- a/benchmark/Main.hs +++ b/benchmark/Main.hs @@ -3,6 +3,7 @@ import Universum hiding (show) import Data.List (nub, zip5) +import qualified Data.Text as T import Gauge (Benchmark, bench, bgroup, nf, whnf) import Gauge.Main (defaultMain) import Prelude (show) @@ -24,6 +25,7 @@ , bgroupConcatMap , bgroupMember , bgroupFold + , bgroupTextConversion ] bgroupList :: forall a . @@ -171,3 +173,15 @@ bgroup "foldl'" [ bench "flipped" $ nf flipFoldl' testList , bench "base" $ nf ghcFoldl' testList ] + +bgroupTextConversion :: Benchmark +bgroupTextConversion = + bgroup "text conversions" + [ let str = replicate 100000 'a' + countLength x = length (toString x) + in bench "toString . toText" $ whnf (countLength . toText) str + + , let txt = T.replicate 100000 (T.singleton 'a') + countLength x = length (toText x) + in bench "toText . toString" $ whnf (countLength . toString) txt + ] diff --git a/src/Universum/Base.hs b/src/Universum/Base.hs --- a/src/Universum/Base.hs +++ b/src/Universum/Base.hs @@ -117,8 +117,6 @@ -- 3 -- >>> const 3 $! Prelude.undefined -- *** Exception: Prelude.undefined --- CallStack (from HasCallStack): --- error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err -- ... ($!) :: (a -> b) -> a -> b f $! x = let !vx = x in f vx diff --git a/src/Universum/Lifted/File.hs b/src/Universum/Lifted/File.hs --- a/src/Universum/Lifted/File.hs +++ b/src/Universum/Lifted/File.hs @@ -28,22 +28,22 @@ -- Text ---------------------------------------------------------------------------- --- | Lifted version of 'Data.Text.appendFile'. +-- | Lifted version of 'Data.Text.IO.appendFile'. appendFile :: MonadIO m => FilePath -> Text -> m () appendFile a b = liftIO (XIO.appendFile a b) {-# INLINE appendFile #-} --- | Lifted version of 'Data.Text.getLine'. +-- | Lifted version of 'Data.Text.IO.getLine'. getLine :: MonadIO m => m Text getLine = liftIO XIO.getLine {-# INLINE getLine #-} --- | Lifted version of 'Data.Text.readFile'. +-- | Lifted version of 'Data.Text.IO.readFile'. readFile :: MonadIO m => FilePath -> m Text readFile a = liftIO (XIO.readFile a) {-# INLINE readFile #-} --- | Lifted version of 'Data.Text.writeFile'. +-- | Lifted version of 'Data.Text.IO.writeFile'. writeFile :: MonadIO m => FilePath -> Text -> m () writeFile a b = liftIO (XIO.writeFile a b) {-# INLINE writeFile #-} diff --git a/src/Universum/String/Conversion.hs b/src/Universum/String/Conversion.hs --- a/src/Universum/String/Conversion.hs +++ b/src/Universum/String/Conversion.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- | This module implements type class which allow to have conversion to and -- from 'Text', 'String' and 'ByteString' types (including both strict and lazy @@ -30,6 +31,8 @@ import Data.Either (Either) import Data.Function (id, (.)) import Data.String (String) +import qualified Data.Text.Internal as T +import qualified Data.Text.Internal.Fusion.Common as TF import Universum.Functor ((<$>)) import Universum.String.Reexport (ByteString, IsString, Read, Text, fromString) @@ -158,6 +161,113 @@ instance ToString LT.Text where toString = LT.unpack + +{- + +@toString . toText@ pattern may occur quite often after inlining because +we tend to use 'Text' rather than 'String' in function signatures, but +there are still some libraries which use 'String's and thus make us perform +conversions back and forth. + +Note that @toString . toText@ is not strictly equal to identity function, see +explanation in the comment below. +-} + +{-# RULES "pack/unpack" [~0] + forall s. T.unpack (T.pack s) = s +#-} + +{- [Note toString-toText-rewritting] + +We can do even better if take rules defined in 'Data.Text' into account. + +Quoting investigation of @int-index: + +If we look at @unpack@ and @pack@ they are defined as + +@ +unpack = S.unstreamList . stream +{-# INLINE [1] unpack #-} + +pack = unstream . S.map safe . S.streamList +{-# INLINE [1] pack #-} +@ + +After they get inlined, the rule seems to be + +@ +(S.unstreamList . stream) ((unstream . S.map safe . S.streamList) a) +@ + +If we also inline function composition, we get + +@ +S.unstreamList (stream (unstream (S.map safe (S.streamList a)))) +@ + +`stream` and `unstream` surely cancel out via this rule: + +@ +{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-} +@ + +So we are left with + +@ +S.unstreamList (S.map safe (S.streamList a)) +@ + +Now, what's this 'safe' function? Turns out it's defined as + +@ +safe :: Char -> Char +safe c + | ord c .&. 0x1ff800 /= 0xd800 = c + | otherwise = '\xfffd' +@ + +Aha, so it's mapping some codepoints to @'\xfffd'@! +There's a comment on top of it to explain this: + +``` +-- UTF-16 surrogate code points are not included in the set of Unicode +-- scalar values, but are unfortunately admitted as valid 'Char' +-- values by Haskell. They cannot be represented in a 'Text'. This +-- function remaps those code points to the Unicode replacement +-- character (U+FFFD, \'�\'), and leaves other code points +-- unchanged. +``` + +This logic is lost with the mentioned rewrite rule. +Not a huge loss, but it does mean that this rewrite rule isn't meaning preserving. + + +We hope that in most cases it's fine. +And if it's not, one can mark his function using either @pack@ or @unpack@ +with @NOINLINE@ pragma to prevent the rule from firing. + +So, eventually, we add the following rule: +-} +{-# RULES "pack/unpack internal" [1] + forall s. TF.unstreamList (TF.map T.safe (TF.streamList s)) = s +#-} + +{- In case if GHC didn't manage to inline and rewrite everything in +the remaining phases (@Data.Text.pack@ is inlined at 1-st phase), +we still have "pack/unpack" rule. Hopefully, one of them will fire. +-} + +{- The opposite rule is safe to have because 'T.safe' /is/ the identity +function for strings made up from valid characters, and text is guaranteed +to have only valid ones. +However, for this case there is no @unstream (stream s) = id@ rule, +so we don't delve deep into internals. As long as @stream@ and @unstream@ +only perform conversion between text and stream of characters, they should +be safe to collapse. +-} +{-# RULES "unpack/pack" [~0] + forall s. T.pack (T.unpack s) = s +#-} -- | Polymorhpic version of 'Text.Read.readEither'. -- diff --git a/test/Test/Universum/Property.hs b/test/Test/Universum/Property.hs --- a/test/Test/Universum/Property.hs +++ b/test/Test/Universum/Property.hs @@ -1,35 +1,51 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} + module Test.Universum.Property ( hedgehogTestTree ) where -import Universum +import Universum import Data.List (nub) -import Hedgehog (Property, Gen, MonadGen, forAll, property, assert, (===)) -import Test.Tasty (testGroup, TestTree) +import Hedgehog (Gen, MonadGen, Property, assert, forAll, property, (===)) +#if MIN_VERSION_hedgehog(1,0,0) +import Hedgehog (GenBase) +#endif +import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as LB +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range import qualified Universum as U -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as LB -import qualified Data.Text as T -import qualified Data.Text.Lazy as LT - - hedgehogTestTree :: TestTree -hedgehogTestTree = testGroup "Tests" [utfProps, listProps, boolMProps] +hedgehogTestTree = testGroup "Tests" [stringProps, utfProps, listProps, boolMProps] +stringProps :: TestTree +stringProps = testGroup "String conversions" + [ testProperty "toString . toText = id" prop_StringToTextAndBack + , testProperty "`toString . toText` for UTF-16 surrogate" + prop_StringToTextAndBackSurrogate + , testProperty "toText . toString = id" prop_TextToStringAndBack + ] + utfProps :: TestTree -utfProps = testGroup "utf8 conversion property tests" +utfProps = testGroup "utf8 conversion property tests" [ testProperty "String to ByteString invertible" prop_StringToBytes , testProperty "Text to ByteString invertible" prop_TextToBytes , testProperty "ByteString to Text or String invertible" prop_BytesTo ] +#if MIN_VERSION_hedgehog(1,0,0) +unicode' :: (MonadGen m, GenBase m ~ Identity) => m U.Char +#else unicode' :: MonadGen m => m U.Char +#endif unicode' = do a <- Gen.unicode if U.elem a ['\65534', '\65535'] @@ -39,17 +55,50 @@ utf8String :: Gen U.String utf8String = Gen.string (Range.linear 0 10000) unicode' +unicodeAllString :: Gen U.String +unicodeAllString = Gen.string (Range.linear 0 10000) Gen.unicodeAll + utf8Text :: Gen T.Text utf8Text = Gen.text (Range.linear 0 10000) unicode' +unicodeAllText :: Gen T.Text +unicodeAllText = Gen.text (Range.linear 0 10000) Gen.unicodeAll + utf8Bytes :: Gen B.ByteString utf8Bytes = Gen.utf8 (Range.linear 0 10000) unicode' -- "\65534" fails, but this is from BU.toString -- > import qualified Data.ByteString.UTF8 as BU -- > BU.toString (BU.fromString "\65534") == "\65533" --- > True +-- > True +prop_StringToTextAndBack :: Property +prop_StringToTextAndBack = property $ do + str <- forAll unicodeAllString + toString (toText str) === str + +-- | See comment to this function: +-- +-- +-- While 'String' may contain surrogate UTF-16 code points, actually UTF-8 +-- doesn't allow them, as well as 'Text'. 'Data.Text.pack' replaces invalid +-- characters with unicode replacement character, so by default +-- @toString . toText@ is not identity. +-- +-- However, we have a rewrite rule by which we /replace/ @toString . toText@ +-- occurrences with the identity function. +prop_StringToTextAndBackSurrogate :: Property +prop_StringToTextAndBackSurrogate = property $ do + -- Surrogate character like this one should remain intact + -- Without rewrite rule this string would be transformed to "\9435" + let str = "\xD800" + toString (toText str) === str + +prop_TextToStringAndBack :: Property +prop_TextToStringAndBack = property $ do + txt <- forAll unicodeAllText + toText (toString txt) === txt + prop_StringToBytes :: Property prop_StringToBytes = property $ do str <- forAll utf8String @@ -74,7 +123,7 @@ -- ordNub listProps :: TestTree -listProps = testGroup "list function property tests" +listProps = testGroup "list function property tests" [ testProperty "Hedgehog ordNub xs == nub xs" prop_ordNubCorrect , testProperty "Hedgehog hashNub xs == nub xs" prop_hashNubCorrect , testProperty "Hedgehog sortNub xs == sort $ nub xs" prop_sortNubCorrect @@ -126,4 +175,3 @@ prop_orM = property $ do bs <- forAll genBoolList U.orM (return <$> bs) === ((return $ U.or bs) :: U.Maybe U.Bool) - diff --git a/universum.cabal b/universum.cabal --- a/universum.cabal +++ b/universum.cabal @@ -1,5 +1,5 @@ name: universum -version: 1.5.0 +version: 1.6.0 synopsis: Custom prelude used in Serokell description: See README.md file for more details. homepage: https://github.com/serokell/universum @@ -13,10 +13,10 @@ build-type: Simple cabal-version: >=1.18 bug-reports: https://github.com/serokell/universum/issues -tested-with: GHC == 7.10.3 - , GHC == 8.0.2 +tested-with: GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.3 + , GHC == 8.6.5 extra-doc-files: CHANGES.md , CONTRIBUTING.md , README.md @@ -82,7 +82,9 @@ , mtl , safe-exceptions , stm - , text + -- Make sure that "toString-toText-rewritting" note + -- is still valid when bumping this constraint. + , text >= 1.0.0.0 && <= 1.2.3.1 , transformers , unordered-containers , utf8-string @@ -133,9 +135,8 @@ , universum , containers , gauge + , text , unordered-containers - if impl(ghc == 7.10.3) - build-depends: semigroups >= 0.18 default-extensions: NoImplicitPrelude ScopedTypeVariables