diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,144 @@ -Unreleased +1.8.3.1 +======= + +* [#304](https://github.com/serokell/universum/pull/304) + * Add support for GHC-9.14 without any user-visible changes. + +1.8.3 +======= + +* [#301](https://github.com/serokell/universum/pull/301) + * Relax the upper bound on `text`. +* [#300](https://github.com/serokell/universum/pull/300) + * Fix building with microlens-0.5. + +1.8.2.2 +======= + +* [#297](https://github.com/serokell/universum/pull/297) + * Add support for GHC-9.10 without any user-visible changes. + +1.8.2.1 +======= + +* [#293](https://github.com/serokell/universum/pull/293) + * Add explicit kind signatures for custom operators. + * Bump some dependency constraints to support GHC-9.8. + +1.8.2 ===== +* [#289](https://github.com/serokell/universum/pull/289): + Make universum work with LTS-21.0. + * Re-export `(~)` type operator. +* [#283](https://github.com/serokell/universum/pull/283): + Bump the upper version bound on `text` to `2.0.2`. + +1.8.1.1 +======= + +* [#282](https://github.com/serokell/universum/pull/282): + Bump the upper version bound on `text` to `2.0.1`. + +1.8.1 +===== + +* [#271](https://github.com/serokell/universum/pull/271): + Add compatibility with tasty-hedgehog 1.2.0.0 + +1.8.0 +===== + +* [#252](https://github.com/serokell/universum/pull/252): + Remove `Option` re-export. Use `Maybe` instead. + +* [#176](https://github.com/serokell/universum/issues/176): + Deprecate `note`. + +* [#206](https://github.com/serokell/universum/issues/206): + Remove `listToMaybe`. + _Migration guide:_ use `safeHead` directly with functions from + `Universum.Container` instead. + +* [#182](https://github.com/serokell/universum/issues/182): + Deprecate `microlens` and `microlens-mtl` dependencies. + +* [#165](https://github.com/serokell/universum/issues/165): + Change the type of `readMaybe` from `readMaybe :: Read a => String -> Maybe a` + to it's polymorphic version `readMaybe :: forall b a. (ToString a, Read b) => a -> Maybe b`. + +* [#199](https://github.com/serokell/universum/issues/199): + Change type of `concatMap` from `concatMap :: Foldable f => (a -> [b]) -> t a -> [b]` + to `concatMap :: Container c => (Element c -> [b]) -> c -> [b]`. + +* [250](https://github.com/serokell/universum/issues): + Replace `group` export from `Data.List` with `group`, `groupBy`, `groupWith` and `groupAllWith` from `Data.List.NonEmpty`. + +1.7.3 +===== + +* [#236](https://github.com/serokell/universum/issues/236): + Add `updateMVar'` and `updateTVar'`. +* [#244](https://github.com/serokell/universum/issues/244) + Add `ToPairs` instances for `[(k, v)]` and `NonEmpty (k, v)`. + +* [#238](https://github.com/serokell/universum/pull/238): + Add `fromList`. + +1.7.2 (rev1) +===== + +* Permit `text-1.2.5.0`. + +1.7.2 +===== + +* Permit `text-1.2.4.1`. +* [#233](https://github.com/serokell/universum/issues/223): + Add `someNE`. + +1.7.1 +===== + +* [#230](https://github.com/serokell/universum/issues/230): + Add `hoistMaybe` and `hoistEither` functions + similar to [relude](https://hackage.haskell.org/package/relude-0.7.0.0/docs/Relude-Monad-Trans.html#v:hoistMaybe) + +1.7.0 +===== + +* [#221](https://github.com/serokell/universum/issues/221): + Add safe versions of `minimum`, `maximum`, `minimumBy`, `maximumBy`, `foldr1`, `foldl1` functions for `NonEmpty` list. + Old their versions from `Container` typeclass now return `Maybe` and have + `safe` prefix in name (e.g. `safeMinimum`). + Add unsafe versions of those functions to `Unsafe` module. +* [#185](https://github.com/serokell/universum/issues/185): + Enable more warnings, fix all warnings. + +1.6.1 +===== + +* [#219](https://github.com/serokell/universum/issues/219): + Bump upper bound on `text`. + +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 +195,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/CONTRIBUTING.md b/CONTRIBUTING.md --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -51,7 +51,7 @@ Processing of an issue depends on its category. Specifically: 1. A `not-code` issue can be resolved at any time. PRs can be merged whenever GitHub allows it. -Minimal number of approvals is set to 2 in GitHub settings. +Minimal number of approvals is set in GitHub settings. 2. Rules for the `fix` issues are the same as for `not-code` with an additional rule that PRs for such issues should increase the last component in the version and this version should be uploaded to Hackage as soon as the PR is merged (also new tag and release are created). 3. Work on the `feature` issues is organized in milestones. Each milestone corresponds to a release which increases at least the third (`feature`) version component. @@ -66,8 +66,8 @@ However, 4 approvals (at least 3 from Serokell) are necessary for inclusion into a milestone. 2 disapprovals from Serokell or 4 disapprovals in total are enough to prevent the issue from getting into a milestone. If an issue is about removal of something (`x`), it should be done in two steps. -The first step is deprecation of `x` which happens in a `breaking` release. -The second step is deprecation of `x` which happens in another `breaking` release after deprecation of `x`. +The first step is to deprecate `x` which happens in a `breaking` release. +The second step is to delete `x` which happens in another `breaking` release after deprecating `x`. There can't be more than one breaking release in less than 5 weeks. Note: approval of any PR implies that the person who approves it confirms that the PR corresponds to the issue mentioned there and the issue has a correct type. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,8 +1,7 @@ Universum ========= -[![Build Status](https://travis-ci.org/serokell/universum.svg?branch=master)](https://travis-ci.org/serokell/universum) -[![Windows build status](https://ci.appveyor.com/api/projects/status/github/serokell/universum?branch=master&svg=true)](https://ci.appveyor.com/project/gromakovsky/universum) +[![GitHub CI](https://github.com/serokell/universum/workflows/CI/badge.svg)](https://github.com/serokell/universum/actions) [![Hackage](https://img.shields.io/hackage/v/universum.svg)](https://hackage.haskell.org/package/universum) [![Stackage LTS](http://stackage.org/package/universum/badge/lts)](http://stackage.org/lts/package/universum) [![Stackage Nightly](http://stackage.org/package/universum/badge/nightly)](http://stackage.org/nightly/package/universum) @@ -13,12 +12,10 @@ 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 - CI and other properties are just waiting to be added! -4. Focus on safety, convenience and efficiency. +3. Focus on safety, convenience and efficiency. What is this file about? ------------------------ @@ -57,8 +54,7 @@ new basic set of defaults. There already were plenty of [preludes](https://guide.aelve.com/haskell/alternative-preludes-zr69k1hc), so we didn't plan to implement everything from scratch. After some long, hot discussions, our team decided to base our custom prelude on -[`protolude`](https://github.com/sdiehl/protolude). If you're not familiar with it, -you can read [a tutorial about `protolude`](http://www.stephendiehl.com/posts/protolude.html). +[`protolude`](https://github.com/protolude/protolude). The next section explains why we've made this choice and what we are willing to do. This tutorial doesn't cover the differences from `protolude`. Instead, it explains how Universum is different from regular `Prelude`. @@ -80,8 +76,7 @@ Instead, we reexport common and well-known things from `base` and some other libraries that are used in everyday production programming in _Haskell_. > **Note**: well, we did end up inventing _some_ new things. -4. Export more useful and commonly used functions. [Hello, my name is Dmitry. I was - coding _Haskell_ for 3 years but still hoogling which module `liftIO` comes from.](https://twitter.com/magnars/status/834683466130345984) +4. Export more useful and commonly used functions. Things like `liftIO`, `ReaderT` type, `MVar`-related functions have unambiguous names, are used in almost every non-trivial project, and it's really tedious to import them manually every time. @@ -92,8 +87,7 @@ 1. Not trying to be as general as possible (thus we don't export much from [`GHC.Generics`](https://github.com/sdiehl/protolude/blob/41710698eedc66fb0bfc5623d3c3a672421fbab5/src/Protolude.hs#L365)). -2. Not trying to maintain every version of `ghc` compiler (but [at least the - latest 3](https://github.com/serokell/universum/blob/b6353285859e9ed3544bddbf55d70237330ad64a/.travis.yml#L15)). +2. Not trying to maintain every version of `ghc` compiler (but [at least the latest 3](/.github/workflows/ci.yml)). 3. Trying to make writing production code easier (see [enhancements and fixes](https://github.com/serokell/universum/issues)). @@ -134,8 +128,8 @@ Gotchas [↑](#structure-of-this-tutorial) ------- -* `head`, `tail`, `last`, `init` work with `NonEmpty a` instead of `[a]`. -* Safe analogue for `head` function: `safeHead :: [a] -> Maybe a`. +* `head`, `tail`, `last`, `init`, `foldl1`, `minimum` and other were-partial functions work with `NonEmpty a` instead of `[a]`. +* Safe analogue for `head`, `foldl1`, `foldr1`, `minimum`, `maximum` functions, for instance: `safeHead :: [a] -> Maybe a`. * `undefined` triggers a compiler warning, which is probably not what you want. Either use `throwIO`, `Except`, `error` or `bug`. * `map` is `fmap` now. * Multiple sorting functions are available without imports: @@ -147,6 +141,7 @@ `OverloadedStrings` is enabled – it happens because the compiler doesn't know what type to infer for the string. Use `putTextLn` in this case. * Since `show` doesn't come from `Show` anymore, you can't write `Show` instances easily. +See [migration guide](#migration-guide-from-prelude-) for details. * You can't call some `Foldable` methods over `Maybe` and some other types. `Foldable` generalization is useful but [potentially error-prone](https://www.reddit.com/r/haskell/comments/60r9hu/proposal_suggest_explicit_type_application_for/). @@ -154,12 +149,13 @@ [`Container` type class](https://github.com/serokell/universum/blob/b6353285859e9ed3544bddbf55d70237330ad64a/src/Universum/Container/Class.hs#L180) but that restricts the usage of functions like `length` over `Maybe`, `Either`, `Identity` and tuples. We're also using _GHC 8_ feature of - [custom compile-time errors](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#custom-compile-time-errors) + [custom compile-time errors](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_errors.html) to produce [more helpful messages](https://github.com/serokell/universum/blob/54a742c10720f11c739f2d268365d723924b83a9/src/Containers.hs#L474). * 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) @@ -288,7 +284,7 @@ * Conversions between `Either` and `Maybe` like `rightToMaybe` and `maybeToLeft` with clear semantic. * `using(Reader|State)[T]` functions as aliases for `flip run(Reader|State)[T]`. -* [`One` type class](https://github.com/serokell/universum/blob/master/src/Containers.hs#L473) +* [`One` type class](/src/Universum/Container/Class.hs) for creating singleton containers. Even monomorhpic ones like `Text`. * `evaluateWHNF` and `evaluateNF` functions as clearer and lifted aliases for `evaluate` and `evaluate . force`. @@ -303,7 +299,7 @@ This section describes what you need to change to make your code compile with `universum`. 1. Enable `-XOverloadedStrings` and `-XTypeFamilies` extension by default for your project. -2. Since `head`, `tail`, `last` and `init` work for `NonEmpty` you should +2. Since `head`, `tail`, `minimum` and some other functions work for `NonEmpty` you should refactor your code in one of the multiple ways described below: 1. Change `[a]` to `NonEmpty a` where it makes sense. 2. Use functions which return `Maybe`. They can be implemented using `nonEmpty` function. Like `head <$> nonEmpty l`. @@ -344,19 +340,6 @@ + Use `toText/toLText/toString` functions to convert to `Text/LazyText/String` types. + Use `encodeUtf8/decodeUtf8` to convert to/from `ByteString`. 8. Run `hlint` using `.hlint.yaml` file from `universum` package to cleanup code and imports. - -Projects that use Universum [↑](#structure-of-this-tutorial) ---------------------------- - -Please submit a PR if you are using Universum! - -| λ | -|---| -| [cardano-report-server](https://github.com/input-output-hk/cardano-report-server) | -| [cardano-sl](https://github.com/input-output-hk/cardano-sl) | -| [importify](https://github.com/serokell/importify) | -| [log-warper](https://github.com/serokell/log-warper) | -| [orgstat](https://github.com/volhovm/orgstat) | -| [tintin](https://github.com/theam/tintin) | -| [require](https://theam.github.io/require/) | -| [ariadne](https://github.com/serokell/ariadne) | +9. Since vanilla `show` from the `Show` class is not available, your custom `Show` instances will fail to compile. +You can `import qualified Text.Show` to bring vanilla `show` to scope with qualified name. +It will not conflict with `show` from `universum` and your `Show` instances will compile successfully. diff --git a/benchmark/Main.hs b/benchmark/Main.hs --- a/benchmark/Main.hs +++ b/benchmark/Main.hs @@ -1,8 +1,11 @@ -module Main where +module Main + ( main + ) where 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 +27,7 @@ , bgroupConcatMap , bgroupMember , bgroupFold + , bgroupTextConversion ] bgroupList :: forall a . @@ -68,7 +72,7 @@ ] groupSort :: [a] -> [a] - groupSort = map Unsafe.head . group . sort + groupSort = map NonEmpty.head . group . sort safeSort :: [a] -> [a] safeSort = map NonEmpty.head . NonEmpty.group . sort @@ -106,10 +110,11 @@ ] ] where + super10 :: [()] -> Bool super10 = null - ... (: []) ... Unsafe.head ... pure ... Unsafe.head + ... ((: []) ... Unsafe.head ... pure ... Unsafe.head ... (: [(), (), (), ()]) ... Unsafe.head ... (: []) ... Unsafe.head - ... (: [()]) ... Unsafe.head ... (: [(), ()]) ... Unsafe.head + ... (: [()]) ... Unsafe.head ... (: [(), ()]) ... Unsafe.head :: [()] -> [()]) norm10 = null . (: []) . Unsafe.head . pure . Unsafe.head @@ -171,3 +176,12 @@ bgroup "foldl'" [ bench "flipped" $ nf flipFoldl' testList , bench "base" $ nf ghcFoldl' testList ] + +bgroupTextConversion :: Benchmark +bgroupTextConversion = + bgroup "text conversions" + [ -- With @toText . toString -> id@ rewrite rules we expect ~10ns + -- Without the rules: >10ms + let txt = T.replicate 10000000 (T.singleton 'a') + in bench "toText . toString" $ whnf (toText . toString) txt + ] diff --git a/src/Universum.hs b/src/Universum.hs --- a/src/Universum.hs +++ b/src/Universum.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE RankNTypes #-} {- | Main module that reexports all functionality allowed to use without importing any other modules. Just add next lines to your @@ -80,8 +82,26 @@ , module Universum.VarArg -- * Lenses - , module Lens.Micro - , module Lens.Micro.Mtl + , Lens + , Lens' + , Traversal + , Traversal' + , over + , set + , (%~) + , (.~) + , (^.) + , (^..) + , (^?) + , _1 + , _2 + , _3 + , _4 + , _5 + , preuse + , preview + , use + , view ) where import Universum.Applicative @@ -104,6 +124,99 @@ import Universum.VarArg -- Lenses -import Lens.Micro (Lens, Lens', Traversal, Traversal', over, set, (%~), (&), (.~), (<&>), (^.), - (^..), (^?), _1, _2, _3, _4, _5) -import Lens.Micro.Mtl (preuse, preview, use, view) +import qualified Lens.Micro (ASetter, Getting, over, set, (%~), (.~), (^.), + (^..), (^?), _1, _2, _3, _4, _5) +import qualified Lens.Micro.Mtl (preuse, preview, use, view) +#if MIN_VERSION_microlens(0,5,0) +import Lens.Micro (Field1, Field2, Field3, Field4, Field5) +#else +import Lens.Micro.Internal (Field1, Field2, Field3, Field4, Field5) +#endif + +{-# DEPRECATED + Lens + , Lens' + , Traversal + , Traversal' + , over + , set + , (%~) + , (.~) + , (^.) + , (^..) + , (^?) + , _1 + , _2 + , _3 + , _4 + , _5 + , preuse + , preview + , use + , view + "Use corresponding function from 'lens' or 'microlens' package" +#-} + +type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t +type Lens' s a = Lens s s a a + +type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t +type Traversal' s a = Traversal s s a a + +over :: Lens.Micro.ASetter s t a b -> (a -> b) -> s -> t +over = Lens.Micro.over + +set :: Lens.Micro.ASetter s t a b -> b -> s -> t +set = Lens.Micro.set + +(%~) :: Lens.Micro.ASetter s t a b -> (a -> b) -> s -> t +(%~) = (Lens.Micro.%~) + +infixr 4 %~ + +(.~) :: Lens.Micro.ASetter s t a b -> b -> s -> t +(.~) = (Lens.Micro..~) + +infixr 4 .~ + +(^.) :: s -> Lens.Micro.Getting a s a -> a +(^.) = (Lens.Micro.^.) + +infixl 8 ^. + +(^..) :: s -> Lens.Micro.Getting (Endo [a]) s a -> [a] +(^..) = (Lens.Micro.^..) + +infixl 8 ^.. + +(^?) :: s -> Lens.Micro.Getting (First a) s a -> Maybe a +(^?) = (Lens.Micro.^?) + +infixl 8 ^? + +_1 :: Field1 s t a b => Lens s t a b +_1 = Lens.Micro._1 + +_2 :: Field2 s t a b => Lens s t a b +_2 = Lens.Micro._2 + +_3 :: Field3 s t a b => Lens s t a b +_3 = Lens.Micro._3 + +_4 :: Field4 s t a b => Lens s t a b +_4 = Lens.Micro._4 + +_5 :: Field5 s t a b => Lens s t a b +_5 = Lens.Micro._5 + +preuse :: MonadState s m => Lens.Micro.Getting (First a) s a -> m (Maybe a) +preuse = Lens.Micro.Mtl.preuse + +preview :: MonadReader s m => Lens.Micro.Getting (First a) s a -> m (Maybe a) +preview = Lens.Micro.Mtl.preview + +use :: MonadState s m => Lens.Micro.Getting a s a -> m a +use = Lens.Micro.Mtl.use + +view :: MonadReader s m => Lens.Micro.Getting a s a -> m a +view = Lens.Micro.Mtl.view diff --git a/src/Universum/Applicative.hs b/src/Universum/Applicative.hs --- a/src/Universum/Applicative.hs +++ b/src/Universum/Applicative.hs @@ -7,10 +7,13 @@ module Universum.Applicative ( module Control.Applicative , pass + , someNE ) where import Control.Applicative (Alternative (..), Applicative (..), Const (..), ZipList (..), liftA2, liftA3, optional, (<**>)) +import Data.Functor (fmap) +import qualified Data.List.NonEmpty as NE -- $setup -- >>> import Universum.Monad (Maybe) @@ -21,6 +24,11 @@ -- Just () pass :: Applicative f => f () pass = pure () + +-- | Similar to 'some', but reflects in types that a non-empty list +-- is returned. +someNE :: Alternative f => f a -> f (NE.NonEmpty a) +someNE x = fmap NE.fromList (some x) {- orAlt :: (Alternative f, Monoid a) => f a -> f a diff --git a/src/Universum/Base.hs b/src/Universum/Base.hs --- a/src/Universum/Base.hs +++ b/src/Universum/Base.hs @@ -1,9 +1,8 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE Unsafe #-} --- | Reexports from @GHC.*@ modules of --- package. +-- | Reexports from @GHC.*@ modules of the package. module Universum.Base ( -- * Base types @@ -26,6 +25,9 @@ , module Data.Proxy , module Data.Typeable , module Data.Void +#if MIN_VERSION_base(4,17,0) + , module Data.Type.Equality +#endif , module GHC.Base , module GHC.Enum @@ -35,22 +37,14 @@ , module GHC.Num , module GHC.Real , module GHC.Show - -#if MIN_VERSION_base(4,10,0) , module GHC.TypeNats -#else - , module GHC.TypeLits -#endif - , module GHC.Types - -#if ( __GLASGOW_HASKELL__ >= 800 ) , module GHC.OverloadedLabels , module GHC.ExecutionStack , module GHC.Stack -- * Data.Kind + , Constraint , Type -#endif , ($!) ) where @@ -67,45 +61,32 @@ -- Base typeclasses import Data.Eq (Eq (..)) -import Data.Foldable (Foldable, concat, concatMap, foldlM, foldrM, maximumBy, minimumBy) +import Data.Foldable (Foldable, concat, foldlM, foldrM) +import Data.Kind (Constraint, Type) import Data.Ord (Down (..), Ord (..), Ordering (..), comparing) import Data.Traversable (Traversable (..), fmapDefault, foldMapDefault, forM, mapAccumL, mapAccumR) -- Base GHC types -#if ( __GLASGOW_HASKELL__ >= 710 ) import Data.Proxy (Proxy (..)) import Data.Typeable (Typeable) import Data.Void (Void, absurd, vacuous) +#if MIN_VERSION_base(4,17,0) +import Data.Type.Equality (type (~)) #endif -import GHC.Base (String, asTypeOf, maxInt, minInt, ord, seq) +import GHC.Base (Bool, Char, Coercible, IO, Int, Ordering, String, Word, asTypeOf, maxInt, minInt, ord, seq) import GHC.Enum (Bounded (..), Enum (..), boundedEnumFrom, boundedEnumFromThen) -import GHC.Exts (Constraint, FunPtr, Ptr) +import GHC.ExecutionStack (getStackTrace, showStackTrace) +import GHC.Exts (FunPtr, Ptr) import GHC.Float (Double (..), Float (..), Floating (acos, acosh, asin, asinh, atan, atanh, cos, cosh, exp, logBase, pi, sin, sinh, sqrt, tan, tanh, (**))) import GHC.Generics (Generic) import GHC.Num (Integer, Num (..), subtract) +import GHC.OverloadedLabels (IsLabel (..)) import GHC.Real hiding (showSigned, (%)) import GHC.Show (Show) -#if MIN_VERSION_base(4,10,0) -import GHC.TypeNats (CmpNat, KnownNat, Nat, SomeNat (..), natVal, someNatVal) -#else -import GHC.TypeLits (CmpNat, KnownNat, Nat, SomeNat (..), natVal, someNatVal) -#endif - -import GHC.Types (Bool, Char, Coercible, IO, Int, Ordering, Word) - - -#if ( __GLASGOW_HASKELL__ >= 800 ) -import GHC.ExecutionStack (getStackTrace, showStackTrace) -import GHC.OverloadedLabels (IsLabel (..)) import GHC.Stack (CallStack, HasCallStack, callStack, currentCallStack, getCallStack, prettyCallStack, prettySrcLoc, withFrozenCallStack) -#endif - -#if ( __GLASGOW_HASKELL__ >= 800 ) --- TODO: move Constraint here later -import Data.Kind (Type) -#endif +import GHC.TypeNats (CmpNat, KnownNat, Nat, SomeNat (..), natVal, someNatVal) -- $setup -- >>> import Universum.Function (const, ($)) @@ -117,8 +98,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/Bool/Guard.hs b/src/Universum/Bool/Guard.hs --- a/src/Universum/Bool/Guard.hs +++ b/src/Universum/Bool/Guard.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE Safe #-} + -- | This module contains monadic predicates. module Universum.Bool.Guard diff --git a/src/Universum/Bool/Reexport.hs b/src/Universum/Bool/Reexport.hs --- a/src/Universum/Bool/Reexport.hs +++ b/src/Universum/Bool/Reexport.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE Safe #-} + -- | This module reexports functions to work with 'Bool' type. module Universum.Bool.Reexport diff --git a/src/Universum/Container.hs b/src/Universum/Container.hs --- a/src/Universum/Container.hs +++ b/src/Universum/Container.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE Safe #-} + -- | This module exports all container-related stuff. module Universum.Container @@ -5,5 +7,5 @@ , module Universum.Container.Reexport ) where -import Universum.Container.Class +import Universum.Container.Class hiding (checkingNotNull) import Universum.Container.Reexport diff --git a/src/Universum/Container/Class.hs b/src/Universum/Container/Class.hs --- a/src/Universum/Container/Class.hs +++ b/src/Universum/Container/Class.hs @@ -11,6 +11,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} +{-# OPTIONS_GHC -Wno-unused-type-patterns #-} -- | Reimagined approach for 'Foldable' type hierarchy. Forbids usages -- of 'length' function and similar over 'Maybe' and other potentially unsafe @@ -22,7 +23,9 @@ module Universum.Container.Class ( -- * Foldable-like classes and methods ToPairs (..) + , FromList (..) , Container (..) + , checkingNotNull , flipfoldl' @@ -36,32 +39,32 @@ , sequenceA_ , sequence_ , asum + , concatMap -- * Others , One(..) ) where import Data.Coerce (Coercible, coerce) -import Prelude hiding (all, and, any, elem, foldMap, foldl, foldr, mapM_, notElem, null, or, print, - product, sequence_, sum) +import Data.Kind (Type) +import Prelude hiding (all, and, any, concatMap, elem, foldMap, foldl, foldr, mapM_, notElem, null, +#if __GLASGOW_HASKELL__ >= 910 + foldl', +#endif + or, print, product, sequence_, sum) -import Universum.Applicative (Alternative (..), Const, ZipList, pass) -import Universum.Base (Word8) +import Universum.Applicative (Alternative (..), Const, ZipList (..), pass) +import Universum.Base (HasCallStack, Word8) import Universum.Container.Reexport (HashMap, HashSet, Hashable, IntMap, IntSet, Map, Seq, Set, Vector) import Universum.Functor (Identity) -import Universum.Monad.Reexport (fromMaybe) import Universum.Monoid (All (..), Any (..), Dual, First (..), Last, Product, Sum) -#if __GLASGOW_HASKELL__ >= 800 -import GHC.Err (errorWithoutStackTrace) +import qualified GHC.Exts as Exts import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError) -#endif -#if ( __GLASGOW_HASKELL__ >= 800 ) import qualified Data.List.NonEmpty as NE import Universum.List.Reexport (NonEmpty) -#endif import qualified Data.Foldable as Foldable @@ -70,6 +73,8 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL +import qualified Data.List (concatMap) + import qualified Data.Text as T import qualified Data.Text.Lazy as TL @@ -111,9 +116,9 @@ class ToPairs t where {-# MINIMAL toPairs #-} -- | Type of keys of the mapping. - type Key t :: * + type Key t :: Type -- | Type of value of the mapping. - type Val t :: * + type Val t :: Type -- | Converts the structure to the list of the key-value pairs. -- >>> toPairs (HashMap.fromList [('a', "xxx"), ('b', "yyy")]) @@ -168,13 +173,91 @@ elems = M.elems {-# INLINE elems #-} +instance ToPairs [(k, v)] where + type Key [(k, v)] = k + type Val [(k, v)] = v + toPairs = id + {-# INLINE toPairs #-} + +instance ToPairs (NonEmpty (k, v)) where + type Key (NonEmpty (k, v)) = k + type Val (NonEmpty (k, v)) = v + toPairs = NE.toList + {-# INLINE toPairs #-} + ---------------------------------------------------------------------------- +-- FromList +---------------------------------------------------------------------------- + +-- | Type class for data types that can be constructed from a list. +class FromList l where + type ListElement l :: Type + type ListElement l = Exts.Item l + + type FromListC l :: Exts.Constraint + type FromListC l = () + + {- | Make a value from list. + + For simple types like '[]' and 'Set': + + @ + 'toList' . 'fromList' ≡ id + 'fromList' . 'toList' ≡ id + @ + + For map-like types: + + @ + 'toPairs' . 'fromList' ≡ id + 'fromList' . 'toPairs' ≡ id + @ + + -} + fromList :: FromListC l => [ListElement l] -> l + default fromList + :: (Exts.IsList l, Exts.Item l ~ a, ListElement l ~ a) + => [ListElement l] -> l + fromList = Exts.fromList + +instance FromList [a] +instance FromList (Vector a) +instance FromList (Seq a) +instance FromList (ZipList a) where + type ListElement (ZipList a) = a + fromList = ZipList +instance FromList (NonEmpty a) where + type FromListC (NonEmpty a) = HasCallStack + fromList l = case l of + [] -> error "empty list" + x : xs -> x NE.:| xs + +instance FromList IntSet +instance Ord a => FromList (Set a) +instance FromList (IntMap v) +instance Ord k => FromList (Map k v) +#if MIN_VERSION_hashable(1,4,0) +instance (Hashable k) => FromList (HashMap k v) +#else +instance (Eq k, Hashable k) => FromList (HashMap k v) +#endif + +instance FromList T.Text +instance FromList TL.Text +instance FromList BS.ByteString where + type ListElement BS.ByteString = Word8 + fromList = BS.pack +instance FromList BSL.ByteString where + type ListElement BSL.ByteString = Word8 + fromList = BSL.pack + +---------------------------------------------------------------------------- -- Containers (e.g. tuples and Maybe aren't containers) ---------------------------------------------------------------------------- -- | Default implementation of 'Element' associated type family. -type family ElementDefault (t :: *) :: * where - ElementDefault (f a) = a +type family ElementDefault (t :: Type) :: Type where + ElementDefault (_ a) = a -- | Very similar to 'Foldable' but also allows instances for monomorphic types -- like 'Text' but forbids instances for 'Maybe' and similar. This class is used as @@ -195,7 +278,7 @@ -- so we can't implement nice interface using old higher-kinded types -- approach. Implementing this as an associated type family instead of -- top-level family gives you more control over element types. - type Element t :: * + type Element t :: Type type Element t = ElementDefault t -- | Convert container to list of elements. @@ -216,7 +299,7 @@ -- >>> null @Text "aba" -- False null :: t -> Bool - default null :: (Foldable f, t ~ f a, Element t ~ a) => t -> Bool + default null :: (Foldable f, t ~ f a) => t -> Bool null = Foldable.null {-# INLINE null #-} @@ -236,7 +319,7 @@ {-# INLINE foldl' #-} length :: t -> Int - default length :: (Foldable f, t ~ f a, Element t ~ a) => t -> Int + default length :: (Foldable f, t ~ f a) => t -> Int length = Foldable.length {-# INLINE length #-} @@ -249,16 +332,6 @@ elem = Foldable.elem {-# INLINE elem #-} - maximum :: Ord (Element t) => t -> Element t - default maximum :: (Foldable f, t ~ f a, Element t ~ a, Ord (Element t)) => t -> Element t - maximum = Foldable.maximum - {-# INLINE maximum #-} - - minimum :: Ord (Element t) => t -> Element t - default minimum :: (Foldable f, t ~ f a, Element t ~ a, Ord (Element t)) => t -> Element t - minimum = Foldable.minimum - {-# INLINE minimum #-} - foldMap :: Monoid m => (Element t -> m) -> t -> m foldMap f = foldr (mappend . f) mempty {-# INLINE foldMap #-} @@ -272,36 +345,6 @@ where f' k x z = k $! f x z {-# INLINE foldr' #-} - foldr1 :: (Element t -> Element t -> Element t) -> t -> Element t - foldr1 f xs = -#if __GLASGOW_HASKELL__ >= 800 - fromMaybe (errorWithoutStackTrace "foldr1: empty structure") - (foldr mf Nothing xs) -#else - fromMaybe (error "foldr1: empty structure") - (foldr mf Nothing xs) -#endif - where - mf x m = Just (case m of - Nothing -> x - Just y -> f x y) - {-# INLINE foldr1 #-} - - foldl1 :: (Element t -> Element t -> Element t) -> t -> Element t - foldl1 f xs = -#if __GLASGOW_HASKELL__ >= 800 - fromMaybe (errorWithoutStackTrace "foldl1: empty structure") - (foldl mf Nothing xs) -#else - fromMaybe (error "foldl1: empty structure") - (foldl mf Nothing xs) -#endif - where - mf m y = Just (case m of - Nothing -> y - Just x -> f x y) - {-# INLINE foldl1 #-} - notElem :: Eq (Element t) => Element t -> t -> Bool notElem x = not . elem x {-# INLINE notElem #-} @@ -328,6 +371,43 @@ safeHead = foldr (\x _ -> Just x) Nothing {-# INLINE safeHead #-} + safeMaximum :: Ord (Element t) => t -> Maybe (Element t) + default safeMaximum + :: (Foldable f, t ~ f a, Element t ~ a, Ord (Element t)) + => t -> Maybe (Element t) + safeMaximum = checkingNotNull Foldable.maximum + {-# INLINE safeMaximum #-} + + safeMinimum :: Ord (Element t) => t -> Maybe (Element t) + default safeMinimum + :: (Foldable f, t ~ f a, Element t ~ a, Ord (Element t)) + => t -> Maybe (Element t) + safeMinimum = checkingNotNull Foldable.minimum + {-# INLINE safeMinimum #-} + + safeFoldr1 :: (Element t -> Element t -> Element t) -> t -> Maybe (Element t) + safeFoldr1 f xs = foldr mf Nothing xs + where + mf x m = Just (case m of + Nothing -> x + Just y -> f x y) + {-# INLINE safeFoldr1 #-} + + safeFoldl1 :: (Element t -> Element t -> Element t) -> t -> Maybe (Element t) + safeFoldl1 f xs = foldl mf Nothing xs + where + mf m y = Just (case m of + Nothing -> y + Just x -> f x y) + {-# INLINE safeFoldl1 #-} + +-- | Helper for lifting operations which require container to be not empty. +checkingNotNull :: Container t => (t -> Element t) -> t -> Maybe (Element t) +checkingNotNull f t + | null t = Nothing + | otherwise = Just $ f t +{-# INLINE checkingNotNull #-} + ---------------------------------------------------------------------------- -- Instances for monomorphic containers ---------------------------------------------------------------------------- @@ -344,18 +424,18 @@ {-# INLINE foldl #-} foldl' = T.foldl' {-# INLINE foldl' #-} - foldr1 = T.foldr1 - {-# INLINE foldr1 #-} - foldl1 = T.foldl1 - {-# INLINE foldl1 #-} + safeFoldr1 f = checkingNotNull (T.foldr1 f) + {-# INLINE safeFoldr1 #-} + safeFoldl1 f = checkingNotNull (T.foldl1 f) + {-# INLINE safeFoldl1 #-} length = T.length {-# INLINE length #-} elem c = T.isInfixOf (T.singleton c) -- there are rewrite rules for this {-# INLINE elem #-} - maximum = T.maximum - {-# INLINE maximum #-} - minimum = T.minimum - {-# INLINE minimum #-} + safeMaximum = checkingNotNull T.maximum + {-# INLINE safeMaximum #-} + safeMinimum = checkingNotNull T.minimum + {-# INLINE safeMinimum #-} all = T.all {-# INLINE all #-} any = T.any @@ -377,19 +457,19 @@ {-# INLINE foldl #-} foldl' = TL.foldl' {-# INLINE foldl' #-} - foldr1 = TL.foldr1 - {-# INLINE foldr1 #-} - foldl1 = TL.foldl1 - {-# INLINE foldl1 #-} + safeFoldr1 f = checkingNotNull (TL.foldr1 f) + {-# INLINE safeFoldr1 #-} + safeFoldl1 f = checkingNotNull (TL.foldl1 f) + {-# INLINE safeFoldl1 #-} length = fromIntegral . TL.length {-# INLINE length #-} -- will be okay thanks to rewrite rules elem c s = TL.isInfixOf (TL.singleton c) s {-# INLINE elem #-} - maximum = TL.maximum - {-# INLINE maximum #-} - minimum = TL.minimum - {-# INLINE minimum #-} + safeMaximum = checkingNotNull TL.maximum + {-# INLINE safeMaximum #-} + safeMinimum = checkingNotNull TL.minimum + {-# INLINE safeMinimum #-} all = TL.all {-# INLINE all #-} any = TL.any @@ -411,20 +491,20 @@ {-# INLINE foldl #-} foldl' = BS.foldl' {-# INLINE foldl' #-} - foldr1 = BS.foldr1 - {-# INLINE foldr1 #-} - foldl1 = BS.foldl1 - {-# INLINE foldl1 #-} + safeFoldr1 f = checkingNotNull (BS.foldr1 f) + {-# INLINE safeFoldr1 #-} + safeFoldl1 f = checkingNotNull (BS.foldl1 f) + {-# INLINE safeFoldl1 #-} length = BS.length {-# INLINE length #-} elem = BS.elem {-# INLINE elem #-} notElem = BS.notElem {-# INLINE notElem #-} - maximum = BS.maximum - {-# INLINE maximum #-} - minimum = BS.minimum - {-# INLINE minimum #-} + safeMaximum = checkingNotNull BS.maximum + {-# INLINE safeMaximum #-} + safeMinimum = checkingNotNull BS.minimum + {-# INLINE safeMinimum #-} all = BS.all {-# INLINE all #-} any = BS.any @@ -446,20 +526,20 @@ {-# INLINE foldl #-} foldl' = BSL.foldl' {-# INLINE foldl' #-} - foldr1 = BSL.foldr1 - {-# INLINE foldr1 #-} - foldl1 = BSL.foldl1 - {-# INLINE foldl1 #-} + safeFoldr1 f = checkingNotNull (BSL.foldr1 f) + {-# INLINE safeFoldr1 #-} + safeFoldl1 f = checkingNotNull (BSL.foldl1 f) + {-# INLINE safeFoldl1 #-} length = fromIntegral . BSL.length {-# INLINE length #-} elem = BSL.elem {-# INLINE elem #-} notElem = BSL.notElem {-# INLINE notElem #-} - maximum = BSL.maximum - {-# INLINE maximum #-} - minimum = BSL.minimum - {-# INLINE minimum #-} + safeMaximum = checkingNotNull BSL.maximum + {-# INLINE safeMaximum #-} + safeMinimum = checkingNotNull BSL.minimum + {-# INLINE safeMinimum #-} all = BSL.all {-# INLINE all #-} any = BSL.any @@ -485,10 +565,10 @@ {-# INLINE length #-} elem = IS.member {-# INLINE elem #-} - maximum = IS.findMax - {-# INLINE maximum #-} - minimum = IS.findMin - {-# INLINE minimum #-} + safeMaximum = checkingNotNull IS.findMax + {-# INLINE safeMaximum #-} + safeMinimum = checkingNotNull IS.findMin + {-# INLINE safeMinimum #-} safeHead = fmap fst . IS.minView {-# INLINE safeHead #-} @@ -502,7 +582,11 @@ notElem = Set.notMember {-# INLINE notElem #-} +#if MIN_VERSION_hashable(1,4,0) +instance (Hashable v) => Container (HashSet v) where +#else instance (Eq v, Hashable v) => Container (HashSet v) where +#endif elem = HashSet.member {-# INLINE elem #-} @@ -514,7 +598,6 @@ instance Container [a] instance Container (Const a b) -#if __GLASGOW_HASKELL__ >= 800 -- Algebraic types instance Container (Dual a) instance Container (First a) @@ -523,7 +606,6 @@ instance Container (Sum a) instance Container (NonEmpty a) instance Container (ZipList a) -#endif -- Containers instance Container (HashMap k v) @@ -548,7 +630,6 @@ flipfoldl' f = foldl' (flip f) {-# INLINE flipfoldl' #-} -#if MIN_VERSION_base(4,10,1) -- | Stricter version of 'Prelude.sum'. -- -- >>> sum [1..10] @@ -568,11 +649,9 @@ -- use -- maybeToMonoid :: Monoid m => Maybe m -> m -- ... -#endif sum :: (Container t, Num (Element t)) => t -> Element t sum = foldl' (+) 0 -#if MIN_VERSION_base(4,10,1) -- | Stricter version of 'Prelude.product'. -- -- >>> product [1..10] @@ -592,7 +671,6 @@ -- use -- maybeToMonoid :: Monoid m => Maybe m -> m -- ... -#endif product :: (Container t, Num (Element t)) => t -> Element t product = foldl' (*) 1 @@ -682,11 +760,21 @@ asum = foldr (<|>) empty {-# INLINE asum #-} +{- | Version of 'Data.Foldable.concatMap' constrained to 'Container'. + +>>> concatMap (\x -> [x + 1, x + 2]) [1, 2, 3] +[2,3,3,4,4,5] + +@since 1.8.0 +-} +concatMap :: Container c => (Element c -> [b]) -> c -> [b] +concatMap f = Data.List.concatMap f . toList +{-# INLINE concatMap #-} + ---------------------------------------------------------------------------- -- Disallowed instances ---------------------------------------------------------------------------- -#if __GLASGOW_HASKELL__ >= 800 type family DisallowInstance (z :: Symbol) :: ErrorMessage where DisallowInstance z = Text "Do not use 'Foldable' methods on " :<>: Text z :$$: Text "Suggestions:" @@ -701,20 +789,11 @@ :$$: Text " use" :$$: Text " maybeToMonoid :: Monoid m => Maybe m -> m" :$$: Text "" -#endif -#if __GLASGOW_HASKELL__ >= 800 instance TypeError (DisallowInstance "tuple") => Container (a, b) instance TypeError (DisallowInstance "Maybe") => Container (Maybe a) instance TypeError (DisallowInstance "Either") => Container (Either a b) instance TypeError (DisallowInstance "Identity") => Container (Identity a) -#else -class ForbiddenFoldable a -instance ForbiddenFoldable (a, b) => Container (a, b) -instance ForbiddenFoldable (Maybe a) => Container (Maybe a) -instance ForbiddenFoldable (Either a b) => Container (Either a b) -instance ForbiddenFoldable (Identity a) => Container (Identity a) -#endif ---------------------------------------------------------------------------- -- One @@ -742,12 +821,10 @@ one = (:[]) {-# INLINE one #-} -#if ( __GLASGOW_HASKELL__ >= 800 ) instance One (NE.NonEmpty a) where type OneItem (NE.NonEmpty a) = a one = (NE.:|[]) {-# INLINE one #-} -#endif instance One (SEQ.Seq a) where type OneItem (SEQ.Seq a) = a diff --git a/src/Universum/Container/Reexport.hs b/src/Universum/Container/Reexport.hs --- a/src/Universum/Container/Reexport.hs +++ b/src/Universum/Container/Reexport.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE Trustworthy #-} + -- | This module reexports all container related stuff from 'Prelude'. module Universum.Container.Reexport diff --git a/src/Universum/Debug.hs b/src/Universum/Debug.hs --- a/src/Universum/Debug.hs +++ b/src/Universum/Debug.hs @@ -1,15 +1,14 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} -#if ( __GLASGOW_HASKELL__ >= 804 ) -{-# LANGUAGE TypeInType #-} -#endif -- | Functions for debugging. If you left these functions in your code -- then warning is generated to remind you about left usages. Also, some @@ -32,18 +31,14 @@ import Control.Monad (Monad, return) import Data.Data (Data) import Data.Text (Text, pack, unpack) -import Data.Typeable (Typeable) import GHC.Generics (Generic) import System.IO.Unsafe (unsafePerformIO) -#if ( __GLASGOW_HASKELL__ >= 800 ) import GHC.Exception (errorCallWithCallStackException) import GHC.Exts (RuntimeRep, TYPE, raise#) -import Universum.Base (HasCallStack, callStack) -#endif - import Universum.Applicative (pass) +import Universum.Base (HasCallStack, callStack) import Universum.Print (putStrLn) import qualified Prelude as P @@ -56,14 +51,9 @@ return expr) -- | 'P.error' that takes 'Text' as an argument. -#if ( __GLASGOW_HASKELL__ >= 800 ) error :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack => Text -> a error s = raise# (errorCallWithCallStackException (unpack s) callStack) -#else -error :: Text -> a -error s = P.error (unpack s) -#endif -- | Version of 'Debug.Trace.traceShow' that leaves a warning. {-# WARNING traceShow "'traceShow' remains in code" #-} @@ -120,13 +110,9 @@ -- | Similar to 'undefined' but data type. {-# WARNING Undefined "'Undefined' type remains in code" #-} data Undefined = Undefined - deriving (P.Eq, P.Ord, P.Show, P.Read, P.Enum, P.Bounded, Data, Typeable, Generic) + deriving stock (P.Eq, P.Ord, P.Show, P.Read, P.Enum, P.Bounded, Data, Generic) -- | 'P.undefined' that leaves a warning in code on every usage. {-# WARNING undefined "'undefined' function remains in code (or use 'error')" #-} -#if ( __GLASGOW_HASKELL__ >= 800 ) undefined :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack => a -#else -undefined :: a -#endif undefined = P.undefined diff --git a/src/Universum/DeepSeq.hs b/src/Universum/DeepSeq.hs --- a/src/Universum/DeepSeq.hs +++ b/src/Universum/DeepSeq.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE Trustworthy #-} + -- | This module contains useful functions to evaluate expressions to weak-head -- normal form or just normal form. Useful to force traces or @error@ inside -- monadic computation or to remove space leaks. diff --git a/src/Universum/Exception.hs b/src/Universum/Exception.hs --- a/src/Universum/Exception.hs +++ b/src/Universum/Exception.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE Safe #-} @@ -9,24 +9,21 @@ module Universum.Exception ( module Control.Exception.Safe -#if ( __GLASGOW_HASKELL__ >= 800 ) , Bug (..) , bug , pattern Exc -#endif , note ) where -- exceptions from safe-exceptions import Control.Exception.Safe (Exception (..), MonadCatch, MonadMask (..), MonadThrow, SomeException (..), bracket, bracketOnError, bracket_, catch, - catchAny, displayException, finally, handleAny, onException, - throwM, try, tryAny) + catchAny, displayException, finally, handleAny, onException, throwM, + try, tryAny) import Control.Monad.Except (MonadError, throwError) import Universum.Applicative (Applicative (pure)) import Universum.Monad (Maybe (..), maybe) -#if ( __GLASGOW_HASKELL__ >= 800 ) import Data.List ((++)) import GHC.Show (Show) import GHC.Stack (CallStack, HasCallStack, callStack, prettyCallStack) @@ -36,7 +33,7 @@ -- | Type that represents exceptions used in cases when a particular codepath -- is not meant to be ever executed, but happens to be executed anyway. data Bug = Bug SomeException CallStack - deriving (Show) + deriving stock (Show) instance Exception Bug where displayException (Bug e cStack) = Safe.displayException e ++ "\n" @@ -46,21 +43,15 @@ -- throw the exception wrapped into 'Bug' data type. bug :: (HasCallStack, Exception e) => e -> a bug e = Safe.impureThrow (Bug (Safe.toException e) callStack) -#endif -- To suppress redundant applicative constraint warning on GHC 8.0 -- | Throws error for 'Maybe' if 'Data.Maybe.Nothing' is given. -- Operates over 'MonadError'. -#if ( __GLASGOW_HASKELL__ >= 800 ) +{-# DEPRECATED note "Don't use this function. Use 'maybeToRight' instead" #-} note :: (MonadError e m) => e -> Maybe a -> m a note err = maybe (throwError err) pure -#else -note :: (MonadError e m, Applicative m) => e -> Maybe a -> m a -note err = maybe (throwError err) pure -#endif -#if ( __GLASGOW_HASKELL__ >= 800 ) {- | Pattern synonym to easy pattern matching on exceptions. So intead of writing something like this: @@ -86,4 +77,3 @@ pattern Exc e <- (fromException -> Just e) where Exc e = toException e -#endif diff --git a/src/Universum/Function.hs b/src/Universum/Function.hs --- a/src/Universum/Function.hs +++ b/src/Universum/Function.hs @@ -1,7 +1,9 @@ +{-# LANGUAGE Safe #-} + -- | This module reexports very basic and primitive functions and function combinators. module Universum.Function ( module Data.Function ) where -import Data.Function (const, fix, flip, id, on, ($), (.)) +import Data.Function (const, fix, flip, id, on, ($), (.), (&)) diff --git a/src/Universum/Functor/Reexport.hs b/src/Universum/Functor/Reexport.hs --- a/src/Universum/Functor/Reexport.hs +++ b/src/Universum/Functor/Reexport.hs @@ -12,6 +12,6 @@ import Control.Arrow ((&&&)) import Data.Bifunctor (Bifunctor (..)) -import Data.Functor (Functor (..), void, ($>), (<$>)) +import Data.Functor (Functor (..), void, ($>), (<$>), (<&>)) import Data.Functor.Compose (Compose (..)) import Data.Functor.Identity (Identity (..)) diff --git a/src/Universum/Lifted/Concurrent.hs b/src/Universum/Lifted/Concurrent.hs --- a/src/Universum/Lifted/Concurrent.hs +++ b/src/Universum/Lifted/Concurrent.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE Safe #-} -- | Concurrency useful and common functions. @@ -14,6 +15,7 @@ , tryPutMVar , tryReadMVar , tryTakeMVar + , updateMVar' -- * STM , STM @@ -22,6 +24,7 @@ , newTVarIO , readTVarIO , STM.modifyTVar' + , updateTVar' , STM.newTVar , STM.readTVar , STM.writeTVar @@ -29,14 +32,18 @@ import Control.Concurrent.MVar (MVar) import Control.Concurrent.STM.TVar (TVar) +import Control.Monad (return) import Control.Monad.STM (STM) +import Control.Monad.State (StateT (..)) import Control.Monad.Trans (MonadIO, liftIO) import Data.Bool (Bool) import Data.Function (($), (.)) import Data.Maybe (Maybe) +import System.IO (IO) -import qualified Control.Concurrent.MVar as CCM (newEmptyMVar, newMVar, putMVar, readMVar, swapMVar, - takeMVar, tryPutMVar, tryReadMVar, tryTakeMVar) +import qualified Control.Concurrent.MVar as CCM (modifyMVar, newEmptyMVar, newMVar, putMVar, + readMVar, swapMVar, takeMVar, tryPutMVar, + tryReadMVar, tryTakeMVar) import qualified Control.Concurrent.STM.TVar as STM (modifyTVar', newTVar, newTVarIO, readTVar, readTVarIO, writeTVar) import qualified Control.Monad.STM as STM (atomically) @@ -108,3 +115,26 @@ readTVarIO :: MonadIO m => TVar a -> m a readTVarIO = liftIO . STM.readTVarIO {-# INLINE readTVarIO #-} + +---------------------------------------------------------------------------- +-- Common helpers +---------------------------------------------------------------------------- + +-- | Like 'modifyMVar', but modification is specified as a 'State' computation. +-- +-- This method is strict in produced @s@ value. +updateMVar' :: MonadIO m => MVar s -> StateT s IO a -> m a +updateMVar' var (StateT f) = + liftIO . CCM.modifyMVar var $ \s -> do + (a, !s') <- f s + return (s', a) +{-# INLINE updateMVar' #-} + +-- | Like 'modifyTVar\'', but modification is specified as a 'State' monad. +updateTVar' :: TVar s -> StateT s STM a -> STM a +updateTVar' var (StateT f) = do + s <- STM.readTVar var + (a, !s') <- f s + STM.writeTVar var s' + return a +{-# INLINE updateTVar' #-} 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 @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | Lifted versions of functions working with files and common IO. @@ -22,28 +21,28 @@ import System.IO (Handle, IOMode) import qualified Data.Text.IO as XIO -import qualified System.IO as XIO (openFile, hClose, IO) +import qualified System.IO as XIO (IO, hClose, openFile) ---------------------------------------------------------------------------- -- 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/List/Reexport.hs b/src/Universum/List/Reexport.hs --- a/src/Universum/List/Reexport.hs +++ b/src/Universum/List/Reexport.hs @@ -1,26 +1,18 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} -- | This module reexports functinons to work with list, 'NonEmpty' and String types. module Universum.List.Reexport ( module Data.List - -#if ( __GLASGOW_HASKELL__ >= 800 ) , module Data.List.NonEmpty -#endif - , module GHC.Exts ) where import Data.List (break, cycle, drop, dropWhile, filter, genericDrop, genericLength, - genericReplicate, genericSplitAt, genericTake, group, inits, intercalate, + genericReplicate, genericSplitAt, genericTake, inits, intercalate, intersperse, isPrefixOf, iterate, permutations, repeat, replicate, reverse, scanl, scanr, sort, sortBy, sortOn, splitAt, subsequences, tails, take, takeWhile, transpose, unfoldr, unzip, unzip3, zip, zip3, zipWith, (++)) - -#if ( __GLASGOW_HASKELL__ >= 800 ) -import Data.List.NonEmpty (NonEmpty (..), head, init, last, nonEmpty, tail) -#endif +import Data.List.NonEmpty (NonEmpty (..), group, groupAllWith, groupBy, groupWith, head, init, last, nonEmpty, tail) import GHC.Exts (sortWith) diff --git a/src/Universum/List/Safe.hs b/src/Universum/List/Safe.hs --- a/src/Universum/List/Safe.hs +++ b/src/Universum/List/Safe.hs @@ -1,27 +1,29 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | This module contains safe functions to work with list type (mostly with 'NonEmpty'). module Universum.List.Safe ( uncons -#if ( __GLASGOW_HASKELL__ >= 800 ) , whenNotNull , whenNotNullM -#endif + , foldr1 + , foldl1 + , minimum + , maximum + , minimumBy + , maximumBy ) where -#if ( __GLASGOW_HASKELL__ >= 800 ) +import qualified Data.Foldable as F +import Data.Ord (Ord, Ordering) + import Universum.Applicative (Applicative, pass) import Universum.List.Reexport (NonEmpty (..)) -import Universum.Monad (Monad (..)) -#endif - -import Universum.Monad (Maybe (..)) +import Universum.Monad (Maybe (..), Monad (..)) -- $setup -- >>> import Universum.Applicative (pure) --- >>> import Universum.Base ((==), even) +-- >>> import Universum.Base ((==), (+), even) -- >>> import Universum.Bool (Bool (..), not) -- >>> import Universum.Container (length) -- >>> import Universum.Function (($)) @@ -39,7 +41,6 @@ uncons [] = Nothing uncons (x:xs) = Just (x, xs) -#if ( __GLASGOW_HASKELL__ >= 800 ) {- | Performs given action over 'NonEmpty' list if given list is non empty. >>> whenNotNull [] $ \(b :| _) -> print (not b) @@ -56,4 +57,49 @@ whenNotNullM :: Monad m => m [a] -> (NonEmpty a -> m ()) -> m () whenNotNullM ml f = ml >>= \l -> whenNotNull l f {-# INLINE whenNotNullM #-} -#endif + +-- | A variant of 'foldl' that has no base case, and thus may only be +-- applied to 'NonEmpty'. +-- +-- >>> foldl1 (+) (1 :| [2,3,4,5]) +-- 15 +foldl1 :: (a -> a -> a) -> NonEmpty a -> a +foldl1 = F.foldl1 +{-# INLINE foldl1 #-} + +-- | A variant of 'foldr' that has no base case, and thus may only be +-- applied to 'NonEmpty'. +-- +-- >>> foldr1 (+) (1 :| [2,3,4,5]) +-- 15 +foldr1 :: (a -> a -> a) -> NonEmpty a -> a +foldr1 = F.foldr1 +{-# INLINE foldr1 #-} + +-- | The least element of a 'NonEmpty' with respect to the given +-- comparison function. +minimumBy :: (a -> a -> Ordering) -> NonEmpty a -> a +minimumBy = F.minimumBy +{-# INLINE minimumBy #-} + +-- | The least element of a 'NonEmpty'. +-- +-- >>> minimum (1 :| [2,3,4,5]) +-- 1 +minimum :: Ord a => NonEmpty a -> a +minimum = F.minimum +{-# INLINE minimum #-} + +-- | The largest element of a 'NonEmpty' with respect to the given +-- comparison function. +maximumBy :: (a -> a -> Ordering) -> NonEmpty a -> a +maximumBy = F.maximumBy +{-# INLINE maximumBy #-} + +-- | The largest element of a 'NonEmpty'. +-- +-- >>> maximum (1 :| [2,3,4,5]) +-- 5 +maximum :: Ord a => NonEmpty a -> a +maximum = F.maximum +{-# INLINE maximum #-} diff --git a/src/Universum/Monad.hs b/src/Universum/Monad.hs --- a/src/Universum/Monad.hs +++ b/src/Universum/Monad.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} -- | Reexporting useful monadic stuff. diff --git a/src/Universum/Monad/Container.hs b/src/Universum/Monad/Container.hs --- a/src/Universum/Monad/Container.hs +++ b/src/Universum/Monad/Container.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} -- | This module exports functions which allow to process instances of @@ -17,6 +19,9 @@ import Data.Function ((.)) import Data.Traversable (Traversable (traverse)) import Prelude (Bool (..), Monoid, flip) +#if MIN_VERSION_base(4,17,0) +import Data.Type.Equality (type (~)) +#endif import Universum.Base (IO) import Universum.Container (Container, Element, fold, toList) diff --git a/src/Universum/Monad/Maybe.hs b/src/Universum/Monad/Maybe.hs --- a/src/Universum/Monad/Maybe.hs +++ b/src/Universum/Monad/Maybe.hs @@ -13,8 +13,7 @@ ) where import Universum.Applicative (Applicative, pass, pure) -import Universum.Monad.Reexport (fromMaybe) -import Universum.Monad.Reexport (Maybe (..), Monad (..)) +import Universum.Monad.Reexport (Maybe (..), Monad (..), fromMaybe) -- $setup -- >>> import Universum.Bool (Bool (..), not) diff --git a/src/Universum/Monad/Reexport.hs b/src/Universum/Monad/Reexport.hs --- a/src/Universum/Monad/Reexport.hs +++ b/src/Universum/Monad/Reexport.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} -- | This module reexports functions to work with monads. @@ -58,42 +57,11 @@ import Control.Monad.Trans.Maybe (MaybeT (..), exceptToMaybeT, maybeToExceptT) -- Maybe -import Data.Maybe (Maybe (..), catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, +import Data.Maybe (Maybe (..), catMaybes, fromMaybe, isJust, isNothing, mapMaybe, maybe, maybeToList) -- Either import Data.Either (Either (..), either, isLeft, isRight, lefts, partitionEithers, rights) import Control.Monad hiding (fail) - -#if __GLASGOW_HASKELL__ >= 800 import Control.Monad.Fail (MonadFail (..)) -#else -import Prelude (String) -import Text.ParserCombinators.ReadP (ReadP) -import Text.ParserCombinators.ReadPrec (ReadPrec) - -import Universum.Base (IO) - -import qualified Prelude as P (fail) - --- | Class for 'Monad's that can 'fail'. --- Copied from 'fail' by Herbert Valerio Riedel (the library is under BSD3). -class Monad m => MonadFail m where - fail :: String -> m a - -instance MonadFail Maybe where - fail _ = Nothing - -instance MonadFail [] where - fail _ = [] - -instance MonadFail IO where - fail = P.fail - -instance MonadFail ReadPrec where - fail = P.fail -- = P (\_ -> fail s) - -instance MonadFail ReadP where - fail = P.fail -#endif diff --git a/src/Universum/Monad/Trans.hs b/src/Universum/Monad/Trans.hs --- a/src/Universum/Monad/Trans.hs +++ b/src/Universum/Monad/Trans.hs @@ -14,13 +14,17 @@ , executingStateT , usingState , usingStateT + + -- * Convenient functions to work with 'MaybeT' and 'ExceptT' transformers + , hoistMaybe + , hoistEither ) where -import Prelude (flip, fst, snd) +import Prelude (Applicative (..), flip, fst, snd) import Universum.Functor (Functor, (<$>)) -import Universum.Monad.Reexport (Reader, ReaderT, State, StateT, runReader, runReaderT, runState, - runStateT) +import Universum.Monad.Reexport (Either, ExceptT (..), Maybe, MaybeT (..), Reader, ReaderT, State, + StateT, runReader, runReaderT, runState, runStateT) -- | Shorter and more readable alias for @flip runReaderT@. usingReaderT :: r -> ReaderT r m a -> m a @@ -65,3 +69,13 @@ executingState :: s -> State s a -> s executingState s st = snd (usingState s st) {-# INLINE executingState #-} + +-- | Lift a 'Maybe' to the 'MaybeT' monad +hoistMaybe :: Applicative m => Maybe a -> MaybeT m a +hoistMaybe m = MaybeT (pure m) +{-# INLINE hoistMaybe #-} + +-- | Lift a 'Either' to the 'ExceptT' monad +hoistEither :: Applicative m => Either e a -> ExceptT e m a +hoistEither e = ExceptT (pure e) +{-# INLINE hoistEither #-} diff --git a/src/Universum/Monoid.hs b/src/Universum/Monoid.hs --- a/src/Universum/Monoid.hs +++ b/src/Universum/Monoid.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} -- | This module reexports functions to work with monoids plus adds extra useful functions. module Universum.Monoid ( module Data.Monoid -#if ( __GLASGOW_HASKELL__ >= 800 ) , module Data.Semigroup -#endif , maybeToMonoid ) where import Data.Monoid (All (..), Alt (..), Any (..), Dual (..), Endo (..), First (..), Last (..), Monoid (..), Product (..), Sum (..)) - -#if ( __GLASGOW_HASKELL__ >= 800 ) -import Data.Semigroup (Option (..), Semigroup (sconcat, stimes, (<>)), WrappedMonoid, cycle1, - mtimesDefault, stimesIdempotent, stimesIdempotentMonoid, stimesMonoid) -#endif +import Data.Semigroup (Semigroup (sconcat, stimes, (<>)), WrappedMonoid, cycle1, mtimesDefault, + stimesIdempotent, stimesIdempotentMonoid, stimesMonoid) import Universum.Monad.Reexport (Maybe, fromMaybe) diff --git a/src/Universum/Nub.hs b/src/Universum/Nub.hs --- a/src/Universum/Nub.hs +++ b/src/Universum/Nub.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE CPP #-} + {-| Functions to remove duplicates from a list. = Performance @@ -28,29 +31,16 @@ , unstableNub ) where +#if !MIN_VERSION_hashable(1,4,0) import Data.Eq (Eq) +#endif import Data.Hashable (Hashable) import Data.HashSet as HashSet import Data.Ord (Ord) -import Prelude (Bool, Char, (.)) +import Prelude ((.)) import qualified Data.Set as Set --- Liquid Haskell check for duplicates. -{-@ type ListUnique a = {v : [a] | NoDups v} @-} - -{-@ predicate NoDups L = Set_emp (dups L) @-} - -{-@ measure dups :: [a] -> (Set.Set a) - dups ([]) = {v | Set_emp v} - dups (x:xs) = {v | v = - if (Set_mem x (listElts xs)) - then (Set_cup (Set_sng x) (dups xs)) - else (dups xs)} -@-} - -{-@ Set.toList :: Set.Set a -> ListUnique a @-} - -- | Like 'Prelude.nub' but runs in @O(n * log n)@ time and requires 'Ord'. -- -- >>> ordNub [3, 3, 3, 2, 2, -1, 1] @@ -68,7 +58,11 @@ -- -- >>> hashNub [3, 3, 3, 2, 2, -1, 1] -- [3,2,-1,1] +#if MIN_VERSION_hashable(1,4,0) +hashNub :: (Hashable a) => [a] -> [a] +#else hashNub :: (Eq a, Hashable a) => [a] -> [a] +#endif hashNub = go HashSet.empty where go _ [] = [] @@ -81,7 +75,6 @@ -- -- >>> sortNub [3, 3, 3, 2, 2, -1, 1] -- [-1,1,2,3] -{-@ sortNub :: [a] -> ListUnique a @-} sortNub :: (Ord a) => [a] -> [a] sortNub = Set.toList . Set.fromList @@ -89,5 +82,9 @@ -- -- >>> unstableNub [3, 3, 3, 2, 2, -1, 1] -- [1,2,3,-1] +#if MIN_VERSION_hashable(1,4,0) +unstableNub :: (Hashable a) => [a] -> [a] +#else unstableNub :: (Eq a, Hashable a) => [a] -> [a] +#endif unstableNub = HashSet.toList . HashSet.fromList diff --git a/src/Universum/Print/Internal.hs b/src/Universum/Print/Internal.hs --- a/src/Universum/Print/Internal.hs +++ b/src/Universum/Print/Internal.hs @@ -12,9 +12,11 @@ __even for minor version increments__. -} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE Trustworthy #-} + module Universum.Print.Internal (Print(..)) where -import qualified System.IO as SIO (hPutStr, hPutStrLn, Handle) +import qualified System.IO as SIO (Handle, hPutStr, hPutStrLn) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL diff --git a/src/Universum/String.hs b/src/Universum/String.hs --- a/src/Universum/String.hs +++ b/src/Universum/String.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE Safe #-} + -- | Type classes for convertion between different string representations. module Universum.String 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 @@ -2,7 +2,8 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE Trustworthy #-} +{-# 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 @@ -23,14 +24,21 @@ -- * Show and read functions , readEither + , readMaybe , show ) where import Data.Bifunctor (first) import Data.Either (Either) import Data.Function (id, (.)) +import Data.Maybe (Maybe) import Data.String (String) +import qualified Data.Text.Internal as T +#if !MIN_VERSION_text(2,0,2) +import qualified Data.Text.Internal.Fusion.Common as TF +#endif + import Universum.Functor ((<$>)) import Universum.String.Reexport (ByteString, IsString, Read, Text, fromString) @@ -43,7 +51,7 @@ import qualified Data.Text.Encoding.Error as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT -import qualified Text.Read (readEither) +import qualified Text.Read (readEither, readMaybe) import qualified GHC.Show as Show (Show (show)) @@ -159,14 +167,140 @@ 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, as documentation for 'T.pack' function mentions, @toString . toText@ +is not strictly equal to the identity function. Thus, replacing @toString . toText@ +with @id@ will result in losing transformation of surrogate code points. +But in the most cases this is what the user wants. +-} + +{-# RULES "pack/unpack" [~0] + forall s. T.unpack (T.pack s) = s +#-} + +-- This applies when `text` is older than 2.0.2, the oldest GHC version +-- with such `text` is 9.4.4 +-- TODO: remove once we stop supporting GHC 9.4 and older. +#if !MIN_VERSION_text(2,0,2) +{- + +We can do even better than above 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: + +``` +-- Unicode 'Data.Char.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 +#-} +#endif + +{- 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'. -- -- >>> readEither @Text @Int "123" -- Right 123 -- >>> readEither @Text @Int "aa" -- Left "Prelude.read: no parse" +-- +-- @since 1.8.0 readEither :: (ToString a, Read b) => a -> Either Text b readEither = first toText . Text.Read.readEither . toString + +-- | Polymorhpic version of 'Text.Read.readMaybe'. +-- +-- >>> readMaybe @Int @Text "123" +-- Just 123 +-- >>> readMaybe @Int @Text "aa" +-- Nothing +readMaybe :: forall b a. (ToString a, Read b) => a -> Maybe b +readMaybe = Text.Read.readMaybe . toString -- | Generalized version of 'Prelude.show'. show :: forall b a . (Show.Show a, IsString b) => a -> b diff --git a/src/Universum/String/Reexport.hs b/src/Universum/String/Reexport.hs --- a/src/Universum/String/Reexport.hs +++ b/src/Universum/String/Reexport.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE Safe #-} + -- | This module reexports functions to work with 'Text' and 'ByteString' types. module Universum.String.Reexport @@ -22,4 +24,4 @@ import Data.Text.Encoding.Error (OnDecodeError, OnError, UnicodeException, lenientDecode, strictDecode) import Data.Text.Lazy (fromStrict, toStrict) -import Text.Read (Read, readMaybe, reads) +import Text.Read (Read, reads) diff --git a/src/Universum/TypeOps.hs b/src/Universum/TypeOps.hs --- a/src/Universum/TypeOps.hs +++ b/src/Universum/TypeOps.hs @@ -1,18 +1,13 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -#if __GLASGOW_HASKELL__ <= 710 -{-# LANGUAGE Trustworthy #-} -#else -{-# LANGUAGE Safe #-} -#endif +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeOperators #-} -- | Type operators for writing convenient type signatures. @@ -22,11 +17,7 @@ , type ($) ) where -#if __GLASGOW_HASKELL__ <= 710 -import GHC.Prim (Constraint) -#else import Data.Kind (Constraint) -#endif -- | Infix application. -- @@ -35,6 +26,7 @@ -- = -- f :: Either String (Maybe Int) -- @ +type ($) :: (k2 -> k1) -> k2 -> k1 type f $ a = f a infixr 2 $ @@ -46,7 +38,7 @@ -- a :: (Show a, Read a) => a -> a -- @ type family (<+>) (c :: [k -> Constraint]) (a :: k) where - (<+>) '[] a = (() :: Constraint) + (<+>) '[] _ = (() :: Constraint) (<+>) (ch ': ct) a = (ch a, (<+>) ct a) infixl 9 <+> @@ -65,7 +57,7 @@ -- f :: Each '[Show] [a, b] => a -> b -> String -- @ type family Each (c :: [k -> Constraint]) (as :: [k]) where - Each c '[] = (() :: Constraint) + Each _ '[] = (() :: Constraint) Each c (h ': t) = (c <+> h, Each c t) -- | Map several constraints over a single variable. @@ -76,4 +68,5 @@ -- = -- a :: (Show a, Read a) => a -> a -- @ +type With :: [k -> Constraint] -> k -> Constraint type With a b = a <+> b diff --git a/src/Universum/Unsafe.hs b/src/Universum/Unsafe.hs --- a/src/Universum/Unsafe.hs +++ b/src/Universum/Unsafe.hs @@ -22,15 +22,19 @@ , at , (!!) , fromJust + , foldr1 + , foldl1 + , minimum + , maximum + , minimumBy + , maximumBy ) where -import Data.List (head, init, last, tail, (!!)) +import Data.List (foldl1, foldr1, head, init, last, maximum, maximumBy, minimum, minimumBy, tail, + (!!)) import Data.Maybe (fromJust) import Universum.Base (Int) - --- Non empty list definition for @liquidhaskell@. -{-@ type NonEmptyList a = {xs : [a] | len xs > 0} @-} -- | Similar to '!!' but with flipped arguments. {-@ at :: n : Nat -> {xs : NonEmptyList a | len xs > n} -> a @-} diff --git a/src/Universum/VarArg.hs b/src/Universum/VarArg.hs --- a/src/Universum/VarArg.hs +++ b/src/Universum/VarArg.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- | Provides operator of variable-arguments function composition. @@ -11,6 +14,10 @@ ( SuperComposition(..) ) where +#if MIN_VERSION_base(4,17,0) +import Data.Type.Equality (type (~)) +#endif + -- $setup -- >>> import Universum.Base ((+)) -- >>> import Universum.Container (null) @@ -48,12 +55,12 @@ infixl 8 ... -instance (a ~ c, r ~ b) => +instance {-# INCOHERENT #-} (a ~ c, r ~ b) => SuperComposition (a -> b) c r where f ... g = f g {-# INLINE (...) #-} -instance (SuperComposition (a -> b) d r1, r ~ (c -> r1)) => +instance {-# INCOHERENT #-} (SuperComposition (a -> b) d r1, r ~ (c -> r1)) => SuperComposition (a -> b) (c -> d) r where (f ... g) c = f ... g c {-# INLINE (...) #-} diff --git a/test/Doctest.hs b/test/Doctest.hs --- a/test/Doctest.hs +++ b/test/Doctest.hs @@ -1,14 +1,5 @@ -{-# LANGUAGE CPP #-} - module Main (main) where -#if defined(mingw32_HOST_OS) || __GLASGOW_HASKELL__ < 802 - -main :: IO () -main = return () - -#else - import System.FilePath.Glob (glob) import Test.DocTest (doctest) @@ -16,5 +7,3 @@ main = do sourceFiles <- glob "src/**/*.hs" doctest $ "-XNoImplicitPrelude" : sourceFiles - -#endif diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,9 +1,9 @@ -module Main where - -import Test.Tasty (defaultMain) +module Main + ( main + ) where -import Test.Universum.Property (hedgehogTestTree) +import Test.Tasty +import Tree (tests) main :: IO () -main = do - defaultMain hedgehogTestTree +main = tests >>= defaultMain diff --git a/test/Test/Universum/BoolMProps.hs b/test/Test/Universum/BoolMProps.hs new file mode 100644 --- /dev/null +++ b/test/Test/Universum/BoolMProps.hs @@ -0,0 +1,22 @@ +module Test.Universum.BoolMProps + ( hprop_andM + , hprop_orM + ) where + +import Hedgehog (Gen, Property, forAll, property, (===)) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import qualified Universum as U + +genBoolList :: Gen [U.Bool] +genBoolList = Gen.list (Range.linear 0 1000) Gen.bool + +hprop_andM :: Property +hprop_andM = property $ do + bs <- forAll genBoolList + U.andM (return <$> bs) === ((return $ U.and bs) :: U.Maybe U.Bool) + +hprop_orM :: Property +hprop_orM = property $ do + bs <- forAll genBoolList + U.orM (return <$> bs) === ((return $ U.or bs) :: U.Maybe U.Bool) diff --git a/test/Test/Universum/Issue208.hs b/test/Test/Universum/Issue208.hs new file mode 100644 --- /dev/null +++ b/test/Test/Universum/Issue208.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE + GeneralizedNewtypeDeriving + , UndecidableInstances + , FlexibleContexts + , GADTs + , DerivingStrategies + , CPP +#-} +module Test.Universum.Issue208 + () where + +#if __GLASGOW_HASKELL__ >= 900 + +import Universum (Container) + +-- In ghc-8.6.3 this code will produce a @redundant constraint@ warning. +-- In ghc-9.0.2 and newer no warnings would be produced. +-- Issue #208: https://github.com/serokell/universum/issues/208 + +newtype Test = Test [Int] + deriving newtype (Container) + +#endif diff --git a/test/Test/Universum/ListProps.hs b/test/Test/Universum/ListProps.hs new file mode 100644 --- /dev/null +++ b/test/Test/Universum/ListProps.hs @@ -0,0 +1,35 @@ +module Test.Universum.ListProps + ( hprop_ordNubCorrect + , hprop_hashNubCorrect + , hprop_sortNubCorrect + , hprop_unstableNubCorrect + ) where + +import Data.List (nub) +import Hedgehog (Gen, Property, forAll, property, (===)) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import qualified Universum as U + +genIntList :: Gen [U.Int] +genIntList = Gen.list (Range.linear 0 10000) Gen.enumBounded + +hprop_ordNubCorrect :: Property +hprop_ordNubCorrect = property $ do + xs <- forAll genIntList + U.ordNub xs === nub xs + +hprop_hashNubCorrect :: Property +hprop_hashNubCorrect = property $ do + xs <- forAll genIntList + U.hashNub xs === nub xs + +hprop_sortNubCorrect :: Property +hprop_sortNubCorrect = property $ do + xs <- forAll genIntList + U.sortNub xs === (U.sort $ nub xs) + +hprop_unstableNubCorrect :: Property +hprop_unstableNubCorrect = property $ do + xs <- forAll genIntList + (U.sort $ U.unstableNub xs) === (U.sort $ nub xs) diff --git a/test/Test/Universum/Property.hs b/test/Test/Universum/Property.hs deleted file mode 100644 --- a/test/Test/Universum/Property.hs +++ /dev/null @@ -1,129 +0,0 @@ -module Test.Universum.Property - ( hedgehogTestTree - ) where - -import Universum - -import Data.List (nub) -import Hedgehog (Property, Gen, MonadGen, forAll, property, assert, (===)) -import Test.Tasty (testGroup, TestTree) -import Test.Tasty.Hedgehog - -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] - -utfProps :: TestTree -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 - ] - -unicode' :: MonadGen m => m U.Char -unicode' = do - a <- Gen.unicode - if U.elem a ['\65534', '\65535'] - then unicode' - else return a - -utf8String :: Gen U.String -utf8String = Gen.string (Range.linear 0 10000) unicode' - -utf8Text :: Gen T.Text -utf8Text = Gen.text (Range.linear 0 10000) unicode' - -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 - -prop_StringToBytes :: Property -prop_StringToBytes = property $ do - str <- forAll utf8String - assert $ str == (decodeUtf8 (encodeUtf8 str :: B.ByteString)) - && str == (decodeUtf8 (encodeUtf8 str :: LB.ByteString)) - - -prop_TextToBytes :: Property -prop_TextToBytes = property $ do - txt <- forAll utf8Text - assert $ txt == (decodeUtf8 (encodeUtf8 txt :: B.ByteString)) - && txt == (decodeUtf8 (encodeUtf8 txt :: LB.ByteString)) - --- "\239\191\190" fails, but this is the same as "\65534" :: String -prop_BytesTo :: Property -prop_BytesTo = property $ do - utf <- forAll utf8Bytes - assert $ utf == (encodeUtf8 (decodeUtf8 utf :: U.String)) - && utf == (encodeUtf8 (decodeUtf8 utf :: T.Text)) - && utf == (encodeUtf8 (decodeUtf8 utf :: LT.Text)) - --- ordNub - -listProps :: TestTree -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 - , testProperty "Hedgehog sort $ unstableNub xs == sort $ nub xs" prop_unstableNubCorrect - ] - -genIntList :: Gen [U.Int] -genIntList = Gen.list (Range.linear 0 10000) Gen.enumBounded - -prop_ordNubCorrect :: Property -prop_ordNubCorrect = property $ do - xs <- forAll genIntList - U.ordNub xs === nub xs - -prop_hashNubCorrect :: Property -prop_hashNubCorrect = property $ do - xs <- forAll genIntList - U.hashNub xs === nub xs - -prop_sortNubCorrect :: Property -prop_sortNubCorrect = property $ do - xs <- forAll genIntList - U.sortNub xs === (U.sort $ nub xs) - -prop_unstableNubCorrect :: Property -prop_unstableNubCorrect = property $ do - xs <- forAll genIntList - (U.sort $ U.unstableNub xs) === (U.sort $ nub xs) - - --- logicM --- this section needs a little more thought - -genBoolList :: Gen [U.Bool] -genBoolList = Gen.list (Range.linear 0 1000) Gen.bool - -boolMProps :: TestTree -boolMProps = testGroup "lifted logic function property tests" - [ testProperty "Hedgehog andM" prop_andM - , testProperty "Hedgehog orM" prop_orM - ] - -prop_andM :: Property -prop_andM = property $ do - bs <- forAll genBoolList - U.andM (return <$> bs) === ((return $ U.and bs) :: U.Maybe U.Bool) - -prop_orM :: Property -prop_orM = property $ do - bs <- forAll genBoolList - U.orM (return <$> bs) === ((return $ U.or bs) :: U.Maybe U.Bool) - diff --git a/test/Test/Universum/StringProps.hs b/test/Test/Universum/StringProps.hs new file mode 100644 --- /dev/null +++ b/test/Test/Universum/StringProps.hs @@ -0,0 +1,55 @@ +-- Some tests in this module have a caveat: they depend on compiler +-- optimizations and will likely fail if compiled with -O0. +-- That's because they depend on rewrite rules (and test these rules), +-- and these rules are usually not triggered without certain optimizations. + +module Test.Universum.StringProps + ( hprop_StringToTextAndBack + , hprop_StringToTextAndBackSurrogate + , hprop_TextToStringAndBack + ) where + +import Universum + +import qualified Data.Text as T +import Hedgehog (Gen, Property, forAll, property, (===)) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import qualified Universum as U + +unicodeAllString :: Gen U.String +unicodeAllString = Gen.string (Range.linear 0 10000) Gen.unicodeAll + +unicodeAllText :: Gen T.Text +unicodeAllText = Gen.text (Range.linear 0 10000) Gen.unicodeAll + +-- "\65534" fails, but this is from BU.toString +-- > import qualified Data.ByteString.UTF8 as BU +-- > BU.toString (BU.fromString "\65534") == "\65533" +-- > True + +hprop_StringToTextAndBack :: Property +hprop_StringToTextAndBack = property $ do + str <- forAll unicodeAllString + toString (toText str) === str + +-- | +-- 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. +hprop_StringToTextAndBackSurrogate :: Property +hprop_StringToTextAndBackSurrogate = property $ do + -- Surrogate character like this one should remain intact + -- Without the rewrite rule this string would be transformed to some other, + -- valid string + let str = "\xD800" + toString (toText str) === str + +hprop_TextToStringAndBack :: Property +hprop_TextToStringAndBack = property $ do + txt <- forAll unicodeAllText + toText (toString txt) === txt diff --git a/test/Test/Universum/UtfProps.hs b/test/Test/Universum/UtfProps.hs new file mode 100644 --- /dev/null +++ b/test/Test/Universum/UtfProps.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} + +module Test.Universum.UtfProps + ( hprop_StringToBytes + , hprop_TextToBytes + , hprop_BytesTo + ) where + +import Universum + +import Hedgehog (Gen, MonadGen, Property, assert, forAll, property) +#if MIN_VERSION_hedgehog(1,0,0) +import Hedgehog (GenBase) +#endif + +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 + +#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'] + then unicode' + else return a + +utf8String :: Gen U.String +utf8String = Gen.string (Range.linear 0 10000) unicode' + +utf8Text :: Gen T.Text +utf8Text = Gen.text (Range.linear 0 10000) unicode' + +utf8Bytes :: Gen B.ByteString +utf8Bytes = Gen.utf8 (Range.linear 0 10000) unicode' + +hprop_StringToBytes :: Property +hprop_StringToBytes = property $ do + str <- forAll utf8String + assert $ str == (decodeUtf8 (encodeUtf8 str :: B.ByteString)) + && str == (decodeUtf8 (encodeUtf8 str :: LB.ByteString)) + + +hprop_TextToBytes :: Property +hprop_TextToBytes = property $ do + txt <- forAll utf8Text + assert $ txt == (decodeUtf8 (encodeUtf8 txt :: B.ByteString)) + && txt == (decodeUtf8 (encodeUtf8 txt :: LB.ByteString)) + +-- "\239\191\190" fails, but this is the same as "\65534" :: String +hprop_BytesTo :: Property +hprop_BytesTo = property $ do + utf <- forAll utf8Bytes + assert $ utf == (encodeUtf8 (decodeUtf8 utf :: U.String)) + && utf == (encodeUtf8 (decodeUtf8 utf :: T.Text)) + && utf == (encodeUtf8 (decodeUtf8 utf :: LT.Text)) diff --git a/test/Tree.hs b/test/Tree.hs new file mode 100644 --- /dev/null +++ b/test/Tree.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display -optF --generated-module -optF Tree #-} diff --git a/universum.cabal b/universum.cabal --- a/universum.cabal +++ b/universum.cabal @@ -1,5 +1,6 @@ +cabal-version: 2.2 name: universum -version: 1.5.0 +version: 1.8.3.1 synopsis: Custom prelude used in Serokell description: See README.md file for more details. homepage: https://github.com/serokell/universum @@ -11,21 +12,52 @@ category: Prelude stability: stable 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 - , GHC == 8.2.2 - , GHC == 8.4.3 +tested-with: GHC == 8.10.7 + , GHC == 9.0.2 + , GHC == 9.2.8 + , GHC == 9.4.8 + , GHC == 9.6.7 + , GHC == 9.8.4 + , GHC == 9.10.3 + , GHC == 9.12.2 + , GHC == 9.14.1 extra-doc-files: CHANGES.md , CONTRIBUTING.md , README.md source-repository head type: git - location: git@github.com:serokell/universum.git + location: https://github.com/serokell/universum.git +common common-options + build-depends: base >= 4.8 && < 5 + ghc-options: + -- Source: https://medium.com/mercury-bank/enable-all-the-warnings-a0517bc081c3 + -Weverything + -Wno-missing-exported-signatures + -Wno-missing-import-lists + -Wno-missed-specialisations + -Wno-all-missed-specialisations + -Wno-unsafe + -Wno-safe + -Wno-missing-local-signatures + -Wno-monomorphism-restriction + -Wno-implicit-prelude + -Wno-prepositive-qualified-module + -Wno-inferred-safe-imports + if impl(ghc >= 9.2.0) + ghc-options: -Wno-missing-kind-signatures + + if impl(ghc >= 9.14.0) + ghc-options: -Wno-pattern-namespace-specifier + + default-language: Haskell2010 + + default-extensions: TypeOperators + library + import: common-options hs-source-dirs: src exposed-modules: Universum @@ -69,73 +101,88 @@ Universum.Unsafe Universum.VarArg - ghc-options: -Wall -fwarn-implicit-prelude - - build-depends: base >= 4.8 && < 5 - , bytestring + build-depends: bytestring , containers , deepseq - , ghc-prim >= 0.4.0.0 , hashable , microlens , microlens-mtl , mtl , safe-exceptions , stm - , text + , text >= 1.0.0.0 && <= 2.2 , transformers , unordered-containers , utf8-string , vector - default-language: Haskell2010 + ghc-options: -Wimplicit-prelude default-extensions: NoImplicitPrelude OverloadedStrings test-suite universum-test + import: common-options type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs - other-modules: Test.Universum.Property + other-modules: + Tree + Test.Universum.Issue208 + Test.Universum.StringProps + Test.Universum.UtfProps + Test.Universum.ListProps + Test.Universum.BoolMProps - build-depends: base >= 4.8 && < 5 - , universum + build-depends: universum , bytestring , text - , utf8-string , hedgehog , tasty , tasty-hedgehog + build-tool-depends: + tasty-discover:tasty-discover - ghc-options: -Wall -threaded - default-language: Haskell2010 + ghc-options: -Wno-missing-safe-haskell-mode + ghc-options: -threaded test-suite universum-doctest + import: common-options + if os(windows) + buildable: False + type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Doctest.hs - build-depends: base >= 4.8 && < 5 - , doctest + build-depends: doctest , Glob + ghc-options: -Wno-missing-safe-haskell-mode ghc-options: -threaded - default-language: Haskell2010 + -- https://github.com/sol/doctest/issues/327 + -- TODO: re-enable when the issue is resolved + if impl(ghc >= 9.0.0) + buildable: False benchmark universum-benchmark + import: common-options type: exitcode-stdio-1.0 - default-language: Haskell2010 - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N + hs-source-dirs: benchmark main-is: Main.hs - build-depends: base < 5 - , universum + build-depends: universum , containers , gauge + , text , unordered-containers - if impl(ghc == 7.10.3) - build-depends: semigroups >= 0.18 + + ghc-options: -Wno-missing-safe-haskell-mode + if impl(ghc >= 9.8.0) + ghc-options: -Wno-x-partial + -- TODO (#298): migrate from gauge to something + buildable: False default-extensions: NoImplicitPrelude ScopedTypeVariables