relude 0.5.0 → 0.6.0.0
raw patch · 63 files changed
+2931/−669 lines, 63 filesdep −tastydep −tasty-hedgehogdep ~basedep ~hashabledep ~hedgehog
Dependencies removed: tasty, tasty-hedgehog
Dependency ranges changed: base, hashable, hedgehog
Files
- CHANGELOG.md +101/−0
- CONTRIBUTING.md +5/−5
- README.md +124/−71
- benchmark/Main.hs +2/−2
- relude.cabal +75/−73
- src/Relude.hs +139/−50
- src/Relude/Applicative.hs +5/−3
- src/Relude/Base.hs +2/−2
- src/Relude/Bool.hs +1/−1
- src/Relude/Bool/Guard.hs +37/−5
- src/Relude/Bool/Reexport.hs +1/−1
- src/Relude/Container.hs +1/−1
- src/Relude/Container/One.hs +52/−9
- src/Relude/Container/Reexport.hs +1/−1
- src/Relude/Debug.hs +159/−27
- src/Relude/DeepSeq.hs +53/−6
- src/Relude/Exception.hs +8/−6
- src/Relude/Extra/Bifunctor.hs +22/−2
- src/Relude/Extra/CallStack.hs +1/−1
- src/Relude/Extra/Enum.hs +63/−21
- src/Relude/Extra/Foldable.hs +36/−0
- src/Relude/Extra/Foldable1.hs +77/−8
- src/Relude/Extra/Group.hs +3/−3
- src/Relude/Extra/Lens.hs +6/−1
- src/Relude/Extra/Map.hs +51/−25
- src/Relude/Extra/Newtype.hs +5/−4
- src/Relude/Extra/Tuple.hs +16/−7
- src/Relude/Extra/Type.hs +114/−10
- src/Relude/Extra/Validation.hs +247/−47
- src/Relude/File.hs +4/−1
- src/Relude/Foldable.hs +1/−1
- src/Relude/Foldable/Fold.hs +19/−42
- src/Relude/Foldable/Reexport.hs +4/−1
- src/Relude/Function.hs +14/−2
- src/Relude/Functor.hs +1/−1
- src/Relude/Functor/Fmap.hs +1/−1
- src/Relude/Functor/Reexport.hs +1/−1
- src/Relude/Lifted.hs +5/−1
- src/Relude/Lifted/Concurrent.hs +19/−6
- src/Relude/Lifted/Exit.hs +31/−10
- src/Relude/Lifted/File.hs +3/−2
- src/Relude/Lifted/IORef.hs +80/−10
- src/Relude/Lifted/Terminal.hs +4/−3
- src/Relude/List.hs +41/−2
- src/Relude/List/NonEmpty.hs +2/−2
- src/Relude/List/Reexport.hs +219/−6
- src/Relude/Monad.hs +1/−1
- src/Relude/Monad/Either.hs +99/−37
- src/Relude/Monad/Maybe.hs +63/−21
- src/Relude/Monad/Reexport.hs +1/−1
- src/Relude/Monad/Trans.hs +32/−13
- src/Relude/Monoid.hs +9/−7
- src/Relude/Nub.hs +10/−3
- src/Relude/Numeric.hs +6/−7
- src/Relude/Print.hs +46/−9
- src/Relude/String.hs +1/−1
- src/Relude/String/Conversion.hs +373/−41
- src/Relude/String/Reexport.hs +191/−7
- src/Relude/Unsafe.hs +18/−4
- test/Doctest.hs +10/−2
- test/Spec.hs +12/−5
- test/Test/Relude/Extra/Validation/Property.hs +174/−0
- test/Test/Relude/Property.hs +29/−26
CHANGELOG.md view
@@ -3,6 +3,107 @@ `relude` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.6.0.0 — Oct 30, 2019++* [#171](https://github.com/kowainik/relude/issues/171):+ Add custom type errors to various functions and instances.+ + `head`, `tail`, `last`, `init`+ + `words`, `unwords`, `lines`, `unlines`+ + `error`+ + `ToText`, `ToLText`, `ToString` instances for bytestrings+ + `Foldable1` instance for ordinary lists+ + `Monad` instance for `Validation`++ (by [@vrom911](https://github.com/vrom911), [@chshersh](https://github.com/chshersh))+* [#164](https://github.com/kowainik/relude/issues/164):+ Reexport `ShortByteString`, `toShort`/`fromShort` functions.+ (by [@vrom911](https://github.com/vrom911))+* [#182](https://github.com/kowainik/relude/issues/182):+ Support GHC-8.8.1.+ (by [@chshersh](https://github.com/chshersh))+* [#168](https://github.com/kowainik/relude/pull/168),+ [#197](https://github.com/kowainik/relude/pull/197):+ Improve documentation significantly (more and better examples, better wording).+ (by [@chshersh](https://github.com/chshersh),+ [@vrom911](https://github.com/vrom911),+ [@Cmdv](https://github.com/Cmdv))+* [#177](https://github.com/kowainik/relude/issues/177):+ Improve usage of performance pragmas.+ (by [@chshersh](https://github.com/chshersh))+* [#167](https://github.com/kowainik/relude/issues/167):+ Rename functions (and deprecate old versions):+ + `prec` to `prev`+ + `dupe` to `dup`++ (by [@Cmdv](https://github.com/Cmdv), [@chshersh](https://github.com/chshersh))+* [#192](https://github.com/kowainik/relude/issues/192):+ Reexport `foldMap'` from `Data.Foldable`.+ (by [@tfausak](https://github.com/tfausak))+* [#201](https://github.com/kowainik/relude/issues/201):+ Implement `!!?` as a safe equivalent of `!!` that returns a `Maybe`.+ (by [@kutyel](https://github.com/kutyel))+* [#203](https://github.com/kowainik/relude/issues/203):+ Implement the `guarded` combinator.+ (by [@JonathanLorimer](https://github.com/JonathanLorimer))+* [#214](https://github.com/kowainik/relude/issues/214):+ Add `mapMaybeM` function.+ (by [@vrom911](https://github.com/vrom911))+* [#174](https://github.com/kowainik/relude/issues/174):+ Implement `bimapBoth` in `Relude.Extra.Tuple` module,+ mark `mapBoth` as DEPRECATED.+ (by [@astynax](https://github.com/astynax))+* [#221](https://github.com/kowainik/relude/issues/221):+ Improve documentation for the `Validation` module significantly.+ (by [@chshersh](https://github.com/chshersh))+* [#176](https://github.com/kowainik/relude/issues/176):+ Implement property-based tests for `Validation` laws.+ (by [@astynax](https://github.com/astynax))+* [#172](https://github.com/kowainik/relude/issues/172):+ Add `Monoid` and `Semigroup` instances for the `Validation` type.+ (by [@mauriciofierrom](https://github.com/mauriciofierrom))+* [#156](https://github.com/kowainik/relude/issue/156):+ Implement helper type-level functions in `Relude.Extra.Type`.+ (by [@TheMatten](https://github.com/TheMatten))+* [#170](https://github.com/kowainik/relude/issues/170):+ Implement `Elem` type family.+ (by [@kutyel](https://github.com/kutyel))+* [#165](https://github.com/kowainik/relude/pull/165):+ Re-export `GHC.Float.atan2`.+ (by [@ethercrow](https://github.com/ethercrow))+* [#155](https://github.com/kowainik/relude/issue/155):+ Implement `foldlSC` — short-circuting list fold — in `Relude.Extra.Foldable`.+ (by [@josephcsible](https://github.com/josephcsible))+* [#158](https://github.com/kowainik/relude/issue/158):+ Support GHC-8.6.5.+ (by [@chshersh](https://github.com/chshersh))+* [#148](https://github.com/kowainik/relude/issues/148):+ Migrate HLint rules to the latest Dhall spec.+ (by [@vrom911](https://github.com/vrom911))+* [#178](https://github.com/kowainik/relude/issues/178):+ Made `die` be polymorphic in its return type.+ (by [@ilyakooo0](https://github.com/ilyakooo0))+* [#162](https://github.com/kowainik/relude/pull/162),+ [#189](https://github.com/kowainik/relude/pull/189),+ [#190](https://github.com/kowainik/relude/pull/190),+ [#191](https://github.com/kowainik/relude/pull/191),+ [#193](https://github.com/kowainik/relude/pull/193),+ [#194](https://github.com/kowainik/relude/pull/194),+ [#195](https://github.com/kowainik/relude/pull/195):+ Various refactorings and code improvements:+ + __Breaking change:__ Reorder type parameters to `asumMap`+ + Implement `andM`, `orM`, `allM`, and `anyM` in terms of `&&^` and `||^`+ + Use `foldr` instead of explicit recursion and `toList`+ + Use `mapToFst` instead of `zip` to improve list fusion in `inverseMap`+ + Implement `foldMap1` for `NonEmpty` in terms of `foldr`+ + Use `$>` instead of `*>` and `pure` where possible+ + Implement `asumMap` and `foldMapA` by coercing `foldMap`+ + Return Failure early in `<*` and `*>` too++ (by [@josephcsible](https://github.com/josephcsible))+* [#187](https://github.com/kowainik/relude/issues/187):+ Remove `tasty` and `tasty-hedgehog` dependencies and their redundant imports.+ (by [@dalpd](https://github.com/dalpd))+ ## 0.5.0 — Mar 18, 2019 * [#127](https://github.com/kowainik/relude/issues/127):
CONTRIBUTING.md view
@@ -19,25 +19,25 @@ issue, so everyone is aware that you're on it. If there's no such issue — simply create a new one! -To get started with the Pull Request implementation you should first +To get started with the Pull Request implementation you should first [fork](../../fork), then clone the repo: git clone git@github.com:your-username/project-name.git -Make your changes and consider the following checklist to go through +Make your changes and consider the following checklist to go through before submitting your pull request. ### :white_check_mark: Check list - [ ] New/fixed features work as expected (Bonus points for the new tests). - [ ] There are no warnings during compilation. - [ ] `hlint .` output is: _No Hints_ (see [`hlint`][hlint] tool docs).-- [ ] The code is formatted with the [`stylish-haskell`][stylish-tool] tool +- [ ] The code is formatted with the [`stylish-haskell`][stylish-tool] tool using [stylish-haskell.yaml][stylish] file in the repository.-- [ ] The code style of the files you changed is preserved (for more specific +- [ ] The code style of the files you changed is preserved (for more specific details on our style guide check [this document][style-guide]). - [ ] Commit messages are in the proper format. Start the first line of the commit with the issue number in square parentheses.- + **_Example:_** `[#42] Upgrade upper bounds of 'base'` After all above is done commit and push to your fork.
README.md view
@@ -1,23 +1,27 @@-# Relude+# relude --[](https://travis-ci.org/kowainik/relude)-[](https://hackage.haskell.org/package/relude)+++[](https://github.com/kowainik/relude/actions)+[](http://travis-ci.org/kowainik/relude)+[](https://ci.appveyor.com/project/kowainik/relude)+[](https://hackage.haskell.org/package/relude) [](http://stackage.org/lts/package/relude) [](http://stackage.org/nightly/package/relude)-[](http://packdeps.haskellers.com/reverse/relude) [](https://opensource.org/licenses/MIT) -`relude` is a custom prelude, an alternative to default `Prelude`.-`relude` tries to achieve the following goals:+**`relude`** is an alternative prelude library. If you find the default+`Prelude` unsatisfying, despite its advantages, consider using `relude` instead. +Below you can find key design principles behind `relude`:+ 1. **Avoid all** [**partial functions**](https://www.reddit.com/r/haskell/comments/5n51u3/why_are_partial_functions_as_in_head_tail_bad/) (like `head :: [a] -> a`). The types of partial functions lie about their behavior and usage of such functions can lead to the unexpected bugs. Though you can still use some unsafe functions from `Relude.Unsafe` module, but they are not exported by default. 2. **Type-safety**. We like to make invalid states unrepresentable. And if it's- possible to express this concept through the types then we will do it.+ possible to express this concept through the types then we do it. _Example:_ ```haskell@@ -31,18 +35,18 @@ use spaceleak-free functions (like our custom `sum` and `product`), introduce `{-# INLINE #-}` and `{-# SPECIALIZE #-}` pragmas where appropriate. 4. **Minimalism** (low number of dependencies). We don't force users of `relude` to- stick to some specific lens or text formatting or logging library.-5. **Convenience** (like lifted to `MonadIO` functions, more reexports). But we+ stick to some specific lens or text formatting or logging library. If+ possible, `relude` tries to depend only on boot libraries.+ [Dependency graph](relude-dependency-graph.pdf) of `relude` can give you clearer picture.+5. **Convenience** (e.g lifted to `MonadIO` functions, more reexports). Despite minimalism, we want to bring common types and functions (like `containers` and `bytestring`) into scope because they are used in almost every application anyways. 6. **Provide 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))- * Documentation regarding [internal module structure]((http://hackage.haskell.org/package/relude/docs/Relude.html))- * `relude`-specific [HLint](http://hackage.haskell.org/package/hlint) rules:- [`.hlint.yaml`](.hlint.yaml)+ + Tutorial+ + Migration guide from `Prelude`+ + Haddock for every function with examples tested by [`doctest`](http://hackage.haskell.org/package/doctest)+ + Documentation on [internal module structure](http://hackage.haskell.org/package/relude/docs/Relude.html)+ + `relude`-specific [HLint](http://hackage.haskell.org/package/hlint) rules: [`.hlint.yaml`](.hlint.yaml) 7. **User-friendliness.** Ability to quickly migrate to `relude` if you're familiar with the common libraries like `text` and `containers`. 8. **Exploration.** Experiment with new ideas and proposals without introducing@@ -50,39 +54,73 @@ exported by default so it's quite easy to bring something new and let users decide to use it or not. -This README contains introduction to `Relude` and a tutorial on how to use it.+This README contains introduction to `relude` and a tutorial on how to use it. ## Structure of this tutorial This tutorial has several parts: -1. [Get started](#get-started-)+1. [When to use an alternative prelude?](#when-to-use-an-alternative-prelude-)+2. [Get started](#get-started-) * [base-noprelude](#base-noprelude-) * [Mixins](#mixins-) * [NoImplicitPrelude](#NoImplicitPrelude-)-2. [Difference from Prelude](#difference-from-prelude-)-3. [Reexports](#reexports-)-4. [What's new?](#whats-new-)+3. [Difference from Prelude](#difference-from-prelude-)+4. [Reexports](#reexports-)+5. [What's new?](#whats-new-) 6. [Migration guide](#migration-guide-) 7. [Comparison with other alternative preludes](#comparison-with-other-alternative-preludes-) * [Relude vs Protolude](#relude-vs-protolude-) 8. [For developers](#for-developers-) This is neither a tutorial on _Haskell_ nor tutorial on each function contained-in `Relude`. For detailed documentation of every function together with examples+in `relude`. For detailed documentation of every function together with examples and usage, see [_Haddock documentation_](http://hackage.haskell.org/package/relude). +## When to use an alternative prelude? [↑](#structure-of-this-tutorial)++The module with the name `Prelude` is a module imported by default in every Haskell+source file of your project. If you want to use some data types or functions+which are not exposed by `Prelude`, you need to import them, adding necessary+libraries to your project dependencies. Unlike ordinary libraries, alternative+preludes provide different set of available by default functions and data types.++Replacing default `Prelude` from `base` has the following disadvantages:++1. Increased threshold entrance: you need to learn a different standard library.+ + `relude` tries to lower this threshold as much as possible: excellent+ documentation, no custom abstractions, behavior is changed only for a small+ subset of functions.+2. Extra dependencies: adding more libraries to dependencies increases build+ times and maintenance burden.+ + `relude` depends only on boot libraries (almost) which results in small build time, follows+ [PvP](https://pvp.haskell.org/) and cares about backwards compatibility.++However, using an alternative prelude, specifically `relude`, has the following+**advantages**:++1. Increased code safety: no partial functions, no space-leak functions.+2. Increased productivity: no need to import common functions and data types,+ more common idioms provided.+3. Increased performance: some functions in `relude` are faster than in default `Prelude`.++Our recommendations when to use `relude`:++1. When you develop an application (e.g. CLI tool, web-app). In that case greater+ productivity is more important than a low number of dependencies.+2. When writing a big framework. Some of them can be bigger than applications.+ ## Get started [↑](#structure-of-this-tutorial) If you want to start using `relude` in your project and explore it with the help-of compiler, set everything up according to one of the instructions below.+of the compiler, set everything up according to one of the instructions below. ### base-noprelude [↑](#structure-of-this-tutorial) This is the recommended way to use custom prelude. It requires you to perform the following steps: -1. Replace `base` dependency with corresponding version of `base-noprelude` in+1. Replace the `base` dependency with corresponding version of `base-noprelude` in your `.cabal` file. 2. Add a `relude` dependency to your `.cabal` file. 3. Add the following `Prelude` module to your project (both to filesystem and to `exposed-modules`):@@ -159,47 +197,62 @@ ## Difference from Prelude [↑](#structure-of-this-tutorial) -* `head`, `tail`, `last`, `init` work with `NonEmpty a` instead of `[a]`.-* `undefined` triggers a compiler warning, because you probably don't want to- leave `undefined` in your code. Either use `throwIO`, `Except`, `error` or- `bug`.-* Multiple sorting functions are available without imports:- + `sortBy :: (a -> a -> Ordering) -> [a] -> [a]`: sorts list using given custom comparator.- + `sortWith :: Ord b => (a -> b) -> [a] -> [a]`: sorts a list based on some property of its elements.- + `sortOn :: Ord b => (a -> b) -> [a] -> [a]`: just like `sortWith`, but more- time-efficient if function is calculated slowly (though less- space-efficient). So you should write `sortOn length` (would sort elements- by length) but `sortWith fst` (would sort list of pairs by first element).-* Functions `sum` and `product` are strict now, which makes them more efficient.-* Since `show` doesn't come from `Show` anymore, you need to export- `Text.Show` module if you want to implement `Show` instance manually. This can be done like this:- ```haskell- import qualified Text.Show- ```-* You can't call `elem` and `notElem` functions over `Set` and `HashSet`. These- functions are forbidden for these two types because of the performance reasons.-* `error` takes `Text`.-* `lookup` for lists is not exported.+Main differences from `Prelude` can be grouped into the following categories: +* Changed behavior of common functions+ + `head`, `tail`, `last`, `init` work with `NonEmpty a` instead of `[a]`.+ * `lines`, `unlines`, `words`, `unwords` work with `Text` instead of `String`.+ + `show` is polymorphic over return type.+ + Functions `sum` and `product` are strict now, which makes them more efficient.+ + You can't call `elem` and `notElem` functions over `Set` and `HashSet`.+ These functions are forbidden for these two types because of the performance+ reasons.+ + `error` takes `Text`+ + `undefined` triggers a compiler warning, because you probably don't want to+ leave `undefined` in your code. Either use `throwIO`, `Except`, `error` or+ `bug`.+* Not reexported+ + `read`+ + `lookup` for lists+ + `log`+* Completely new functions are brougth into scope+ + See [What's new?](#whats-new-) section for a detailed overview.+* New reexports+ + See [Reexports](#reexports-) section for a detailed overview.+ ## Reexports [↑](#structure-of-this-tutorial) `relude` reexports some parts of the following libraries: -* `base`-* `containers`-* `unordered-containers`-* `text`-* `bytestring`-* `transformers`-* `mtl`-* `deepseq`-* `stm`+* [`base`](http://hackage.haskell.org/package/base)+* [`bytestring`](http://hackage.haskell.org/package/bytestring)+* [`containers`](http://hackage.haskell.org/package/containers)+* [`deepseq`](http://hackage.haskell.org/package/deepseq)+* [`hashable`](http://hackage.haskell.org/package/hashable)+* [`mtl`](http://hackage.haskell.org/package/mtl)+* [`stm`](http://hackage.haskell.org/package/stm)+* [`text`](http://hackage.haskell.org/package/text)+* [`transformers`](http://hackage.haskell.org/package/transformers)+* [`unordered-containers`](http://hackage.haskell.org/package/unordered-containers) If you want to clean up imports after switching to `relude`, you can use `relude`-specific [`.hlint.yaml`](.hlint.yaml) configuration for this task. ### base +Multiple sorting functions are available:+ + `sortBy :: (a -> a -> Ordering) -> [a] -> [a]`: sorts list using given custom comparator.+ + `sortWith :: Ord b => (a -> b) -> [a] -> [a]`: sorts a list based on some property of its elements.+ + `sortOn :: Ord b => (a -> b) -> [a] -> [a]`: just like `sortWith`, but more+ time-efficient if function is calculated slowly (though less+ space-efficient). So you should write `sortOn length` (would sort elements+ by length) but `sortWith fst` (would sort list of pairs by first element).++`readMaybe` and `readEither` are like `read` but total and give either `Maybe`+or `Either` with parse error.++`(&)` – reverse application. `x & f & g` instead of `g $ f $ x` is useful sometimes.+ Some generally useful modules from `base` package, like: `Control.Applicative`, `Data.Traversable`, `Data.Monoid`, `Data.List`, and lots of others. @@ -266,7 +319,6 @@ * `uncons` splits a list at the first element. * `ordNub` and `sortNub` are _O(n log n)_ versions of `nub` (which is quadratic) and `hashNub` and `unstableNub` are almost _O(n)_ versions of `nub`.-* `(&)` – reverse application. `x & f & g` instead of `g $ f $ x` is useful sometimes. * `whenM`, `unlessM`, `ifM`, `guardM` are available and do what you expect them to do (e.g. `whenM (doesFileExist "foo")`). * General fold functions:@@ -274,8 +326,6 @@ foldMapA :: (Monoid b, Applicative m, Foldable f) => (a -> m b) -> f a -> m b foldMapM :: (Monoid b, Monad m, Foldable f) => (a -> m b) -> f a -> m b ```-* `readMaybe` and `readEither` are like `read` but total and give either- `Maybe` or `Either` with parse error. * `when(Just|Nothing|Left|Right|NotEmpty)[M][_]` let you conditionally execute something. Before: @@ -300,14 +350,11 @@ ``` * `andM`, `allM`, `anyM`, `orM` are monadic version of corresponding functions from `base`.- * 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](src/Relude/Container/One.hs) for creating singleton containers. Even monomorhpic ones like `Text`.-* [`StaticMap` and `DynamicMap`type classes](src/Relude/Extra/Map.hs) as a- general interface for `Map`-like data structures. * `evaluateWHNF` and `evaluateNF` functions as clearer and lifted aliases for `evaluate` and `evaluate . force`. * `MonadFail` instance for `Either`.@@ -317,6 +364,7 @@ * Convenient functions to work with `(Bounded a, Enum a)` types: 1. `universe :: (Bounded a, Enum a) => [a]`: get all values of the type. 2. `inverseMap :: (Bounded a, Enum a, Ord k) => (a -> k) -> k -> Maybe a`: convert functions like `show` to parsers.+ * Nice helpers to deal with `newtype`s in a more pleasant way: ```haskell@@ -337,6 +385,8 @@ non-empty structures like `NonEmpty`. * `Validation` data type as an alternative to `Either` when you want to combine all errors.+* [`StaticMap` and `DynamicMap` type classes](src/Relude/Extra/Map.hs) as a+ general interface for `Map`-like data structures. Explore `Extra` modules: [`Relude.Extra`](src/Relude/Extra/) @@ -382,8 +432,16 @@ + Use `toText/toLText/toString` functions to convert to `Text/LazyText/String` types. + Use `encodeUtf8/decodeUtf8` to convert to/from `ByteString`. + Use `(putStr[Ln]|readFile|writeFile|appendFile)[Text|LText|BS|LBS]` functions.-6. Run `hlint` using `.hlint.yaml` file from `relude` package to cleanup code and imports. +6. Since `show` doesn't come from `Show` anymore, you need to export+ `Text.Show` module if you want to implement `Show` instance manually. This can be done like this:+ ```haskell+ import qualified Text.Show+ ```++7. Run `hlint` using `.hlint.yaml` file from `relude` package to cleanup code and imports.++ ### Running HLint on CI Instead of storing a `relude`-specific `.hlint.yaml` file inside your repository,@@ -399,7 +457,7 @@ two commands on your CI: ```yaml-curl https://raw.githubusercontent.com/kowainik/relude/55968311244690f5cc8b4484a37a63d988ea2ec4/.hlint.yaml -o .hlint-relude.yaml+curl https://raw.githubusercontent.com/kowainik/relude/v0.6.0.0/.hlint.yaml -o .hlint-relude.yaml curl -sSL https://raw.github.com/ndmitchell/neil/master/misc/travis.sh | sh -s -- hlint -h .hlint-relude.yaml . ``` @@ -426,7 +484,7 @@ * Almost every function has usage examples and all examples are tested with `doctest` (which also sometimes hard to do because of multiple GHC versions support, but we try really hard)- * [Tutorial + migration guide](structure-of-this-tutorial) from+ * [Tutorial + migration guide](#structure-of-this-tutorial) from `Prelude` and just general description of the whole package and libraries it depends on. 3. `relude` has custom HLint rules specific to it: you can use them to remove@@ -464,8 +522,8 @@ $ cabal new-install dhall-json ``` -Dhall 3.0.0 is required, so make sure that the previous command installed-dhall-json >= 1.2.4.+Dhall 9.0.0 is required, so make sure that the previous command installed+dhall-json >= 1.4.0. To generate `hlint` file: @@ -482,8 +540,3 @@ See our blog post where we describe the details of the implementation for this solution: * [Dhall To HLint](https://kowainik.github.io/posts/2018-09-09-dhall-to-hlint)---## Acknowledgement--Icons made by [Freepik](http://www.freepik.com) from [www.flaticon.com](https://www.flaticon.com/) is licensed by [CC 3.0 BY](http://creativecommons.org/licenses/by/3.0/).
benchmark/Main.hs view
@@ -2,7 +2,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -} @@ -89,7 +89,7 @@ bgroupFold = do let testList = [1..100000] :: [Int] let flipFoldl' = flipfoldl' HashSet.insert mempty- let ghcFoldl' = foldl' (\hashSet element -> HashSet.insert element hashSet) mempty+ let ghcFoldl' = foldl' (\hash el -> HashSet.insert el hash) mempty bgroup "foldl'" [ bench "flipped" $ nf flipFoldl' testList , bench "base" $ nf ghcFoldl' testList ]
relude.cabal view
@@ -1,10 +1,14 @@-cabal-version: 2.0+cabal-version: 2.4 name: relude-version: 0.5.0+version: 0.6.0.0 synopsis: Custom prelude from Kowainik description:- == Goals+ @__relude__@ is an alternative prelude library. If you find the default+ @Prelude@ unsatisfying, despite its advantages, consider using @relude@+ instead. .+ == Relude design goals+ . * __Avoid all [partial functions](https://www.reddit.com/r/haskell/comments/5n51u3/why_are_partial_functions_as_in_head_tail_bad/)__ (like @head :: [a] -> a@). The types of partial functions lie about their behavior and usage of such functions can lead to the unexpected bugs. Though@@ -16,57 +20,86 @@ /Example:/ @ whenNotNull :: Applicative f => [a] -> (NonEmpty a -> f ()) -> f () @ . * __Performance.__ Prefer @Text@ over @[String](https://www.reddit.com/r/haskell/comments/29jw0s/whats_wrong_with_string/)@,- use spaceleak-free functions (like our custom @sum@ and @product@).+ use spaceleak-free functions (like our custom @sum@ and @product@),+ introduce @\{\-\# INLINE \#\-\}@ and @\{\-\# SPECIALIZE \#\-\}@ pragmas where+ appropriate. . * __Minimalism__ (low number of dependencies). We don't force users of @relude@ to- stick to some specific lens or text formatting or logging library.+ stick to some specific lens or text formatting or logging library. If+ possible, @relude@ tries to depend only on boot libraies. .- * __Convenience__ (like lifted to @MonadIO@ functions, more reexports). But we- want to bring common types and functions (like @containers@ and @bytestrng@)- into scope because they are used in almost every application anyways.+ * __Convenience__ (like lifted to @MonadIO@ functions, more reexports).+ Despite minimalism, we want to bring common types and functions (like+ @containers@ and @bytestring@) into scope because they are used in almost+ every application anyways. . * __Provide excellent documentation.__- .- 1. Tutorial- .- 2. Migration guide from @Prelude@- .- 3. Haddock with examples for (almost) every function- (all examples are tested with [`doctest`](http://hackage.haskell.org/package/doctest))- .- 4. Documentation regarding [internal module structure]((http://hackage.haskell.org/package/relude/docs/Relude.html))- .- 5. @relude@-specific [HLint](http://hackage.haskell.org/package/hlint) rules: @[.hlint.yaml](https://github.com/kowainik/relude/blob/master/.hlint.yaml)@ .+ 1. Tutorial+ .+ 2. Migration guide from @Prelude@+ .+ 3. Haddock for every function with examples tested by+ [doctest](http://hackage.haskell.org/package/doctest)).+ .+ 4. Documentation regarding [internal module structure](http://hackage.haskell.org/package/relude/docs/Relude.html)+ .+ 5. @relude@-specific [HLint](http://hackage.haskell.org/package/hlint) rules: @[.hlint.yaml](https://github.com/kowainik/relude/blob/master/.hlint.yaml)@+ . * __User-friendliness.__ Ability to quickly migrate to @relude@ if you're familiar- with the common libraries like @text@ and @containers@.+ with the common libraries like @text@ and @containers@. @relude@ also makes heavy usage+ of custom type errors to provide better UX. .- * __Exploration.__ Experiment with new ideas and proposals without introducing- breaking changes.+ * __Exploration.__ Experiment with new ideas and proposals without+ introducing breaking changes. @relude@ uses the approach with @Extra.*@+ modules which are not exported by default so it's quite easy to bring+ something new and let users decide to use it or not. homepage: https://github.com/kowainik/relude bug-reports: https://github.com/kowainik/relude/issues license: MIT license-file: LICENSE-author: Kowainik, Stephen Diehl, Serokell+author: Dmitrii Kovanikov, Veronika Romashkina, Stephen Diehl, Serokell maintainer: Kowainik <xrom.xkov@gmail.com> copyright: 2016 Stephen Diehl, 2016-2018 Serokell, 2018-2019 Kowainik category: Prelude stability: stable build-type: Simple-tested-with: GHC == 8.0.2- , GHC == 8.2.2- , GHC == 8.4.4- , GHC == 8.6.4 extra-doc-files: CHANGELOG.md- , CONTRIBUTING.md- , README.md+ CONTRIBUTING.md+ README.md+tested-with: GHC == 8.0.2+ GHC == 8.2.2+ GHC == 8.4.4+ GHC == 8.6.5+ GHC == 8.8.1 + source-repository head type: git location: git@github.com:kowainik/relude.git +common common-options+ build-depends: base >= 4.9 && < 4.14++ ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -fwarn-implicit-prelude+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths++ default-language: Haskell2010+ default-extensions: InstanceSigs+ NoImplicitPrelude+ OverloadedStrings+ ScopedTypeVariables+ TypeApplications+ library+ import: common-options hs-source-dirs: src exposed-modules: Relude@@ -115,6 +148,7 @@ Relude.Extra.Bifunctor Relude.Extra.CallStack Relude.Extra.Enum+ Relude.Extra.Foldable Relude.Extra.Foldable1 Relude.Extra.Group Relude.Extra.Lens@@ -125,90 +159,58 @@ Relude.Extra.Validation Relude.Unsafe - ghc-options: -Wall- -Wcompat- -Widentities- -Wincomplete-uni-patterns- -Wincomplete-record-updates- -fwarn-implicit-prelude - build-depends: base >= 4.9 && < 5- , bytestring ^>= 0.10+ build-depends: bytestring ^>= 0.10 , containers >= 0.5.7 && < 0.7 , deepseq ^>= 1.4 , ghc-prim >= 0.4.0.0 && < 0.6- , hashable ^>= 1.2+ , hashable >= 1.2 && < 1.4 , mtl ^>= 2.2 , stm >= 2.4 && < 2.6 , text ^>= 1.2 , transformers ^>= 0.5 , unordered-containers >= 0.2.7 && < 0.3 - default-language: Haskell2010- default-extensions: NoImplicitPrelude- OverloadedStrings test-suite relude-test+ import: common-options type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs other-modules: Test.Relude.Property-- build-depends: base >= 4.9 && < 5- , relude+ Test.Relude.Extra.Validation.Property+ build-depends: relude , bytestring , text- , hedgehog >= 0.6- , tasty- , tasty-hedgehog-- ghc-options: -Wall- -threaded- -Wincomplete-uni-patterns- -Wincomplete-record-updates- -Wcompat- -Widentities- -Wredundant-constraints+ , hedgehog ^>= 1.0 - default-language: Haskell2010- default-extensions: NoImplicitPrelude- TypeApplications+ ghc-options: -threaded test-suite relude-doctest+ import: common-options type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Doctest.hs - build-depends: base >= 4.9 && < 5+ build-depends: relude , doctest , Glob , QuickCheck ghc-options: -threaded- default-language: Haskell2010 benchmark relude-benchmark+ import: common-options type: exitcode-stdio-1.0 hs-source-dirs: benchmark main-is: Main.hs - build-depends: base >= 4.9 && < 5- , relude+ build-depends: relude , containers , gauge , unordered-containers - ghc-options: -Wall- -threaded+ ghc-options: -threaded -rtsopts -with-rtsopts=-N- -Wincomplete-uni-patterns- -Wincomplete-record-updates- -Wcompat- -Widentities- -Wredundant-constraints-- default-language: Haskell2010- default-extensions: NoImplicitPrelude- ScopedTypeVariables
src/Relude.hs view
@@ -4,29 +4,41 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -The main module that reexports all functionality. It's allowed to use it without-importing any other modules. If you want to use @relude@ per-module basis then-just add next lines to your module to replace default 'Prelude':+The main module that reexports all functionality. It's considered to be a+@Prelude@ replacement. -@-\{\-\# LANGUAGE NoImplicitPrelude \#\-\}+One of the most convenient ways to use @relude@ is via @mixins@ feature. To use+this feature need to specify @cabal-version: 2.4@ in your package description.+And then you can add the following lines to the required stanza to replace+default "Prelude" with @relude@. -__import__ "Relude" @+mixins: base hiding (Prelude)+ , relude (Relude as Prelude)+@ Alternatively, you can replace @base@ package in your dependencies with @[base-noprelude](http://hackage.haskell.org/package/base-noprelude)@ and add-the following 'Prelude' module to your package to use @relude@ by default in-every module instead of 'Prelude':+the following "Prelude" module to your package to use @relude@ by default in+every module instead of "Prelude": @ __module__ Prelude (__module__ "Relude") __where__ __import__ "Relude" @ +If you want to use @relude@ per-module basis then just add next lines to your+module to replace default "Prelude":++@+\{\-\# LANGUAGE NoImplicitPrelude \#\-\}++__import__ "Relude"+@+ This documentation section contains the description of internal module structure to help navigate between modules, search for interesting functionalities and understand where you need to put your new changes (if you're a contributor).@@ -40,43 +52,7 @@ @Relude.SomeCategory.SomeName@. For example, see modules "Relude.Foldable.Fold" and "Relude.Foldable.Reexport". -Below is a short description of what you can find under different modules,-imported by default from "Relude":--* __"Relude.Applicative"__: reexports from "Control.Applicative" and some- general-purpose applicative combinators.-* __"Relude.Base"__: different general types and type classes from @base@- package ('Int', 'Num', 'Generic', etc.) not exported by other modules.-* __"Relude.Bool"__: 'Bool' data type with different predicates and combinators.-* __"Relude.Container"__: 'One' typeclass for creating data structures from- singleton lement and reexports of types from packages @containers@ and- @unordered-containers@.-* __"Relude.Debug"__: @trace@-like debugging functions with compile-time- warnings (so you don't forget to remove them).-* __"Relude.DeepSeq"__: reexports from "Control.DeepSeq" module and- functions to evaluate expressions to weak-head normal form or normal form.-* __"Relude.Exception"__: reexports "Control.Exception", introduces 'bug'- function as better 'error' and 'Exc' pattern synonym for convenient- pattern-matching on exceptions.-* __"Relude.File"__: functions to work with file content as 'Text' or 'ByteString'.-* __"Relude.Foldable"__: reexports functions for 'Foldable' and 'Traversable'.-* __"Relude.Function"__: almost everything from "Data.Function" module.-* __"Relude.Functor"__: reexports from "Data.Functor", "Data.Bifunctor",- other useful 'Functor' combinators.-* __"Relude.Lifted"__: lifted to 'MonadIO' functions to work with console,- files, 'IORef's, 'MVar's, etc.-* __"Relude.List"__: big chunk of "Data.List", 'NonEmpty' type and- functions for this type ('head', 'tail', 'last', 'init').-* __"Relude.Monad"__: reexports from "Data.Maybe" and "Data.Either" modules,- monad transormers, various combinators.-* __"Relude.Monoid"__: reexports from "Data.Monoid" and "Data.Semigroup".-* __"Relude.Nub"__: better versions of @nub@ function for list.-* __"Relude.Numeric"__: functions and types to work with numerical data.-* __"Relude.Print"__: printing to terminal functions for 'Text' and 'ByteString'.-* __"Relude.String"__: reexports from @text@ and @bytestring@ packages with- conversion functions between different textual types.--And these modules are not exported by default, but you can easily bring them to+The following modules are not exported by default, but you can easily bring them to every module in your package by modifying your "Prelude" file: * __"Relude.Extra.Bifunctor"__: additional combinators for 'Bifunctor'.@@ -84,8 +60,10 @@ 'CallStack'. * __"Relude.Extra.Enum"__: extra utilities for types that implement 'Bounded' and 'Enum' constraints.-* __"Relude.Extra.Foldable1"__: 'Foldable1' typeclass like 'Foldable' but for- non-empty structures.+* __"Relude.Extra.Foldable"__: extra folds for instances of the 'Foldable'+ typeclass. Currently, just a short-circuitable left fold.+* __"Relude.Extra.Foldable1"__: 'Relude.Extra.Foldable1.Foldable1' typeclass+ like 'Foldable' but for non-empty structures. * __"Relude.Extra.Group"__: grouping functions, polymorphic on return @Map@ type. * __"Relude.Extra.Lens"__: minimal implementation of @lens@ package required for basic usage.@@ -94,32 +72,51 @@ @newtype@. * __"Relude.Extra.Tuple"__: functions for working with tuples. * __"Relude.Extra.Type"__: functions for inspecting and working with types.-* __"Relude.Extra.Validation"__: 'Validation' data type.+* __"Relude.Extra.Validation"__: 'Relude.Extra.Validation.Validation' data type. * __"Relude.Unsafe"__: unsafe partial functions (produce 'error') for lists and 'Maybe'. -} module Relude- ( -- * Reexports from base and from modules in this repo+ ( -- * Modules available by default module Relude.Applicative+ -- $applicative , module Relude.Base+ -- $base , module Relude.Bool+ -- $bool , module Relude.Container+ -- $container , module Relude.Debug+ -- $debug , module Relude.DeepSeq+ -- $deepseq , module Relude.Exception+ -- $exception , module Relude.File+ -- $file , module Relude.Foldable+ -- $foldable , module Relude.Function+ -- $function , module Relude.Functor+ -- $functor , module Relude.Lifted+ -- $lifted , module Relude.List+ -- $list , module Relude.Monad+ -- $monad , module Relude.Monoid+ -- $monoid , module Relude.Nub+ -- $nub , module Relude.Numeric+ -- $numeric , module Relude.Print+ -- $print , module Relude.String+ -- $string ) where import Relude.Applicative@@ -141,3 +138,95 @@ import Relude.Numeric import Relude.Print import Relude.String++{- $applicative+__"Relude.Applicative"__ contains reexports from "Control.Applicative" and some+general-purpose applicative combinators.+-}++{- $base+__"Relude.Base"__ contains different general types and type classes from @base@+package ('Char', 'Eq', 'Generic', etc.) not exported by other modules.+-}++{- $bool+__"Relude.Bool"__ contains 'Bool' data type with different predicates and combinators.+-}++{- $container+__"Relude.Container"__ provides 'One' typeclass for creating data structures+from singleton lement and reexports of types from packages @containers@ and+@unordered-containers@.+-}++{- $debug+__"Relude.Debug"__ contains @trace@-like debugging functions with compile-time+warnings (so you don't forget to remove them).+-}++{- $deepseq+__"Relude.DeepSeq"__ has reexports from "Control.DeepSeq" module and functions+to evaluate expressions to weak-head normal form or normal form.+-}++{- $exception+__"Relude.Exception"__ contains reexports from "Control.Exception", introduces+'bug' function as better 'error' and 'Exc' pattern synonym for convenient+pattern-matching on exceptions.+-}++{- $file+__"Relude.File"__ implements functions to work with file content as 'Text' or+'ByteString'.+-}++{- $foldable+__"Relude.Foldable"__ reexports functions for 'Foldable' and 'Traversable' and+provide own better alternatives to some existing functions.+-}++{- $function+__"Relude.Function"__ contains almost everything from the "Data.Function" module.+-}++{- $functor+__"Relude.Functor"__ contains reexports from "Data.Functor", "Data.Bifunctor",+other useful 'Functor' combinators.+-}++{- $lifted+__"Relude.Lifted"__ implements lifted to 'MonadIO' functions to work with+console, files, 'IORef's, 'MVar's, etc.+-}++{- $list+__"Relude.List"__ provides big chunk of "Data.List", 'NonEmpty' type and+functions for this type ('head', 'tail', 'last', 'init').+-}++{- $monad+__"Relude.Monad"__ contains functions and data types from "Data.Maybe" and+"Data.Either" modules, monad transormers and other various combinators.+-}++{- $monoid+__"Relude.Monoid"__ reexports various types and functions from "Data.Monoid" and+"Data.Semigroup".+-}++{- $nub+__"Relude.Nub"__ implements better versions of @nub@ function for list.+-}++{- $numeric+__"Relude.Numeric"__ contains functions and types to work with numerical data.+-}++{- $print+__"Relude.Print"__ contains printing to terminal functions for 'Text' and 'ByteString'.+-}++{- $string+__"Relude.String"__ contains reexports from @text@ and @bytestring@ packages+with conversion functions between different textual types.+-}
src/Relude/Applicative.hs view
@@ -4,7 +4,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Convenient utils to work with 'Applicative'. There were more functions in this module@@ -31,9 +31,11 @@ -- Just () pass :: Applicative f => f () pass = pure ()+{-# INLINE pass #-} -{- | For chaining applicative operations in forward applications using '(&)'-Named version of the '<**>' operator, which is '<*>' but flipped+{- | Named version of the '<**>' operator, which is '<*>' but flipped. For+chaining applicative operations in forward applications using+'Relude.Function.&'. >>> Just (+ 1) & appliedTo (Just 2) Just 3
src/Relude/Base.hs view
@@ -5,7 +5,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Reexports from @Data.*@ and @GHC.*@ modules of@@ -64,7 +64,7 @@ import Data.Typeable (Typeable) import Data.Void (Void, absurd, vacuous) -import GHC.Base (String, asTypeOf, ord, seq, ($!))+import GHC.Base (asTypeOf, ord, seq, ($!)) import GHC.Enum (Bounded (..), Enum (..), boundedEnumFrom, boundedEnumFromThen) import GHC.Generics (Generic) import GHC.Show (Show)
src/Relude/Bool.hs view
@@ -4,7 +4,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Convenient commonly used and very helpful functions to work with 'Bool' and also
src/Relude/Bool/Guard.hs view
@@ -2,14 +2,15 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Monadic boolean combinators. -} module Relude.Bool.Guard- ( guardM+ ( guarded+ , guardM , ifM , unlessM , whenM@@ -17,9 +18,10 @@ , (||^) ) where +import Relude.Applicative (Alternative, Applicative (..), empty) import Relude.Bool.Reexport (Bool (..), guard, unless, when) import Relude.Function (flip)-import Relude.Monad (Monad, MonadPlus, return, (>>=))+import Relude.Monad (Monad, MonadPlus, (>>=)) -- $setup -- >>> import Relude.Applicative (pure)@@ -28,6 +30,7 @@ -- >>> import Relude.Function (($)) -- >>> import Relude.Monad (Maybe (..)) -- >>> import Relude.Print (putTextLn)+-- >>> import Relude (Int, String, even, const) -- | Monadic version of 'when'. --@@ -77,12 +80,41 @@ guardM f = f >>= guard {-# INLINE guardM #-} +{- | Either lifts a value into an alternative context or gives a+minimal value depending on a predicate.++>>> guarded even 3 :: [Int]+[]+>>> guarded even 2 :: [Int]+[2]+>>> guarded (const True) "hello" :: Maybe String+Just "hello"+>>> guarded (const False) "world" :: Maybe String+Nothing++You can use this function to implement smart constructors simpler:++@+__newtype__ HttpHost = HttpHost+ { unHttpHost :: Text+ }++mkHttpHost :: Text -> Maybe HttpHost+mkHttpHost host = HttpHost \<$\> 'guarded' (not . Text.null) host+@++@since 0.6.0.0+-}+guarded :: Alternative f => (a -> Bool) -> a -> f a+guarded p a = if p a then pure a else empty+{-# INLINE guarded #-}+ -- | Monadic version of 'Data.Bool.(&&)' operator. -- -- >>> Just False &&^ error "Shouldn't be evaluated" -- Just False (&&^) :: Monad m => m Bool -> m Bool -> m Bool-(&&^) e1 e2 = ifM e1 e2 (return False)+(&&^) e1 e2 = ifM e1 e2 (pure False) {-# INLINE (&&^) #-} -- | Monadic version of 'Data.Bool.(||)' operator.@@ -90,5 +122,5 @@ -- >>> Just True ||^ error "Shouldn't be evaluated" -- Just True (||^) :: Monad m => m Bool -> m Bool -> m Bool-(||^) e1 e2 = ifM e1 (return True) e2+e1 ||^ e2 = ifM e1 (pure True) e2 {-# INLINE (||^) #-}
src/Relude/Bool/Reexport.hs view
@@ -2,7 +2,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Reexports functions to work with 'Bool' type.
src/Relude/Container.hs view
@@ -2,7 +2,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> This module exports all container-related stuff.
src/Relude/Container/One.hs view
@@ -6,14 +6,14 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Typeclass for creating structures from a singleton element. It has three main goals: 1. Give a shorter name for the construction: uses 'one' instead of common @singleton@. 2. Work with monomorphic structures like 'T.Text' or 'IntSet'.-3. Give a clearer and less scary name for cases where you can use 'pure' or @(:[])@.+3. Give a clearer and less scary name for cases where you can use 'Relude.pure' or @(:[])@. -} module Relude.Container.One@@ -30,6 +30,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Short as SBS import qualified Data.Text as T import qualified Data.Text.Lazy as TL@@ -47,6 +48,7 @@ -- >>> import qualified Data.HashMap.Strict as HashMap -- >>> import qualified Data.Text as Text -- >>> import qualified Data.ByteString as ByteString+-- >>> import qualified Data.ByteString.Short as ShortByteString -- >>> import qualified Data.Text.Lazy as LText -- >>> import qualified Data.ByteString.Lazy as LByteString @@ -69,13 +71,14 @@ class One x where -- | Type of single element of the structure. type OneItem x- -- | Create a list, map, 'Text', etc from a single element.++ -- | Create a list, map, 'T.Text', etc from a single element. one :: OneItem x -> x -- Lists {- | Allows to create a singleton list. You might prefer function with name 'one'-instead of 'pure' or @(:[])@.+instead of 'Relude.pure' or @(:[])@. >>> one 42 :: [Int] [42]@@ -84,11 +87,13 @@ -} instance One [a] where type OneItem [a] = a++ one :: a -> [a] one = (:[]) {-# INLINE one #-} {- | Allows to create singleton 'NE.NonEmpty' list. You might prefer function with-name 'one' instead of 'pure' or @(:|[])@.+name 'one' instead of 'Relude.pure' or @(:|[])@. >>> one 42 :: NonEmpty Int 42 :| []@@ -97,6 +102,8 @@ -} instance One (NE.NonEmpty a) where type OneItem (NE.NonEmpty a) = a++ one :: a -> NE.NonEmpty a one = (NE.:|[]) {-# INLINE one #-} @@ -109,6 +116,8 @@ -} instance One (SEQ.Seq a) where type OneItem (SEQ.Seq a) = a++ one :: a -> SEQ.Seq a one = SEQ.singleton {-# INLINE one #-} @@ -123,6 +132,8 @@ -} instance One T.Text where type OneItem T.Text = Char++ one :: Char -> T.Text one = T.singleton {-# INLINE one #-} @@ -135,6 +146,8 @@ -} instance One TL.Text where type OneItem TL.Text = Char++ one :: Char -> TL.Text one = TL.singleton {-# INLINE one #-} @@ -147,6 +160,8 @@ -} instance One BS.ByteString where type OneItem BS.ByteString = Word8++ one :: Word8 -> BS.ByteString one = BS.singleton {-# INLINE one #-} @@ -159,9 +174,25 @@ -} instance One BSL.ByteString where type OneItem BSL.ByteString = Word8++ one :: Word8 -> BSL.ByteString one = BSL.singleton {-# INLINE one #-} +{- | Create singleton 'SBS.ShortByteString'.++>>> one 97 :: ShortByteString+"a"++prop> ShortByteString.length (one x) == 1+-}+instance One SBS.ShortByteString where+ type OneItem SBS.ShortByteString = Word8++ one :: Word8 -> SBS.ShortByteString+ one x = SBS.pack [x]+ {-# INLINE one #-}+ -- Maps {- | Create singleton 'Map' from key-value pair.@@ -173,6 +204,8 @@ -} instance One (Map k v) where type OneItem (Map k v) = (k, v)++ one :: (k, v) -> Map k v one = uncurry M.singleton {-# INLINE one #-} @@ -185,6 +218,8 @@ -} instance Hashable k => One (HashMap k v) where type OneItem (HashMap k v) = (k, v)++ one :: (k, v) -> HashMap k v one = uncurry HM.singleton {-# INLINE one #-} @@ -197,6 +232,8 @@ -} instance One (IntMap v) where type OneItem (IntMap v) = (Int, v)++ one :: (Int, v) -> IntMap v one = uncurry IM.singleton {-# INLINE one #-} @@ -209,8 +246,10 @@ prop> length (one @(Set Int) x) == 1 -}-instance One (Set v) where- type OneItem (Set v) = v+instance One (Set a) where+ type OneItem (Set a) = a++ one :: a -> Set a one = Set.singleton {-# INLINE one #-} @@ -221,8 +260,10 @@ prop> length (one @(HashSet Int) x) == 1 -}-instance Hashable v => One (HashSet v) where- type OneItem (HashSet v) = v+instance Hashable a => One (HashSet a) where+ type OneItem (HashSet a) = a++ one :: a -> HashSet a one = HashSet.singleton {-# INLINE one #-} @@ -235,5 +276,7 @@ -} instance One IntSet where type OneItem IntSet = Int++ one :: Int -> IntSet one = IS.singleton {-# INLINE one #-}
src/Relude/Container/Reexport.hs view
@@ -2,7 +2,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Reexports all container-related stuff from @base@, @containers@ and
src/Relude/Debug.hs view
@@ -1,25 +1,30 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE Trustworthy #-}--#if ( __GLASGOW_HASKELL__ >= 804 )-{-# LANGUAGE TypeInType #-}-#endif+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {- | Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Functions for debugging. If you left these functions in your code then a warning is generated to remind you about left usages. Also some functions (and data types) are convenient for prototyping.++Use these functions only for debugging purposes. They break referential trasparency,+they are only useful when you want to observe intermediate values of your pure functions. -} module Relude.Debug@@ -39,56 +44,183 @@ import Data.Data (Data) import GHC.Exts (RuntimeRep, TYPE)+import GHC.TypeLits (ErrorMessage (..), TypeError) import Relude.Applicative (Applicative)-import Relude.Base (Bounded, Enum, Eq, Generic, HasCallStack, Ord, Show, String, Typeable)-import Relude.String (Read, Text, toString)+import Relude.Base (Bounded, Char, Constraint, Enum, Eq, Generic, HasCallStack, Ord, Show, Type,+ Typeable)+import Relude.String (Read, String, Text, toString) import qualified Debug.Trace as Debug import qualified Prelude ++-- $setup+-- >>> import Relude+-- >>> :set -Wno-deprecations+ ---------------------------------------------------------------------------- -- trace ---------------------------------------------------------------------------- --- | Version of 'Debug.Trace.trace' that leaves warning.+{- | Version of 'Debug.Trace.trace' that leaves warning.++>>> increment l = map (+1) l+>>> increment [2, 3, 4]+[3,4,5]++>>> increment l = trace ("incrementing each value of: " ++ show l) (map (+1) l)+>>> increment [2, 3, 4]+incrementing each value of: [2,3,4]+[3,4,5]++-} trace :: String -> a -> a trace = Debug.trace {-# WARNING trace "'trace' remains in code" #-} --- | Version of 'Debug.Trace.traceShow' that leaves warning.+{- | Version of 'Debug.Trace.traceShow' that leaves warning.++>>> increment l = map (+1) l+>>> increment [2, 3, 4]+[3,4,5]++>>> increment l = traceShow l (map (+1) l)+>>> increment [2, 3, 4]+[2,3,4]+[3,4,5]++-} traceShow :: Show a => a -> b -> b traceShow = Debug.traceShow {-# WARNING traceShow "'traceShow' remains in code" #-} --- | Version of 'Debug.Trace.traceShowId' that leaves warning.+{- | Version of 'Debug.Trace.traceShowId' that leaves warning.++>>> traceShowId (1+2+3, "hello" ++ "world")+(6,"helloworld")+(6,"helloworld")++-} traceShowId :: Show a => a -> a traceShowId = Debug.traceShowId {-# WARNING traceShowId "'traceShowId' remains in code" #-} --- | Version of 'Debug.Trace.traceShowM' that leaves warning.-traceShowM :: (Show a, Applicative f) => a -> f ()-traceShowM = Debug.traceShowM-{-# WARNING traceShowM "'traceShowM' remains in code" #-}+{- | Version of 'Debug.Trace.traceM' that leaves warning. --- | Version of 'Debug.Trace.traceM' that leaves warning.+>>> :{+let action :: Maybe Int+ action = do+ x <- Just 3+ traceM ("x: " ++ show x)+ y <- pure 12+ traceM ("y: " ++ show y)+ pure (x*2 + y)+in action+:}+x: 3+y: 12+Just 18+-} traceM :: (Applicative f) => String -> f () traceM = Debug.traceM {-# WARNING traceM "'traceM' remains in code" #-} --- | Version of 'Debug.Trace.traceId' that leaves warning.+{-|+Like 'traceM', but uses 'Relude.show' on the argument to convert it to a+'String'.++>>> :{+let action :: Maybe Int+ action = do+ x <- Just 3+ traceShowM x+ y <- pure 12+ traceShowM y+ pure (x*2 + y)+in action+:}+3+12+Just 18+-}+traceShowM :: (Show a, Applicative f) => a -> f ()+traceShowM = Debug.traceShowM+{-# WARNING traceShowM "'traceShowM' remains in code" #-}++{- | Version of 'Debug.Trace.traceId' that leaves warning.++>>> traceId "hello"+"hello+hello"+-} traceId :: String -> String traceId = Debug.traceId {-# WARNING traceId "'traceId' remains in code" #-} ------------------------------------------------------------------------------- error and undefined+-- error ---------------------------------------------------------------------------- --- | 'Prelude.error' that takes 'Text' as an argument.-error :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack- => Text -> a+{- | Throw pure errors. Use this function only to when you are sure that this+branch of code execution is not possible. __DO NOT USE__ 'error' as a normal+error handling mechanism.++#ifdef mingw32_HOST_OS+>>> error "oops"+*** Exception: oops+CallStack (from HasCallStack):+ error, called at src\\Relude\\Debug.hs:204:11 in ...+ ...+#else+>>> error "oops"+*** Exception: oops+CallStack (from HasCallStack):+ error, called at src/Relude/Debug.hs:204:11 in ...+...+#endif++⚠️__CAUTION__⚠️ Unlike "Prelude" version, 'error' takes 'Relude.Text' as an+argument. In case it used by mistake, the user will see the following:++>>> error ("oops" :: String)+...+... 'error' expects 'Text' but was given 'String'.+ Possible fixes:+ * Make sure OverloadedStrings extension is enabled+ * Use 'error (toText msg)' instead of 'error msg'+...+>>> error False+...+... 'error' works with 'Text'+ But given: Bool+...+-}+error+ :: forall (r :: RuntimeRep) (a :: TYPE r) (t :: Type) .+ (HasCallStack, IsText t)+ => t+ -> a error e = Prelude.error (toString e)++type IsText (t :: Type) = (t ~ Text, CheckIsText t)++type family CheckIsText (t :: Type) :: Constraint where+ CheckIsText Text = ()+ CheckIsText [Char] = TypeError+ ( 'Text "'error' expects 'Text' but was given 'String'."+ ':$$: 'Text "Possible fixes:"+ ':$$: 'Text " * Make sure OverloadedStrings extension is enabled"+ ':$$: 'Text " * Use 'error (toText msg)' instead of 'error msg'"+ )+ CheckIsText a = TypeError+ ( 'Text "'error' works with 'Text'"+ ':$$: 'Text "But given: " ':<>: 'ShowType a+ )++----------------------------------------------------------------------------+-- Undefined and undefined+---------------------------------------------------------------------------- -- | Similar to 'undefined' but data type. data Undefined = Undefined
src/Relude/DeepSeq.hs view
@@ -2,7 +2,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> This module contains useful functions to evaluate expressions to weak-head@@ -20,25 +20,72 @@ import Control.DeepSeq (NFData (..), deepseq, force, ($!!)) -import Relude.Base (seq)+import Relude.Base (IO, seq) import Relude.Function ((.)) import Relude.Monad (MonadIO, liftIO, (<$!>)) import qualified Control.Exception.Base (evaluate) --- | Lifted alias for 'Control.Exception.Base.evaluate' with clearer name.++-- $setup+-- >>> import Relude++{- | Lifted alias for 'Control.Exception.Base.evaluate' with clearer name.++>>> list = [2, 1, 3] :: [Int]+>>> :sprint list+list = _+>>> () <$ evaluateWHNF list+>>> :sprint list+list = _ : _+-} evaluateWHNF :: MonadIO m => a -> m a evaluateWHNF = liftIO . Control.Exception.Base.evaluate+{-# INLINE evaluateWHNF #-}+{-# SPECIALIZE evaluateWHNF :: a -> IO a #-} --- | Like 'evaluateWNHF' but discards value.+{- | Like 'evaluateWHNF' but discards value.++>>> list = [2, 1, 3] :: [Int]+>>> :sprint list+list = _+>>> evaluateWHNF_ list+>>> :sprint list+list = _ : _++-} evaluateWHNF_ :: MonadIO m => a -> m () evaluateWHNF_ what = (`seq` ()) <$!> evaluateWHNF what+{-# INLINE evaluateWHNF_ #-}+{-# SPECIALIZE evaluateWHNF_ :: a -> IO () #-} --- | Alias for @evaluateWHNF . force@ with clearer name.+{- | Alias for @evaluateWHNF . force@ with clearer name.++>>> list = [2, 1, 3] :: [Int]+>>> :sprint list+list = _+>>> () <$ evaluateNF list+>>> :sprint list+list = [2,1,3]++-} evaluateNF :: (NFData a, MonadIO m) => a -> m a evaluateNF = evaluateWHNF . force+{-# INLINE evaluateNF #-}+{-# SPECIALIZE evaluateNF :: NFData a => a -> IO a #-} --- | Alias for @evaluateWHNF . rnf@. Similar to 'evaluateNF'+{- | Alias for @evaluateWHNF . rnf@. Similar to 'evaluateNF' -- but discards resulting value.++>>> list = [2, 1, 3] :: [Int]+>>> :sprint list+list = _+>>> evaluateNF_ list+>>> :sprint list+list = [2,1,3]++-} evaluateNF_ :: (NFData a, MonadIO m) => a -> m () evaluateNF_ = evaluateWHNF . rnf+{-# INLINE evaluateNF_ #-}+{-# SPECIALIZE evaluateNF_ :: NFData a => a -> IO () #-}
src/Relude/Exception.hs view
@@ -7,11 +7,11 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -Re-exports most useful functionality from 'safe-exceptions'. Also-provides some functions to work with exceptions over 'MonadError'.+Re-exports most useful functionality from the "Control.Exception" module. Also+provides some convenient utilities to throw and handle exceptions. -} module Relude.Exception@@ -32,8 +32,10 @@ import qualified Control.Exception as E (displayException, throw, toException) --- | Type that represents exceptions used in cases when a particular codepath--- is not meant to be ever executed, but happens to be executed anyway.++{- | 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) @@ -66,7 +68,7 @@ @ isNonCriticalExc :: SomeException -> Bool isNonCriticalExc = \case- Exc (_ :: NodeAttackedError) -> True -- matching all exceptions of type 'NodeAttackedError'+ Exc (_ :: NodeAttackedError) -> True -- matching all exceptions of type NodeAttackedError Exc DialogUnexpected{} -> True _ -> False @
src/Relude/Extra/Bifunctor.hs view
@@ -1,6 +1,6 @@ {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Useful combinators for bifunctors inside functors. This set of functions is@@ -12,17 +12,34 @@ baz :: Maybe (Either a b) qux :: Maybe (a, b)++doo :: (a, a)+dee :: Either a a @ -} module Relude.Extra.Bifunctor- ( bimapF+ ( bimapBoth+ , bimapF , firstF , secondF ) where import Relude +{- | Maps a function over both elements of a bifunctor.++>>> bimapBoth length ("a", "bb")+(1,2)+>>> map (bimapBoth not) [Left True, Right False]+[Left False,Right True]++@since 0.6.0.0+-}+bimapBoth :: Bifunctor f => (a -> b) -> f a a -> f b b+bimapBoth f = bimap f f+{-# INLINE bimapBoth #-}+ {- | Fmaps functions for nested bifunctor. Short for @fmap (bimap f g)@. >>> bimapF not length $ Just (False, ['a', 'b'])@@ -30,6 +47,7 @@ -} bimapF :: (Functor f, Bifunctor p) => (a -> c) -> (b -> d) -> f (p a b) -> f (p c d) bimapF f g = fmap (bimap f g)+{-# INLINE bimapF #-} {- | Short for @fmap . first@. @@ -38,6 +56,7 @@ -} firstF :: (Functor f, Bifunctor p) => (a -> c) -> f (p a b) -> f (p c b) firstF = fmap . first+{-# INLINE firstF #-} {- | Short for @fmap . second@. @@ -46,3 +65,4 @@ -} secondF :: (Functor f, Bifunctor p) => (b -> d) -> f (p a b) -> f (p a d) secondF = fmap . second+{-# INLINE secondF #-}
src/Relude/Extra/CallStack.hs view
@@ -1,6 +1,6 @@ {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Contains useful functions to work with GHC callstack.
src/Relude/Extra/Enum.hs view
@@ -1,9 +1,6 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}- {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Mini @bounded-enum@ framework inside @relude@.@@ -13,16 +10,16 @@ ( universe , inverseMap , next+ , prev , prec , safeToEnum ) where import Relude+import Relude.Extra.Tuple (mapToFst) import qualified Data.Map.Strict as M --- $setup--- >>> :set -XTypeApplications {- | Returns all values of some 'Bounded' 'Enum' in ascending order. @@ -34,32 +31,67 @@ -} universe :: (Bounded a, Enum a) => [a] universe = [minBound .. maxBound]+{-# INLINE universe #-} {- | @inverseMap f@ creates a function that is the inverse of a given function-@f@. It does so by constructing 'M.Map' for every value @f a@. The+@f@. It does so by constructing 'M.Map' internally for each value @f a@. The implementation makes sure that the 'M.Map' is constructed only once and then shared for every call. -The complexity of reversed mapping though is \(\mathcal{O}(\log n)\).+__Memory usage note:__ don't inverse functions that have types like 'Int'+as their result. In this case the created 'M.Map' will have huge size. -Usually you want to use 'inverseMap' to inverse 'show' function.+The complexity of reversed mapping is \(\mathcal{O}(\log n)\). +__Performance note:__ make sure to specialize monomorphic type of your functions+that use 'inverseMap' to avoid 'M.Map' reconstruction.++One of the common 'inverseMap' use-case is inverting the 'show' or a 'show'-like+function.+ >>> data Color = Red | Green | Blue deriving (Show, Enum, Bounded) >>> parse = inverseMap show :: String -> Maybe Color >>> parse "Red" Just Red >>> parse "Black" Nothing++__Correctness note:__ 'inverseMap' expects /injective function/ as its argument,+i.e. the function must map distinct arguments to distinct values.++Typical usage of this function looks like this:++@+__data__ GhcVer+ = Ghc802+ | Ghc822+ | Ghc844+ | Ghc865+ | Ghc881+ __deriving__ ('Eq', 'Ord', 'Show', 'Enum', 'Bounded')++showGhcVer :: GhcVer -> 'Text'+showGhcVer = \\__case__+ Ghc802 -> "8.0.2"+ Ghc822 -> "8.2.2"+ Ghc844 -> "8.4.4"+ Ghc865 -> "8.6.5"+ Ghc881 -> "8.8.1"++parseGhcVer :: 'Text' -> 'Maybe' GhcVer+parseGhcVer = 'inverseMap' showGhcVer+@ -}-inverseMap :: forall a k . (Bounded a, Enum a, Ord k)- => (a -> k) -> (k -> Maybe a)+inverseMap+ :: forall a k .+ (Bounded a, Enum a, Ord k)+ => (a -> k)+ -> (k -> Maybe a) inverseMap f = \k -> M.lookup k dict where dict :: M.Map k a- dict = M.fromList $ zip (map f univ) univ-- univ :: [a]- univ = universe+ dict = M.fromList $ map (mapToFst f) (universe @a)+{-# INLINE inverseMap #-} {- | Like 'succ', but doesn't fail on 'maxBound'. Instead it returns 'minBound'. @@ -70,25 +102,34 @@ >>> succ True *** Exception: Prelude.Enum.Bool.succ: bad argument -}-next :: (Eq a, Bounded a, Enum a) => a -> a+next :: (Eq a, Bounded a, Enum a) => a -> a next e | e == maxBound = minBound | otherwise = succ e+{-# INLINE next #-} {- | Like 'pred', but doesn't fail on 'minBound'. Instead it returns 'maxBound'. ->>> prec False+>>> prev False True->>> prec True+>>> prev True False >>> pred False *** Exception: Prelude.Enum.Bool.pred: bad argument++@since 0.6.0.0 -}-prec :: (Eq a, Bounded a, Enum a) => a -> a-prec e+prev :: (Eq a, Bounded a, Enum a) => a -> a+prev e | e == minBound = maxBound | otherwise = pred e+{-# INLINE prev #-} +-- | See 'prev'.+prec :: (Eq a, Bounded a, Enum a) => a -> a+prec = prev+{-# DEPRECATED prec "Use 'prev' instead, it has more idiomatic and common name" #-}+ {- | Returns 'Nothing' if given 'Int' outside range. >>> safeToEnum @Bool 0@@ -101,4 +142,5 @@ Nothing -} safeToEnum :: forall a . (Bounded a, Enum a) => Int -> Maybe a-safeToEnum i = guard (fromEnum @a minBound <= i && i <= fromEnum @a maxBound) *> Just (toEnum i)+safeToEnum i = guard (fromEnum @a minBound <= i && i <= fromEnum @a maxBound) $> toEnum i+{-# INLINE safeToEnum #-}
+ src/Relude/Extra/Foldable.hs view
@@ -0,0 +1,36 @@+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MIT+Maintainer: Kowainik <xrom.xkov@gmail.com>++Contains utility functions for working with tuples.++@since 0.6.0.0+-}++module Relude.Extra.Foldable+ ( foldlSC+ ) where++import Relude+++{- | A left-associative fold that's tail-recursive but can still short-circuit.+Returning a 'Left' short-circuits and immediately returns the value inside.+Returning a 'Right' continues the fold as usual with the value inside.++>>> foldlSC (\acc x -> if x == 0 then Left 0 else Right $! acc * x) 1 [1..6]+720+>>> foldlSC (\acc x -> if x == 0 then Left 0 else Right $! acc * x) 1 (0:error "Short-circuiting should keep this from happening")+0++@since 0.6.0.0+-}+foldlSC :: forall t b a. Foldable t => (b -> a -> Either b b) -> b -> t a -> b+foldlSC f = flip $ foldr go id+ where+ go :: a -> (b -> b) -> b -> b+ go x k z = case f z x of+ Left l -> l+ Right r -> k r+{-# INLINE foldlSC #-}
src/Relude/Extra/Foldable1.hs view
@@ -1,10 +1,12 @@-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {- | Copyright: (c) 2011-2015 Edward Kmett (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -} @@ -18,9 +20,14 @@ import Data.Functor.Product (Product (..)) import Data.Functor.Sum (Sum (..))+import GHC.TypeLits (ErrorMessage (..), TypeError) import qualified Data.Semigroup as SG ++-- $setup+-- >>> import Relude+ {- | The class of foldable data structures that cannot be empty. -} class Foldable f => Foldable1 f where@@ -30,6 +37,8 @@ >>> foldMap1 SG.Sum (1 :| [2, 3, 4]) Sum {getSum = 10}+ >>> foldMap1 show (123 :| [456, 789, 0])+ "1234567890" -} foldMap1 :: Semigroup m => (a -> m) -> f a -> m @@ -88,12 +97,13 @@ fold1 = sconcat {-# INLINE fold1 #-} - foldMap1 :: Semigroup m => (a -> m) -> NonEmpty a -> m- foldMap1 f (a :| []) = f a- foldMap1 f (a :| b : bs) = f a <> foldMap1 f (b :| bs)+ foldMap1 :: forall m a . Semigroup m => (a -> m) -> NonEmpty a -> m+ foldMap1 f (a :| as) = foldr go f as a+ where+ go :: a -> (a -> m) -> a -> m+ go b g x = f x <> g b {-# INLINE foldMap1 #-} - toNonEmpty :: NonEmpty a -> NonEmpty a toNonEmpty = id {-# INLINE toNonEmpty #-}@@ -110,7 +120,6 @@ {-# INLINE maximum1 #-} {-# INLINE minimum1 #-} - instance Foldable1 Identity where foldMap1 :: Semigroup m => (a -> m) -> Identity a -> m foldMap1 = coerce@@ -188,6 +197,66 @@ foldMap1 f (InL x) = foldMap1 f x foldMap1 f (InR y) = foldMap1 f y {-# INLINE foldMap1 #-}+++----------------------------------------------------------------------------+-- List custom error+----------------------------------------------------------------------------++-- | For tracking usage of ordinary list with 'Foldable1' functions.+type family IsListError :: Constraint+ where+ IsListError = TypeError+ ( 'Text "The methods of the 'Foldable1' type class work with non-empty containers."+ ':$$: 'Text "However, one of the 'Foldable1' functions is applied to the List."+ ':$$: 'Text ""+ ':$$: 'Text "Possible fixes:"+ ':$$: 'Text " * Replace []"+ ':$$: 'Text " with one of the: 'NonEmpty', 'Identity', '(c,)', 'Compose f g', 'Product f g', 'Sum f g'"+ ':$$: 'Text " * Or use 'Foldable' class for your own risk."+ )+++{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only.++'Foldable1' is not supposed to be used with the lists.++In case it is used by mistake, the user will see the following:++>>> head1 [1, 2, 3]+...+... The methods of the 'Foldable1' type class work with non-empty containers.+ However, one of the 'Foldable1' functions is applied to the List.+...+ Possible fixes:+ * Replace []+ with one of the: 'NonEmpty', 'Identity', '(c,)', 'Compose f g', 'Product f g', 'Sum f g'+ * Or use 'Foldable' class for your own risk.+...++@since 0.6.0.0+-}+instance IsListError => Foldable1 [] where+ foldMap1 :: Semigroup m => (a -> m) -> [a] -> m+ foldMap1 _ _ = error "Unreachable list instance of Foldable1"++ fold1 :: Semigroup m => [m] -> m+ fold1 _ = error "Unreachable list instance of Foldable1"++ toNonEmpty :: [a] -> NonEmpty a+ toNonEmpty _ = error "Unreachable list instance of Foldable1"++ head1 :: [a] -> a+ head1 _ = error "Unreachable list instance of Foldable1"++ last1 :: [a] -> a+ last1 _ = error "Unreachable list instance of Foldable1"++ maximum1 :: Ord a => [a] -> a+ maximum1 _ = error "Unreachable list instance of Foldable1"++ minimum1 :: Ord a => [a] -> a+ minimum1 _ = error "Unreachable list instance of Foldable1" {- | Strictly folds non-empty structure with given function @f@:
src/Relude/Extra/Group.hs view
@@ -1,9 +1,8 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies #-} {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Polymorphic grouping functions.@@ -18,6 +17,7 @@ import Relude.Extra.Map import Data.List.NonEmpty ((<|))+ {- | Groups elements using results of the given function as keys.
src/Relude/Extra/Lens.hs view
@@ -3,7 +3,7 @@ {- | Copyright: (c) 2013-2016 Edward Kmett (c) 2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> This module aims to provide a minimal implementation of @lens@ package required@@ -11,6 +11,10 @@ therefore if you need to expand to the full version the process should be straightforward. +Main ideas implemented in this module are described in the following blog post:++* [Write yourself a lens (by Veronika Romashkina)](https://vrom911.github.io/blog/write-yourself-a-lens)+ == Usage To use lenses in your project, you don't need to add any other dependency rather@@ -164,6 +168,7 @@ ) where import Relude+ {- | The monomorphic lenses which don't change the type of the container (or of the value inside). It has a 'Functor' constraint, and since both 'Const' and
src/Relude/Extra/Map.hs view
@@ -2,7 +2,7 @@ {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Contains implementation of polymorhic type classes for data types 'Set' and@@ -24,11 +24,11 @@ import GHC.Exts (IsList (Item, toList)) -import Relude.Applicative (pure, (*>)) import Relude.Base (Eq, Ord, Type) import Relude.Bool (Bool, guard, not) import Relude.Container.Reexport (HashMap, HashSet, Hashable, IntMap, IntSet, Map, Set, fst, snd) import Relude.Function ((.))+import Relude.Functor.Reexport (($>)) import Relude.List (map) import Relude.Monad.Reexport (Maybe (..), fromMaybe) import Relude.Numeric (Int)@@ -59,81 +59,107 @@ type Key (Map k v) = k type Val (Map k v) = v - size = M.size- lookup = M.lookup- member = M.member+ size = M.size {-# INLINE size #-}+ lookup = M.lookup {-# INLINE lookup #-}+ member = M.member {-# INLINE member #-} instance (Eq k, Hashable k) => StaticMap (HashMap k v) where type Key (HashMap k v) = k type Val (HashMap k v) = v - size = HM.size- lookup = HM.lookup- member = HM.member+ size = HM.size {-# INLINE size #-}+ lookup = HM.lookup {-# INLINE lookup #-}+ member = HM.member {-# INLINE member #-} instance StaticMap (IntMap v) where type Key (IntMap v) = Int type Val (IntMap v) = v - size = IM.size- lookup = IM.lookup- member = IM.member+ size = IM.size {-# INLINE size #-}+ lookup = IM.lookup {-# INLINE lookup #-}+ member = IM.member {-# INLINE member #-} instance Ord a => StaticMap (Set a) where type Key (Set a) = a type Val (Set a) = a - size = S.size- member = S.member- lookup k m = guard (member k m) *> pure k+ size = S.size {-# INLINE size #-}- {-# INLINE lookup #-}+ member = S.member {-# INLINE member #-}+ lookup k m = guard (member k m) $> k+ {-# INLINE lookup #-} instance (Eq a, Hashable a) => StaticMap (HashSet a) where type Key (HashSet a) = a type Val (HashSet a) = a - size = HS.size- member = HS.member- lookup k m = guard (member k m) *> pure k+ size = HS.size {-# INLINE size #-}- {-# INLINE lookup #-}+ member = HS.member {-# INLINE member #-}+ lookup k m = guard (member k m) $> k+ {-# INLINE lookup #-} instance StaticMap IntSet where type Key IntSet = Int type Val IntSet = Int - size = IS.size- member = IS.member- lookup k m = guard (member k m) *> pure k+ size = IS.size {-# INLINE size #-}- {-# INLINE lookup #-}+ member = IS.member {-# INLINE member #-}+ lookup k m = guard (member k m) $> k+ {-# INLINE lookup #-} --- | Operator version of 'lookup' function.+{- | Operator version of 'lookup' function.++>>> let myHashMap = HashMap.fromList [('a', "xxx"), ('b', "yyy")]+>>> myHashMap !? 'b'+Just "yyy"++>>> myHashMap !? 'd'+Nothing++-} infixl 9 !? (!?) :: StaticMap t => t -> Key t -> Maybe (Val t) (!?) m k = lookup k m {-# INLINE (!?) #-} --- | Inverse of 'member' function.+{- | Inverse of 'member' function.++>>> let myHashMap = HashMap.fromList [('a', "xxx"), ('b', "yyy")]+>>> notMember 'b' myHashMap+False++>>> notMember 'c' myHashMap+True++-} notMember :: StaticMap t => Key t -> t -> Bool notMember k = not . member k {-# INLINE notMember #-} {- | Return the value to which the specified key is mapped, or the default value if this map contains no mapping for the key.++>>> let myHashMap = HashMap.fromList [('a', "xxx"), ('b', "yyy")]+>>> lookupDefault "zzz" 'b' myHashMap+"yyy"++>>> lookupDefault "zzz" 'c' myHashMap+"zzz"+ -} lookupDefault :: StaticMap t => Val t -- ^ Default value to return.
src/Relude/Extra/Newtype.hs view
@@ -1,9 +1,8 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Functions to ease work with newtypes.@@ -22,6 +21,7 @@ import Relude + -- $setup -- >>> :set -XTypeApplications -- >>> import Data.Semigroup (Max (..))@@ -89,7 +89,8 @@ {-# INLINE underF2 #-} #endif -{- | Coercible composition+{- | Coercible composition. This function allows to write more efficient+implementations of functions compoitions over @newtypes@. -} (#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c) (#.) _f = coerce
src/Relude/Extra/Tuple.hs view
@@ -2,14 +2,15 @@ {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Contains utility functions for working with tuples. -} module Relude.Extra.Tuple- ( dupe+ ( dup+ , dupe , mapToFst , mapToSnd , mapBoth@@ -20,21 +21,28 @@ import Relude + {- | Creates a tuple by pairing something with itself. ->>> dupe "foo"+>>> dup "foo" ("foo","foo")->>> dupe ()+>>> dup () ((),())++@since 0.6.0.0 -}+dup :: a -> (a, a)+dup a = (a, a)+{-# INLINE dup #-}++-- | See 'dup'. dupe :: a -> (a, a)-dupe a = (a, a)-{-# INLINE dupe #-}+dupe = dup+{-# DEPRECATED dupe "Use 'dup' instead, it has more idiomatic and common name" #-} {- | Apply a function, with the result in the fst slot, and the value in the other. - A dual to 'mapToSnd' >>> mapToFst (+1) 10@@ -63,6 +71,7 @@ -} mapBoth :: (a -> b) -> (a, a) -> (b, b) mapBoth f (a1, a2) = (f a1, f a2)+{-# DEPRECATED mapBoth "Use 'Relude.Extra.Bifunctor.bimapBoth' from \"Relude.Extra.Bifunctor\" instead" #-} {-# INLINE mapBoth #-} {- | Apply a function that returns a value inside of a functor,
src/Relude/Extra/Type.hs view
@@ -1,28 +1,41 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -Contains useful functions to work with Types.+Contains useful utilities to work with Types. -} module Relude.Extra.Type ( typeName+ , type (++)+ , AllHave+ , Elem+ , Fst+ , Snd ) where import Relude -#if ( __GLASGOW_HASKELL__ >= 822 )-import Type.Reflection (Typeable, typeRep)+#if ( __GLASGOW_HASKELL__ >= 802 )+import Type.Reflection (typeRep) #else-import Data.Typeable (Typeable, typeRep)+import Data.Typeable (typeRep) #endif ++-- $setup+-- >>> :set -XDataKinds -XTypeOperators+ {- | Gets a string representation of a type. __NOTE:__ This must be used with __TypeApplications__ language extension.@@ -37,9 +50,100 @@ "Maybe Int" -} typeName :: forall a. Typeable a => Text-#if ( __GLASGOW_HASKELL__ >= 822 )+#if ( __GLASGOW_HASKELL__ >= 802 ) typeName = show (typeRep @a) #else typeName = show (typeRep (Proxy @a)) #endif {-# INLINE typeName #-}++{- | Concatenates type-level lists.++>>> :kind! '[ 'Just 5, 'Nothing] ++ '[ 'Just 3, 'Nothing, 'Just 1]+'[ 'Just 5, 'Nothing] ++ '[ 'Just 3, 'Nothing, 'Just 1] :: [Maybe+ Nat]+= '[ 'Just 5, 'Nothing, 'Just 3, 'Nothing, 'Just 1]++>>> :kind! '[] ++ '[ 'Just 3, 'Nothing, 'Just 1]+'[] ++ '[ 'Just 3, 'Nothing, 'Just 1] :: [Maybe Nat]+= '[ 'Just 3, 'Nothing, 'Just 1]++@since 0.6.0.0+-}+infixr 5 +++type family (++) (xs :: [k]) (ys :: [k]) :: [k] where+ '[] ++ ys = ys+ (x ': xs) ++ ys = x ': xs ++ ys++{- | Builds combined 'Constraint' by applying Constraint constructor to all+elements of type-level list.++>>> :kind! AllHave Show '[Int, Text, Double]+AllHave Show '[Int, Text, Double] :: Constraint+= (Show Int, (Show Text, (Show Double, () :: Constraint)))++which is equivalent to:++@+(Show Int, Show Text, Show Double) :: Constraint+@++@since 0.6.0.0+-}+type family AllHave (f :: k -> Constraint) (xs :: [k]) :: Constraint where+ AllHave _ '[] = ()+ AllHave f (x ': xs) = (f x, AllHave f xs)++{- | Returns first element of tuple type (with kind @*@) or type-level tuple+(with kind @(k1, k2)@, marked by prefix quote).++>>> :kind! Maybe (Fst '(Int, Text))+Maybe (Fst '(Int, Text)) :: *+= Maybe Int++>>> :kind! Maybe (Fst (Int, Text))+Maybe (Fst (Int, Text)) :: *+= Maybe Int++@since 0.6.0.0+-}+type family Fst (t :: k) :: k' where+ Fst '(x, _) = x+ Fst (x, _) = x++{- | Returns second element of tuple type (with kind @*@) or type-level tuple+(with kind @(k1, k2)@, marked by prefix quote).++>>> :kind! Maybe (Snd '(Int, Text))+Maybe (Snd '(Int, Text)) :: *+= Maybe Text+>>> :kind! Maybe (Snd (Int, Text))+Maybe (Snd (Int, Text)) :: *+= Maybe Text++@since 0.6.0.0+-}+type family Snd (t :: k) :: k' where+ Snd '(_, y) = y+ Snd (_, y) = y++{- | Check that a type is an element of a list:++>>> :kind! Elem String '[]+Elem String '[] :: Bool+= 'False++>>> :kind! Elem String '[Int, String]+Elem String '[Int, String] :: Bool+= 'True++>>> :kind! Elem String '[Int, Bool]+Elem String '[Int, Bool] :: Bool+= 'False++@since 0.6.0.0+-}+type family Elem (e :: t) (es :: [t]) :: Bool where+ Elem _ '[] = 'False+ Elem x (x ': xs) = 'True+ Elem x (_ ': xs) = Elem x xs
src/Relude/Extra/Validation.hs view
@@ -1,28 +1,109 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {- | Copyright: (c) 2014 Chris Allen, Edward Kmett (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -Monoidal 'Validation' sibling to 'Either'.+'Validation' is a monoidal sibling to 'Either' but 'Validation' doesn't have a+'Monad' instance. 'Validation' allows to accumulate all errors instead of+short-circuting on the first error so you can display all possible errors at+once. Common use-cases include:++1. Validating each input of a form with multiple inputs.+2. Performing multiple validations of a single value.++Instances of different standard typeclasses provide various semantics:++1. 'Functor': change the type inside 'Success'.+2. 'Bifunctor': change both 'Failure' and 'Success'.+3. 'Applicative': apply function to values inside 'Success' and accumulate+ errors inside 'Failure'.+4. 'Semigroup': accumulate both 'Failure' and 'Success' with '<>'.+5. 'Monoid': 'Success' that shores 'mempty'.+6. 'Alternative': return first 'Success' or accumulate all errors inside 'Failure'. -} module Relude.Extra.Validation- ( Validation(..)+ ( -- * How to use+ -- $use+ Validation(..) , validationToEither , eitherToValidation ) where +import GHC.TypeLits (ErrorMessage (..), TypeError)+ import Relude --- $setup--- >>> :set -XTypeApplications -XOverloadedStrings+-- >>> $setup+-- >>> import Relude --- | 'Validation' is 'Either' with a Left that is a 'Monoid'+{- $use++Take for example a type @Computer@ that needs to be validated:++>>> :{+data Computer = Computer+ { computerRam :: !Int -- ^ Ram in Gigabytes+ , computerCpus :: !Int+ } deriving (Eq, Show)+:}++You can validate that the computer has a minimum of 16GB of RAM:++>>> :{+validateRam :: Int -> Validation [Text] Int+validateRam ram+ | ram >= 16 = Success ram+ | otherwise = Failure ["Not enough RAM"]+:}++and that the processor has at least two CPUs:++>>> :{+validateCpus :: Int -> Validation [Text] Int+validateCpus cpus+ | cpus >= 2 = Success cpus+ | otherwise = Failure ["Not enough CPUs"]+:}++You can use these functions with the 'Applicative' instance of the 'Validation'+type to construct a validated @Computer@. You will get either (pun intended) a+valid @Computer@ or the errors that prevent it from being considered valid.++Like so:++>>> :{+mkComputer :: Int -> Int -> Validation [Text] Computer+mkComputer ram cpus = Computer+ <$> validateRam ram+ <*> validateCpus cpus+:}++Using @mkComputer@ we get a @Success Computer@ or a list with all possible errors:++>>> mkComputer 16 2+Success (Computer {computerRam = 16, computerCpus = 2})++>>> mkComputer 16 1+Failure ["Not enough CPUs"]++>>> mkComputer 15 2+Failure ["Not enough RAM"]++>>> mkComputer 15 1+Failure ["Not enough RAM","Not enough CPUs"]+-}++-- | 'Validation' is 'Either' with a 'Left' that is a 'Semigroup'. data Validation e a = Failure e | Success a@@ -39,66 +120,142 @@ _ <$ Failure e = Failure e {-# INLINE (<$) #-} -{- | __Examples__+{- | This instances covers the following cases: ->>> let fa = Success (*3) :: Validation [Text] (Int -> Int)->>> let ga = Success (*4) :: Validation [Text] (Int -> Int)->>> let a = Success 1 :: Validation [Text] Int->>> let b = Success 7 :: Validation [Text] Int->>> let c = Failure ["Not correct"] :: Validation [Text] Int->>> let d = Failure ["Not correct either"] :: Validation [Text] Int+1. Both 'Success': combine values inside 'Success' with '<>'.+2. Both 'Failure': combine values inside 'Failure' with '<>'.+3. One 'Success', one 'Failure': return 'Failure'. ->>> fa <*> b-Success 21+__Examples__ ->>> fa <*> c-Failure ["Not correct"]+>>> success1 = Success [42] :: Validation [Text] [Int]+>>> success2 = Success [69] :: Validation [Text] [Int]+>>> failure1 = Failure ["WRONG"] :: Validation [Text] [Int]+>>> failure2 = Failure ["FAIL"] :: Validation [Text] [Int] ->>> c *> d *> b-Failure ["Not correct","Not correct either"]+>>> success1 <> success2+Success [42,69] ->>> liftA2 (+) a b-Success 8+>>> failure1 <> failure2+Failure ["WRONG","FAIL"] ->>> liftA2 (+) a c-Failure ["Not correct"]+>>> success1 <> failure1+Failure ["WRONG"]++@since 0.6.0.0 -}+instance (Semigroup e, Semigroup a) => Semigroup (Validation e a) where+ (<>) :: Validation e a -> Validation e a -> Validation e a+ (<>) = liftA2 (<>)+ {-# INLINE (<>) #-}++{- | 'mempty' is @'Success' 'mempty'@.++@since 0.6.0.0+-}+instance (Semigroup e, Monoid a) => Monoid (Validation e a) where+ mempty :: Validation e a+ mempty = Success mempty+ {-# INLINE mempty #-}++{- | This instance if the most important instance for the 'Validation' data+type. It's responsible for the many implementations. And it allows to accumulate+errors while performing validation or combining the results in the applicative+style.++__Examples__++>>> success1 = Success 42 :: Validation [Text] Int+>>> success2 = Success 69 :: Validation [Text] Int+>>> successF = Success (* 2) :: Validation [Text] (Int -> Int)+>>> failure1 = Failure ["WRONG"] :: Validation [Text] Int+>>> failure2 = Failure ["FAIL"] :: Validation [Text] Int++>>> successF <*> success1+Success 84++>>> successF <*> failure1+Failure ["WRONG"]++>>> (+) <$> success1 <*> success2+Success 111++>>> (+) <$> failure1 <*> failure2+Failure ["WRONG","FAIL"]++>>> liftA2 (+) success1 failure1+Failure ["WRONG"]++>>> liftA3 (,,) failure1 success1 failure2+Failure ["WRONG","FAIL"]++Implementations of all functions are lazy and they correctly work if some+arguments are not fully evaluated.++>>> :{+isFailure :: Validation e a -> Bool+isFailure (Failure _) = True+isFailure (Success _) = False+:}++>>> failure1 *> failure2+Failure ["WRONG","FAIL"]+>>> isFailure $ failure1 *> failure2+True+>>> epicFail = error "Impossible validation" :: Validation [Text] Int+>>> isFailure $ failure1 *> epicFail+True+-} instance Semigroup e => Applicative (Validation e) where pure :: a -> Validation e a pure = Success {-# INLINE pure #-} -#if MIN_VERSION_base(4,10,0)- liftA2 :: (a -> b -> c) -> Validation e a -> Validation e b -> Validation e c- liftA2 _ (Failure el) (Failure er) = Failure (el <> er)- liftA2 _ (Failure e) (Success _) = Failure e- liftA2 _ (Success _) (Failure e) = Failure e- liftA2 f (Success a) (Success b) = Success (f a b)- {-# INLINE liftA2 #-}-#endif- (<*>) :: Validation e (a -> b) -> Validation e a -> Validation e b Failure e <*> b = Failure $ case b of- Failure e' -> e <> e'- Success _ -> e+ Failure e' -> e <> e'+ Success _ -> e Success _ <*> Failure e = Failure e Success f <*> Success a = Success (f a) {-# INLINE (<*>) #-} (*>) :: Validation e a -> Validation e b -> Validation e b- Failure el *> Failure er = Failure (el <> er)- Failure e *> Success _ = Failure e- Success _ *> Failure e = Failure e- Success _ *> Success b = Success b+ Failure e *> b = Failure $ case b of+ Failure e' -> e <> e'+ Success _ -> e+ Success _ *> Failure e = Failure e+ Success _ *> Success b = Success b {-# INLINE (*>) #-} (<*) :: Validation e a -> Validation e b -> Validation e a- Failure el <* Failure er = Failure (el <> er)- Failure e <* Success _ = Failure e- Success _ <* Failure e = Failure e- Success a <* Success _ = Success a+ Failure e <* b = Failure $ case b of+ Failure e' -> e <> e'+ Success _ -> e+ Success _ <* Failure e = Failure e+ Success a <* Success _ = Success a {-# INLINE (<*) #-} ++{- | This instance implements the following behavior for the binary operator:++1. Both 'Failure': combine values inside 'Failure' using '<>'.+2. At least is 'Success': return the left 'Success' (the earliest 'Success').+3. 'empty' is @'Failure' 'mempty'@.++__Examples__++>>> success1 = Success [42] :: Validation [Text] [Int]+>>> success2 = Success [69] :: Validation [Text] [Int]+>>> failure1 = Failure ["WRONG"] :: Validation [Text] [Int]+>>> failure2 = Failure ["FAIL"] :: Validation [Text] [Int]++>>> success1 <|> success2+Success [42]+>>> failure1 <|> failure2+Failure ["WRONG","FAIL"]+>>> failure2 <|> success2+Success [69]+-} instance (Semigroup e, Monoid e) => Alternative (Validation e) where empty :: Validation e a empty = Failure mempty@@ -167,16 +324,59 @@ {-# INLINE bitraverse #-} #endif --- | Transform a 'Validation' into an 'Either'.+{- | Transform a 'Validation' into an 'Either'.++>>> validationToEither (Success "whoop")+Right "whoop"++>>> validationToEither (Failure "nahh")+Left "nahh"+-} validationToEither :: Validation e a -> Either e a validationToEither = \case Failure e -> Left e Success a -> Right a {-# INLINE validationToEither #-} --- | Transform an 'Either' into a 'Validation'.+{- | Transform an 'Either' into a 'Validation'.++>>> eitherToValidation (Right "whoop")+Success "whoop"++>>> eitherToValidation (Left "nahh")+Failure "nahh"+-} eitherToValidation :: Either e a -> Validation e a eitherToValidation = \case Left e -> Failure e Right a -> Success a {-# INLINE eitherToValidation #-}++----------------------------------------------------------------------------+-- Custom errors+----------------------------------------------------------------------------++{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only.++It's not possible to implement lawful 'Monad' instance for 'Validation'.++In case it is used by mistake, the user will see the following:++>>> Success 42 >>= \n -> if even n then Success n else Failure ["Not even"]+...+... Type 'Validation' doesn't have lawful 'Monad' instance+ which means that you can't use 'Monad' methods with 'Validation'.+...++@since 0.6.0.0+-}+instance (NoValidationMonadError, Semigroup e) => Monad (Validation e) where+ return = error "Unreachable Validation instance of Monad"+ (>>=) = error "Unreachable Validation instance of Monad"++-- | Helper type family to produce error messages+type family NoValidationMonadError :: Constraint where+ NoValidationMonadError = TypeError+ ( 'Text "Type 'Validation' doesn't have lawful 'Monad' instance"+ ':$$: 'Text "which means that you can't use 'Monad' methods with 'Validation'."+ )
src/Relude/File.hs view
@@ -1,10 +1,13 @@ {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Lifted to 'MonadIO' families of file processing functions for 'Text', 'LText', 'ByteString' and 'LByteString' types.++These functions are lifted which means that you can also use them inside+various Monad Transformers without adding 'liftIO' call explicitly. __NOTE:__ These functions are for working with textual data. Functions that work with 'Text' or 'LText' types are system and locale-sensitive (encoding,
src/Relude/Foldable.hs view
@@ -1,6 +1,6 @@ {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> This module exports all 'Foldable' and 'Traversable' related stuff.
src/Relude/Foldable/Fold.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -9,7 +8,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Fixes and additions to 'Foldable'.@@ -31,17 +30,13 @@ , anyM , andM , orM-- -- * Internals- , DisallowElem- , ElemErrorMessage ) where import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError) import Relude.Applicative (Alternative, Applicative (..), pure)-import Relude.Base (Constraint, Eq, IO, Type, ($!))-import Relude.Bool (Bool (..))+import Relude.Base (Constraint, Eq, IO, Type, coerce, ($!))+import Relude.Bool (Bool (..), (&&^), (||^)) import Relude.Container.Reexport (HashSet, Set) import Relude.Foldable.Reexport (Foldable (..)) import Relude.Function (flip, (.))@@ -53,7 +48,6 @@ -- $setup--- >>> :set -XOverloadedStrings -- >>> import Relude -- >>> import qualified Data.HashMap.Strict as HashMap @@ -73,8 +67,8 @@ >>> asumMap (\x -> if x > 2 then Just x else Nothing) [1..4] Just 3 -}-asumMap :: (Foldable f, Alternative m) => (a -> m b) -> f a -> m b-asumMap f = getAlt . foldMap (Alt . f)+asumMap :: forall b m f a . (Foldable f, Alternative m) => (a -> m b) -> f a -> m b+asumMap = coerce (foldMap :: (a -> Alt m b) -> f a -> Alt m b) {-# INLINE asumMap #-} {- | Polymorphic version of @concatMapA@ function.@@ -83,7 +77,7 @@ Just [1,1,1,2,2,2,3,3,3] -} foldMapA :: forall b m f a . (Semigroup b, Monoid b, Applicative m, Foldable f) => (a -> m b) -> f a -> m b-foldMapA f = getAp . foldMap (Ap . f)+foldMapA = coerce (foldMap :: (a -> Ap m b) -> f a -> Ap m b) {-# INLINE foldMapA #-} {- | Polymorphic version of @concatMapM@ function.@@ -121,7 +115,7 @@ False >>> elem False (one True :: Set Bool) ...- • Do not use 'elem' and 'notElem' methods from 'Foldable' on Set+... Do not use 'elem' and 'notElem' methods from 'Foldable' on Set Suggestions: Instead of elem :: (Foldable t, Eq a) => a -> t a -> Bool@@ -144,7 +138,7 @@ True >>> notElem False (one True :: Set Bool) ...- • Do not use 'elem' and 'notElem' methods from 'Foldable' on Set+... Do not use 'elem' and 'notElem' methods from 'Foldable' on Set Suggestions: Instead of elem :: (Foldable t, Eq a) => a -> t a -> Bool@@ -177,12 +171,9 @@ False -} andM :: (Foldable f, Monad m) => f (m Bool) -> m Bool-andM = go . toList- where- go [] = pure True- go (p:ps) = do- q <- p- if q then go ps else pure False+andM = foldr (&&^) (pure True)+{-# INLINE andM #-}+{-# SPECIALIZE andM :: [IO Bool] -> IO Bool #-} {- | Monadic version of 'F.or'. @@ -194,12 +185,9 @@ Nothing -} orM :: (Foldable f, Monad m) => f (m Bool) -> m Bool-orM = go . toList- where- go [] = pure False- go (p:ps) = do- q <- p- if q then pure True else go ps+orM = foldr (||^) (pure False)+{-# INLINE orM #-}+{-# SPECIALIZE orM :: [IO Bool] -> IO Bool #-} {- | Monadic version of 'F.all'. @@ -211,12 +199,9 @@ Nothing -} allM :: (Foldable f, Monad m) => (a -> m Bool) -> f a -> m Bool-allM p = go . toList- where- go [] = pure True- go (x:xs) = do- q <- p x- if q then go xs else pure False+allM p = foldr ((&&^) . p) (pure True)+{-# INLINE allM #-}+{-# SPECIALIZE allM :: (a -> IO Bool) -> [a] -> IO Bool #-} {- | Monadic version of 'F.any'. @@ -228,17 +213,9 @@ Nothing -} anyM :: (Foldable f, Monad m) => (a -> m Bool) -> f a -> m Bool-anyM p = go . toList- where- go [] = pure False- go (x:xs) = do- q <- p x- if q then pure True else go xs--{-# SPECIALIZE andM :: [IO Bool] -> IO Bool #-}-{-# SPECIALIZE orM :: [IO Bool] -> IO Bool #-}+anyM p = foldr ((||^) . p) (pure False)+{-# INLINE anyM #-} {-# SPECIALIZE anyM :: (a -> IO Bool) -> [a] -> IO Bool #-}-{-# SPECIALIZE allM :: (a -> IO Bool) -> [a] -> IO Bool #-} ---------------------------------------------------------------------------- -- Type level tricks
src/Relude/Foldable/Reexport.hs view
@@ -2,7 +2,7 @@ {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Reexports "Data.Foldable" and "Data.Traversable".@@ -20,6 +20,9 @@ import Data.Foldable (Foldable (fold, foldMap, foldl', foldr, length, null, toList), all, and, any, asum, concat, concatMap, find, foldlM, forM_, for_, mapM_, or, sequenceA_, sequence_, traverse_)+#if MIN_VERSION_base(4,13,0)+import Data.Foldable (foldMap')+#endif import Data.Traversable (Traversable (..), forM, mapAccumL, mapAccumR) #if MIN_VERSION_base(4,10,0) import Data.Bifoldable (Bifoldable (..), biList, biall, biand, biany, biasum, bielem, bifind,
src/Relude/Function.hs view
@@ -2,7 +2,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> This module reexports very basic and primitive functions and function combinators.@@ -19,7 +19,19 @@ import Control.Category ((<<<), (>>>)) import Data.Function (const, fix, flip, id, on, ($), (&), (.)) --- | Renamed version of 'Prelude.id'.++-- $setup+-- >>> import Relude++{- | Renamed version of 'Prelude.id'.++>>> identity 10+10++>>> fmap identity [1,2,3]+[1,2,3]++-} identity :: a -> a identity = id {-# INLINE identity #-}
src/Relude/Functor.hs view
@@ -4,7 +4,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Convenient functions to work with 'Functor'.
src/Relude/Functor/Fmap.hs view
@@ -5,7 +5,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> This module contains useful functions to work with 'Functor' type class.
src/Relude/Functor/Reexport.hs view
@@ -5,7 +5,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Reexports functionality regarding 'Functor' and 'Bifunctor' typeclasses.
src/Relude/Lifted.hs view
@@ -2,10 +2,14 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Lifted versions of base functions.++These functions are lifted in a sense that you can use them inside various+monad transformers without adding 'Relude.liftIO' calls explicitly. However, you still+can use all these functions inside plain 'Relude.IO' monad as usual. -} module Relude.Lifted
src/Relude/Lifted/Concurrent.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE Safe #-}+{-# LANGUAGE Trustworthy #-} {- | Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Lifted 'MVar' and 'STM' functions.@@ -38,11 +38,12 @@ import Control.Concurrent.MVar (MVar) import Control.Concurrent.STM.TVar (TVar) import Control.Monad.STM (STM)-import Control.Monad.Trans (MonadIO, liftIO)-import Data.Bool (Bool)-import Data.Function (($), (.))-import Data.Maybe (Maybe) +import Relude.Base (IO)+import Relude.Bool (Bool)+import Relude.Function (($), (.))+import Relude.Monad (Maybe, MonadIO (..))+ import qualified Control.Concurrent.MVar as CCM (newEmptyMVar, newMVar, putMVar, readMVar, swapMVar, takeMVar, tryPutMVar, tryReadMVar, tryTakeMVar) import qualified Control.Concurrent.STM.TVar as STM (modifyTVar', newTVar, newTVarIO, readTVar,@@ -57,46 +58,55 @@ newEmptyMVar :: MonadIO m => m (MVar a) newEmptyMVar = liftIO CCM.newEmptyMVar {-# INLINE newEmptyMVar #-}+{-# SPECIALIZE newEmptyMVar :: IO (MVar a) #-} -- | Lifted to 'MonadIO' version of 'CCM.newMVar'. newMVar :: MonadIO m => a -> m (MVar a) newMVar = liftIO . CCM.newMVar {-# INLINE newMVar #-}+{-# SPECIALIZE newMVar :: a -> IO (MVar a) #-} -- | Lifted to 'MonadIO' version of 'CCM.putMVar'. putMVar :: MonadIO m => MVar a -> a -> m () putMVar m a = liftIO $ CCM.putMVar m a {-# INLINE putMVar #-}+{-# SPECIALIZE putMVar :: MVar a -> a -> IO () #-} -- | Lifted to 'MonadIO' version of 'CCM.readMVar'. readMVar :: MonadIO m => MVar a -> m a readMVar = liftIO . CCM.readMVar {-# INLINE readMVar #-}+{-# SPECIALIZE readMVar :: MVar a -> IO a #-} -- | Lifted to 'MonadIO' version of 'CCM.swapMVar'. swapMVar :: MonadIO m => MVar a -> a -> m a swapMVar m v = liftIO $ CCM.swapMVar m v {-# INLINE swapMVar #-}+{-# SPECIALIZE swapMVar :: MVar a -> a -> IO a #-} -- | Lifted to 'MonadIO' version of 'CCM.takeMVar'. takeMVar :: MonadIO m => MVar a -> m a takeMVar = liftIO . CCM.takeMVar {-# INLINE takeMVar #-}+{-# SPECIALIZE takeMVar :: MVar a -> IO a #-} -- | Lifted to 'MonadIO' version of 'CCM.tryPutMVar'. tryPutMVar :: MonadIO m => MVar a -> a -> m Bool tryPutMVar m v = liftIO $ CCM.tryPutMVar m v {-# INLINE tryPutMVar #-}+{-# SPECIALIZE tryPutMVar :: MVar a -> a -> IO Bool #-} -- | Lifted to 'MonadIO' version of 'CCM.tryReadMVar'. tryReadMVar :: MonadIO m => MVar a -> m (Maybe a) tryReadMVar = liftIO . CCM.tryReadMVar {-# INLINE tryReadMVar #-}+{-# SPECIALIZE tryReadMVar :: MVar a -> IO (Maybe a) #-} -- | Lifted to 'MonadIO' version of 'CCM.tryTakeMVar'. tryTakeMVar :: MonadIO m => MVar a -> m (Maybe a) tryTakeMVar = liftIO . CCM.tryTakeMVar {-# INLINE tryTakeMVar #-}+{-# SPECIALIZE tryTakeMVar :: MVar a -> IO (Maybe a) #-} ---------------------------------------------------------------------------- -- Lifted STM@@ -106,13 +116,16 @@ atomically :: MonadIO m => STM a -> m a atomically = liftIO . STM.atomically {-# INLINE atomically #-}+{-# SPECIALIZE atomically :: STM a -> IO a #-} -- | Lifted to 'MonadIO' version of 'STM.newTVarIO'. newTVarIO :: MonadIO m => a -> m (TVar a) newTVarIO = liftIO . STM.newTVarIO {-# INLINE newTVarIO #-}+{-# SPECIALIZE newTVarIO :: a -> IO (TVar a) #-} -- | Lifted to 'MonadIO' version of 'STM.readTVarIO'. readTVarIO :: MonadIO m => TVar a -> m a readTVarIO = liftIO . STM.readTVarIO {-# INLINE readTVarIO #-}+{-# SPECIALIZE readTVarIO :: TVar a -> IO a #-}
src/Relude/Lifted/Exit.hs view
@@ -4,7 +4,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Lifted versions of functions that work with exit processes.@@ -23,22 +23,43 @@ import qualified System.Exit as XIO --- | Lifted version of 'System.Exit.exitWith'.+-- $setup+-- >>> import Relude+-- >>> import System.Exit (ExitCode (..))+++{- | Lifted version of 'System.Exit.exitWith'.++>>> exitWith (ExitFailure 3)+*** Exception: ExitFailure 3++>>> exitWith ExitSuccess+*** Exception: ExitSuccess+-} exitWith :: MonadIO m => ExitCode -> m a exitWith a = liftIO (XIO.exitWith a)-{-# INLINE exitWith #-} --- | Lifted version of 'System.Exit.exitFailure'.+{- | Lifted version of 'System.Exit.exitFailure'.++>>> exitFailure+*** Exception: ExitFailure 1+-} exitFailure :: MonadIO m => m a exitFailure = liftIO XIO.exitFailure-{-# INLINE exitFailure #-} --- | Lifted version of 'System.Exit.exitSuccess'.+{- | Lifted version of 'System.Exit.exitSuccess'.++>>> exitSuccess+*** Exception: ExitSuccess+-} exitSuccess :: MonadIO m => m a exitSuccess = liftIO XIO.exitSuccess-{-# INLINE exitSuccess #-} --- | Lifted version of 'System.Exit.die'.-die :: MonadIO m => String -> m ()+{- | Lifted version of 'System.Exit.die'.++>>> die "Goodbye!"+Goodbye!+*** Exception: ExitFailure 1+-}+die :: MonadIO m => String -> m a die err = liftIO (XIO.die err)-{-# INLINE die #-}
src/Relude/Lifted/File.hs view
@@ -2,7 +2,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Lifted versions of functions working with files and common IO.@@ -14,9 +14,10 @@ , appendFile ) where -import Relude.Base (FilePath, IO, String)+import Relude.Base (FilePath, IO) import Relude.Function ((.)) import Relude.Monad.Reexport (MonadIO (..))+import Relude.String (String) import qualified System.IO as IO
src/Relude/Lifted/IORef.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE Safe #-}+{-# LANGUAGE Trustworthy #-} {- | Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Lifted reexports from 'Data.IORef' module.@@ -26,45 +26,115 @@ import Data.Function (($), (.)) import Data.IORef (IORef) +import Relude.Base (IO)+ import qualified Data.IORef as Ref (atomicModifyIORef, atomicModifyIORef', atomicWriteIORef, modifyIORef, modifyIORef', newIORef, readIORef, writeIORef) --- | Lifted version of 'Ref.newIORef'.++-- $setup+-- >>> import Relude++{- | Lifted version of 'Ref.newIORef'.++>>> ref <- newIORef False+>>> :t ref+ref :: IORef Bool++-} newIORef :: MonadIO m => a -> m (IORef a) newIORef = liftIO . Ref.newIORef {-# INLINE newIORef #-}+{-# SPECIALIZE newIORef :: a -> IO (IORef a) #-} --- | Lifted version of 'Ref.readIORef'.+{- | Lifted version of 'Ref.readIORef'.++>>> ref <- newIORef 42+>>> readIORef ref+42++-} readIORef :: MonadIO m => IORef a -> m a readIORef = liftIO . Ref.readIORef {-# INLINE readIORef #-}+{-# SPECIALIZE readIORef :: IORef a -> IO a #-} --- | Lifted version of 'Ref.writeIORef'.+{- | Lifted version of 'Ref.writeIORef'.++>>> ref <- newIORef 42+>>> writeIORef ref 43+>>> readIORef ref+43++-} writeIORef :: MonadIO m => IORef a -> a -> m () writeIORef ref what = liftIO $ Ref.writeIORef ref what {-# INLINE writeIORef #-}+{-# SPECIALIZE writeIORef :: IORef a -> a -> IO () #-} --- | Lifted version of 'Ref.modifyIORef'.+{- | Lifted version of 'Ref.modifyIORef'.++>>> ref <- newIORef 42+>>> modifyIORef ref (\a -> a + 6)+>>> readIORef ref+48++-} modifyIORef :: MonadIO m => IORef a -> (a -> a) -> m () modifyIORef ref how = liftIO $ Ref.modifyIORef ref how {-# INLINE modifyIORef #-}+{-# SPECIALIZE modifyIORef :: IORef a -> (a -> a) -> IO () #-} --- | Lifted version of 'Ref.modifyIORef''.+{- | Lifted version of 'Ref.modifyIORef''.++>>> ref <- newIORef 42+>>> modifyIORef' ref (\a -> a + 3)+>>> readIORef ref+45++-} modifyIORef' :: MonadIO m => IORef a -> (a -> a) -> m () modifyIORef' ref how = liftIO $ Ref.modifyIORef' ref how {-# INLINE modifyIORef' #-}+{-# SPECIALIZE modifyIORef' :: IORef a -> (a -> a) -> IO () #-} --- | Lifted version of 'Ref.atomicModifyIORef'.+{- | Lifted version of 'Ref.atomicModifyIORef'.++>>> ref <- newIORef 42+>>> atomicModifyIORef ref (\a -> (a, a + 3))+45+>>> readIORef ref+42++-} atomicModifyIORef :: MonadIO m => IORef a -> (a -> (a, b)) -> m b atomicModifyIORef ref how = liftIO $ Ref.atomicModifyIORef ref how {-# INLINE atomicModifyIORef #-}+{-# SPECIALIZE atomicModifyIORef :: IORef a -> (a -> (a, b)) -> IO b #-} --- | Lifted version of 'Ref.atomicModifyIORef''.+{- | Lifted version of 'Ref.atomicModifyIORef''.++>>> ref <- newIORef 42+>>> atomicModifyIORef' ref (\a -> (a, a + 3))+45+>>> readIORef ref+42++-} atomicModifyIORef' :: MonadIO m => IORef a -> (a -> (a, b)) -> m b atomicModifyIORef' ref how = liftIO $ Ref.atomicModifyIORef' ref how {-# INLINE atomicModifyIORef' #-}+{-# SPECIALIZE atomicModifyIORef' :: IORef a -> (a -> (a, b)) -> IO b #-} --- | Lifted version of 'Ref.atomicWriteIORef'.+{- | Lifted version of 'Ref.atomicWriteIORef'.++>>> ref <- newIORef 42+>>> atomicWriteIORef ref 45+>>> readIORef ref+45++-} atomicWriteIORef :: MonadIO m => IORef a -> a -> m () atomicWriteIORef ref what = liftIO $ Ref.atomicWriteIORef ref what {-# INLINE atomicWriteIORef #-}+{-# SPECIALIZE atomicWriteIORef :: IORef a -> a -> IO () #-}
src/Relude/Lifted/Terminal.hs view
@@ -2,7 +2,7 @@ {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Lifted functions to work with stdin and stdout.@@ -15,13 +15,14 @@ , putStrLn ) where -import Relude.Base (IO, Show, String)+import Relude.Base (IO, Show) import Relude.Function ((.)) import Relude.Monad.Reexport (MonadIO (..))-import Relude.String.Reexport (Text)+import Relude.String.Reexport (String, Text) import qualified Data.Text.IO as TIO import qualified System.IO as IO (print, putStr, putStrLn)+ -- | Lifted version of 'Data.Text.getLine'. getLine :: MonadIO m => m Text
src/Relude/List.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE Safe #-}+{-# LANGUAGE Trustworthy #-} {- | Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Utility functions to work with lists.@@ -13,7 +13,46 @@ module Relude.List ( module Relude.List.NonEmpty , module Relude.List.Reexport+ , (!!?) ) where ++import Relude.Base ((<))+import Relude.Bool (otherwise) import Relude.List.NonEmpty import Relude.List.Reexport+import Relude.Monad (Maybe (..))+import Relude.Numeric (Int, (-))+++-- $setup+-- >>> import Relude++{- | Safer version of 'Relude.Unsafe.!!', returns a Maybe.+get element from list using index value starting from `0`.++>>> [] !!? 0+Nothing++>>> ["a", "b", "c"] !!? 3+Nothing++>>> [1, 2, 3] !!? (-1)+Nothing++>>> ["a", "b", "c"] !!? 2+Just "c"++@since 0.6.0.0+-}+infix 9 !!?+(!!?) :: [a] -> Int -> Maybe a+(!!?) xs i+ | i < 0 = Nothing+ | otherwise = go i xs+ where+ go :: Int -> [a] -> Maybe a+ go 0 (x:_) = Just x+ go j (_:ys) = go (j - 1) ys+ go _ [] = Nothing+{-# INLINE (!!?) #-}
src/Relude/List/NonEmpty.hs view
@@ -4,7 +4,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> This module contains safe functions to work with list type in terms of 'NonEmpty'.@@ -22,6 +22,7 @@ import Relude.List.Reexport (NonEmpty (..), nonEmpty) import Relude.Monad (Maybe (..), Monad (..)) + -- $setup -- >>> import Relude @@ -41,7 +42,6 @@ >>> whenNotNull [] $ \(b :| _) -> print (not b) >>> whenNotNull [False,True] $ \(b :| _) -> print (not b) True- -} whenNotNull :: Applicative f => [a] -> (NonEmpty a -> f ()) -> f () whenNotNull [] _ = pass
src/Relude/List/Reexport.hs view
@@ -1,19 +1,39 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {- | Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Reexports most of the "Data.List" and "Data.List.NonEmpty".++Note, that Relude reexports 'head', 'tail', 'init', 'last' from+"Data,List.NonEmpty" instead of the "Data.List", so these functions are safe to+use.++@relude@ also provides custom type error for better experience with transition+from lists to 'NonEmpty' with those functions. -} module Relude.List.Reexport- ( module Data.List- , module Data.List.NonEmpty- , module GHC.Exts+ ( -- * List+ module Data.List+ , sortWith+ -- * NonEmpty List+ , NonEmpty (..)+ , nonEmpty+ , head+ , init+ , last+ , tail ) where import Data.List (break, cycle, drop, dropWhile, filter, genericDrop, genericLength,@@ -21,5 +41,198 @@ intersperse, isPrefixOf, iterate, map, permutations, repeat, replicate, reverse, scanl, scanr, sort, sortBy, sortOn, splitAt, subsequences, tails, take, takeWhile, transpose, uncons, unfoldr, unzip, unzip3, zip, zip3, zipWith, (++))-import Data.List.NonEmpty (NonEmpty (..), head, init, last, nonEmpty, tail)+import Data.List.NonEmpty (NonEmpty (..), nonEmpty) import GHC.Exts (sortWith)+import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError)++import Relude.Base (Constraint, Type)++import qualified Data.List.NonEmpty as NE (head, init, last, tail)+++-- $setup+-- >>> import Relude+++-- | For tracking usage of ordinary list with @head@-like functions.+type IsNonEmpty+ (f :: Type -> Type) -- Container, e.g. NonEmpty or []+ (a :: Type) -- Type of the element+ (res :: Type) -- Type of the result of the work of the function+ (fun :: Symbol) -- Function name+ = (f ~ NonEmpty, CheckNonEmpty f a res fun)++type family CheckNonEmpty+ (f :: Type -> Type)+ (a :: Type)+ (res :: Type)+ (fun :: Symbol)+ :: Constraint+ where+ CheckNonEmpty NonEmpty _ _ _ = ()+ CheckNonEmpty [] a res fun = TypeError+ ( 'Text "'" ':<>: 'Text fun ':<>: 'Text "' works with 'NonEmpty', not ordinary lists."+ ':$$: 'Text "Possible fix:"+ ':$$: 'Text " Replace: [" ':<>: 'ShowType a ':<>: 'Text "]"+ ':$$: 'Text " With: NonEmpty " ':<>: 'ShowType a+ ':$$: 'Text ""+ ':$$: 'Text "However, you can use '" ':<>: 'Text fun ':<>: 'Text "' with the ordinary lists."+ ':$$: 'Text "Apply 'viaNonEmpty' function from relude:"+ ':$$: 'Text " viaNonEmpty " ':<>: 'Text fun ':<>: 'Text " (yourList)"+ ':$$: 'Text "Note, that this will return 'Maybe " ':<>: 'ShowType res ':<>: 'Text "'"+ ':$$: 'Text "therefore it is a safe function unlike '" ':<>: 'Text fun ':<>: 'Text "' from the standard Prelude"+ )+ CheckNonEmpty t a _ fun = TypeError+ ( 'Text "'"+ ':<>: 'Text fun+ ':<>: 'Text "' works with 'NonEmpty "+ ':<>: 'ShowType a+ ':<>: 'Text "' lists"+ ':$$: 'Text "But given: "+ ':<>: 'ShowType t+ ':<>: 'Text " "+ ':<>: 'ShowType a+ )+++{- | @O(1)@. Extracts the first element of a 'NonEmpty' list.++Actual type of this function is the following:++@+head :: 'NonEmpty' a -> a+@++but it was given a more complex type to provide friendlier compile time errors.++>>> head ('a' :| "bcde")+'a'+>>> head [0..5 :: Int]+...+... 'head' works with 'NonEmpty', not ordinary lists.+ Possible fix:+ Replace: [Int]+ With: NonEmpty Int+...+ However, you can use 'head' with the ordinary lists.+ Apply 'viaNonEmpty' function from relude:+ viaNonEmpty head (yourList)+ Note, that this will return 'Maybe Int'+ therefore it is a safe function unlike 'head' from the standard Prelude+...+>>> head (Just 'a')+...+... 'head' works with 'NonEmpty Char' lists+ But given: Maybe Char+...+-}+head :: IsNonEmpty f a a "head" => f a -> a+head = NE.head+{-# INLINE head #-}++{- | @O(n)@. Return all the elements of a 'NonEmpty' list except the last one+element.++Actual type of this function is the following:++@+init :: 'NonEmpty' a -> [a]+@++but it was given a more complex type to provide friendlier compile time errors.++>>> init ('a' :| "bcde")+"abcd"+>>> init [0..5 :: Int]+...+... 'init' works with 'NonEmpty', not ordinary lists.+ Possible fix:+ Replace: [Int]+ With: NonEmpty Int+...+ However, you can use 'init' with the ordinary lists.+ Apply 'viaNonEmpty' function from relude:+ viaNonEmpty init (yourList)+ Note, that this will return 'Maybe [Int]'+ therefore it is a safe function unlike 'init' from the standard Prelude+...+>>> init (Just 'a')+...+... 'init' works with 'NonEmpty Char' lists+ But given: Maybe Char+...+-}+init :: IsNonEmpty f a [a] "init" => f a -> [a]+init = NE.init+{-# INLINE init #-}++{- | @O(n)@. Extracts the last element of a 'NonEmpty' list.++Actual type of this function is the following:++@+last :: 'NonEmpty' a -> a+@++but it was given a more complex type to provide friendlier compile time errors.++>>> last ('a' :| "bcde")+'e'+>>> last [0..5 :: Int]+...+... 'last' works with 'NonEmpty', not ordinary lists.+ Possible fix:+ Replace: [Int]+ With: NonEmpty Int+...+ However, you can use 'last' with the ordinary lists.+ Apply 'viaNonEmpty' function from relude:+ viaNonEmpty last (yourList)+ Note, that this will return 'Maybe Int'+ therefore it is a safe function unlike 'last' from the standard Prelude+...+>>> last (Just 'a')+...+... 'last' works with 'NonEmpty Char' lists+ But given: Maybe Char+...+-}+last :: IsNonEmpty f a a "last" => f a -> a+last = NE.last+{-# INLINE last #-}++{- | @O(1)@. Return all the elements of a 'NonEmpty' list after the head+element.++Actual type of this function is the following:++@+tail :: 'NonEmpty' a -> [a]+@++but it was given a more complex type to provide friendlier compile time errors.++>>> tail ('a' :| "bcde")+"bcde"+>>> tail [0..5 :: Int]+...+... 'tail' works with 'NonEmpty', not ordinary lists.+ Possible fix:+ Replace: [Int]+ With: NonEmpty Int+...+ However, you can use 'tail' with the ordinary lists.+ Apply 'viaNonEmpty' function from relude:+ viaNonEmpty tail (yourList)+ Note, that this will return 'Maybe [Int]'+ therefore it is a safe function unlike 'tail' from the standard Prelude+...+>>> tail (Just 'a')+...+... 'tail' works with 'NonEmpty Char' lists+ But given: Maybe Char+...+-}+tail :: IsNonEmpty f a [a] "tail" => f a -> [a]+tail = NE.tail+{-# INLINE tail #-}
src/Relude/Monad.hs view
@@ -4,7 +4,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Reexporting useful monadic stuff.
src/Relude/Monad/Either.hs view
@@ -7,7 +7,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Utilites to work with @Either@ data type.@@ -38,7 +38,7 @@ import Relude.Applicative (pure) import Relude.Function ((.)) import Relude.Monad.Reexport (Either (..), MonadFail (..), either)-import Relude.String (IsString, fromString)+import Relude.String.Reexport (IsString (..), String) #if MIN_VERSION_base(4,10,0) import Data.Either (fromLeft, fromRight)@@ -64,88 +64,150 @@ fromRight _ (Right b) = b #endif + -- $setup--- >>> import Relude.Bool (Bool (..))+-- >>> import Relude instance IsString str => MonadFail (Either str) where+ fail :: String -> Either str a fail = Left . fromString --- | Maps left part of 'Either' to 'Maybe'.------ >>> leftToMaybe (Left True)--- Just True--- >>> leftToMaybe (Right "aba")--- Nothing+{- | Maps left part of 'Either' to 'Maybe'.++>>> leftToMaybe (Left True)+Just True+>>> leftToMaybe (Right "aba")+Nothing+-} leftToMaybe :: Either l r -> Maybe l leftToMaybe = either Just (const Nothing)+{-# INLINE leftToMaybe #-} --- | Maps right part of 'Either' to 'Maybe'.------ >>> rightToMaybe (Left True)--- Nothing--- >>> rightToMaybe (Right "aba")--- Just "aba"+{- | Maps right part of 'Either' to 'Maybe'.++>>> rightToMaybe (Left True)+Nothing+>>> rightToMaybe (Right "aba")+Just "aba"+-} rightToMaybe :: Either l r -> Maybe r rightToMaybe = either (const Nothing) Just+{-# INLINE rightToMaybe #-} --- | Maps 'Maybe' to 'Either' wrapping default value into 'Left'.------ >>> maybeToRight True (Just "aba")--- Right "aba"--- >>> maybeToRight True Nothing--- Left True+{- | Maps 'Maybe' to 'Either' wrapping default value into 'Left'.++>>> maybeToRight True (Just "aba")+Right "aba"+>>> maybeToRight True Nothing+Left True+-} maybeToRight :: l -> Maybe r -> Either l r maybeToRight l = maybe (Left l) Right+{-# INLINE maybeToRight #-} --- | Maps 'Maybe' to 'Either' wrapping default value into 'Right'.------ >>> maybeToLeft True (Just "aba")--- Left "aba"--- >>> maybeToLeft True Nothing--- Right True+{- | Maps 'Maybe' to 'Either' wrapping default value into 'Right'.++>>> maybeToLeft True (Just "aba")+Left "aba"+>>> maybeToLeft True Nothing+Right True+-} maybeToLeft :: r -> Maybe l -> Either l r maybeToLeft r = maybe (Right r) Left+{-# INLINE maybeToLeft #-} --- | Applies given action to 'Either' content if 'Left' is given and returns--- the result. In case of 'Right' the default value will be returned.+{- | Applies given action to 'Either' content if 'Left' is given and returns+the result. In case of 'Right' the default value will be returned.++>>> whenLeft "bar" (Left 42) (\a -> "success!" <$ print a)+42+"success!"++>>> whenLeft "bar" (Right 42) (\a -> "success!" <$ print a)+"bar"+-} whenLeft :: Applicative f => a -> Either l r -> (l -> f a) -> f a whenLeft _ (Left l) f = f l whenLeft a (Right _) _ = pure a {-# INLINE whenLeft #-} --- | Applies given action to 'Either' content if 'Left' is given.+{- | Applies given action to 'Either' content if 'Left' is given.++>>> whenLeft_ (Right 42) putTextLn+>>> whenLeft_ (Left "foo") putTextLn+foo+-} whenLeft_ :: Applicative f => Either l r -> (l -> f ()) -> f () whenLeft_ = whenLeft () {-# INLINE whenLeft_ #-} --- | Monadic version of 'whenLeft'.+{- | Monadic version of 'whenLeft'.++>>> whenLeftM "bar" (pure $ Left 42) (\a -> "success!" <$ print a)+42+"success!"++>>> whenLeftM "bar" (pure $ Right 42) (\a -> "success!" <$ print a)+"bar"+-} whenLeftM :: Monad m => a -> m (Either l r) -> (l -> m a) -> m a whenLeftM a me f = me >>= \e -> whenLeft a e f {-# INLINE whenLeftM #-} --- | Monadic version of 'whenLeft_'.+{- | Monadic version of 'whenLeft_'.++>>> whenLeftM_ (pure $ Right 42) putTextLn+>>> whenLeftM_ (pure $ Left "foo") putTextLn+foo+-} whenLeftM_ :: Monad m => m (Either l r) -> (l -> m ()) -> m () whenLeftM_ me f = me >>= \e -> whenLeft_ e f {-# INLINE whenLeftM_ #-} --- | Applies given action to 'Either' content if 'Right' is given and returns--- the result. In case of 'Left' the default value will be returned.+{- | Applies given action to 'Either' content if 'Right' is given and returns+the result. In case of 'Left' the default value will be returned.++>>> whenRight "bar" (Left "foo") (\a -> "success!" <$ print a)+"bar"++>>> whenRight "bar" (Right 42) (\a -> "success!" <$ print a)+42+"success!"+-} whenRight :: Applicative f => a -> Either l r -> (r -> f a) -> f a whenRight a (Left _) _ = pure a whenRight _ (Right r) f = f r {-# INLINE whenRight #-} --- | Applies given action to 'Either' content if 'Right' is given.+{- | Applies given action to 'Either' content if 'Right' is given.++>>> whenRight_ (Left "foo") print+>>> whenRight_ (Right 42) print+42+-} whenRight_ :: Applicative f => Either l r -> (r -> f ()) -> f () whenRight_ = whenRight () {-# INLINE whenRight_ #-} --- | Monadic version of 'whenRight'.+{- | Monadic version of 'whenRight'.++>>> whenRightM "bar" (pure $ Left "foo") (\a -> "success!" <$ print a)+"bar"++>>> whenRightM "bar" (pure $ Right 42) (\a -> "success!" <$ print a)+42+"success!"+-} whenRightM :: Monad m => a -> m (Either l r) -> (r -> m a) -> m a whenRightM a me f = me >>= \e -> whenRight a e f {-# INLINE whenRightM #-} --- | Monadic version of 'whenRight_'.+{- | Monadic version of 'whenRight_'.++>>> whenRightM_ (pure $ Left "foo") print+>>> whenRightM_ (pure $ Right 42) print+42+-} whenRightM_ :: Monad m => m (Either l r) -> (r -> m ()) -> m () whenRightM_ me f = me >>= \e -> whenRight_ e f {-# INLINE whenRightM_ #-}
src/Relude/Monad/Maybe.hs view
@@ -4,7 +4,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Utility functions to work with 'Data.Maybe' data type as monad.@@ -18,11 +18,16 @@ , whenNothing_ , whenNothingM , whenNothingM_+ , mapMaybeM ) where import Relude.Applicative (Applicative, pass, pure)-import Relude.Monad.Reexport (Maybe (..), Monad (..), fromMaybe)+import Relude.Foldable.Reexport (mapM)+import Relude.Function ((.))+import Relude.Functor.Reexport (fmap)+import Relude.Monad.Reexport (Maybe (..), Monad (..), catMaybes, fromMaybe) + -- $setup -- >>> import Relude @@ -33,61 +38,98 @@ >>> readMaybe "Tru" ?: False False- -} infixr 0 ?: (?:) :: Maybe a -> a -> a mA ?: b = fromMaybe b mA {-# INLINE (?:) #-} -{- | Specialized version of 'for_' for 'Maybe'. It's used for code readability.+{- | Specialized version of 'Relude.for_' for 'Maybe'. It's used for code readability.+ Also helps to avoid space leaks: <http://www.snoyman.com/blog/2017/01/foldable-mapm-maybe-and-recursive-functions Foldable.mapM_ space leak>. >>> whenJust Nothing $ \b -> print (not b) >>> whenJust (Just True) $ \b -> print (not b) False- -} whenJust :: Applicative f => Maybe a -> (a -> f ()) -> f () whenJust (Just x) f = f x whenJust Nothing _ = pass {-# INLINE whenJust #-} --- | Monadic version of 'whenJust'.+{- | Monadic version of 'whenJust'.++>>> whenJustM (pure Nothing) $ \b -> print (not b)+>>> whenJustM (pure $ Just True) $ \b -> print (not b)+False+-} whenJustM :: Monad m => m (Maybe a) -> (a -> m ()) -> m () whenJustM mm f = mm >>= \m -> whenJust m f {-# INLINE whenJustM #-} --- | Performs default 'Applicative' action if 'Nothing' is given.--- Otherwise returns content of 'Just' pured to 'Applicative'.------ >>> whenNothing Nothing [True, False]--- [True,False]--- >>> whenNothing (Just True) [True, False]--- [True]+{- | Performs default 'Applicative' action if 'Nothing' is given.+Otherwise returns content of 'Just' pured to 'Applicative'.++>>> whenNothing Nothing [True, False]+[True,False]+>>> whenNothing (Just True) [True, False]+[True]+-} whenNothing :: Applicative f => Maybe a -> f a -> f a whenNothing (Just x) _ = pure x whenNothing Nothing m = m {-# INLINE whenNothing #-} --- | Performs default 'Applicative' action if 'Nothing' is given.--- Do nothing for 'Just'. Convenient for discarding 'Just' content.------ >>> whenNothing_ Nothing $ putTextLn "Nothing!"--- Nothing!--- >>> whenNothing_ (Just True) $ putTextLn "Nothing!"+{- | Performs default 'Applicative' action if 'Nothing' is given.+Do nothing for 'Just'. Convenient for discarding 'Just' content.++>>> whenNothing_ Nothing $ putTextLn "Nothing!"+Nothing!+>>> whenNothing_ (Just True) $ putTextLn "Nothing!"+-} whenNothing_ :: Applicative f => Maybe a -> f () -> f () whenNothing_ Nothing m = m whenNothing_ _ _ = pass {-# INLINE whenNothing_ #-} --- | Monadic version of 'whenNothing'.+{- | Monadic version of 'whenNothingM'.++>>> whenNothingM (pure $ Just True) $ True <$ putTextLn "Is Just!"+True+>>> whenNothingM (pure Nothing) $ False <$ putTextLn "Is Nothing!"+Is Nothing!+False+-} whenNothingM :: Monad m => m (Maybe a) -> m a -> m a whenNothingM mm action = mm >>= \m -> whenNothing m action {-# INLINE whenNothingM #-} --- | Monadic version of 'whenNothingM_'.+{- | Monadic version of 'whenNothingM_'.++>>> whenNothingM_ (pure $ Just True) $ putTextLn "Is Just!"+>>> whenNothingM_ (pure Nothing) $ putTextLn "Is Nothing!"+Is Nothing!+-} whenNothingM_ :: Monad m => m (Maybe a) -> m () -> m () whenNothingM_ mm action = mm >>= \m -> whenNothing_ m action {-# INLINE whenNothingM_ #-}+++{- | The monadic version of the 'Data.Maybe.mapMaybe' function.++>>> :{+evenInHalf :: Int -> IO (Maybe Int)+evenInHalf n+ | even n = pure $ Just $ n `div` 2+ | otherwise = pure Nothing+:}++>>> mapMaybeM evenInHalf [1..10]+[1,2,3,4,5]++@since 0.6.0.0+-}+mapMaybeM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m [b]+mapMaybeM f = fmap catMaybes . mapM f+{-# INLINE mapMaybeM #-}
src/Relude/Monad/Reexport.hs view
@@ -4,7 +4,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Reexports functions to work with monads.
src/Relude/Monad/Trans.hs view
@@ -4,7 +4,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Monad transformers utilities.@@ -34,17 +34,33 @@ import Relude.Monad.Reexport (Either, ExceptT (..), Maybe, MaybeT (..), Reader, ReaderT, State, StateT, runReader, runReaderT, runState, runStateT) --- | Shorter and more readable alias for @flip runReaderT@.++-- $setup+-- >>> import Relude++{- | Shorter and more readable alias for @flip runReaderT@.++>>> usingReaderT 42 $ asks (+5)+47+-} usingReaderT :: r -> ReaderT r m a -> m a usingReaderT = flip runReaderT {-# INLINE usingReaderT #-} --- | Shorter and more readable alias for @flip runReader@.+{- | Shorter and more readable alias for @flip runReader@.++>>> usingReader 42 $ asks (+5)+47+-} usingReader :: r -> Reader r a -> a usingReader = flip runReader {-# INLINE usingReader #-} --- | Shorter and more readable alias for @flip runStateT@.+{- | Shorter and more readable alias for @flip runStateT@.++>>> usingStateT 0 $ put 42 >> pure False+(False,42)+-} usingStateT :: s -> StateT s m a -> m (a, s) usingStateT = flip runStateT {-# INLINE usingStateT #-}@@ -54,30 +70,33 @@ usingState = flip runState {-# INLINE usingState #-} --- | Alias for @flip evalStateT@. It's not shorter but sometimes--- more readable. Done by analogy with @using*@ functions family.+{- | Alias for @flip evalStateT@. It's not shorter but sometimes+more readable. Done by analogy with @using*@ functions family.+-} evaluatingStateT :: Functor f => s -> StateT s f a -> f a evaluatingStateT s st = fst <$> usingStateT s st {-# INLINE evaluatingStateT #-} --- | Alias for @flip evalState@. It's not shorter but sometimes--- more readable. Done by analogy with @using*@ functions family.+{- | Alias for @flip evalState@. It's not shorter but sometimes+more readable. Done by analogy with @using*@ functions family.+-} evaluatingState :: s -> State s a -> a evaluatingState s st = fst (usingState s st) {-# INLINE evaluatingState #-} --- | Alias for @flip execStateT@. It's not shorter but sometimes--- more readable. Done by analogy with @using*@ functions family.+{- | Alias for @flip execStateT@. It's not shorter but sometimes+more readable. Done by analogy with @using*@ functions family.+-} executingStateT :: Functor f => s -> StateT s f a -> f s executingStateT s st = snd <$> usingStateT s st {-# INLINE executingStateT #-} --- | Alias for @flip execState@. It's not shorter but sometimes--- more readable. Done by analogy with @using*@ functions family.+{- | Alias for @flip execState@. It's not shorter but sometimes+more readable. Done by analogy with @using*@ functions family.+-} 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
src/Relude/Monoid.hs view
@@ -6,7 +6,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Reexports functions to work with monoids plus adds extra useful functions.@@ -47,14 +47,16 @@ -- >>> import Relude.Monad (Maybe (..)) -- >>> import Relude.Numeric (Int) --- | Extracts 'Monoid' value from 'Maybe' returning 'mempty' if 'Nothing'.------ >>> maybeToMonoid (Just [1,2,3] :: Maybe [Int])--- [1,2,3]--- >>> maybeToMonoid (Nothing :: Maybe [Int])--- []+{- | Extracts 'Monoid' value from 'Maybe' returning 'mempty' if 'Relude.Nothing'.++>>> maybeToMonoid (Just [1,2,3] :: Maybe [Int])+[1,2,3]+>>> maybeToMonoid (Nothing :: Maybe [Int])+[]+-} maybeToMonoid :: Monoid m => Maybe m -> m maybeToMonoid = fromMaybe mempty+{-# INLINE maybeToMonoid #-} #if !MIN_VERSION_base(4,12,0) -- | This data type witnesses the lifting of a 'Monoid' into an
src/Relude/Nub.hs view
@@ -2,7 +2,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Functions to remove duplicates from a list.@@ -43,20 +43,23 @@ import qualified Data.Set as Set + {- | Like 'Prelude.nub' but runs in \( O(n \log n) \) time and requires 'Ord'. >>> ordNub [3, 3, 3, 2, 2, -1, 1] [3,2,-1,1] -}-ordNub :: (Ord a) => [a] -> [a]+ordNub :: forall a . (Ord a) => [a] -> [a] ordNub = go Set.empty where+ go :: Set.Set a -> [a] -> [a] go _ [] = [] go s (x:xs) = if x `Set.member` s then go s xs else x : go (Set.insert x s) xs+{-# INLINEABLE ordNub #-} {- | Like 'Prelude.nub' but runs in \( O(n \log_{16} n) \) time and requires 'Hashable'. @@ -64,14 +67,16 @@ [3,2,-1,1] -}-hashNub :: (Eq a, Hashable a) => [a] -> [a]+hashNub :: forall a . (Eq a, Hashable a) => [a] -> [a] hashNub = go HashSet.empty where+ go :: HashSet.HashSet a -> [a] -> [a] go _ [] = [] go s (x:xs) = if x `HashSet.member` s then go s xs else x : go (HashSet.insert x s) xs+{-# INLINEABLE hashNub #-} {- | Like 'ordNub' runs in \( O(n \log n) \) but also sorts a list. @@ -81,6 +86,7 @@ -} sortNub :: (Ord a) => [a] -> [a] sortNub = Set.toList . Set.fromList+{-# INLINE sortNub #-} {- | Like 'hashNub' runs in \( O(n \log_{16} n) \) but has better performance; it doesn't save the order. @@ -90,3 +96,4 @@ -} unstableNub :: (Eq a, Hashable a) => [a] -> [a] unstableNub = HashSet.toList . HashSet.fromList+{-# INLINE unstableNub #-}
src/Relude/Numeric.hs view
@@ -1,9 +1,6 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}- {- | Copyright: (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -} @@ -25,7 +22,7 @@ import Data.Word (Word, Word16, Word32, Word64, Word8, byteSwap16, byteSwap32, byteSwap64) import GHC.Base (maxInt, minInt) import GHC.Float (Double (..), Float (..), Floating (acos, acosh, asin, asinh, atan, atanh, cos, cosh, exp, logBase, pi, sin, sinh, sqrt, tan, tanh, (**)),- RealFloat (floatRadix, floatDigits, floatRange, decodeFloat, encodeFloat, isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE))+ RealFloat (atan2, decodeFloat, encodeFloat, floatDigits, floatRadix, floatRange, isDenormalized, isIEEE, isInfinite, isNaN, isNegativeZero)) import GHC.Num (Integer, Num (..), subtract) import GHC.Real (Fractional (..), Integral (..), Ratio, Rational, Real (..), RealFrac (..), denominator, even, fromIntegral, gcd, lcm, numerator, odd, realToFrac, (^), (^^))@@ -54,7 +51,8 @@ integerToBounded n | n < toInteger (minBound @a) = Nothing | n > toInteger (maxBound @a) = Nothing- | otherwise = Just (fromIntegral n)+ | otherwise = Just (fromIntegral n)+{-# INLINE integerToBounded #-} {- | Tranforms an integer number to a natural. Only non-negative integers are considered natural, everything else will return `Nothing`.@@ -71,5 +69,6 @@ -} integerToNatural :: Integer -> Maybe Natural integerToNatural n- | n < 0 = Nothing+ | n < 0 = Nothing | otherwise = Just $ fromIntegral n+{-# INLINE integerToNatural #-}
src/Relude/Print.hs view
@@ -7,7 +7,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Functions like 'Prelude.putStr' and 'Prelude.putStrLn' but for 'Text', 'LText',@@ -42,25 +42,42 @@ -- Text ---------------------------------------------------------------------------- --- | Lifted version of 'T.putStr'.+{- | Lifted version of 'T.putStr'.++>>> putText "Hello, world!"+Hello, world!+-} putText :: MonadIO m => Text -> m () putText = liftIO . T.putStr {-# SPECIALIZE putText :: Text -> Base.IO () #-} {-# INLINE putText #-} --- | Lifted version of 'T.putStrLn'.++{- | Lifted version of 'T.putStrLn'.++>>> putTextLn "Hello, world!"+Hello, world!+-} putTextLn :: MonadIO m => Text -> m () putTextLn = liftIO . T.putStrLn {-# SPECIALIZE putTextLn :: Text -> Base.IO () #-} {-# INLINE putTextLn #-} --- | Lifted version of 'TL.putStr'.+{- | Lifted version of 'TL.putStr'.++>>> putLText "Hello, world!"+Hello, world!+-} putLText :: MonadIO m => LText -> m () putLText = liftIO . TL.putStr {-# SPECIALIZE putLText :: LText -> Base.IO () #-} {-# INLINE putLText #-} --- | Lifted version of 'TL.putStrLn'.+{- | Lifted version of 'TL.putStrLn'.++>>> putLTextLn "Hello, world!"+Hello, world!+-} putLTextLn :: MonadIO m => LText -> m () putLTextLn = liftIO . TL.putStrLn {-# SPECIALIZE putLTextLn :: LText -> Base.IO () #-}@@ -70,25 +87,45 @@ -- ByteString ---------------------------------------------------------------------------- --- | Lifted version of 'BS.putStr'.+{- | Lifted version of 'BS.putStr'.++>>> putBS ("Hello, world!" :: ByteString)+Hello, world!+-} putBS :: MonadIO m => ByteString -> m () putBS = liftIO . BS.putStr {-# SPECIALIZE putBS :: ByteString -> Base.IO () #-} {-# INLINE putBS #-} --- | Lifted version of 'BS.putStrLn'.++{- | Lifted version of 'BS.putStrLn'.++>>> putBSLn ("Hello, world!" :: ByteString)+Hello, world!++-} putBSLn :: MonadIO m => ByteString -> m () putBSLn = liftIO . BS.putStrLn {-# SPECIALIZE putBSLn :: ByteString -> Base.IO () #-} {-# INLINE putBSLn #-} --- | Lifted version of 'LBS.putStr'.+{- | Lifted version of 'LBS.putStr'.++>>> putLBS ("Hello, world!" :: LByteString)+Hello, world!++-} putLBS :: MonadIO m => LByteString -> m () putLBS = liftIO . LBS.putStr {-# SPECIALIZE putLBS :: LByteString -> Base.IO () #-} {-# INLINE putLBS #-} --- | Lifted version of 'LBS.putStrLn'.+{- | Lifted version of 'LBS.putStrLn'.++>>> putLBSLn ("Hello, world!" :: LByteString)+Hello, world!++-} putLBSLn :: MonadIO m => LByteString -> m () putLBSLn = liftIO . LBS.putStrLn {-# SPECIALIZE putLBSLn :: LByteString -> Base.IO () #-}
src/Relude/String.hs view
@@ -2,7 +2,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> Type classes for convertion between different string representations.
src/Relude/String/Conversion.hs view
@@ -1,22 +1,26 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-} {- | Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> This module implements type class which allow to have conversion to and from-'Text', 'String' and 'ByteString' types (including both strict and lazy-versions). Usually you need to export 'Text' modules qualified and use 'T.pack'-\/ 'T.unpack' functions to convert to\/from 'Text'. Now you can just use-'toText' \/ 'toString' functions.+'Relude.String.Reexport.Text', 'String' and 'ByteString' types+(including both strict and lazy versions). Usually you need to export+'Relude.String.Reexport.Text' modules qualified and use 'T.pack' \/ 'T.unpack'+functions to convert to\/from 'Relude.String.Reexport.Text'. Now you can just+use 'toText' \/ 'toString' functions. -} module Relude.String.Conversion@@ -26,9 +30,9 @@ -- * Conversion type classes , ConvertUtf8 (..)- , ToString (..)- , ToLText (..) , ToText (..)+ , ToLText (..)+ , ToString (..) , LazyStrict (..) , fromLazy , fromStrict@@ -38,27 +42,27 @@ , show ) where -import Data.Bifunctor (first)-import Data.Either (Either)-import Data.Function (id, (.))-import Data.String (String)+import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError)+import Prelude (error) -import Relude.Functor ((<$>))-import Relude.String.Reexport (ByteString, IsString, Read, Text, fromString)+import Relude.Base (Constraint, Type)+import Relude.Function (id, (.))+import Relude.Functor (first, (<$>))+import Relude.Monad.Reexport (Either)+import Relude.String.Reexport (ByteString, IsString, Read, ShortByteString, String, Text, fromShort,+ fromString, toShort) -import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import qualified Data.Text as T import qualified Data.Text.Encoding as T 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 GHC.Show as Show (Show (show)) import qualified Text.Read (readEither) -import qualified GHC.Show as Show (Show (show)) -- $setup--- >>> :set -XTypeApplications -XOverloadedStrings -- >>> import Relude -- | Type synonym for 'Data.Text.Lazy.Text'.@@ -98,98 +102,420 @@ -} decodeUtf8Strict :: b -> Either T.UnicodeException a -instance ConvertUtf8 String B.ByteString where+instance ConvertUtf8 String ByteString where+ encodeUtf8 :: String -> ByteString encodeUtf8 = T.encodeUtf8 . T.pack+ {-# INLINE encodeUtf8 #-}++ decodeUtf8 :: ByteString -> String decodeUtf8 = T.unpack . T.decodeUtf8+ {-# INLINE decodeUtf8 #-}++ decodeUtf8Strict :: ByteString -> Either T.UnicodeException String decodeUtf8Strict = (T.unpack <$>) . decodeUtf8Strict+ {-# INLINE decodeUtf8Strict #-} -instance ConvertUtf8 T.Text B.ByteString where+instance ConvertUtf8 Text ByteString where+ encodeUtf8 :: Text -> ByteString encodeUtf8 = T.encodeUtf8+ {-# INLINE encodeUtf8 #-}++ decodeUtf8 :: ByteString -> Text decodeUtf8 = T.decodeUtf8With T.lenientDecode+ {-# INLINE decodeUtf8 #-}++ decodeUtf8Strict :: ByteString -> Either T.UnicodeException Text decodeUtf8Strict = T.decodeUtf8'+ {-# INLINE decodeUtf8Strict #-} -instance ConvertUtf8 LT.Text B.ByteString where+instance ConvertUtf8 LText ByteString where+ encodeUtf8 :: LText -> ByteString encodeUtf8 = LB.toStrict . encodeUtf8+ {-# INLINE encodeUtf8 #-}++ decodeUtf8 :: ByteString -> LText decodeUtf8 = LT.decodeUtf8With T.lenientDecode . LB.fromStrict+ {-# INLINE decodeUtf8 #-}++ decodeUtf8Strict :: ByteString -> Either T.UnicodeException LText decodeUtf8Strict = decodeUtf8Strict . LB.fromStrict--- | Converting 'String' to 'LB.ByteString' might be a slow operation.--- Consider using lazy bytestring at first place.-instance ConvertUtf8 String LB.ByteString where+ {-# INLINE decodeUtf8Strict #-}++{- | Converting 'String' to 'LB.ByteString' might be a slow operation.+Consider using lazy bytestring at first place.+-}+instance ConvertUtf8 String LByteString where+ encodeUtf8 :: String -> LByteString encodeUtf8 = LT.encodeUtf8 . LT.pack+ {-# INLINE encodeUtf8 #-}++ decodeUtf8 :: LByteString -> String decodeUtf8 = LT.unpack . LT.decodeUtf8+ {-# INLINE decodeUtf8 #-}++ decodeUtf8Strict :: LByteString -> Either T.UnicodeException String decodeUtf8Strict = (T.unpack <$>) . decodeUtf8Strict+ {-# INLINE decodeUtf8Strict #-} -instance ConvertUtf8 T.Text LB.ByteString where+instance ConvertUtf8 Text LByteString where+ encodeUtf8 :: Text -> LByteString encodeUtf8 = LB.fromStrict . T.encodeUtf8+ {-# INLINE encodeUtf8 #-}++ decodeUtf8 :: LByteString -> Text decodeUtf8 = T.decodeUtf8With T.lenientDecode . LB.toStrict+ {-# INLINE decodeUtf8 #-}++ decodeUtf8Strict :: LByteString -> Either T.UnicodeException Text decodeUtf8Strict = T.decodeUtf8' . LB.toStrict+ {-# INLINE decodeUtf8Strict #-} -instance ConvertUtf8 LT.Text LB.ByteString where+instance ConvertUtf8 LText LByteString where+ encodeUtf8 :: LText -> LByteString encodeUtf8 = LT.encodeUtf8+ {-# INLINE encodeUtf8 #-}++ decodeUtf8 :: LByteString -> LText decodeUtf8 = LT.decodeUtf8With T.lenientDecode+ {-# INLINE decodeUtf8 #-}++ decodeUtf8Strict :: LByteString -> Either T.UnicodeException LText decodeUtf8Strict = LT.decodeUtf8'+ {-# INLINE decodeUtf8Strict #-} +-- | @since 0.6.0.0+instance ConvertUtf8 String ShortByteString where+ encodeUtf8 :: String -> ShortByteString+ encodeUtf8 = toShort . encodeUtf8+ {-# INLINE encodeUtf8 #-}++ decodeUtf8 :: ShortByteString -> String+ decodeUtf8 = decodeUtf8 . fromShort+ {-# INLINE decodeUtf8 #-}++ decodeUtf8Strict :: ShortByteString -> Either T.UnicodeException String+ decodeUtf8Strict = decodeUtf8Strict . fromShort+ {-# INLINE decodeUtf8Strict #-}++-- | @since 0.6.0.0+instance ConvertUtf8 Text ShortByteString where+ encodeUtf8 :: Text -> ShortByteString+ encodeUtf8 = toShort . encodeUtf8+ {-# INLINE encodeUtf8 #-}++ decodeUtf8 :: ShortByteString -> Text+ decodeUtf8 = decodeUtf8 . fromShort+ {-# INLINE decodeUtf8 #-}++ decodeUtf8Strict :: ShortByteString -> Either T.UnicodeException Text+ decodeUtf8Strict = decodeUtf8Strict . fromShort+ {-# INLINE decodeUtf8Strict #-}++-- | @since 0.6.0.0+instance ConvertUtf8 LText ShortByteString where+ encodeUtf8 :: LText -> ShortByteString+ encodeUtf8 = toShort . encodeUtf8+ {-# INLINE encodeUtf8 #-}++ decodeUtf8 :: ShortByteString -> LText+ decodeUtf8 = decodeUtf8 . fromShort+ {-# INLINE decodeUtf8 #-}++ decodeUtf8Strict :: ShortByteString -> Either T.UnicodeException LText+ decodeUtf8Strict = decodeUtf8Strict . fromShort+ {-# INLINE decodeUtf8Strict #-}+ -- | Type class for converting other strings to 'T.Text'. class ToText a where- toText :: a -> T.Text+ toText :: a -> Text instance ToText String where+ toText :: String -> Text toText = T.pack+ {-# INLINE toText #-} -instance ToText T.Text where+instance ToText Text where+ toText :: Text -> Text toText = id+ {-# INLINE toText #-} -instance ToText LT.Text where+instance ToText LText where+ toText :: LText -> Text toText = LT.toStrict+ {-# INLINE toText #-} +{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only.++You should always specify encoding of bytes explicitly.++In case it is used by mistake, the user will see the following:++>>> toText ("some string" :: ByteString)+...+... Type 'ByteString' doesn't have instance of 'ToText'.+ Use 'decodeUtf8' or 'decodeUtf8Strict' to convert from UTF-8:+ decodeUtf8 :: ByteString -> Text+ decodeUtf8Strict :: ByteString -> Either UnicodeException Text+...++@since 0.6.0.0+-}+instance EncodingError ToText "ByteString" "Text" => ToText ByteString where+ toText :: ByteString -> Text+ toText = error "Unreachable ByteString instance of ToText"++{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only.++You should always specify encoding of bytes explicitly.++In case it is used by mistake, the user will see the following:++>>> toText ("some string" :: LByteString)+...+... Type 'LByteString' doesn't have instance of 'ToText'.+ Use 'decodeUtf8' or 'decodeUtf8Strict' to convert from UTF-8:+ decodeUtf8 :: LByteString -> Text+ decodeUtf8Strict :: LByteString -> Either UnicodeException Text+...++@since 0.6.0.0+-}+instance EncodingError ToText "LByteString" "Text" => ToText LByteString where+ toText :: LByteString -> Text+ toText = error "Unreachable LByteString instance of ToText"++{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only.++You should always specify encoding of bytes explicitly.++In case it is used by mistake, the user will see the following:++>>> toText ("some string" :: ShortByteString)+...+... Type 'ShortByteString' doesn't have instance of 'ToText'.+ Use 'decodeUtf8' or 'decodeUtf8Strict' to convert from UTF-8:+ decodeUtf8 :: ShortByteString -> Text+ decodeUtf8Strict :: ShortByteString -> Either UnicodeException Text+...++@since 0.6.0.0+-}+instance EncodingError ToText "ShortByteString" "Text" => ToText ShortByteString where+ toText :: ShortByteString -> Text+ toText = error "Unreachable ShortByteString instance of ToText"+ -- | Type class for converting other strings to 'LT.Text'. class ToLText a where- toLText :: a -> LT.Text+ toLText :: a -> LText instance ToLText String where+ toLText :: String -> LText toLText = LT.pack+ {-# INLINE toLText #-} -instance ToLText T.Text where+instance ToLText Text where+ toLText :: Text -> LText toLText = LT.fromStrict+ {-# INLINE toLText #-} instance ToLText LT.Text where+ toLText :: LText -> LText toLText = id+ {-# INLINE toLText #-} +{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only.++You should always specify encoding of bytes explicitly.++In case it is used by mistake, the user will see the following:++>>> toLText ("some string" :: ByteString)+...+... Type 'ByteString' doesn't have instance of 'ToLText'.+ Use 'decodeUtf8' or 'decodeUtf8Strict' to convert from UTF-8:+ decodeUtf8 :: ByteString -> LText+ decodeUtf8Strict :: ByteString -> Either UnicodeException LText+...++@since 0.6.0.0+-}+instance EncodingError ToLText "ByteString" "LText" => ToLText ByteString where+ toLText :: ByteString -> LText+ toLText = error "Unreachable ByteString instance of ToLText"++{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only.++You should always specify encoding of bytes explicitly.++In case it is used by mistake, the user will see the following:++>>> toLText ("some string" :: LByteString)+...+... Type 'LByteString' doesn't have instance of 'ToLText'.+ Use 'decodeUtf8' or 'decodeUtf8Strict' to convert from UTF-8:+ decodeUtf8 :: LByteString -> LText+ decodeUtf8Strict :: LByteString -> Either UnicodeException LText+...++@since 0.6.0.0+-}+instance EncodingError ToLText "LByteString" "LText" => ToLText LByteString where+ toLText :: LByteString -> LText+ toLText = error "Unreachable LByteString instance of ToLText"++{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only.++You should always specify encoding of bytes explicitly.++In case it is used by mistake, the user will see the following:++>>> toLText ("some string" :: ShortByteString)+...+... Type 'ShortByteString' doesn't have instance of 'ToLText'.+ Use 'decodeUtf8' or 'decodeUtf8Strict' to convert from UTF-8:+ decodeUtf8 :: ShortByteString -> LText+ decodeUtf8Strict :: ShortByteString -> Either UnicodeException LText+...++@since 0.6.0.0+-}+instance EncodingError ToLText "ShortByteString" "LText" => ToLText ShortByteString where+ toLText :: ShortByteString -> LText+ toLText = error "Unreachable ShortByteString instance of ToLText"+ -- | Type class for converting other strings to 'String'. class ToString a where toString :: a -> String instance ToString String where+ toString :: String -> String toString = id+ {-# INLINE toString #-} -instance ToString T.Text where+instance ToString Text where+ toString :: Text -> String toString = T.unpack+ {-# INLINE toString #-} -instance ToString LT.Text where+instance ToString LText where+ toString :: LText -> String toString = LT.unpack+ {-# INLINE toString #-} --- | Polymorhpic version of 'Text.Read.readEither'.------ >>> readEither @Text @Int "123"--- Right 123--- >>> readEither @Text @Int "aa"--- Left "Prelude.read: no parse"+{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only.++You should always specify encoding of bytes explicitly.++In case it is used by mistake, the user will see the following:++>>> toString ("some string" :: ByteString)+...+... Type 'ByteString' doesn't have instance of 'ToString'.+ Use 'decodeUtf8' or 'decodeUtf8Strict' to convert from UTF-8:+ decodeUtf8 :: ByteString -> String+ decodeUtf8Strict :: ByteString -> Either UnicodeException String+...++@since 0.6.0.0+-}+instance EncodingError ToString "ByteString" "String" => ToString ByteString where+ toString :: ByteString -> String+ toString = error "Unreachable ByteString instance of ToString"++{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only.++You should always specify encoding of bytes explicitly.++In case it is used by mistake, the user will see the following:++>>> toString ("some string" :: LByteString)+...+... Type 'LByteString' doesn't have instance of 'ToString'.+ Use 'decodeUtf8' or 'decodeUtf8Strict' to convert from UTF-8:+ decodeUtf8 :: LByteString -> String+ decodeUtf8Strict :: LByteString -> Either UnicodeException String+...++@since 0.6.0.0+-}+instance EncodingError ToString "LByteString" "String" => ToString LByteString where+ toString :: LByteString -> String+ toString = error "Unreachable LByteString instance of ToString"++{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only.++You should always specify encoding of bytes explicitly.++In case it is used by mistake, the user will see the following:++>>> toString ("some string" :: ShortByteString)+...+... Type 'ShortByteString' doesn't have instance of 'ToString'.+ Use 'decodeUtf8' or 'decodeUtf8Strict' to convert from UTF-8:+ decodeUtf8 :: ShortByteString -> String+ decodeUtf8Strict :: ShortByteString -> Either UnicodeException String+...++@since 0.6.0.0+-}+instance EncodingError ToString "ShortByteString" "String" => ToString ShortByteString where+ toString :: ShortByteString -> String+ toString = error "Unreachable ShortByteString instance of ToString"++-- | Helper type family to produce error messages+type family EncodingError+ (c :: Type -> Constraint)+ (from :: Symbol)+ (to :: Symbol)+ :: Constraint+ where+ EncodingError c from to = TypeError+ ( 'Text "Type '" ':<>: 'Text from ':<>: 'Text "' doesn't have instance of '"+ ':<>: 'ShowType c ':<>: 'Text "'."+ ':$$: 'Text "Use 'decodeUtf8' or 'decodeUtf8Strict' to convert from UTF-8:"+ ':$$: 'Text " decodeUtf8 :: " ':<>: 'Text from+ ':<>: 'Text " -> " ':<>: 'Text to+ ':$$: 'Text " decodeUtf8Strict :: " ':<>: 'Text from+ ':<>: 'Text " -> Either UnicodeException " ':<>: 'Text to+ )++{- | Polymorhpic version of 'Text.Read.readEither'.++>>> readEither @Text @Int "123"+Right 123+>>> readEither @Text @Int "aa"+Left "Prelude.read: no parse"+-} readEither :: (ToString a, Read b) => a -> Either Text b readEither = first toText . Text.Read.readEither . toString+{-# INLINEABLE readEither #-} --- | Generalized version of 'Prelude.show'.+{- | Generalized version of 'Prelude.show'. Unlike 'Prelude.show' this function+is polymorphic in its result type. This makes it more convenient to work with+data types like 'Relude.String.Reexport.Text' or 'ByteString'. However, if you+pass the result of 'show' to a function that expects polymorphic argument, this+can break type inference, so use @-XTypeApplications@ to specify the textual+type explicitly.++>>> show (42 :: Int)+"42"+>>> show (42 :: Double)+"42.0"+>>> print (show @Text True)+"True"+-} show :: forall b a . (Show.Show a, IsString b) => a -> b show x = fromString (Show.show x)+{-# INLINE show #-} {-# SPECIALIZE show :: Show.Show a => a -> Text #-} {-# SPECIALIZE show :: Show.Show a => a -> LText #-} {-# SPECIALIZE show :: Show.Show a => a -> ByteString #-} {-# SPECIALIZE show :: Show.Show a => a -> LByteString #-} {-# SPECIALIZE show :: Show.Show a => a -> String #-} - -- | Type class for lazy-strict conversions. class LazyStrict l s | l -> s, s -> l where- toLazy :: s -> l+ toLazy :: s -> l toStrict :: l -> s -- | Alias for 'toStrict' function.@@ -207,13 +533,19 @@ {-# SPECIALIZE fromStrict :: Text -> LText #-} instance LazyStrict LByteString ByteString where+ toLazy :: ByteString -> LByteString toLazy = LB.fromStrict {-# INLINE toLazy #-}++ toStrict :: LByteString -> ByteString toStrict = LB.toStrict {-# INLINE toStrict #-} instance LazyStrict LText Text where+ toLazy :: Text -> LText toLazy = LT.fromStrict {-# INLINE toLazy #-}++ toStrict :: LText -> Text toStrict = LT.toStrict {-# INLINE toStrict #-}
src/Relude/String/Reexport.hs view
@@ -1,31 +1,215 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+ {- | Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -Reexports functions to work with 'Text' and 'ByteString' types.+Reexports functions to work with 'Data.Text.Text', 'ByteString' and+'ShortByteString' types. -} module Relude.String.Reexport ( -- * String module Data.String+ , module Text.Read -- * Text- , module Data.Text+ , Text+ , lines+ , unlines+ , words+ , unwords , module Data.Text.Encoding , module Data.Text.Encoding.Error- , module Text.Read -- * ByteString- , module Data.ByteString+ , ByteString++ -- * ShortByteString+ , ShortByteString+ , toShort+ , fromShort ) where import Data.ByteString (ByteString)-import Data.String (IsString (..))-import Data.Text (Text, lines, unlines, unwords, words)+import Data.ByteString.Short (ShortByteString, fromShort, toShort)+import Data.String (IsString (..), String)+import Data.Text (Text) import Data.Text.Encoding (decodeUtf8', decodeUtf8With) import Data.Text.Encoding.Error (OnDecodeError, OnError, UnicodeException, lenientDecode, strictDecode)+import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError) import Text.Read (Read, readMaybe, reads)++import Relude.Base (Constraint, Type)++import qualified Data.Text as Text+++-- $setup+-- >>> import Relude++-- | For tracking usage of Text instead of String+type IsText+ (t :: Type) -- Textual type, e.g. Text, String+ (fun :: Symbol) -- Function name+ = (t ~ Text, CheckText t fun)++type family CheckText (t :: Type) (fun :: Symbol) :: Constraint where+ CheckText Text _ = ()+ CheckText String fun = TypeError+ ( 'Text "'" ':<>: 'Text fun ':<>: 'Text "' works with 'Text', not 'String'."+ ':$$: 'Text "Possible fixes:"+ ':$$: 'Text " 1. Make sure OverloadedStrings extension is enabled."+ ':$$: 'Text " 2. Apply 'toText' to a single value."+ ':$$: 'Text " 3. Apply 'map toText' to the list value."+ )+ CheckText a fun = TypeError+ ( 'Text "'" ':<>: 'Text fun ':<>: 'Text "' works with 'Text'"+ ':$$: 'Text "But given: '" ':<>: 'ShowType a ':<>: 'Text "'"+ )++{- | 'lines' takes 'Data.Text.Text' and splits it into the list by lines.++Actual type of this function is the following:++@+lines :: 'Data.Text.Text' -> ['Data.Text.Text']+@++but it was given a more complex type to provide friendlier compile time errors.++>>> lines ""+[]+>>> lines "one line"+["one line"]+>>> lines "line 1\nline 2"+["line 1","line 2"]+>>> lines ("string line" :: String)+...+... 'lines' works with 'Text', not 'String'.+ Possible fixes:+ 1. Make sure OverloadedStrings extension is enabled.+ 2. Apply 'toText' to a single value.+ 3. Apply 'map toText' to the list value.+...+>>> lines True+...+... 'lines' works with 'Text'+ But given: 'Bool'+...+-}+lines :: IsText t "lines" => t -> [t]+lines = Text.lines+{-# INLINE lines #-}++{- | 'unlines' takes list of 'Data.Text.Text' values and joins them with line separator.++Actual type of this function is the following:++@+unlines :: ['Data.Text.Text'] -> 'Data.Text.Text'+@++but it was given a more complex type to provide friendlier compile time errors.++>>> unlines []+""+>>> unlines ["line 1"]+"line 1\n"+>>> unlines ["first line", "second line"]+"first line\nsecond line\n"+>>> unlines (["line 1", "line 2"] :: [String])+...+... 'unlines' works with 'Text', not 'String'.+ Possible fixes:+ 1. Make sure OverloadedStrings extension is enabled.+ 2. Apply 'toText' to a single value.+ 3. Apply 'map toText' to the list value.+...+>>> unlines [True, False]+...+... 'unlines' works with 'Text'+ But given: 'Bool'+...+-}+unlines :: IsText t "unlines" => [t] -> t+unlines = Text.unlines+{-# INLINE unlines #-}++{- | 'words' takes 'Data.Text.Text' and splits it into the list by words.++Actual type of this function is the following:++@+words :: 'Data.Text.Text' -> ['Data.Text.Text']+@++but it was given a more complex type to provide friendlier compile time errors.++>>> words ""+[]+>>> words "one line"+["one","line"]+>>> words " >_< "+[">_<"]+>>> words ("string words" :: String)+...+... 'words' works with 'Text', not 'String'.+ Possible fixes:+ 1. Make sure OverloadedStrings extension is enabled.+ 2. Apply 'toText' to a single value.+ 3. Apply 'map toText' to the list value.+...+>>> words True+...+... 'words' works with 'Text'+ But given: 'Bool'+...+-}+words :: IsText t "words" => t -> [t]+words = Text.words+{-# INLINE words #-}++{- | 'unwords' takes list of 'Data.Text.Text' values and joins them with space character.++Actual type of this function is the following:++@+unwords :: ['Data.Text.Text'] -> 'Data.Text.Text'+@++but it was given a more complex type to provide friendlier compile time errors.++>>> unwords []+""+>>> unwords ["singleWord"]+"singleWord"+>>> unwords ["word", "another"]+"word another"+>>> unwords (["word", "another"] :: [String])+...+... 'unwords' works with 'Text', not 'String'.+ Possible fixes:+ 1. Make sure OverloadedStrings extension is enabled.+ 2. Apply 'toText' to a single value.+ 3. Apply 'map toText' to the list value.+...+>>> unwords [True, False]+...+... 'unwords' works with 'Text'+ But given: 'Bool'+...+-}+unwords :: IsText t "unwords" => [t] -> t+unwords = Text.unwords+{-# INLINE unwords #-}
src/Relude/Unsafe.hs view
@@ -4,15 +4,15 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -Unsafe functions to work with lists and 'Maybe'. Sometimes unavoidable but it's+Unsafe functions to work with lists and 'Relude.Maybe'. Sometimes unavoidable but it's better not to use them. This module is intended to be imported qualified and it's not even included in default prelude exports. @-import qualified Relude.Unsafe as Unsafe+__import qualified__ Relude.Unsafe as Unsafe foo :: [a] -> a foo = Unsafe.head@@ -31,6 +31,20 @@ import Relude.Function (flip) import Relude.Numeric (Int) --- | Similar to '!!' but with flipped arguments.++-- $setup+-- >>> import Relude++{- | Similar to '!!' but with flipped arguments.+get element from list using index value starting from `0`.++>>> at 2 ["a", "b", "c"]+"c"++it is also usefull when used in a partially applied position like:++>>> map (at 1) [["a","b","c"], ["a","b","c"], ["a","b","c"]]+["b","b","b"]+-} at :: Int -> [a] -> a at = flip (!!)
test/Doctest.hs view
@@ -2,16 +2,24 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -} module Main (main) where +import Relude+ import System.FilePath.Glob (glob) import Test.DocTest (doctest) main :: IO () main = do sourceFiles <- glob "src/**/*.hs"- doctest $ "-XNoImplicitPrelude" : sourceFiles+ doctest+ $ "-XInstanceSigs"+ : "-XNoImplicitPrelude"+ : "-XOverloadedStrings"+ : "-XScopedTypeVariables"+ : "-XTypeApplications"+ : sourceFiles
test/Spec.hs view
@@ -2,7 +2,7 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -} @@ -10,9 +10,16 @@ import Relude -import Test.Tasty (defaultMain)--import Test.Relude.Property (hedgehogTestTree)+import Hedgehog (checkParallel)+import System.IO (hSetEncoding, utf8)+import Test.Relude.Property (hedgehogTestList) main :: IO ()-main = defaultMain hedgehogTestTree+main = do+ -- fix terminal encoding+ hSetEncoding stdout utf8+ hSetEncoding stderr utf8++ mapM checkParallel hedgehogTestList >>= \p -> if and p then exitSuccess else exitFailure++
+ test/Test/Relude/Extra/Validation/Property.hs view
@@ -0,0 +1,174 @@+{- HLINT ignore "Alternative law, right identity" -}+{- HLINT ignore "Alternative law, left identity" -}+{- HLINT ignore "Monoid law, right identity" -}+{- HLINT ignore "Monoid law, left identity" -}+{- HLINT ignore "Use <$>" -}++{-+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MIT+Maintainer: Kowainik <xrom.xkov@gmail.com>+-}++module Test.Relude.Extra.Validation.Property+ ( validationLaws+ ) where++import Relude+import Relude.Extra.Validation++import Hedgehog (Gen, Group (..), Property, forAll, forAllWith, property, (===))++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++validationLaws :: [Group]+validationLaws =+ [ validationSemigroupProps+ , validationMonoidProps+ , validationApplicativeProps+ , validationAlternativeProps+ ]++----------------------------------------------------------------------------+-- Generators+----------------------------------------------------------------------------++genFunction :: Gen (Int -> Int)+genFunction = Gen.element [(+), (*), const] <*> genSmallInt++genSmallInt :: Gen Int+genSmallInt = Gen.int (Range.linear (-10) 10)++genSmallText :: Gen Text+genSmallText = Gen.text (Range.linear 3 10) Gen.unicode++asValidation :: Gen a -> Gen (Validation [Text] a)+asValidation gen = Gen.choice+ [ Success <$> gen+ , Failure <$> Gen.list (Range.linear 1 5) genSmallText+ ]++----------------------------------------------------------------------------+-- Property helpers+----------------------------------------------------------------------------++checkAssotiativityFor+ :: (Show a, Eq a) => Gen a -> (a -> a -> a) -> Property+checkAssotiativityFor gen op = property $ do+ a <- forAll gen+ b <- forAll gen+ c <- forAll gen+ a `op` (b `op` c) === (a `op` b) `op` c++----------------------------------------------------------------------------+-- Semigroup instance properties+----------------------------------------------------------------------------++validationSemigroupProps :: Group+validationSemigroupProps =+ Group "Semigroup instance for Validation property tests"+ [ ("associativity:", prop_semigroupAssociativity)+ ]++prop_semigroupAssociativity :: Property+prop_semigroupAssociativity =+ checkAssotiativityFor (asValidation genSmallText) (<>)++----------------------------------------------------------------------------+-- Monoid instance properties+----------------------------------------------------------------------------++validationMonoidProps :: Group+validationMonoidProps =+ Group "Monoid instance for Validation property tests"+ [ ("right identity:", prop_monoidRightIdentity)+ , ("left identity:", prop_monoidLeftIdentity)+ ]++prop_monoidRightIdentity :: Property+prop_monoidRightIdentity = property $ do+ x <- forAll $ asValidation genSmallText+ x <> mempty === x++prop_monoidLeftIdentity :: Property+prop_monoidLeftIdentity = property $ do+ x <- forAll $ asValidation genSmallText+ mempty <> x === x++----------------------------------------------------------------------------+-- Applicative instance properties+----------------------------------------------------------------------------++validationApplicativeProps :: Group+validationApplicativeProps =+ Group "Applicative instance for Validation property tests"+ [ ("identity:", prop_applicativeIdentity)+ , ("composition:", prop_applicativeComposition)+ , ("homomorphism:", prop_applicativeHomomorphism)+ , ("interchange:", prop_applicativeInterchange)+ , ("u *> v == (id <$ u) <*> v", prop_applicativeApplyRight)+ , ("u <* v == liftA2 const u v", prop_applicativeApplyLeft)+ ]++prop_applicativeIdentity :: Property+prop_applicativeIdentity = property $ do+ vx <- forAll $ asValidation genSmallText+ (pure id <*> vx) === vx++prop_applicativeComposition :: Property+prop_applicativeComposition = property $ do+ vf <- forAllWith (const "f") $ asValidation genFunction+ vg <- forAllWith (const "g") $ asValidation genFunction+ vx <- forAll $ asValidation genSmallInt+ (pure (.) <*> vf <*> vg <*> vx) === (vf <*> (vg <*> vx))++prop_applicativeHomomorphism :: Property+prop_applicativeHomomorphism = property $ do+ f <- forAllWith (const "f") genFunction+ x <- forAll genSmallInt+ (pure f <*> pure x) === pure @(Validation [Text]) (f x)++prop_applicativeInterchange :: Property+prop_applicativeInterchange = property $ do+ vf <- forAllWith (const "f") $ asValidation genFunction+ x <- forAll genSmallInt+ (vf <*> pure x) === (pure ($ x) <*> vf)++prop_applicativeApplyRight :: Property+prop_applicativeApplyRight = property $ do+ vy <- forAll $ asValidation genSmallInt+ vx <- forAll $ asValidation genSmallInt+ (vy *> vx) === ((id <$ vy) <*> vx)++prop_applicativeApplyLeft :: Property+prop_applicativeApplyLeft = property $ do+ vy <- forAll $ asValidation genSmallInt+ vx <- forAll $ asValidation genSmallInt+ (vy <* vx) === liftA2 const vy vx++----------------------------------------------------------------------------+-- Alternative instance properties+----------------------------------------------------------------------------++validationAlternativeProps :: Group+validationAlternativeProps =+ Group "Alternative instance for Validation property tests"+ [ ("associativity:", prop_alternativeAssociativity)+ , ("right identity:", prop_alternativeRightIdentity)+ , ("left identity:", prop_alternativeLeftIdentity)+ ]++prop_alternativeAssociativity :: Property+prop_alternativeAssociativity =+ checkAssotiativityFor (asValidation genSmallText) (<|>)++prop_alternativeRightIdentity :: Property+prop_alternativeRightIdentity = property $ do+ x <- forAll $ asValidation genSmallText+ (x <|> empty) === x++prop_alternativeLeftIdentity :: Property+prop_alternativeLeftIdentity = property $ do+ x <- forAll $ asValidation genSmallText+ (empty <|> x) === x
test/Test/Relude/Property.hs view
@@ -2,38 +2,41 @@ Copyright: (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2019 Kowainik-License: MIT+SPDX-License-Identifier: MIT Maintainer: Kowainik <xrom.xkov@gmail.com> -} module Test.Relude.Property- ( hedgehogTestTree+ ( hedgehogTestList ) where import Relude+import Test.Relude.Extra.Validation.Property (validationLaws) import Data.List (nub)-import Hedgehog (Gen, Property, assert, forAll, property, (===))-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.Hedgehog+import Hedgehog (Gen, Property, Group (..), assert, forAll, property, (===)) import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range -hedgehogTestTree :: TestTree-hedgehogTestTree = testGroup "Tests" [utfProps, listProps, boolMProps]+hedgehogTestList :: [Group]+hedgehogTestList =+ [ utfProps+ , listProps+ , logicProps+ ] <> validationLaws ---------------------------------------------------------------------------- -- utf8 conversion ---------------------------------------------------------------------------- -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+utfProps :: Group+utfProps = Group "utf8 conversion property tests"+ [ ("String to ByteString invertible:", prop_StringToBytes)+ , ("Text to ByteString invertible:", prop_TextToBytes)+ , ("ByteString to Text or String invertible:" , prop_BytesTo) ]-+ utf8String :: Gen String utf8String = Gen.string (Range.linear 0 1000) Gen.unicode @@ -72,14 +75,14 @@ -- ordNub ---------------------------------------------------------------------------- -listProps :: TestTree-listProps = testGroup "list function property tests"- [ testProperty "ordNub xs == nub xs" prop_ordNubCorrect- , testProperty "hashNub xs == nub xs" prop_hashNubCorrect- , testProperty "sortNub xs == sort (nub xs)" prop_sortNubCorrect- , testProperty "sort (unstableNub xs) == sort (nub xs)" prop_unstableNubCorrect+listProps :: Group+listProps = Group "list function property tests"+ [ ("ordNub xs == nub xs:", prop_ordNubCorrect)+ , ("hashNub xs == nub xs:", prop_hashNubCorrect)+ , ("sortNub xs == sort (nub xs):" , prop_sortNubCorrect)+ , ("sort (unstableNub xs) == sort (nub xs):" , prop_unstableNubCorrect) ]-+ genIntList :: Gen [Int] genIntList = Gen.list (Range.linear 0 1000) Gen.enumBounded @@ -107,14 +110,14 @@ -- logicM ---------------------------------------------------------------------------- +logicProps :: Group+logicProps = Group "lifted logic function property tests"+ [ ("andM:", prop_andM)+ , ("orM:", prop_orM)+ ]+ genBoolList :: Gen [Bool] genBoolList = Gen.list (Range.linear 0 1000) Gen.bool--boolMProps :: TestTree-boolMProps = testGroup "lifted logic function property tests"- [ testProperty "andM" prop_andM- , testProperty "orM" prop_orM- ] prop_andM :: Property prop_andM = property $ do