universum 1.6.1 → 1.8.3.1
raw patch · 45 files changed
Files
- CHANGES.md +115/−1
- CONTRIBUTING.md +2/−2
- README.md +14/−32
- benchmark/Main.hs +11/−11
- src/Universum.hs +118/−5
- src/Universum/Applicative.hs +8/−0
- src/Universum/Base.hs +15/−34
- src/Universum/Bool/Guard.hs +2/−0
- src/Universum/Bool/Reexport.hs +2/−0
- src/Universum/Container.hs +3/−1
- src/Universum/Container/Class.hs +188/−111
- src/Universum/Container/Reexport.hs +2/−0
- src/Universum/Debug.hs +4/−18
- src/Universum/DeepSeq.hs +2/−0
- src/Universum/Exception.hs +5/−15
- src/Universum/Function.hs +3/−1
- src/Universum/Functor/Reexport.hs +1/−1
- src/Universum/Lifted/Concurrent.hs +33/−3
- src/Universum/Lifted/File.hs +1/−2
- src/Universum/List/Reexport.hs +2/−10
- src/Universum/List/Safe.hs +57/−11
- src/Universum/Monad.hs +1/−1
- src/Universum/Monad/Container.hs +5/−0
- src/Universum/Monad/Maybe.hs +1/−2
- src/Universum/Monad/Reexport.hs +2/−34
- src/Universum/Monad/Trans.hs +17/−3
- src/Universum/Monoid.hs +3/−8
- src/Universum/Nub.hs +14/−17
- src/Universum/Print/Internal.hs +3/−1
- src/Universum/String.hs +2/−0
- src/Universum/String/Conversion.hs +32/−8
- src/Universum/String/Reexport.hs +3/−1
- src/Universum/TypeOps.hs +14/−21
- src/Universum/Unsafe.hs +8/−4
- src/Universum/VarArg.hs +10/−3
- test/Doctest.hs +0/−11
- test/Spec.hs +6/−6
- test/Test/Universum/BoolMProps.hs +22/−0
- test/Test/Universum/Issue208.hs +23/−0
- test/Test/Universum/ListProps.hs +35/−0
- test/Test/Universum/Property.hs +0/−177
- test/Test/Universum/StringProps.hs +55/−0
- test/Test/Universum/UtfProps.hs +64/−0
- test/Tree.hs +1/−0
- universum.cabal +75/−30
CHANGES.md view
@@ -1,5 +1,119 @@-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 =====
CONTRIBUTING.md view
@@ -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.
README.md view
@@ -1,8 +1,7 @@ Universum ========= -[](https://travis-ci.org/serokell/universum)-[](https://ci.appveyor.com/project/gromakovsky/universum)+[](https://github.com/serokell/universum/actions) [](https://hackage.haskell.org/package/universum) [](http://stackage.org/lts/package/universum) [](http://stackage.org/nightly/package/universum)@@ -16,9 +15,7 @@ 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,7 +149,7 @@ [`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.@@ -289,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`.@@ -304,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`.@@ -345,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.
benchmark/Main.hs view
@@ -1,4 +1,6 @@-module Main where+module Main+ ( main+ ) where import Universum hiding (show) @@ -70,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@@ -108,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@@ -177,11 +180,8 @@ 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+ [ -- 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 ]
src/Universum.hs view
@@ -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
src/Universum/Applicative.hs view
@@ -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
src/Universum/Base.hs view
@@ -1,9 +1,8 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE Unsafe #-} --- | Reexports from @GHC.*@ modules of <https://www.stackage.org/lts-8.9/package/base-4.9.1.0 base>--- package.+-- | Reexports from @GHC.*@ modules of the <https://hackage.haskell.org/package/base> 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, ($))
src/Universum/Bool/Guard.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Safe #-}+ -- | This module contains monadic predicates. module Universum.Bool.Guard
src/Universum/Bool/Reexport.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Safe #-}+ -- | This module reexports functions to work with 'Bool' type. module Universum.Bool.Reexport
src/Universum/Container.hs view
@@ -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
src/Universum/Container/Class.hs view
@@ -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
src/Universum/Container/Reexport.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Trustworthy #-}+ -- | This module reexports all container related stuff from 'Prelude'. module Universum.Container.Reexport
src/Universum/Debug.hs view
@@ -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
src/Universum/DeepSeq.hs view
@@ -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.
src/Universum/Exception.hs view
@@ -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
src/Universum/Function.hs view
@@ -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, ($), (.), (&))
src/Universum/Functor/Reexport.hs view
@@ -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 (..))
src/Universum/Lifted/Concurrent.hs view
@@ -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' #-}
src/Universum/Lifted/File.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | Lifted versions of functions working with files and common IO.@@ -22,7 +21,7 @@ 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
src/Universum/List/Reexport.hs view
@@ -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)
src/Universum/List/Safe.hs view
@@ -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 #-}
src/Universum/Monad.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE Safe #-} -- | Reexporting useful monadic stuff.
src/Universum/Monad/Container.hs view
@@ -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)
src/Universum/Monad/Maybe.hs view
@@ -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)
src/Universum/Monad/Reexport.hs view
@@ -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
src/Universum/Monad/Trans.hs view
@@ -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 #-}
src/Universum/Monoid.hs view
@@ -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)
src/Universum/Nub.hs view
@@ -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
src/Universum/Print/Internal.hs view
@@ -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
src/Universum/String.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Safe #-}+ -- | Type classes for convertion between different string representations. module Universum.String
src/Universum/String/Conversion.hs view
@@ -2,7 +2,7 @@ {-# 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@@ -24,15 +24,20 @@ -- * 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)@@ -46,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)) @@ -169,17 +174,24 @@ 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.+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 #-} -{- [Note toString-toText-rewritting]+-- 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 if take rules defined in 'Data.Text' into account.+We can do even better than above if take rules defined in 'Data.Text' into+account. Quoting investigation of @int-index: @@ -230,7 +242,7 @@ There's a comment on top of it to explain this: ```--- UTF-16 surrogate code points are not included in the set of Unicode+-- 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@@ -251,6 +263,7 @@ {-# 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),@@ -258,7 +271,7 @@ -} {- 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+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@@@ -275,8 +288,19 @@ -- 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
src/Universum/String/Reexport.hs view
@@ -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)
src/Universum/TypeOps.hs view
@@ -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
src/Universum/Unsafe.hs view
@@ -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 @-}
src/Universum/VarArg.hs view
@@ -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 (...) #-}
test/Doctest.hs view
@@ -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
test/Spec.hs view
@@ -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
+ test/Test/Universum/BoolMProps.hs view
@@ -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)
+ test/Test/Universum/Issue208.hs view
@@ -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
+ test/Test/Universum/ListProps.hs view
@@ -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)
− test/Test/Universum/Property.hs
@@ -1,177 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeFamilies #-}--module Test.Universum.Property- ( hedgehogTestTree- ) where--import Universum--import Data.List (nub)-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--hedgehogTestTree :: TestTree-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"- [ 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']- then unicode'- else return a--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--prop_StringToTextAndBack :: Property-prop_StringToTextAndBack = property $ do- str <- forAll unicodeAllString- toString (toText str) === str---- | See comment to this function:--- <http://hackage.haskell.org/package/text-1.2.3.1/docs/src/Data.Text.Internal.html#safe>------ 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- 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)
+ test/Test/Universum/StringProps.hs view
@@ -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
+ test/Test/Universum/UtfProps.hs view
@@ -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))
+ test/Tree.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display -optF --generated-module -optF Tree #-}
universum.cabal view
@@ -1,5 +1,6 @@+cabal-version: 2.2 name: universum-version: 1.6.1+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,22 +12,52 @@ category: Prelude stability: stable build-type: Simple-cabal-version: >=1.18 bug-reports: https://github.com/serokell/universum/issues-tested-with: GHC == 8.0.2- , GHC == 8.2.2- , GHC == 8.4.3- , GHC == 8.6.5- , GHC == 8.8.1+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@@ -70,74 +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- -- Make sure that "toString-toText-rewritting" note- -- is still valid when bumping this constraint.- , text >= 1.0.0.0 && <= 1.2.4.0+ , 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++ 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