diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,46 +1,456 @@ -# Change log +# Changelog -Unreleased -==== +`relude` uses [PVP Versioning][1]. +The changelog is available [on GitHub][2]. -0.4.0 — Nov 6, 2018 -===== +## 1.2.2.2 – Aug 5, 2025 -* [#70](https://github.com/kowainik/relude/issues/70): +- Documentation improvements + +## 1.2.2.1 – Jul 29, 2025 + +- Allow containers-0.8. + +- Documentation improvements + +## 1.2.2.0 – Oct 13, 2024 + +- Support GHC-9.10 & GHC-9.8. +- Allow hashable-1.5 + +## 1.2.1.0 – Oct 4, 2023 + +- [#439](https://github.com/kowainik/relude/issues/439): + Support GHC-9.6. +- Upgrade dependencies. Allow: + - `ghc-prim-0.10` + - `text-2.1` + - `bytestring-2.12` + - `containers-0.7` + - `deepseq-1.5` + - `hedgehod-1.3` + - `doctest-0.22` +- Upgrade tests to work with GHC-9.6. + +## 1.2.0.0 – Mar 1, 2023 + +- [#420](https://github.com/kowainik/relude/issues/420): + Support GHC-9.4. +- Reexport `type (~)` from `Data.Type.Equality` for GHC-9.4. +- Add `-Wredundant-strictness-flags` and `-Wforall-identifier` warnings for + GHC-9.4. +- [#430](https://github.com/kowainik/relude/issues/430): + Upgrade dependencies: + - `ghc-prim-0.9` + - `mtl-2.3` + - `hedgehog-1.2` + - `doctest-0.21` +- Drop support of GHC-8.2. + +## 1.1.0.0 — Jun 9, 2022 + +- [#388](https://github.com/kowainik/relude/issues/388): + Support GHC-9.2. +- [#363](https://github.com/kowainik/relude/issues/363): + Remove the `Option` type, reexported from `Data.Semigroup` + (which was removed in `base-4.16`, GHC 9.2) + + **Migration guide:** Use `Maybe` instead of `Option`. + +- [#372](https://github.com/kowainik/relude/issues/372): + Warn on usages of `readFileText`, `readFileLText`, `readFile` and `readFile'`. + + > _NOTE:_ This is a **breaking change** if you build with `-Werror` + > and use the above functions. Use `readFileBS` / `readFileLBS` + > instead to convert to `Text` / `LText` / `String` using + > `decodeUtf8` and similar functions. + +- [#394](https://github.com/kowainik/relude/issues/394): + Support `hashable-1.4`. +- [#408](https://github.com/kowainik/relude/issues/408): + Switch benchmarks from `criterion` to `tasty-bench`. +- [#404](https://github.com/kowainik/relude/issues/404): + Fix condidion for `ordNubOn`, `intNub`, `intNubOn` export for `Relude.Nub` module. + Use min version of `containers-0.6.0` instead of min version of GHC `8.4`. +- Minor documentation improvements and fixes. + +## 1.0.0.1 — Mar 15, 2021 + +- Minor documentation changes. + +## 1.0.0.0 — Mar 12, 2021 + +- [#353](https://github.com/kowainik/relude/issues/353): + Reexport most common modules from the following libraries: + + - `containers` + - `unordered-containers` + - `text` + - `bytestring` + + Now, when using `relude`, you don't need to add these libraries to + your `.cabal` file to enjoy their main API. Try removing them from + your `.cabal` file after upgrading to this version of `relude` to + see if you still need them. + + To utilise this feature, update the `mixin` part of your package + configuration (if you're using the mixins approach) to the following: + + ```cabal + mixins: base hiding (Prelude) + , relude (Relude as Prelude) + , relude + ``` + +- [#345](https://github.com/kowainik/relude/issues/345): + Support GHC-9.0. +- Upgrade minor GHC versions to GHC-8.10.4 and GHC-8.8.4. +- [#268](https://github.com/kowainik/relude/issues/268): + Drop support of GHC-8.0.2. +- [#270](https://github.com/kowainik/relude/issues/270): + Standardise `universe`, `universeNonEmpty` and `inverseMap` functions that + previously were introduced in the `Relude.Extra.Enum` module. `Relude.Enum` + module created that is exported in the main `Relude` module by default. + + **Migration guide:** If you were using any of these functions you can now + remove `Relude.Extra.Enum` from your imports and explicit `mixins` section + as they are available for you with the `Relude` module. + +- Remove the `Eq` constraint on `universeNonEmpty` +- [#269](https://github.com/kowainik/relude/issues/269): + Remove the `Relude.Extra.Validation` module. + + **Migration guide:** + If you use `Relude.Extra.Validation` in you project you need to: + + 1. Add `validation-selective` into the `build-depends` section of your + `.cabal` file. + 2. Change imports of `Relude.Extra.Validation` to `Validation`: + + ```haskell + -- Was: + import Relude.Extra.Validation (Validation (..), ..) + -- Became: + import Validation (Validation (..), ..) + ``` + +- [#346](https://github.com/kowainik/relude/issues/346), + [#347](https://github.com/kowainik/relude/issues/347): + Reimplement `ordNub` through `nubOrd` from `containers`. + Add `ordNubOn`, `intNub` and `intNubOn` functions. +- [#327](https://github.com/kowainik/relude/issues/327): + Add `infinitely` as more strictly typed `forever`. +- [#311](https://github.com/kowainik/relude/issues/311): + Add `maybeAt` function — the non-operator version of `!!?` with its + arguments flipped. +- [#314](https://github.com/kowainik/relude/issues/314): + Add lifted versions of functions to work with `Handle`: + + - `hFlush` + - `hIsEOF` + - `hSetBuffering` + - `hGetBuffering` + +- [#305](https://github.com/kowainik/relude/issues/305): + Add lifted versions of functions to work with environment: + + - `getArgs` + - `lookupEnv` + +- Add lifted version of the `readFile'` function. +- Reexport the `BufferMode` type from `base`. +- [#309](https://github.com/kowainik/relude/issues/309): + Reexport `span` from `Data.List`. +- [#319](https://github.com/kowainik/relude/issues/319): + Implement `partitionWith`. +- [#307](https://github.com/kowainik/relude/issues/307): + Add `foldr1` to `Foldable1`. +- [#316](https://github.com/kowainik/relude/issues/316): + Add `average` and `average1` — efficient functions for finding + average on foldable structures. +- [#306](https://github.com/kowainik/relude/issues/306): + Add `maximumOn1` and `minimumOn1` to `Foldable1`. +- [#301](https://github.com/kowainik/relude/issues/301): + Add `traceShowWith` to `Relude.Debug`. +- [#304](https://github.com/kowainik/relude/issues/304), + [#317](https://github.com/kowainik/relude/issues/317): + Various documentation improvements. +- Updates to `relude`-specific `.hlint` rules. + +Thanks @googleson78, @sushi-shi, @rektrex, @aleator, @mjgpy3, @dalpd, +@Bodigrim for helping with this release! + +## 0.7.0.0 — May 14, 2020 + +- [#253](https://github.com/kowainik/relude/issues/253): + Support GHC-8.10. Upgrade GHC-8.8 to 8.8.3. +- Significant documentation improvements: + - Add high-level description to each reexported module. + - Add String Conversion Table. + - Add `NonEmpty` lists functions tables. + - Add `@since` annotations. + - Improve README. + - Inline some external reexports into explicit lists of exports. + - Rewrite top-level `cabal` description. +- [#234](https://github.com/kowainik/relude/issues/234): + Reexport `scanl1`, `scanr1`, `scanl'` from `Data.List`. +- [#256](https://github.com/kowainik/relude/issues/256): + Make `cycle` total function. +- [#233](https://github.com/kowainik/relude/issues/233): + Add `etaReaderT` to `Relude.Monad.Trans` to help with performance. +- [#294](https://github.com/kowainik/relude/issues/294): + Add `atomicModifyIORef_` and `atomicModifyIORef'_`. +- [#293](https://github.com/kowainik/relude/issues/293): + Add `memptyIfFalse` and `memptyIfTrue` functions. +- Reexport `NonEmpty` functions from `Relude.List.NonEmpty` instead of + `Relude.List.Reexport`. +- [#239](https://github.com/kowainik/relude/issues/239): + Reexport more STM functions that work with `TMVar` from + `Relude.Lifted.Concurrent`. +- [#227](https://github.com/kowainik/relude/issues/227): + Create `Relude.Extra` module +- [#228](https://github.com/kowainik/relude/issues/228): + Add `universeNonEmpty` function. +- [#249](https://github.com/kowainik/relude/issues/249): + **Breaking change:** Fix infix of the `Relude.Extra.Lens` `(^.)` operator. + Change it to `infixl 8`. +- Reexport partial `read` from `Relude.Unsafe` for consistency. +- [#244](https://github.com/kowainik/relude/issues/244): + Remove deprecated functions: `prec`, `dupe` and `mapBoth`. + + **Migration rules:** + + - `prec`: use `prev` instead + - `dupe`: use `dup` instead + - `mapBoth`: use `bimapBoth` instead + +- [#246](https://github.com/kowainik/relude/issues/246): + Deprecate `Relude.Extra.Validation` in favour of + [`validation-selective`](https://hackage.haskell.org/package/validation-selective) + + **Migration rules:** + If you use `Relude.Extra.Validation` in you project you need to: + + 1. Add `validation-selective` into the `build-depends` section of your + `.cabal` file. + 2. Change imports of `Relude.Extra.Validation` to `Validation`: + + ```haskell + -- Was: + import Relude.Extra.Validation (Validation (..), ..) + -- Became: + import Validation (Validation (..), ..) + ``` + +- [#196](https://github.com/kowainik/relude/issues/196): + Deprecate `mapToFst` and `mapToSnd`. Introduce `toFst` and `toSnd` + in `Relude.Extra.Tuple` as shorter aliases for `mapToFst`. Implement + `fmapToFst` and `fmapToSnd`. Add more HLint rules for + `Relude.Extra.Tuple` functions. + + **Migration rules:** + + - Replace `mapToFst` with `toFst` + - Replace `mapToSnd` with `toSnd` + - You can now use `fmapToFst` and `fmapToSnd` instead of + `[f]map (mapToFst f)` and `[f]map (mapToSnd f)` + +- [#286](https://github.com/kowainik/relude/issues/286): + **Breaking change:** `readEither` is not polymorphic over the first argument + anymore. Now it takes `String`. + + **Migration rules:** Use one of the conversion function from the + `Relude.String.Conversion` module to covert your old input value into + `String`. + + For example, if you had + + ```haskell + readEither @Text @Int myText + ``` + + Now it should become: + + ```haskell + readEither @Int (toString myText) + ``` + +- [#281](https://github.com/kowainik/relude/issues/281): + Move `One` property tests from `doctest` to `hedgehog`. + Significant test time boost. +- [#264](https://github.com/kowainik/relude/issues/264): + Support Dhall-16.0.0 in HLint rules. + +## 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/issues/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): + Implement `Relude.Extra.Lens` module. +- [#125](https://github.com/kowainik/relude/issues/125): + Moved many numerical functions and types in `Relude.Numeric`. + Reexport `toIntegralSized` from `Data.Bits`. + Add `integerToBounded` and `integerToNatural` in `Relude.Numeric`. +- [#121](https://github.com/kowainik/relude/issues/121): + Reexport `Ap` from `Data.Monoid`. Change definition of `foldMapA` to use `Ap`. +- [#129](https://github.com/kowainik/relude/issues/129): + Add `appliedTo` and `chainedTo` as named versions of operators `=<<` and `<**>`. +- [#138](https://github.com/kowainik/relude/issues/138): + Add `RealFloat` to `Relude.Numeric`. +- [#144](https://github.com/kowainik/relude/issues/144): + Add `traverseToSnd` and friends to `Relude.Extra.Tuple`. +- [#140](https://github.com/kowainik/relude/issues/140): + Improve text of custom compile-time error messages for `elem` functions. +- [#136](https://github.com/kowainik/relude/issues/136): + Cover `Relude.Extra.*` modules with custom HLint rules. +- [#146](https://github.com/kowainik/relude/issues/146): + Improve documentation for `Relude.File` file: be more explicit about system + locale issues. +- Improve documentation for `One` typeclass and add tests. +- Support ghc-8.6.4 and ghc-8.4.4. + Drop support for ghc-8.6.1 and ghc-8.4.3. + +## 0.4.0 — Nov 6, 2018 + +- [#70](https://github.com/kowainik/relude/issues/70): Reexport `Contravariant` for GHC >= 8.6.1. -* [#103](https://github.com/kowainik/relude/pull/104): +- [#103](https://github.com/kowainik/relude/pull/104): Drop `utf8-string` dependency and improve performance of conversion functions. -* [#98](https://github.com/kowainik/relude/issues/98): +- [#98](https://github.com/kowainik/relude/issues/98): Reexport `Bifoldable` related stuff from `base`. -* [#99](https://github.com/kowainik/relude/issues/99): +- [#99](https://github.com/kowainik/relude/issues/99): Reexport `Bitraversable` related stuff from `base`. -* [#100](https://github.com/kowainik/relude/issues/100): +- [#100](https://github.com/kowainik/relude/issues/100): Add `Relude.Extra.Validation` with `Validation`data type. -* [#89](https://github.com/kowainik/relude/issues/81): +- [#89](https://github.com/kowainik/relude/issues/89): Add `Relude.Extra.Type` module containing a `typeName` function. -* [#92](https://github.com/kowainik/relude/issues/92) +- [#92](https://github.com/kowainik/relude/issues/92) Add `Relude.Extra.Tuple` module, containing `dupe`, `mapToFst`, `mapToSnd`, and `mapBoth` functions. -* [#97](https://github.com/kowainik/relude/issues/97): +- [#97](https://github.com/kowainik/relude/issues/97): Add `(&&^)` and `(||^)` operators. -* [#81](https://github.com/kowainik/relude/issues/81): +- [#81](https://github.com/kowainik/relude/issues/81): Add `asumMap` to `Foldable` functions. -* [#80](https://github.com/kowainik/relude/issues/80): +- [#80](https://github.com/kowainik/relude/issues/80): Add hlint rules for `whenLeft`, `whenLeftM`, `whenRight` and `whenRightM`. -* [#79](https://github.com/kowainik/relude/issues/79): +- [#79](https://github.com/kowainik/relude/issues/79): Add HLint rules for `One` typeclass. -* Remove `openFile` and `hClose`. -* [#83](https://github.com/kowainik/relude/pull/83): +- Remove `openFile` and `hClose`. +- [#83](https://github.com/kowainik/relude/pull/83): Make documentation for `nub` functions prettier. -* [#109](https://github.com/kowainik/relude/issues/109): +- [#109](https://github.com/kowainik/relude/issues/109): Use Dhall v3.0.0 for hlint file generation. -0.3.0 -===== +## 0.3.0 -* [#41](https://github.com/kowainik/relude/issues/41): +- [#41](https://github.com/kowainik/relude/issues/41): Add `Foldable1`. -* [#64](https://github.com/kowainik/relude/issues/64): +- [#63](https://github.com/kowainik/relude/issues/63): Remove `Print` typeclass. Add `put[L]BS[Ln]` functions. `trace` functions now take `String` as argument instead of `Text`. @@ -48,99 +458,94 @@ **Important:** this is a breaking change. If you used polymorphic `putStrLn` you need to remove type application or switch to one of the monomorphic functions. Also, you can't abstract over `Print` typeclass anymore. -* [#66](https://github.com/kowainik/relude/issues/66): + +- [#66](https://github.com/kowainik/relude/issues/66): Export `(>>>)` and `(<<<)` from `Control.Category`. -* [#59](https://github.com/kowainik/relude/issues/59): +- [#59](https://github.com/kowainik/relude/issues/59): Introduce `flap` function and its operator version `??`. -* [#64](https://github.com/kowainik/relude/issues/64): +- [#64](https://github.com/kowainik/relude/issues/64): Improve performance of functions from `Foldable1`. Add `foldl1'` function. -* Reexport `uncons` from `base`. -* Rewrite `die` implementation to use `die` from `base`. -* [#19](https://github.com/kowainik/relude/issues/19): +- Reexport `uncons` from `base`. +- Rewrite `die` implementation to use `die` from `base`. +- [#19](https://github.com/kowainik/relude/issues/19): Rewrite `.hlint.yaml` to Dhall. -* Move `stdin`- and `stdout`-related functions to new module `Relude.Lifted.Terminal`. -* [#67](https://github.com/kowainik/relude/issues/67): +- Move `stdin`- and `stdout`-related functions to new module `Relude.Lifted.Terminal`. +- [#67](https://github.com/kowainik/relude/issues/67): Add HLint rules for `put*` functions. -* [#22](https://github.com/kowainik/relude/issues/22): +- [#22](https://github.com/kowainik/relude/issues/22): `readFile`, `writeFile` and `appendFile` now work with `String`. Add lifted version of `hClose`. Add `readFile`, `writeFile` and `appendFile` alternatives for `Text` and `ByteString`. -* [#61](https://github.com/kowainik/relude/issues/61): +- [#61](https://github.com/kowainik/relude/issues/61): Add `under2` and `underF2` functions to `Relude.Extra.Newtype`. -* [#60](https://github.com/kowainik/relude/issues/60): +- [#60](https://github.com/kowainik/relude/issues/60): Add `hoistMaybe` and `hoistEither` functions. -0.2.0 -===== +## 0.2.0 -* [#43](https://github.com/kowainik/relude/issues/43): +- [#43](https://github.com/kowainik/relude/issues/43): Implement `Relude.Extra.Newtype` module. -* [#46](https://github.com/kowainik/relude/issues/46): +- [#46](https://github.com/kowainik/relude/issues/46): Add a function that returns its own name. -* [#48](https://github.com/kowainik/relude/issues/48): +- [#48](https://github.com/kowainik/relude/issues/48): Export `<&>` from `base`. Also reexport `fromLeft` and `fromRight` from `base` where possible. -* [#49](https://github.com/kowainik/relude/issues/49): +- [#49](https://github.com/kowainik/relude/issues/49): Speed up and refactor property tests. -* [#54](https://github.com/kowainik/relude/issues/54): +- [#54](https://github.com/kowainik/relude/issues/54): Improve documentation. Add more examples to documentation and more tests. Reexport `withReader` and `withReaderT`. Remove `safeHead`. Rename `Relude.List.Safe` to `Relude.List.NonEmpty`. -0.1.1 -===== +## 0.1.1 -* [#44](https://github.com/kowainik/relude/issues/44): +- [#44](https://github.com/kowainik/relude/issues/44): Implement parser deriviation from pretty-printers. -0.1.0 -===== +## 0.1.0 -* [#7](https://github.com/kowainik/relude/issues/7): +- [#7](https://github.com/kowainik/relude/issues/7): Remove `Container.Class.Container`. Export `Foldable`. -* [#2](https://github.com/kowainik/relude/issues/2): +- [#2](https://github.com/kowainik/relude/issues/2): Remove `microlens` from dependencies. -* [#10](https://github.com/kowainik/relude/issues/10): +- [#10](https://github.com/kowainik/relude/issues/10): Remove `VarArg` module. -* [#9](https://github.com/kowainik/relude/issues/9): +- [#9](https://github.com/kowainik/relude/issues/9): Remove `safe-exceptions` from dependencies. Reexport `Exception` and `SomeException` from `Control.Exception` instead. -* [#11](https://github.com/kowainik/relude/issues/11): +- [#11](https://github.com/kowainik/relude/issues/11): Remove `TypeOps` module and `type-operators` dependency. -* [#13](https://github.com/kowainik/relude/issues/13): +- [#13](https://github.com/kowainik/relude/issues/13): Remove `list`, `getContents`, `interact`, `getArgs`, `note` functions. Remove `Lifted.ST` module. Rename `Lifted.Env` to `Lifted.Exit`. -* [#16](https://github.com/kowainik/relude/issues/16): +- [#16](https://github.com/kowainik/relude/issues/16): Rename `whenLeft`, `whenRight`, `whenLeftM`, `whenRightM` to `whenLeft_` and `whenRight_`, `whenLeftM_` and `whenRightM_`. Add `whenLeft`, `whenRight`, `whenLeftM`, `whenRightM` which return the value. -* [#18](https://github.com/kowainik/relude/issues/18): +- [#18](https://github.com/kowainik/relude/issues/18): Add `LazyStrict` type class for conversions. -* `map` is not `fmap` anymore. Reexport `map` from `Data.List` -* [#12](https://github.com/kowainik/relude/issues/12): +- `map` is not `fmap` anymore. Reexport `map` from `Data.List` +- [#12](https://github.com/kowainik/relude/issues/12): Remove `liquid-haskell` support. -* [#20](https://github.com/kowainik/relude/issues/20): +- [#20](https://github.com/kowainik/relude/issues/20): Add `viaNonEmpty` function. -* [#21](https://github.com/kowainik/relude/issues/21): +- [#21](https://github.com/kowainik/relude/issues/21): Add `MonadFail` instance for `Either`. -* [#17](https://github.com/kowainik/relude/issues/17): +- [#17](https://github.com/kowainik/relude/issues/17): Add `foldMapA` and `foldMapM` functions. -* [#4](https://github.com/kowainik/relude/issues/4): +- [#4](https://github.com/kowainik/relude/issues/4): Rename package to `Relude`. -* [#14](https://github.com/kowainik/relude/issues/14): +- [#14](https://github.com/kowainik/relude/issues/14): Add `Relude.Extra.*` modules which are not exported by default but have useful functions. -* [#8](https://github.com/kowainik/relude/issues/8): +- [#8](https://github.com/kowainik/relude/issues/8): Introduce `StaticMap` and `DynamicMap` type classes as universal interface for Map-like structures. - -`relude` uses [PVP Versioning][1]. -The change log is available [on GitHub][2]. [1]: https://pvp.haskell.org [2]: https://github.com/kowainik/relude/releases diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md deleted file mode 100644 --- a/CONTRIBUTING.md +++ /dev/null @@ -1,53 +0,0 @@ -# Contributing to the Kowainik repositories - -## :wave: Greetings Traveler! - -We are delighted you're reading this, and we appreciate the effort you're -taking to make our projects awesome! :sparkles: - -## How to contribute - -### :bug: Report bugs or feature request :bulb: - -If you discover a bug or have any proposals on how to make this project better -don't hesitate to create an issue [here](../../issues/new) in a free format. - -### Create a PR - -We love to receive pull requests from everyone! It's usually a good idea -to tell about your intention to work on something under the corresponding -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 -[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 -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 - using [stylish-haskell.yaml][stylish] file in the repository. -- [ ] 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. -Now you are ready to [submit a pull request](../../compare). - - ----------- -Thanks for spending your time on reading this contributing guide! :sparkling_heart: - -[stylish]: .stylish-haskell.yaml -[stylish-tool]: http://hackage.haskell.org/package/stylish-haskell -[hlint]: http://hackage.haskell.org/package/hlint -[style-guide]: https://github.com/kowainik/org/blob/master/style-guide.md#haskell-style-guide diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,367 +1,783 @@ -# Relude +# relude -![Relude: cyclone logo](https://user-images.githubusercontent.com/4276606/44077619-d2abb39a-9fd6-11e8-9d9f-cc57a9d03fa0.png) -[![Build Status](https://travis-ci.org/kowainik/relude.svg?branch=master)](https://travis-ci.org/kowainik/relude) -[![Hackage](https://img.shields.io/hackage/v/relude.svg)](https://hackage.haskell.org/package/relude) +![Logo](https://user-images.githubusercontent.com/8126674/67678250-9d8eab80-f99f-11e9-96ca-27883ceeefa6.png) + +[![GitHub CI](https://github.com/kowainik/relude/workflows/CI/badge.svg)](https://github.com/kowainik/relude/actions) +[![Hackage](https://img.shields.io/hackage/v/relude.svg?logo=haskell)](https://hackage.haskell.org/package/relude) [![Stackage LTS](http://stackage.org/package/relude/badge/lts)](http://stackage.org/lts/package/relude) [![Stackage Nightly](http://stackage.org/package/relude/badge/nightly)](http://stackage.org/nightly/package/relude) -[![Hackage-Deps](https://img.shields.io/hackage-deps/v/relude.svg)](http://packdeps.haskellers.com/reverse/relude) [![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://opensource.org/licenses/MIT) -`relude` is a custom prelude, an alternative to default `Prelude`. -`relude` tries to achieve the following goals: +**`relude`** is a safe, performant, user-friendly and lightweight Haskell +standard library. -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 unrepresantable. And if it's - possible to express this concept through the types then we will do it. +The default `Prelude` is not perfect and doesn't always satisfy one's needs. +At this stage you may want to try an alternative prelude library. In this README +we are going to give you convincing reasons to consider using `relude` as such +alternative in your next project. - _Example:_ - ```haskell - whenNotNull :: Applicative f => [a] -> (NonEmpty a -> f ()) -> f () - ``` - instead of - ```haskell - whenNotNull :: Applicative f => [a] -> ([a] -> f ()) -> f () - ``` -3. **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`), 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 - 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) -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 - 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. +`relude` has some strong goals and principles that it sticks to. That principles +defines the library decisions and might tell you more about the priorities of +the library. So below you can find the key design principles behind `relude`: -This README contains introduction to `Relude` and a tutorial on how to use it. +1. **Productivity.** You can be more productive with a "non-standard" standard + library, and `relude` helps you with writing safer and more + efficient code faster. +2. **Total programming**. Usage of + [_partial functions_](https://www.reddit.com/r/haskell/comments/5n51u3/why_are_partial_functions_as_in_head_tail_bad/) + can lead to unexpected bugs and runtime exceptions in pure + code. The types of partial functions lie about their behaviour. And + even if it is not always possible to rely only on total functions, + `relude` strives to encourage best-practices and reduce the + chances of introducing a bug. + +| **Partial** | **Total** | +| ------------------------------- | ------------------------------------------ | +| `head :: [a] -> a` | `head :: NonEmpty a -> a` | +| `tail :: [a] -> [a]` | `tail :: NonEmpty a -> [a]` | +| `read :: Read a => String -> a` | `readMaybe :: Read a => String -> Maybe a` | +| `fromJust :: Maybe a -> a` | `fromMaybe :: a -> Maybe a -> a` | + +3. **Type-safety**. We use the _"make invalid states unrepresentable"_ motto as one + of our guiding principles. If it is possible, we express this concept through the + types. + + _Example:_ Here the function's name type and actions are aligned with each other + + ```haskell + whenNotNull :: Applicative f => [a] -> (NonEmpty a -> f ()) -> f () + ``` + + While in here, the type could represent an unreachable state: + + ```haskell + whenNotNull :: Applicative f => [a] -> ([a] -> f ()) -> f () + ``` + +4. **Performance.** We prefer `Text` over [`String`](https://www.reddit.com/r/haskell/comments/29jw0s/whats_wrong_with_string/), + use space-leaks-free functions (e.g. our custom performant `sum` and `product`), introduce + `{-# INLINE #-}` and `{-# SPECIALIZE #-}` pragmas where + appropriate, and make efficient container types + (e.g. `Map`, `HashMap`, `Set`) more accessible. + +5. **Minimalism** (low number of dependencies). We do not force users of + `relude` to stick to any specific lens or text formatting or logging + library. Where possible, `relude` depends only on boot libraries. + The [Dependency graph](https://raw.githubusercontent.com/kowainik/relude/main/relude-dependency-graph.png) + of `relude` can give you a clearer picture. + +6. **Convenience**. Despite minimalism, we want to bring commonly used + types and functions into scope, and make available functions easier + to use. Some examples of conveniences: + + - No need to add `containers`, `unordered-containers`, `text` and + `bytestring` to dependencies in your `.cabal` file to use the + main API of these libraries + - No need to import types like `NonEmpty`, `Text`, `Set`, `Reader[T]`, `MVar`, `STM` + - Functions like `liftIO`, `fromMaybe`, `sortWith` are available by default as well + - `IO` actions are lifted to `MonadIO` + +7. **Excellent documentation.** + + - 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`](https://github.com/kowainik/relude/blob/main/.hlint.yaml) + +8. **User-friendliness.** Anyone should be able to quickly migrate to `relude`. Only + some basic familiarity with the common libraries like `text` and `containers` + should be enough (but not necessary). + +9. **Exploration.** We have space to experiment with new ideas and proposals + without introducing breaking changes. `relude` uses the approach with + `Extra.*` modules which are not exported by default. The chosen approach makes it quite + easy for us to provide new functionality without breaking anything and let + the users decide to use it or not. + +In addition to our key design principles, the following list of +**anti-goals** describes what `relude` is trying to avoid: + +1. **Rewrite `base` from the ground up.** With `relude` you don't need + to unlearn what you already knew, you can leverage existing + knowledge to achieve higher productivity. +2. **Invent custom abstractions.** Learning abstractions is hard, so + we do our best not to introduce new overwhelming concepts. +3. **Rename common definitions.** If something is called `foo` in + `base`, it's also called `foo` in `relude`. So, `relude` doesn't + rename any existing abstractions, but it may introduce a few new + ones, if their benefits outweigh learning curve. + +This README contains an introduction to `relude` and a tutorial on how to use it. + +For a general introduction to alternative preludes, check the excellent +blog post by [Type Classes](https://typeclasses.com/) that highlights +`relude`. + +- [No implicit Prelude](https://typeclasses.com/ghc/no-implicit-prelude) + +For guiding development principles behind `relude` and comparison with +`base`, check out the following talk: + +- [![Introduction to `relude` — an alternative Haskell prelude](https://img.youtube.com/vi/qwAmiJ5M_zM/0.jpg)](https://www.youtube.com/watch?v=qwAmiJ5M_zM) + ## Structure of this tutorial This tutorial has several parts: -1. [Get started.](#get-started-) -2. [Difference from `Prelude`.](#difference-from-prelude-) -3. [Reexports.](#reexports-) -4. [What's new?](#whats-new-) -6. [Migration guide.](#migration-guide-) -7. [For developers.](#for-developers-) +1. [When to use an alternative prelude?](#when-to-use-an-alternative-prelude) +2. [Get started](#get-started) + - [Mixins](#mixins) + - [NoImplicitPrelude](#noimplicitprelude) + - [base-noprelude (not recommended)](#base-noprelude) +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 -and usage, see [_Haddock documentation_](http://hackage.haskell.org/package/relude). +This is neither a tutorial on _Haskell Standard Library_ nor a tutorial on each +function contained in `relude`. For latter see the detailed documentation of +every data type, type class and function together with examples and usages in +the [_Haddock documentation for `relude`_](http://hackage.haskell.org/package/relude). -## Get started [↑](#structure-of-this-tutorial) +## When to use an alternative prelude? -If you want to start using `relude` in your project and explore it with the help -of compiler, set everything up according to the instructions below. +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) -### base-noprelude +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 a different set of available by default functions and data +types by replacing the `Prelude` module. -This is the recommended way to use custom prelude. It requires you to perform -the following steps: +Replacing default `Prelude` from `base` has the following _disadvantages_: -1. Replace `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`): - ```haskell - module Prelude - ( module Relude - ) where +1. Increased entry threshold: you need to _learn_ a different standard library. + - `relude` tries to lower this threshold as much as possible: it comes with + the excellent documentation, no custom abstractions, and 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 the boot libraries (almost) which results in small + build time, follows [PVP](https://pvp.haskell.org/) and cares about + backwards compatibility. - import Relude - ``` - > **NOTE:** if you use [`summoner`](https://github.com/kowainik/summoner) to generate Haskell project, - > this tool can automatically create such structure for you when you specify custom prelude. -4. Optionally modify your `Prelude` to include more or less functions. Probably - you want to hide something from `Relude` module. Or maybe you want to add - something from `Relude.Extra.*` modules! +However, using an alternative prelude, specifically `relude`, has the following +**advantages**: -This is a very convenient way to add a custom prelude to your project because -you don't need to import module manually inside each file and enable the -`NoImplicitPrelude` extension. +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 are provided. +3. Increased performance: some functions in `relude` are faster than in the + default `Prelude`. -### Per-file configuration +Taking into consideration all the above points, we put together our +recommendations when to use `relude`: -Disable the built-in prelude at the top of your file: +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. +And when you may want to stay with the default standard: + +1. When you write a small library that is supposed to be used by other people in + their projects. + +## Get started + +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) + +If you want to start using `relude` in your project, you can set the library up +for you by one of the following ways. + +### Mixins + +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) + +This is the recommended way to use a custom prelude. + +You can use the Cabal feature `mixins` to replace the default `Prelude` with +`Relude` without the need to add extra dependencies or to import `Relude` +manually in each module. +For this you need to add the following lines into your `.cabal` file: + ```haskell + mixins: base hiding (Prelude) + , relude (Relude as Prelude) + , relude +``` + +> **NOTE:** this requires Cabal version to be at least `2.2` + +The above syntax does the following: + +1. Makes all modules of `base` available except `Prelude`. +2. Renames the `Relude` module in `relude` to `Prelude`. +3. Additionally allows importing all other modules from `relude` + (extra modules and reexports from other libraries). + +See the following complete example of how your `.cabal` file may look +like after the set up: + +```cabal +cabal-version: 2.2 +name: prelude-example +version: 0.0.0.0 + +library + exposed-modules: Example + build-depends: base >= 4.14 && < 4.17 + , relude ^>= 1.1.0.0 + + mixins: base hiding (Prelude) + , relude (Relude as Prelude) + , relude + + default-language: Haskell2010 +``` + +> **NOTE:** if you use [`summoner`](https://github.com/kowainik/summoner) to +> generate a Haskell project, the tool automatically creates the `mixins` +> field when you specify a custom prelude. + +If you want to restrict allowed modules in `relude` to a specific list +(e.g. use only `Relude.Extra.Enum` or `Relude.Unsafe` or `Data.Text` +from `text`), you can alternatively list them explicitly under the +first `mixins` entry field as well, like this: + +```cabal + mixins: base hiding (Prelude) + , relude (Relude as Prelude + , Relude.Extra.Enum + , Relude.Unsafe + , Data.Text + ) +``` + +If you want to bring only all `Extra.*` modules into scope, you can add +a single `Relude.Extra` module to `mixins`, and after that you can import all +extra functions and data types from `Relude.Extra`. This is the +easiest way to bring all functions and types from `relude` to your project +(excluding `Relude.Unsafe`). + +```cabal + mixins: base hiding (Prelude) + , relude (Relude as Prelude + , Relude.Extra + ) +``` + +> **NOTE:** due to the existing [stack issue](https://github.com/commercialhaskell/stack/issues/5077), +> `mixins` technique doesn't work with the `stack repl` at the moment. Please, +> consider this before using this method of turning `relude` on in the project. +> +> If having `stack repl` crucial for your workflow, see the following options of +> how to use Relude in your project. + +### NoImplicitPrelude + +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) + +For this option, you need to disable the default `Prelude` module first. +To disable the built-in prelude on module basis, you can add the following +pragma at the top of your file: + +```haskell {-# LANGUAGE NoImplicitPrelude #-} ``` -Or directly in your project `.cabal` file, if you want to use in every module by default: +if you want to disable the default `Prelude` for every module by default, you +can specify this directly in your project `.cabal` file: ```haskell default-extensions: NoImplicitPrelude ``` -Then add the following import to your modules: +Then you need to add `relude` as a dependency of your project. +After doing all above, you can now use `Relude` in any module of your project by +adding a single import: + ```haskell import Relude ``` -## Difference from Prelude [↑](#structure-of-this-tutorial) +### base-noprelude -* `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 `Show` from - `Text.Show` module if you want to implement `Show` instance manually. -* 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. +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) -## Reexports [↑](#structure-of-this-tutorial) +:warning: _This strategy is not reccommended. The package `base-noprelude` is currently not being maintained and its use is likely to cause issues with newer versions of ghc and libraries._ +Alternatively, you can use the `base-noprelude` trick to enable +alternative preludes. This approach can be helpful if you want to have +your own `Prelude` module with some custom functions, not provided by +`relude`. To use the trick, perform the following steps: + +1. Replace the `base` dependency with the corresponding version of `base-noprelude` in + your `.cabal` file. +2. Add the `relude` dependency to your `.cabal` file. +3. Create the file called `Prelude.hs` in your source directory with + the following content: + + ```haskell + module Prelude + ( module Relude + ) where + + import Relude + ``` + +4. Add this module to `exposed-modules` in your `.cabal` file: + ```cabal + exposed-modules: Prelude + ``` +5. Optionally modify your `Prelude` module to include more or fewer functions. + Potentially, you can hide something from the `Relude` module. Or maybe you + want to add something from `Relude.Extra.*` modules! + Customize the module for your needs. + +This is a very convenient way to add a custom prelude to your project because +you don't need to import module manually inside each file and enable the +`NoImplicitPrelude` extension. + +## Difference from Prelude + +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) + +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 the 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 due to 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 brought into scope + - See the [What's new?](#whats-new) section for a detailed overview. +- New reexports + - See the [Reexports](#reexports) section for a detailed overview. + +## Reexports + +[[Back to the Table of Contents] ↑](#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) +- [`ghc-prim`](http://hackage.haskell.org/package/ghc-prim) +- [`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. +If you want to clean up your imports after switching to `relude`, you can use +the `relude`-specific +[`.hlint.yaml`](https://github.com/kowainik/relude/blob/main/.hlint.yaml) +configuration for this task. With this config, `HLint` will produce +warnings and hints on how to have more benefits from `relude`. ### base -Some generally useful modules from `base` package, like: `Control.Applicative`, -`Data.Traversable`, `Data.Monoid`, `Data.List`, and lots of others. +Multiple sorting functions are available for different use-cases: +- `sortBy :: (a -> a -> Ordering) -> [a] -> [a]`: sorts a 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]`: similar to `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 similar to `read` but unlike it, they are total +and return either `Maybe` or `Either` with a parse error. + +`(&)` is the reverse application. The following three expressions are +semantically equivalent: + +- `g (f x)` +- `g $ f $ x` +- `x & f & g` + +Some generally useful modules from `base` package are exported, e.g. +`Control.Applicative`, `Data.Traversable`, `Data.Monoid`, `Data.List`, +and many more. + `liftIO` and `MonadIO` are exported by default. A lot of `IO` functions are generalized to `MonadIO`. -[`Bifunctor`](http://hackage.haskell.org/package/base-4.9.1.0/docs/Data-Bifunctor.html) +[`Bifunctor`](http://hackage.haskell.org/package/base/docs/Data-Bifunctor.html) type class with useful instances is exported. -* `first` and `second` functions apply a function to first/second part of a tuple (for tuples). -* `bimap` takes two functions and applies them to first and second parts respectively. +- `first` and `second` functions apply a function to the first and + second part of a `Bifunctor` (`fst` and `snd` for tuples, `Left` and + `Right` for `Either`). +- `bimap` takes two functions and applies them to the first and second parts respectively. -`trace`, `traceM`, `traceShow`, etc. are available by default. GHC will warn you -if you accidentally leave them in code, however (same for `undefined`). +`trace`, `traceM`, `traceShow`, etc. are available by default. However, GHC will +warn you if you accidentally leave them in code. Same goes for the `undefined` +function. -We also have `data Undefined = Undefined` (which, too, comes with warnings). +We also have `data Undefined = Undefined` (which also comes with the warning). `relude` reexports `Exception` type from the `base` package and introduces the -`bug` function as an alternative to `error`. There's also a very convenient +`bug` function as an alternative to `error`. There is also a very convenient `Exc` pattern-synonym to handle exceptions of different types. -See [`Relude.Exception`](src/Relude/Exception.hs) module for details on exceptions. +See +[`Relude.Exception`](http://hackage.haskell.org/package/relude/docs/Relude-Exception.html) +module for details on exceptions. ### containers & unordered-containers The following types from these two packages are exported: -Then, some commonly used types: -* Maps: strict versions of `Map`, `HashMap`, `IntMap`. -* Sets: `Set`, `HashSet`, `IntSet`. -* Sequences: `Seq`. +- Maps: strict versions of `Map`, `HashMap`, `IntMap`. +- Sets: `Set`, `HashSet`, `IntSet`. +- Sequences: `Seq`. ### text & bytestring -`relude` exports `Text` and `ByteString` (as well as synonyms `LText` and `LByteString` -for lazy versions) and some functions work with `Text` instead of `String` – -specifically, IO functions (`readFile`, `putStrLn`, etc) and `show`. In fact, `show` -is polymorphic and can produce strict or lazy `Text`, `String`, or `ByteString`. -Also, `toText/toLText/toString` can convert `Text|LText|String` types to -`Text/LText/String`. If you want to convert to and from `ByteString` use -`encodeUtf8/decodeUtf8` functions. +`relude` exports `Text` and `ByteString` (as well as their lazy versions — +`LText` and `LByteString`). -### transforms & mtl +Also, some functions now work +with `Text` instead of `String` – `words`, `lines`, etc. +In addition, `relude` provides specialised versions of the `IO` functions to +work with `Text` and `ByteString` — `readFileText`, `writeFileBS`, etc. + +`show` is polymorphic and can produce strict or lazy `Text` or +`ByteString` as well as `String`. + +Also, `toText|toLText|toString` can convert `Text|LText|String` types to +`Text|LText|String`. If you want to convert to and from `ByteString` use +`encodeUtf8|decodeUtf8` functions. + +### transformers & mtl + The following parts of these two libraries are exported: -* Transformers: `State[T]`, `Reader[T]`, `ExceptT`, `MaybeT`. -* Classes: `MonadReader`, `MonadState`, `MonadError`. +- Transformers: `State[T]`, `Reader[T]`, `ExceptT`, `MaybeT`. +- Classes: `MonadReader`, `MonadState`. ### Deepseq -`deepseq` is exported. For instance, if you want to force deep evaluation of -some value (in `IO`), you can write `evaluateNF a`. WHNF evaluation is possible -with `evaluateWHNF a`. +All the main parts of the `deepseq` library are exported. +For instance, if you want to force the deep evaluation of +some value (in `IO`), you can write `evaluateNF a`. +Additionally, the WHNF evaluation is possible +with provided `evaluateWHNF`. -## What's new? [↑](#structure-of-this-tutorial) +## What's new? -Finally, we can move to part describing the new cool features we bring with `relude`. +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) +Finally, let's move to part describing the new cool features we bring with +`relude`. + ### Available by default -* Safe analogue for list functions: use `viaNonEmpty` function to get `Maybe a`. - + `viaNonEmpty head :: [a] -> Maybe a` -* `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: +- Safe analogue for the list functions: + ```haskell + head :: NonEmpty a -> a -- the first element of the list + tail :: NonEmpty a -> [a] -- the list without the first element + last :: NonEmpty a -> a -- the last element of the list + init :: NonEmpty a -> [a] -- the list without the last element + ``` + + You can also still work with lists for these functions. Using `viaNonEmpty` + function you will get `Maybe a` from the list: + + ```haskell + -- viaNonEmpty head :: [a] -> Maybe a + ghci> viaNonEmpty head [1,2,3] + Just 1 + ghci> viaNonEmpty head [] + Nothing + ``` + +- `uncons` splits a list at the first element. +- `ordNub` and `sortNub` are _O(n log n)_ versions of `nub` (which is quadratic), + also, `hashNub` and `unstableNub` are almost _O(n)_ versions of `nub`, + and `intNub` for fast `Int`s nub. +- `whenM`, `unlessM`, `ifM`, `guardM` — monadic guard combinators, that work + with any `Monad`, e.g. `whenM (doesFileExist "foo")`. +- General fold functions: + ```haskell 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: +- `when(Just|Nothing|Left|Right|NotEmpty)[M][_]` functions that + let you conditionally execute something. + **Before:** + ```haskell case mbX of Nothing -> return () Just x -> f x ``` - After: + **After:** ```haskell whenJust mbX $ \x -> f x ``` -* `for_` for loops. There's also `forM_` but `for_` looks a bit nicer. +- `for_` and `forM_` for loops. ```haskell - for_ [1..10] $ \i -> do + for_ files $ \file -> do ... ``` -* `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 +- `andM`, `allM`, `anyM`, `orM` are monadic versions of the corresponding + functions from `base`. +- Conversions between `Either` and `Maybe`, e.g. `rightToMaybe` and `maybeToLeft` + with clear semantics. +- `using(Reader|State)[T]` functions as aliases for `flip run(Reader|State)[T]`. +- [`One` type class](http://hackage.haskell.org/package/relude/docs/Relude-Container-One.html) + for creating singleton containers (even monomorphic ones like `Text`). +- `evaluateWHNF` and `evaluateNF` functions as clearer and lifted aliases for `evaluate` and `evaluate . force`. -* `MonadFail` instance for `Either`. +- `MonadFail` instance for `Either`. -### Need to import explicitly +### Extra bonuses -* 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: +`relude` has a number of `Extra` modules that are not exposed by default (they +are not a part of the `Relude` module). You need to import such modules +separately. +These extra modules include the following functionality: + +- Convenient functions to work with `(Bounded a, Enum a)` types: + + 1. `universe :: (Bounded a, Enum a) => [a]`: get all values of the type. + + ```haskell + ghci> universe @Bool + [True,False] + ``` + + 2. `inverseMap :: (Bounded a, Enum a, Ord k) => (a -> k) -> k -> Maybe a`: + convert functions like `show` to parsers: + + ```haskell + readMyEnums :: Text -> Maybe MyEnum + readMyEnums = inverseMap myShow + ``` + +- Nice helpers to deal with `newtype`s in a more pleasant way: + ```haskell ghci> newtype Foo = Foo Bool deriving Show ghci> under not (Foo True) Foo False ``` -* Functions to operate with `CallStack`: +- Functions to operate with `CallStack`: ```haskell - >>> foo :: HasCallStack => String; foo = ownName - >>> foo + ghci> foo :: HasCallStack => String; foo = ownName + ghci> foo "foo" ``` -* `Foldable1` typeclass that contains generalized interface for folding +- `Foldable1` typeclass that contains generalized interface for folding 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](https://github.com/kowainik/relude/blob/main/src/Relude/Extra/Map.hs) as a + general interface for `Map`-like data structures. +- And much more! -Explore `Extra` modules: [`Relude.Extra`](src/Relude/Extra/) +Explore `Extra` modules: [`Relude.Extra`](http://hackage.haskell.org/package/relude/docs/Relude-Extra.html) -## Migration guide [↑](#structure-of-this-tutorial) +## Migration guide -In order to replace default `Prelude` with `relude` you should start with instructions given in -[_get started_](#get-started-) section. +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) +This section of the guide helps to migrate your project from `base` +to the `relude` library. + +In order to replace the default `Prelude` with `relude` you should start with +instructions provided in the [_Get Started_](#get-started) section. + +### Code changes + This section describes what you need to change to make your code compile with `relude`. 1. Enable `-XOverloadedStrings` extension by default for your project. 2. Since `head`, `tail`, `last` and `init` work for `NonEmpty` you should - refactor your code in one of the multiple ways described below: + refactor your code in one of the described below ways: 1. Change `[a]` to `NonEmpty a` where it makes sense. 2. Use functions which return `Maybe`. There is the `viaNonEmpty` function for this. And you can use it like `viaNonEmpty last l`. - + `tail` is `drop 1`. It's almost never a good idea to use `tail` from `Prelude`. - 3. Add `import qualified Relude.Unsafe as Unsafe` and replace function with qualified usage. -3. If you use `fromJust` or `!!` you should use them from `import qualified Relude.Unsafe as Unsafe`. + - `tail` is `drop 1`. It's almost never a good idea to use `tail` from `Prelude`. + 3. Add `import qualified Relude.Unsafe as Unsafe` and replace the function + with its qualified usage: `Unsafe.head`. +3. If you use `fromJust` or `!!` you should import them from `import qualified Relude.Unsafe as Unsafe`. 4. If you use `foldr` or `forM_` or similar for something like `Maybe a` or - `Either a b` it's recommended to replace usages of such function with + `Either a b` it is recommended to replace usages of such functions with the monomorhpic alternatives: - * `Maybe` - + `(?:) :: Maybe a -> a -> a` - + `fromMaybe :: a -> Maybe a -> a` - + `maybeToList :: Maybe a -> [a]` - + `maybeToMonoid :: Monoid m => Maybe m -> m` - + `maybe :: b -> (a -> b) -> Maybe a -> b` - + `whenJust :: Applicative f => Maybe a -> (a -> f ()) -> f ()` - + `whenJustM :: Monad m => m (Maybe a) -> (a -> m ()) -> m ()` - * `Either` - + `fromLeft :: a -> Either a b -> a` - + `fromRight :: b -> Either a b -> b` - + `either :: (a -> c) -> (b -> c) -> Either a b -> c` - + `whenRight_ :: Applicative f => Either l r -> (r -> f ()) -> f ()` - + `whenRightM_ :: Monad m => m (Either l r) -> (r -> m ()) -> m ()` + - `Maybe` -5. Forget about `String` type. - + Replace `(++)` with `(<>)` for `String`-like types. - + Try to use [`fmt`](http://hackage.haskell.org/package/fmt) library if you need to construct messages. - + 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. + - `(?:) :: Maybe a -> a -> a` + - `fromMaybe :: a -> Maybe a -> a` + - `maybeToList :: Maybe a -> [a]` + - `maybeToMonoid :: Monoid m => Maybe m -> m` + - `maybe :: b -> (a -> b) -> Maybe a -> b` + - `whenJust :: Applicative f => Maybe a -> (a -> f ()) -> f ()` + - `whenJustM :: Monad m => m (Maybe a) -> (a -> m ()) -> m ()` -## For Developers [↑](#structure-of-this-tutorial) + - `Either` + - `fromLeft :: a -> Either a b -> a` + - `fromRight :: b -> Either a b -> b` + - `either :: (a -> c) -> (b -> c) -> Either a b -> c` + - `whenRight_ :: Applicative f => Either l r -> (r -> f ()) -> f ()` + - `whenRightM_ :: Monad m => m (Either l r) -> (r -> m ()) -> m ()` +5. Replace the `String` type with more efficient and suitable ones (e.g. `Text`): + + - Replace `(++)` with `(<>)` for `String`-like types. + - 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. Since `show` doesn't come from `Show` anymore, you need to import the + `Text.Show` module if you want to implement `Show` instance manually. This can be done in the following way: + +```haskell +import qualified Text.Show + +data MyType = ... + +instance Show MyType where + show :: MyType -> String + 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, +you can run HLint with this file automatically on any CI service such as +[Travis CI](https://travis-ci.org/) or [Circle CI](https://circleci.com/). +For this you need to: + +1. Find the commit hash of the `relude` version you are using (can be found in [releases](https://github.com/kowainik/relude/releases)). +2. Run the command that downloads `.hlint.yaml` for that version. +3. Run `hlint` using this file. + +For the latest `relude` version, this can be achieved by executing the following +two commands on your CI: + +```yaml +curl https://raw.githubusercontent.com/kowainik/relude/v1.1.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 . +``` + +See an example of this feature described in the following blog post +about Travis CI settings: + +- [Kodimensional: Dead simple Haskell Travis settings for cabal and stack](https://kodimensional.dev/posts/2019-02-25-haskell-travis#customization-hlint) + +## Comparison with other alternative preludes + +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) + +There are quite a few libraries that can be used as alternative preludes in +Haskell, let's compare Relude with some of them. + +### Relude vs Protolude + +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) + +[Protolude](https://github.com/sdiehl/protolude) is one of the most popular +alternative preludes. It's also relatively small, but: + +1. `relude` has custom HLint rules specific to it: you can use them to remove + redundant imports or find hints on how to use functions from `relude`. Moreover, + the HLint rules are generated using Dhall and there is [a blog post about + this technique](https://kowainik.github.io/posts/2018-09-09-dhall-to-hlint). + This allows to maintain HLint rules with less effort, even though it is + already not an easy task. +2. One significant difference: `head` in `protolude` returns `Maybe a` while in + `relude` it works with `NonEmpty`. +3. `relude` uses type-level features to provide better error messages + on the difference from `Prelude`, and also to forbid `elem` and `notElem` + functions for `Set` and `HashSet` (because `elem` from `Foldable` runs in + _O(n)_ time and you can accidentally use `elem` from `Foldable` but with + `relude` you can't). +4. Protolude supports older GHC versions (from GHC 7.6.1) while `relude` only + supports from GHC 8.4. So if you aim ancient GHC versions, `protolude` + might be a better choice. But because of that it contains a lot of CPP, code + is scary in some places as a consequence and it is more difficult to add, + remove or change things there. +5. `relude` has much better documentation: + - [High-level overview of internal module structure](http://hackage.haskell.org/package/relude/docs/Relude.html) + - 100% Haddock coverage + - Every function has usage examples and all examples are tested with + `doctest` (which also sometimes hard to do due to the multiple GHC + versions support, but we try really hard) + - [Tutorial + migration guide](#structure-of-this-tutorial) from + `Prelude` and just general description of the whole package and libraries + it depends on. +6. `relude` has fewer dependencies and is slightly lighter because of that but still + is very powerful and useful. +7. `relude` is opt-in oriented and has a notion of `Extra.*` modules that are + not exported by default from the `Relude` module. That means that we do not + spoil the global namespace but still have a lot of useful features, like + polymorphic functions to work with every `newtype`, `Enum/Bounded`-related + useful utilities, functions to take a name of any type as `Text` and much + more. It is a straightforward process to make them accessible package-wide + with the `base-noprelude` trick! + +## For Developers + +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) + ### Generating .hlint.yaml Note, that we are using custom `hlint` setting which are `Relude` specific. To keep it up to date don't forget to reflect your changes in this file. We are -using `Dhall` to maintain the configurations. To use it follow the steps below. +using `Dhall` to maintain the configurations (lang version 22.0.0). To +use it follow the steps below. First time: ```shell -$ cabal new-install dhall-json +$ cabal v2-install dhall-yaml-1.2.10 ``` -Dhall 3.0.0 is required, so make sure that the previous command installed -dhall-json >= 1.2.4. - To generate `hlint` file: ```shell -$ dhall-to-yaml --omitNull <<< './hlint/hlint.dhall' > .hlint.yaml +$ dhall-to-yaml-ng <<< './hlint/hlint.dhall' > .hlint.yaml ``` Check that you have generated valid `.hlint.yaml` file without parse errors: @@ -372,9 +788,30 @@ 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) +- [Dhall To HLint](https://kowainik.github.io/posts/2018-09-09-dhall-to-hlint) +### Producing dependency graph -## Acknowledgement +Install `cabal-plan` first: -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/). +```shell +$ cabal v2-install cabal-plan +$ cabal-plan --version +cabal-plan 0.6.2.0 +``` + +Then draw the graph only for the library dependencies: + +```shell +cabal-plan dot --root lib:relude | dot -Tpng -o relude-dependency-graph.png +``` + +### Updating license headers + +Install the `headroom` tool and run it from this repository: + +```shell +cabal v2-install headroom-0.4.3.0 +headroom run +rg "SPDX-License-Identifier : MPL-2.0" --files-with-matches src/ | xargs sed -i 's/SPDX-License-Identifier : MPL-2.0/SPDX-License-Identifier : MIT/g' +``` diff --git a/benchmark/Main.hs b/benchmark/Main.hs --- a/benchmark/Main.hs +++ b/benchmark/Main.hs @@ -1,17 +1,11 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# LANGUAGE CPP #-} -module Main where +module Main (main) where import Relude hiding (show) import Data.List (nub) -import Gauge (Benchmark, bench, bgroup, nf) -import Gauge.Main (defaultMain) +import Test.Tasty.Bench (Benchmark, bench, bgroup, defaultMain, nf) import Prelude (show) import qualified Data.HashSet as HashSet (insert) @@ -24,6 +18,12 @@ , bgroupList listOfBig "big" , bgroupList (nStrings 'z') "small str" , bgroupList (nStrings 'c') "big str" + +#if __GLASGOW_HASKELL__ > 804 + , bgroupIntList listOfSmall "small ints" + , bgroupIntList listOfBig "big ints" +#endif + , bgroupFold ] @@ -71,6 +71,33 @@ safeSort :: [a] -> [a] safeSort = map NonEmpty.head . NonEmpty.group . sort +#if __GLASGOW_HASKELL__ > 804 +bgroupIntList + :: (Int -> [Int]) + -> String + -> Benchmark +bgroupIntList f name = bgroup name $ map ($ f) + [ bgroupNub 100 + , bgroupNub 500 + , bgroupNub 1000 + , bgroupNub 5000 + , bgroupNub 500000 + , bgroupNub 1000000 + ] + where + bgroupNub :: Int -> (Int -> [Int]) -> Benchmark + bgroupNub n listOf = bgroup (show n) nubBenchs + where + listN :: [Int] + listN = listOf n + + nubBenchs :: [Benchmark] + nubBenchs = + [ bench "ordNub" $ nf ordNub listN + , bench "intNub" $ nf intNub listN + ] +#endif + listOfSmall :: Int -> [Int] listOfSmall n = let part = n `div` 100 in concat $ replicate part [1..100] @@ -88,7 +115,8 @@ bgroupFold = do let testList = [1..100000] :: [Int] let flipFoldl' = flipfoldl' HashSet.insert mempty - let ghcFoldl' = foldl' (\hashSet element -> HashSet.insert element hashSet) mempty - bgroup "foldl'" [ bench "flipped" $ nf flipFoldl' testList - , bench "base" $ nf ghcFoldl' testList - ] + let ghcFoldl' = foldl' (\hash el -> HashSet.insert el hash) mempty + bgroup "foldl'" + [ bench "flipped" $ nf flipFoldl' testList + , bench "base" $ nf ghcFoldl' testList + ] diff --git a/relude.cabal b/relude.cabal --- a/relude.cabal +++ b/relude.cabal @@ -1,72 +1,151 @@ -cabal-version: 2.0 +cabal-version: 3.0 name: relude -version: 0.4.0 -synopsis: Custom prelude from Kowainik +version: 1.2.2.2 +synopsis: Safe, performant, user-friendly and lightweight Haskell Standard Library description: - == 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 - you can still use some unsafe functions from @Relude.Unsafe@ module, but they - are not exported by default. - . - * __Type-safety__. We like to make invalid states unrepresantable. And if it's - possible to express this concept through the types then we will do it. - /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@). - . - * __Minimalism__ (low number of dependencies). We don't force users of @relude@ to - stick to some specific lens or text formatting or logging library. - . - * __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. - . - * __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)@ - . - * __User-friendliness.__ Ability to quickly migrate to @relude@ if you're familiar - with the common libraries like @text@ and @containers@. - . - * __Exploration.__ Experiment with new ideas and proposals without introducing - breaking changes. + @__relude__@ is an alternative prelude library. If you find the default + @Prelude@ unsatisfying, despite its advantages, consider using @relude@ + instead. + == Relude goals and design principles + * __Productivity.__ You can be more productive with a "non-standard" standard + library, and @relude@ helps you with writing safer and more + efficient code faster. + + * __Total programming__. Usage of [/partial functions/](https://www.reddit.com/r/haskell/comments/5n51u3/why_are_partial_functions_as_in_head_tail_bad/) + can lead to unexpected bugs and runtime exceptions in pure + code. The types of partial functions lie about their behaviour. And + even if it is not always possible to rely only on total functions, + @relude@ strives to encourage best-practices and reduce the + chances of introducing a bug. + + +---------------------------------+--------------------------------------------+ + | __Partial__ | __Total__ | + +=================================+============================================+ + | @head :: [a] -> a@ | @head :: NonEmpty a -> a@ | + +---------------------------------+--------------------------------------------+ + | @tail :: [a] -> [a]@ | @tail :: NonEmpty a -> [a]@ | + +---------------------------------+--------------------------------------------+ + | @read :: Read a => String -> a@ | @readMaybe :: Read a => String -> Maybe a@ | + +---------------------------------+--------------------------------------------+ + | @fromJust :: Maybe a -> a@ | @fromMaybe :: a -> Maybe a -> a@ | + +---------------------------------+--------------------------------------------+ + + * __Type-safety__. We use the /"make invalid states unrepresentable"/ motto as one + of our guiding principles. If it is possible, we express this concept through the + types. + + /Example:/ @ whenNotNull :: Applicative f => [a] -> (NonEmpty a -> f ()) -> f () @ + + * __Performance.__ We prefer @Text@ over @[String](https://www.reddit.com/r/haskell/comments/29jw0s/whats_wrong_with_string/)@, + use space-leaks-free functions (e.g. our custom performant @sum@ and @product@), + introduce @\{\-\# INLINE \#\-\}@ and @\{\-\# SPECIALIZE \#\-\}@ pragmas where + appropriate, and make efficient container types + (e.g. @Map@, @HashMap@, @Set@) more accessible. + + * __Minimalism__ (low number of dependencies). We do not force users of + @relude@ to stick to any specific lens or text formatting or logging + library. Where possible, @relude@ depends only on boot libraries. + The [Dependency graph](https://raw.githubusercontent.com/kowainik/relude/main/relude-dependency-graph.png) + of @relude@ can give you a clearer picture. + + * __Convenience__. Despite minimalism, we want to bring commonly used + types and functions into scope, and make available functions easier + to use. Some examples of conveniences: + + 1. No need to add @containers@, @unordered-containers@, @text@ + and @bytestring@ to dependencies in your @.cabal@ file to + use the main API of these libraries + 2. No need to import types like @NonEmpty@, @Text@, @Set@, @Reader[T]@, @MVar@, @STM@ + 3. Functions like @liftIO@, @fromMaybe@, @sortWith@ are available by default as well + 4. @IO@ actions are lifted to @MonadIO@ + + * __Excellent documentation.__ + + 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/main/.hlint.yaml)@ + + * __User-friendliness.__ Anyone should be able to quickly migrate to @relude@. Only + some basic familiarity with the common libraries like @text@ and @containers@ + should be enough (but not necessary). + + * __Exploration.__ We have space to experiment with new ideas and proposals + without introducing breaking changes. @relude@ uses the approach with + @Extra.*@ modules which are not exported by default. The chosen approach makes it quite + easy for us to provide new functionality without breaking anything and let + the 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: Stephen Diehl, @serokell, Kowainik +author: Dmitrii Kovanikov, Veronika Romashkina, Stephen Diehl, Serokell maintainer: Kowainik -copyright: 2016 Stephen Diehl, 2016-2018 Serokell, 2018 Kowainik +copyright: 2016 Stephen Diehl, 2016-2018 Serokell, 2018-2023 Kowainik category: Prelude stability: stable build-type: Simple -tested-with: GHC == 8.0.2 - , GHC == 8.2.2 - , GHC == 8.4.3 - , GHC == 8.6.1 extra-doc-files: CHANGELOG.md - , CONTRIBUTING.md - , README.md + README.md +tested-with: GHC == 8.4.4 + GHC == 8.6.5 + GHC == 8.8.4 + GHC == 8.10.7 + GHC == 9.0.2 + GHC == 9.2.8 + GHC == 9.4.7 + GHC == 9.6.6 + GHC == 9.8.2 + GHC == 9.10.1 + source-repository head type: git location: git@github.com:kowainik/relude.git +common common-options + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -fwarn-implicit-prelude + -Wredundant-constraints + -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.8) + ghc-options: -Wmissing-deriving-strategies + if impl(ghc >= 8.10) + ghc-options: -Wunused-packages + if impl(ghc >= 9.0) + ghc-options: -Winvalid-haddock + if impl(ghc >= 9.2) + ghc-options: -Wredundant-bang-patterns + -Woperator-whitespace + if impl(ghc >= 9.4 && < 9.10) + ghc-options: -Wforall-identifier + if impl(ghc >= 9.4) + ghc-options: -Wredundant-strictness-flags + if impl(ghc >= 9.8) + ghc-options: -Wterm-variable-capture + -Winconsistent-flags + + + default-language: Haskell2010 + default-extensions: InstanceSigs + NoImplicitPrelude + OverloadedStrings + ScopedTypeVariables + TypeApplications + library + import: common-options hs-source-dirs: src exposed-modules: Relude @@ -80,6 +159,7 @@ Relude.Container.Reexport Relude.Debug Relude.DeepSeq + Relude.Enum Relude.Exception Relude.File Relude.Foldable @@ -95,6 +175,8 @@ Relude.Lifted.File Relude.Lifted.IORef Relude.Lifted.Terminal + Relude.Lifted.Handle + Relude.Lifted.Env Relude.List Relude.List.NonEmpty Relude.List.Reexport @@ -105,107 +187,106 @@ Relude.Monad.Trans Relude.Monoid Relude.Nub + Relude.Numeric Relude.Print Relude.String Relude.String.Conversion Relude.String.Reexport -- not exported by default - Relude.Extra.Bifunctor - Relude.Extra.CallStack - Relude.Extra.Enum - Relude.Extra.Foldable1 - Relude.Extra.Group - Relude.Extra.Map - Relude.Extra.Newtype - Relude.Extra.Tuple - Relude.Extra.Type - Relude.Extra.Validation + Relude.Extra + Relude.Extra.Bifunctor + Relude.Extra.CallStack + Relude.Extra.Enum + Relude.Extra.Foldable + Relude.Extra.Foldable1 + Relude.Extra.Group + Relude.Extra.Lens + Relude.Extra.Map + Relude.Extra.Newtype + Relude.Extra.Tuple + Relude.Extra.Type Relude.Unsafe - ghc-options: -Wall - -Wcompat - -Widentities - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -fwarn-implicit-prelude + reexported-modules: + -- containers + , Data.IntMap.Lazy + , Data.IntMap.Strict + , Data.IntSet + , Data.Map.Lazy + , Data.Map.Strict + , Data.Set + , Data.Sequence + , Data.Tree + -- unordered-containers + , Data.HashMap.Lazy + , Data.HashMap.Strict + , Data.HashSet + -- text + , Data.Text + , Data.Text.IO + , Data.Text.Lazy + , Data.Text.Lazy.IO + , Data.Text.Read + -- bytestring + , Data.ByteString + , Data.ByteString.Builder + , Data.ByteString.Lazy + , Data.ByteString.Short - build-depends: base >= 4.9 && < 5 - , bytestring ^>= 0.10 - , containers >= 0.5.7 && < 0.7 - , deepseq ^>= 1.4 - , ghc-prim >= 0.4.0.0 && < 0.6 - , hashable ^>= 1.2 - , mtl ^>= 2.2 + + build-depends: base >= 4.11 && < 4.22 + , bytestring >= 0.10 && < 0.13 + , containers >= 0.5.10 && < 0.9 + , deepseq >= 1.4 && < 1.6 + , ghc-prim >= 0.5.0.0 && < 0.14 + , hashable >= 1.2 && < 1.6 + , mtl >= 2.2 && < 2.4 , stm >= 2.4 && < 2.6 - , text ^>= 1.2 - , transformers ^>= 0.5 + , text >= 1.2 && < 2.2 + , transformers >= 0.5 && < 0.7 , 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 + other-modules: Test.Relude.Gen + Test.Relude.Container.One + Test.Relude.Property + build-depends: base , relude , bytestring + , containers , text - , hedgehog >= 0.6 - , tasty - , tasty-hedgehog - - ghc-options: -Wall - -threaded - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wcompat - -Widentities - -Wredundant-constraints + , hedgehog >= 1.0 && < 1.6 - 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 - , doctest + build-depends: relude + , doctest >= 0.20 && < 0.25 , Glob 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 + build-depends: base , relude - , containers - , gauge + , tasty-bench , unordered-containers - ghc-options: -Wall - -threaded - -rtsopts - -with-rtsopts=-N - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wcompat - -Widentities - -Wredundant-constraints - - default-language: Haskell2010 - default-extensions: NoImplicitPrelude - ScopedTypeVariables + ghc-options: -rtsopts diff --git a/src/Relude.hs b/src/Relude.hs --- a/src/Relude.hs +++ b/src/Relude.hs @@ -1,129 +1,140 @@ -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -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': +@relude@ is a safe, performant, user-friendly and lightweight Haskell +standard library. -@ -\{\-\# LANGUAGE NoImplicitPrelude \#\-\} +"Relude" is the main module that reexports all functionality provided by the library that will replace the default @Prelude@ in your project. -__import__ "Relude" +== Usage + +To start using @relude@ in your project, you can set the library up for you by +one of the following ways. + +=== mixins + +One of the most convenient ways to use @relude@ is via the @mixins@ feature. This +feature is available since @Cabal >= 2.2@. In order to use the @mixins@ feature +one needs to specify supported @cabal-version@ in your package description. +And then the following lines should be added to the required stanza to replace +default "Prelude" with @relude@. + @ +cabal-version: 2.4 +... +library + ... + mixins: base hiding (Prelude) + , relude (Relude as Prelude) + , relude +@ +=== @base-noprelude@ + 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 @base@ "Prelude": @ -__module__ Prelude (__module__ "Relude") __where__ +__module__ Prelude + ( __module__ "Relude" + ) __where__ + __import__ "Relude" @ +=== @NoImplicitPrelude@ + +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" +@ + +== Structure + 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). Functions and types are distributed across multiple modules and grouped by meaning or __category__. Name of the module should give you hints regarding what -this module contains. Some /categories/ contain a significant amount of both reexported +this module contains. Some /categories/ contain a significant amount of both +reexported functions and functions of our own. To make it easier to understand these enormous chunks of functions, all reexported stuff is moved into the separate module with name @Relude.SomeCategory.Reexport@ and our own functions and types are in @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.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 -every module in your package by modifying your "Prelude" file: - -* __"Relude.Extra.Bifunctor"__: additional combinators for 'Bifunctor'. -* __"Relude.Extra.CallStack"__: useful functions to extract information from - '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.Group"__: grouping functions, polymorphic on return @Map@ type. -* __"Relude.Extra.Map"__: typeclass for @Map@-like data structures. -* __"Relude.Extra.Newtype"__: generic functions that automatically work for any - @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.Unsafe"__: unsafe partial functions (produce 'error') for lists and - 'Maybe'. -} module Relude - ( -- * Reexports from base and from modules in this repo - module Relude.Applicative - , module Relude.Base - , module Relude.Bool - , module Relude.Container - , module Relude.Debug - , module Relude.DeepSeq - , module Relude.Exception - , module Relude.File - , module Relude.Foldable - , module Relude.Function - , module Relude.Functor - , module Relude.Lifted - , module Relude.List - , module Relude.Monad - , module Relude.Monoid - , module Relude.Nub - , module Relude.Print - , module Relude.String - ) where + ( -- * Default Modules + 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.Enum + -- $enum + , 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 + -- * Extra Modules + -- $extra + ) where + import Relude.Applicative import Relude.Base import Relude.Bool import Relude.Container import Relude.Debug import Relude.DeepSeq +import Relude.Enum import Relude.Exception import Relude.File import Relude.Foldable @@ -134,5 +145,143 @@ import Relude.Monad import Relude.Monoid import Relude.Nub +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 element 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. +-} + +{- $enum +__"Relude.Enum"__ reexports 'Enum' related typeclasses and functions. Also +introduced a few useful helpers to work with Enums. +-} + +{- $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 transformers 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. +-} + +{- $extra +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"__ | Reexports every @Relude.Extra.*@ module | ++------------------------------+-----------------------------------------------------------+ +| __"Relude.Extra.Bifunctor"__ | Additional combinators for 'Bifunctor'. | ++------------------------------+-----------------------------------------------------------+ +| __"Relude.Extra.CallStack"__ | Useful functions to extract information from 'CallStack'. | ++------------------------------+-----------------------------------------------------------+ +| __"Relude.Extra.Enum"__ | Extra utilities for types that implement 'Bounded' | +| | and 'Enum' constraints. | ++------------------------------+-----------------------------------------------------------+ +| __"Relude.Extra.Foldable"__ | Extra folds for instances of the 'Foldable' typeclass. | +| | Currently, just a short-circuitable left fold. | ++------------------------------+-----------------------------------------------------------+ +| __"Relude.Extra.Foldable1"__ | t'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. | ++------------------------------+-----------------------------------------------------------+ +| __"Relude.Extra.Map"__ | Typeclass for @Map@-like data structures. | ++------------------------------+-----------------------------------------------------------+ +| __"Relude.Extra.Newtype"__ | Generic functions that automatically work for any | +| | @newtype@. | ++------------------------------+-----------------------------------------------------------+ +| __"Relude.Extra.Tuple"__ | Functions for working with tuples. | ++------------------------------+-----------------------------------------------------------+ +| __"Relude.Extra.Type"__ | Functions for inspecting and working with types. | ++------------------------------+-----------------------------------------------------------+ +| __"Relude.Unsafe"__ | Unsafe partial functions (produce 'error') for lists and | +| | 'Maybe'. | ++------------------------------+-----------------------------------------------------------+ + +-} diff --git a/src/Relude/Applicative.hs b/src/Relude/Applicative.hs --- a/src/Relude/Applicative.hs +++ b/src/Relude/Applicative.hs @@ -1,51 +1,78 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Applicative +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Convenient utils to work with 'Applicative'. There were more functions in this module -(see ) -but only convenient ans most used are left. +This module contains reexports of 'Applicative' and related functional. +Additionally, it provides convenient combinators to work with 'Applicative'. -} module Relude.Applicative - ( module Control.Applicative - , pass - ) where + ( -- * Reexports + -- $reexports + Alternative (..) + , Applicative (..) + , Const (..) + , ZipList (..) + , liftA3 + , optional + , (<**>) + -- * Combinators + , pass + , appliedTo + ) where + import Control.Applicative (Alternative (..), Applicative (..), Const (..), ZipList (..), liftA2, liftA3, optional, (<**>)) + -- $setup +-- >>> import Relude -- >>> import Relude.Monad (Maybe) --- | Shorter alias for @pure ()@. --- --- >>> pass :: Maybe () --- Just () -pass :: Applicative f => f () -pass = pure () +{- | Shorter alias for @pure ()@. -{- -orAlt :: (Alternative f, Monoid a) => f a -> f a -orAlt f = f <|> pure mempty +>>> pass :: Maybe () +Just () -orEmpty :: Alternative f => Bool -> a -> f a -orEmpty b a = if b then pure a else empty +Useful shortcut when need an empty action: -eitherA :: Alternative f => f a -> f b -> f (Either a b) -eitherA a b = (Left <$> a) <|> (Right <$> b) +@ +printJust :: Maybe Int -> IO () +printJust mInt = case mInt of + Just i -> putStrLn $ "Number: " ++ show i + Nothing -> pass +@ +-} +pass :: Applicative f => f () +pass = pure () +{-# INLINE pass #-} -purer :: (Applicative f, Applicative g) => a -> f (g a) -purer = pure . pure +{- | Named version of the '<**>' operator, which is '<*>' but flipped. It is +helpful for chaining applicative operations in forward applications using +'Relude.Function.&'. -liftAA2 :: (Applicative f, Applicative g) => (a -> b -> c) -> f (g a) -> f (g b) -> f (g c) -liftAA2 = liftA2 . liftA2 +>>> Just (+ 1) & appliedTo (Just 2) +Just 3 +>>> Just (+) & appliedTo (Just 1) & appliedTo (Just 2) +Just 3 +>>> Nothing & appliedTo (Just 2) +Nothing -(<<*>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b) -(<<*>>) = liftA2 (<*>) +@since 0.5.0 +-} +appliedTo :: Applicative f => f a -> f (a -> b) -> f b +appliedTo = (<**>) +{-# INLINE appliedTo #-} + +{- $reexports +Main data types and functions reexported from "Control.Applicative". -} diff --git a/src/Relude/Base.hs b/src/Relude/Base.hs --- a/src/Relude/Base.hs +++ b/src/Relude/Base.hs @@ -1,93 +1,79 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE Unsafe #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE Trustworthy #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Base +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Reexports from @Data.*@ and @GHC.*@ modules of - package. + package. -} module Relude.Base - ( -- * Base types - module Data.Bits - , module Data.Char - , module Data.Int - , module Data.Word - , Natural - - -- * Base type classes - , module Data.Eq - , module Data.Ord - - -- * System IO - , module System.IO + ( -- * Base types + module Data.Char - -- * Types for type-level computation - , module Data.Coerce - , module Data.Kind - , module Data.Proxy - , module Data.Typeable - , module Data.Void + -- * Base type classes + , module Data.Eq + , module Data.Ord - , module GHC.Base - , module GHC.Enum - , module GHC.Float - , module GHC.Generics - , module GHC.Num - , module GHC.Real - , module GHC.Show + -- * System IO + , module System.IO -#if MIN_VERSION_base(4,10,0) - , module GHC.TypeNats -#else - , module GHC.TypeLits + -- * Types for type-level computation + , module Data.Coerce + , module Data.Kind + , module Data.Proxy +#if __GLASGOW_HASKELL__ >= 904 + , module Data.Type.Equality #endif + , module Data.Typeable + , module Data.Void - , module GHC.OverloadedLabels - , module GHC.ExecutionStack - , module GHC.Stack - ) where + -- * Basic type classes + , module GHC.Base + , module GHC.Generics + , module GHC.Show +-- * GHC-specific functionality + , module GHC.TypeNats + , module GHC.OverloadedLabels + , module GHC.ExecutionStack + , module GHC.Stack + ) where + -- Base types -import Data.Bits (xor) import Data.Char (Char, chr) -import Data.Int (Int, Int16, Int32, Int64, Int8) -import Data.Word (Word, Word16, Word32, Word64, Word8, byteSwap16, byteSwap32, byteSwap64) -import Numeric.Natural (Natural) -- IO -import System.IO (FilePath, Handle, IO, IOMode (..), stderr, stdin, stdout, withFile) +import System.IO (FilePath, IO, IOMode (..)) -- Base typeclasses -import Data.Eq (Eq (..)) +import Data.Eq (Eq, (/=), (==)) import Data.Ord (Down (..), Ord (..), Ordering (..), comparing) -- Types for type-level computation import Data.Coerce (Coercible, coerce) import Data.Kind (Constraint, Type) import Data.Proxy (Proxy (..)) +#if __GLASGOW_HASKELL__ >= 904 +import Data.Type.Equality (type (~)) +#endif import Data.Typeable (Typeable) import Data.Void (Void, absurd, vacuous) -import GHC.Base (String, asTypeOf, maxInt, minInt, ord, seq, ($!)) -import GHC.Enum (Bounded (..), Enum (..), boundedEnumFrom, boundedEnumFromThen) -import GHC.Float (Double (..), Float (..), Floating (acos, acosh, asin, asinh, atan, atanh, cos, cosh, exp, logBase, pi, sin, sinh, sqrt, tan, tanh, (**))) +import GHC.Base (asTypeOf, ord, seq, ($!)) import GHC.Generics (Generic) -import GHC.Num (Integer, Num (..), subtract) -import GHC.Real (Fractional (..), Integral (..), Ratio, Rational, Real (..), RealFrac (..), - denominator, even, fromIntegral, gcd, lcm, numerator, odd, realToFrac, (^), (^^)) import GHC.Show (Show) -#if MIN_VERSION_base(4,10,0) import GHC.TypeNats (CmpNat, KnownNat, Nat, SomeNat (..), natVal, someNatVal) -#else -import GHC.TypeLits (CmpNat, KnownNat, Nat, SomeNat (..), natVal, someNatVal) -#endif import GHC.ExecutionStack (getStackTrace, showStackTrace) import GHC.OverloadedLabels (IsLabel (..)) diff --git a/src/Relude/Bool.hs b/src/Relude/Bool.hs --- a/src/Relude/Bool.hs +++ b/src/Relude/Bool.hs @@ -1,20 +1,34 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Bool +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Convenient commonly used and very helpful functions to work with 'Bool' and also with monads. -} module Relude.Bool - ( module Relude.Bool.Guard - , module Relude.Bool.Reexport - ) where + ( module Relude.Bool.Reexport + -- $reexport + , module Relude.Bool.Guard + -- $guard + ) where import Relude.Bool.Guard import Relude.Bool.Reexport + +{- $reexport +Reexports from "Data.Bool" and "Control.Monad". Includes necessary types and +functions to work with 'Bool' type. +-} + +{- $guard +Boolean combinators that work in monads. Like 'ifM' or 'guardM'. +-} diff --git a/src/Relude/Bool/Guard.hs b/src/Relude/Bool/Guard.hs --- a/src/Relude/Bool/Guard.hs +++ b/src/Relude/Bool/Guard.hs @@ -1,26 +1,34 @@ +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Bool.Guard +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Monadic boolean combinators. -} module Relude.Bool.Guard - ( guardM - , ifM - , unlessM - , whenM - , (&&^) - , (||^) - ) where + ( guarded + , guardM + , ifM + , unlessM + , whenM + , (&&^) + , (||^) + ) where +import Relude.Applicative (Alternative, Applicative (..), empty) import Relude.Bool.Reexport (Bool (..), guard, unless, when) import Relude.Function (flip) -import Relude.Monad (Monad, return, MonadPlus, (>>=)) +import Relude.Monad (Monad, MonadPlus, (>>=)) + -- $setup -- >>> import Relude.Applicative (pure) -- >>> import Relude.Bool.Reexport (Bool (..)) @@ -28,67 +36,144 @@ -- >>> import Relude.Function (($)) -- >>> import Relude.Monad (Maybe (..)) -- >>> import Relude.Print (putTextLn) +-- >>> import Relude (Int, String, even, const) --- | Monadic version of 'when'. --- --- >>> whenM (pure False) $ putTextLn "No text :(" --- >>> whenM (pure True) $ putTextLn "Yes text :)" --- Yes text :) --- >>> whenM (Just True) (pure ()) --- Just () --- >>> whenM (Just False) (pure ()) --- Just () --- >>> whenM Nothing (pure ()) --- Nothing +{- | Monadic version of 'when'. +Conditionally executes the provided action. + +>>> whenM (pure False) $ putTextLn "No text :(" +>>> whenM (pure True) $ putTextLn "Yes text :)" +Yes text :) +>>> whenM (Just True) (pure ()) +Just () +>>> whenM (Just False) (pure ()) +Just () +>>> whenM Nothing (pure ()) +Nothing +-} whenM :: Monad m => m Bool -> m () -> m () whenM p m = p >>= flip when m {-# INLINE whenM #-} --- | Monadic version of 'unless'. --- --- >>> unlessM (pure False) $ putTextLn "No text :(" --- No text :( --- >>> unlessM (pure True) $ putTextLn "Yes text :)" +{- | Monadic version of 'unless'. Reverse of 'whenM'. +Conditionally don't execute the provided action. + +>>> unlessM (pure False) $ putTextLn "No text :(" +No text :( +>>> unlessM (pure True) $ putTextLn "Yes text :)" +-} unlessM :: Monad m => m Bool -> m () -> m () unlessM p m = p >>= flip unless m {-# INLINE unlessM #-} --- | Monadic version of @if-then-else@. --- --- >>> ifM (pure True) (putTextLn "True text") (putTextLn "False text") --- True text +{- | Monadic version of @if-then-else@. + +>>> ifM (pure True) (putTextLn "True text") (putTextLn "False text") +True text +>>> ifM (pure False) (putTextLn "True text") (putTextLn "False text") +False text +-} ifM :: Monad m => m Bool -> m a -> m a -> m a ifM p x y = p >>= \b -> if b then x else y {-# INLINE ifM #-} --- | Monadic version of 'guard'. Occasionally useful. --- Here some complex but real-life example: --- --- @ --- findSomePath :: IO (Maybe FilePath) --- --- somePath :: MaybeT IO FilePath --- somePath = do --- path <- MaybeT findSomePath --- guardM $ liftIO $ doesDirectoryExist path --- return path --- @ +{- | Monadic version of 'guard' that help to check that a condition ('Bool') +holds inside. Works with 'Monad's that are also 'Alternative'. + +>>> guardM (Just True) +Just () +>>> guardM (Just False) +Nothing +>>> guardM Nothing +Nothing + +Here some complex but real-life example: + +@ +findSomePath :: IO (Maybe FilePath) + +somePath :: MaybeT IO FilePath +somePath = do + path <- MaybeT findSomePath + guardM $ liftIO $ doesDirectoryExist path + return path +@ +-} guardM :: MonadPlus m => m Bool -> m () guardM f = f >>= guard {-# INLINE guardM #-} --- | Monadic version of 'Data.Bool.(&&)' operator. --- --- >>> Just False &&^ error "Shouldn't be evaluated" --- Just False +{- | Either lifts a value into an alternative context or gives a +minimal value depending on a predicate. Works with 'Alternative's. + +>>> 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. + +It is lazy by the second argument (similar to '(Data.Bool.||)'), meaning that if +the first argument is 'False', the function will return 'False' without evaluating +the second argument. + +>>> Just False &&^ Just True +Just False +>>> Just True &&^ Just True +Just True +>>> Just True &&^ Nothing +Nothing +>>> Just False &&^ Nothing +Just False +>>> Just False &&^ error "Shouldn't be evaluated" +Just False + +@since 0.4.0 +-} (&&^) :: 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. --- --- >>> Just True ||^ error "Shouldn't be evaluated" --- Just True +{- | Monadic version of '(Data.Bool.||)' operator. + +It is lazy by the second argument (similar to '(Data.Bool.||)'), meaning that if +the first argument is 'True', the function will return 'True' without evaluating +the second argument. + +>>> Just False ||^ Just True +Just True +>>> Just False ||^ Just False +Just False +>>> Just False ||^ Nothing +Nothing +>>> Just True ||^ Nothing +Just True +>>> Just True ||^ error "Shouldn't be evaluated" +Just True + +@since 0.4.0 +-} (||^) :: Monad m => m Bool -> m Bool -> m Bool -(||^) e1 e2 = ifM e1 (return True) e2 +e1 ||^ e2 = ifM e1 (pure True) e2 {-# INLINE (||^) #-} diff --git a/src/Relude/Bool/Reexport.hs b/src/Relude/Bool/Reexport.hs --- a/src/Relude/Bool/Reexport.hs +++ b/src/Relude/Bool/Reexport.hs @@ -1,17 +1,31 @@ +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Bool.Reexport +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Reexports functions to work with 'Bool' type. -} module Relude.Bool.Reexport - ( module Control.Monad - , module Data.Bool - ) where + ( -- * "Data.Bool" reexports + Bool (..) + , bool + , not + , otherwise + , (&&) + , (||) + -- * "Control.Monad" reexports + , guard + , when + , unless + ) where import Control.Monad (guard, unless, when) import Data.Bool (Bool (..), bool, not, otherwise, (&&), (||)) diff --git a/src/Relude/Container.hs b/src/Relude/Container.hs --- a/src/Relude/Container.hs +++ b/src/Relude/Container.hs @@ -1,17 +1,39 @@ +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Container +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable This module exports all container-related stuff. -} module Relude.Container - ( module Relude.Container.One - , module Relude.Container.Reexport - ) where + ( module Relude.Container.One + -- $one + , module Relude.Container.Reexport + -- $reexport + ) where import Relude.Container.One import Relude.Container.Reexport + +{- $one +'One' is a typeclass for creating structures from a singleton element. +This module provides many useful instances of 'One' for common containers +as well. +-} + +{- $reexport +Reexports container-related functions, typeclasses and data types from +the following packages: + +* [@base@](https://hackage.haskell.org/package/base) +* [@containers@](https://hackage.haskell.org/package/containers) +* [@unordered-containers@](https://hackage.haskell.org/package/unordered-containers) +-} diff --git a/src/Relude/Container/One.hs b/src/Relude/Container/One.hs --- a/src/Relude/Container/One.hs +++ b/src/Relude/Container/One.hs @@ -1,23 +1,36 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE TypeFamilies #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Container.One +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Typeclass for creating structures from singleton element. +'One' is a 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 'Relude.Applicative.pure' + or @(:[])@. + +@since 0.1.0 -} module Relude.Container.One - ( One (..) - ) where + ( One (..) + ) where -import Relude.Base (Char, Int, Word8) +import Relude.Base (Char) import Relude.Container.Reexport (HashMap, HashSet, Hashable, IntMap, IntSet, Map, Set, uncurry) +import Relude.Numeric (Int, Word8) import qualified Data.List.NonEmpty as NE @@ -25,6 +38,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 @@ -37,12 +51,10 @@ import qualified Data.Set as Set -- $setup --- >>> import Relude.Base (Int, String) --- >>> import Relude.Bool (Bool (..)) --- >>> import Relude.String (Text) --- >>> import qualified Data.HashMap.Strict as HashMap +-- >>> import Relude {- | Typeclass for data types that can be created from one element. +E.g. lists, non-empty containers, maps. >>> one True :: [Bool] [True] @@ -50,82 +62,251 @@ "a" >>> one (3, "hello") :: HashMap Int String fromList [(3,"hello")] + +__Laws:__ + +* __@single-size@__: @∀ x . size (one x) ≡ 1@ + +(where @size@ is a specific function for each container that returns the size of +this container) -} class One x where - -- | Type of single element of the structure. + -- | Type of a 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 'Relude.Applicative.pure' or @(:[])@. + +>>> one 42 :: [Int] +[42] + +@ +law> 'Relude.Foldable.Reexport.length' ('one' @[a] x) ≡ 1 +@ +-} 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 'Relude.Applicative.pure' or @(:|[])@. + +>>> one 42 :: NonEmpty Int +42 :| [] + +@ +law> 'Relude.Foldable.Reexport.length' ('one' @('NE.NonEmpty' a) x) ≡ 1 +@ +-} instance One (NE.NonEmpty a) where type OneItem (NE.NonEmpty a) = a + + one :: a -> NE.NonEmpty a one = (NE.:|[]) {-# INLINE one #-} +{- | Create singleton 'SEQ.Seq'. + +>>> one 42 :: Seq Int +fromList [42] + +@ +law> 'Relude.Foldable.Reexport.length' ('one' @('SEQ.Seq' a) x) ≡ 1 +@ +-} instance One (SEQ.Seq a) where type OneItem (SEQ.Seq a) = a - one = (SEQ.empty SEQ.|>) + + one :: a -> SEQ.Seq a + one = SEQ.singleton {-# INLINE one #-} -- Monomorphic sequences +{- | Create singleton strict 'T.Text'. + +>>> one 'a' :: Text +"a" + +@ +law> 'Data.Text.length' ('one' x) ≡ 1 +@ +-} instance One T.Text where type OneItem T.Text = Char + + one :: Char -> T.Text one = T.singleton {-# INLINE one #-} +{- | Create singleton lazy 'TL.Text'. + +>>> one 'a' :: LText +"a" + +@ +law> 'Data.Text.Lazy.length' ('one' x) ≡ 1 +@ +-} instance One TL.Text where type OneItem TL.Text = Char + + one :: Char -> TL.Text one = TL.singleton {-# INLINE one #-} +{- | Create singleton strict 'BS.ByteString'. + +>>> one 97 :: ByteString +"a" + +@ +law> 'BS.length' ('one' x) ≡ 1 +@ +-} instance One BS.ByteString where type OneItem BS.ByteString = Word8 + + one :: Word8 -> BS.ByteString one = BS.singleton {-# INLINE one #-} +{- | Create singleton lazy 'BSL.ByteString'. + +>>> one 97 :: LByteString +"a" + +@ +law> 'BSL.length' ('one' x) ≡ 1 +@ +-} 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" + +@ +law> 'SBS.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. + +>>> one (3, "foo") :: Map Int Text +fromList [(3,"foo")] + +@ +law> 'Relude.Foldable.Reexport.length' ('one' @('Map' k v) (k, v)) ≡ 1 +@ +-} 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 #-} +{- | Create singleton 'HashMap' from key-value pair. + +>>> one (3, "foo") :: HashMap Int Text +fromList [(3,"foo")] + +@ +law> 'Relude.Foldable.Reexport.length' ('one' @('HashMap' k v) (k, v)) ≡ 1 +@ +-} 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 #-} +{- | Create singleton 'IntMap' from key-value pair. + +>>> one (3, "foo") :: IntMap Text +fromList [(3,"foo")] + +@ +law> 'Relude.Foldable.Reexport.length' ('one' @('IntMap' a) x) ≡ 1 +@ +-} instance One (IntMap v) where type OneItem (IntMap v) = (Int, v) + + one :: (Int, v) -> IntMap v one = uncurry IM.singleton {-# INLINE one #-} -- Sets -instance One (Set v) where - type OneItem (Set v) = v +{- | Create singleton 'Set'. + +>>> one 42 :: Set Int +fromList [42] + +@ +law> 'Relude.Foldable.Reexport.length' ('one' @('Set' a) x) ≡ 1 +@ +-} +instance One (Set a) where + type OneItem (Set a) = a + + one :: a -> Set a one = Set.singleton {-# INLINE one #-} -instance Hashable v => One (HashSet v) where - type OneItem (HashSet v) = v +{- | Create singleton 'HashSet'. + +>>> one 42 :: HashSet Int +fromList [42] + +@ +law> 'Relude.Foldable.Reexport.length' ('one' @('HashSet' a) x) ≡ 1 +@ +-} +instance Hashable a => One (HashSet a) where + type OneItem (HashSet a) = a + + one :: a -> HashSet a one = HashSet.singleton {-# INLINE one #-} +{- | Create singleton 'IntSet'. + +>>> one 42 :: IntSet +fromList [42] + +@ +law> 'Data.IntSet.size' ('one' x) ≡ 1 +@ +-} instance One IntSet where type OneItem IntSet = Int + + one :: Int -> IntSet one = IS.singleton {-# INLINE one #-} diff --git a/src/Relude/Container/Reexport.hs b/src/Relude/Container/Reexport.hs --- a/src/Relude/Container/Reexport.hs +++ b/src/Relude/Container/Reexport.hs @@ -1,26 +1,45 @@ +{-# LANGUAGE Trustworthy #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Container.Reexport +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Reexports all container-related stuff from @base@, @containers@ and -@unordered-containers@ packages. +Reexports container-related data types, functions and typeclasses from @base@, +@containers@ and @unordered-containers@ packages. -} module Relude.Container.Reexport - ( module Data.Hashable - , module Data.HashMap.Strict - , module Data.HashSet - , module Data.IntMap.Strict - , module Data.IntSet - , module Data.Map.Strict - , module Data.Sequence - , module Data.Set - , module Data.Tuple - , module GHC.Exts - ) where + ( -- * "Data.Hashable" reexports + Hashable (..) + -- * "Data.HashMap.Strict" reexports + , HashMap + -- * "Data.HashSet" reexports + , HashSet + -- * "Data.IntMap.Strict" reexports + , IntMap + -- * "Data.IntSet" reexports + , IntSet + -- * "Data.Map.Strict" reexports + , Map + -- * "Data.Sequence" reexports + , Seq + -- * "Data.Set" reexports + , Set + -- * "Data.Tuple" reexports + , curry + , fst + , snd + , swap + , uncurry + -- * "GHC.Exts" reexports + , IsList (..) + ) where import Data.Hashable (Hashable (hashWithSalt)) import Data.HashMap.Strict (HashMap) diff --git a/src/Relude/Debug.hs b/src/Relude/Debug.hs --- a/src/Relude/Debug.hs +++ b/src/Relude/Debug.hs @@ -1,98 +1,309 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE CPP #-} -#if ( __GLASGOW_HASKELL__ >= 804 ) -{-# LANGUAGE TypeInType #-} +#if __GLASGOW_HASKELL__ >= 902 +{-# OPTIONS_GHC -Wno-operator-whitespace #-} #endif +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeFamilies #-} +#if ( __GLASGOW_HASKELL__ < 906 ) +{-# LANGUAGE TypeInType #-} +#endif +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Debug +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -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. +This module contains functions for debugging __pure__ functions. You +can't use functions like 'System.IO.putStrLn' for this purpose because +they require changes to the type signature, but functions in this module +avoid this problem by being pure on their own. + +Additionally, these functions produce compile-time warnings, if you leave them +in your code. Warnings help you to cleanup all debugging usages before +releasing. + +@ +__ghci>__ foo = trace "I forgot trace in code" + +\:4:7: __warning__: [-Wdeprecations] + In the use of ‘trace’ (imported from "Relude"): + "'trace' remains in code" +@ + +The following table briefly shows names and types of all functions in +this module. + ++-----------------+----------------------------------------+ +| __Name__ | __Type__ | ++=================+========================================+ +| 'trace' | @String -> a -> a@ | ++-----------------+----------------------------------------+ +| 'traceShow' | @Show a => a -> b -> b@ | ++-----------------+----------------------------------------+ +| 'traceShowId' | @Show a => a -> a@ | ++-----------------+----------------------------------------+ +| 'traceShowWith' | @Show b => (a -> b) -> a -> a@ | ++-----------------+----------------------------------------+ +| 'traceId' | @String -> String@ | ++-----------------+----------------------------------------+ +| 'traceM' | @(Applicative f) => String -> f ()@ | ++-----------------+----------------------------------------+ +| 'traceShowM' | @(Show a, Applicative f) => a -> f ()@ | ++-----------------+----------------------------------------+ + +__⚠ NOTE:__ Use these functions only for local debugging +purposes. They break referential transparency, they are only useful +when you want to observe intermediate values of your pure functions +and to understand the behaviour locally. If you want to log debug +messages in your application, consider using a logging library +instead. -} module Relude.Debug - ( -- * Tracing - trace - , traceM - , traceId - , traceShow - , traceShowId - , traceShowM + ( -- * Tracing + trace + , traceShow + , traceShowId + , traceShowWith + , traceId + , traceM + , traceShowM - -- * Imprecise error - , error - , Undefined (..) - , undefined - ) where + -- * Imprecise error + , error + , Undefined (..) + , undefined + ) where import Data.Data (Data) +#if __GLASGOW_HASKELL__ >= 904 +import Data.Type.Equality (type (~)) +#endif 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 (Char, Constraint, Eq, Generic, HasCallStack, Ord, Show, Type, Typeable) +import Relude.Enum (Bounded, Enum) +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. +{- | Prints the given 'String' message and returns the passed value of +type @a@. + +>>> 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] + +* If you want to print a 'Show'able value instead of 'String', use 'traceShow'. +* If you want to print the value itself, use 'traceShowId'. +* If you want to print by specifying a custom formatting function, use 'traceShowWith'. + +-} trace :: String -> a -> a trace = Debug.trace {-# WARNING trace "'trace' remains in code" #-} --- | Version of 'Debug.Trace.traceShow' that leaves warning. +{- | Similar to 'trace' but prints a given value with the 'Show' +instance instead of a 'String'. + +>>> 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] + +* If you want to print a specific 'String' instead, use 'trace' +* If you want to print and return the same value, use 'traceShowId' +* If you want to specify a custom printing function, use 'traceShowWith' +-} traceShow :: Show a => a -> b -> b traceShow = Debug.traceShow {-# WARNING traceShow "'traceShow' remains in code" #-} --- | Version of 'Debug.Trace.traceShowId' that leaves warning. +{- | Similar to 'traceShow' but prints the given value itself instead +of a separate value. + +>>> traceShowId (1+2+3, "hello" ++ "world") +(6,"helloworld") +(6,"helloworld") + +* If you to specify a different value to print, use 'trace' or 'traceShow' +* If you want to have more control over printing, use 'traceShowWith' +-} 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" #-} +{- | Similar 'traceShowId', but uses a provided function to convert the +argument to a value with the 'Show' constraint. --- | Version of 'Debug.Trace.traceM' that leaves warning. +>>> traceShowWith fst (1, "ABC") +1 +(1,"ABC") + +In other words, @'traceShowId' ≡ 'traceShowWith' id@. + +This function is useful for debugging values that do not have 'Show' +instance: + +>>> fst $ traceShowWith fst (1, id) +1 +1 + +* If you don't need such flexibility, use simpler 'trace', 'traceShow' or 'traceShowId' + +@since 1.0.0.0 +-} +traceShowWith :: Show b => (a -> b) -> a -> a +traceShowWith f v = Debug.traceShow (f v) v +{-# WARNING traceShowWith "'traceShowWith remains in code" #-} + +{- | Trace function to print values while working a pure monad +(e.g. 'Maybe', 'State', etc.) + +>>> :{ +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 + +* If you want to print a value with the 'Show' instance instead, use 'traceShowM' +-} 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 'Prelude.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" #-} + +{- | Similar to 'traceShowId' but specialised for 'String'. + +>>> 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. + +⚠️__CAUTION__⚠️ Unlike "Prelude" version, 'error' takes + t'Relude.String.Reexport.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 - deriving (Eq, Ord, Show, Read, Enum, Bounded, Data, Typeable, Generic) + deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Data, Typeable, Generic) {-# WARNING Undefined "'Undefined' type remains in code" #-} -- | 'Prelude.undefined' that leaves warning in code on every usage. diff --git a/src/Relude/DeepSeq.hs b/src/Relude/DeepSeq.hs --- a/src/Relude/DeepSeq.hs +++ b/src/Relude/DeepSeq.hs @@ -1,44 +1,99 @@ +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.DeepSeq +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable This module contains useful functions to evaluate expressions to weak-head -normal form or just normal form. Useful to force traces or @error@ inside -monadic computation or to remove space leaks. +normal form (WHNF) or just normal form (NF). Useful to force traces or @error@s +inside monadic computations or to remove space leaks. -} module Relude.DeepSeq - ( module Control.DeepSeq - , evaluateNF - , evaluateNF_ - , evaluateWHNF - , evaluateWHNF_ - ) where + ( -- * "Control.DeepSeq" reexports + NFData (..) + , deepseq + , force + , ($!!) + -- * Evaluation + , evaluateNF + , evaluateNF_ + , evaluateWHNF + , evaluateWHNF_ + ) where + 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 a clearer name. + +>>> let list = [1..5] :: [Int] +>>> :sprint list +list = _ +>>> () <$ evaluateWHNF list +>>> :sprint list +list = 1 : _ +-} 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. + +>>> let list = [1..5] :: [Int] +>>> :sprint list +list = _ +>>> evaluateWHNF_ list +>>> :sprint list +list = 1 : _ +-} 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 a clearer name. + +>>> let list = [1..5] :: [Int] +>>> :sprint list +list = _ +>>> () <$ evaluateNF list +>>> :sprint list +list = [1,2,3,4,5] +-} 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' --- but discards resulting value. +{- | Alias for @evaluateWHNF . rnf@. Similar to 'evaluateNF' +but discards the resulting value. + +>>> let list = [1..5] :: [Int] +>>> :sprint list +list = _ +>>> evaluateNF_ list +>>> :sprint list +list = [1,2,3,4,5] +-} evaluateNF_ :: (NFData a, MonadIO m) => a -> m () evaluateNF_ = evaluateWHNF . rnf +{-# INLINE evaluateNF_ #-} +{-# SPECIALIZE evaluateNF_ :: NFData a => a -> IO () #-} diff --git a/src/Relude/Enum.hs b/src/Relude/Enum.hs new file mode 100644 --- /dev/null +++ b/src/Relude/Enum.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE Safe #-} + +{- | +Module : Relude.Enum +Copyright : (c) 2021-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +Reexports 'Enum' related typeclasses and functions. Also introduces a few useful +helpers to work with Enums. + +__Note:__ 'universe', 'universeNonEmpty' and 'inverseMap' were previously in the +extra modules, but due to their benefit in different use cases. If you imported +@Relude.Extra.Enum@ module, you can remove it now, as these functions are +reexported in the main "Relude" module. + +@since 1.0.0.0 +-} + +module Relude.Enum + ( -- * Useful combinators for Enums + universe + , universeNonEmpty + , inverseMap + -- * Base reexports + , module GHC.Enum + ) where + +import GHC.Enum (Bounded (..), Enum (..), boundedEnumFrom, boundedEnumFromThen) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.List (drop) +import Data.Maybe (Maybe (..)) + +import Relude.Base (Ord (..)) +import Relude.Extra.Tuple (fmapToFst) + +import qualified Data.Map.Strict as M + + +-- $setup +-- >>> import Relude + +{- | Returns all values of some 'Bounded' 'Enum' in ascending order. + +>>> universe :: [Bool] +[False,True] + +>>> universe @Ordering +[LT,EQ,GT] + +>>> data TrafficLight = Red | Blue | Green deriving (Show, Enum, Bounded) +>>> universe :: [TrafficLight] +[Red,Blue,Green] + +>>> data Singleton = Singleton deriving (Show, Enum, Bounded) +>>> universe @Singleton +[Singleton] + +@since 0.1.0 +-} +universe :: (Bounded a, Enum a) => [a] +universe = [minBound .. maxBound] +{-# INLINE universe #-} + +{- | Like 'universe', but returns 'NonEmpty' list of some enumeration + +>>> universeNonEmpty :: NonEmpty Bool +False :| [True] + +>>> universeNonEmpty @Ordering +LT :| [EQ,GT] + +>>> data TrafficLight = Red | Blue | Green deriving (Show, Eq, Enum, Bounded) +>>> universeNonEmpty :: NonEmpty TrafficLight +Red :| [Blue,Green] + +>>> data Singleton = Singleton deriving (Show, Eq, Enum, Bounded) +>>> universeNonEmpty @Singleton +Singleton :| [] + +@since 0.7.0.0 +-} +universeNonEmpty :: forall a . (Bounded a, Enum a) => NonEmpty a +universeNonEmpty = minBound :| drop 1 universe +{-# INLINE universeNonEmpty #-} + +{- | @inverseMap f@ creates a function that is the inverse of a given function +@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. + +__Memory usage note:__ don't inverse functions that have types like 'Int' +as their input. In this case the created 'M.Map' will have huge size. + +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 +@ + +@since 0.1.1 +-} +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 (fmapToFst f (universe @a)) +{-# INLINE inverseMap #-} diff --git a/src/Relude/Exception.hs b/src/Relude/Exception.hs --- a/src/Relude/Exception.hs +++ b/src/Relude/Exception.hs @@ -1,26 +1,33 @@ +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE Safe #-} {-# LANGUAGE ViewPatterns #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Exception +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -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 - ( module Control.Exception + ( -- * "Control.Exception" reexports + Exception (..) + , SomeException (..) - , Bug (..) - , bug - , pattern Exc - ) where + -- * 'Bug's + , Bug (..) + , bug + , pattern Exc + ) where import Control.Exception (Exception (..), SomeException (..)) import Data.List ((++)) @@ -32,25 +39,29 @@ 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) + deriving stock (Show) instance Exception Bug where - displayException (Bug e cStack) = E.displayException e ++ "\n" - ++ prettyCallStack cStack + displayException (Bug e cStack) = + E.displayException e ++ "\n" + ++ prettyCallStack cStack -- | Generate a pure value which, when forced, will throw the given exception impureThrow :: Exception e => e -> a impureThrow = E.throw . E.toException --- | Generate a pure value which, when forced, will synchronously --- throw the exception wrapped into 'Bug' data type. +{- | Generate a pure value which, when forced, will synchronously +throw the exception wrapped into 'Bug' data type. +-} bug :: (HasCallStack, Exception e) => e -> a bug e = impureThrow (Bug (E.toException e) callStack) -{- | Pattern synonym to easy pattern matching on exceptions. So intead of +{- | Pattern synonym to easy pattern matching on exceptions. So instead of writing something like this: @ @@ -66,7 +77,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 @ diff --git a/src/Relude/Extra.hs b/src/Relude/Extra.hs new file mode 100644 --- /dev/null +++ b/src/Relude/Extra.hs @@ -0,0 +1,98 @@ +{- | +Module : Relude.Extra +Copyright : (c) 2019-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +This module exports all extra-related stuff. +The extra modules are not exported by default, but you can easily bring them to +every module in your package by modifying your "Prelude" file. +-} + +module Relude.Extra + ( module Relude.Extra.Bifunctor + -- $Bifunctor + , module Relude.Extra.CallStack + -- $CallStack + , module Relude.Extra.Enum + -- $Enum + , module Relude.Extra.Foldable + -- $Foldable + , module Relude.Extra.Foldable1 + -- $Foldable1 + , module Relude.Extra.Group + -- $Group + , module Relude.Extra.Lens + -- $Lens + , module Relude.Extra.Map + -- $Map + , module Relude.Extra.Newtype + -- $Newtype + , module Relude.Extra.Tuple + -- $Tuple + , module Relude.Extra.Type + -- $Type + ) where + +import Relude.Extra.Bifunctor +import Relude.Extra.CallStack +import Relude.Extra.Enum +import Relude.Extra.Foldable +import Relude.Extra.Foldable1 +import Relude.Extra.Group +import Relude.Extra.Lens +import Relude.Extra.Map +import Relude.Extra.Newtype +import Relude.Extra.Tuple +import Relude.Extra.Type + +{- $Bifunctor +Additional combinators for t'Relude.Functor.Reexport.Bifunctor'. +-} + +{- $CallStack +Useful functions to extract information from t'Relude.Base.CallStack'. +-} +{- $Enum +Extra utilities for types that implement t'Relude.Enum.Bounded' and t'Relude.Enum.Enum' +constraints. +-} +{- $Foldable +Extra folds for instances of the t'Relude.Foldable.Reexport.Foldable' typeclass. +Currently, just a short-circuitable left fold 'foldlSC'. +-} + +{- $Foldable1 +'Foldable1' is a typeclass like t'Relude.Foldable.Reexport.Foldable' but for non-empty +structures. For example, t'Relude.List.NonEmpty.NonEmpty', +'Relude.Functor.Reexport.Identity'. + +'Foldable1' has all type-safe and total methods like `head1`, `maximum1` in +contradiction with t'Relude.Foldable.Reexport.Foldable'. +-} + +{- $Group +Grouping functions, polymorphic on return @Map@ type. +-} + +{- $Lens +Minimal implementation of @lens@ package required for basic usage. +-} + +{- $Map +The typeclass for @Map@-like data structures. +-} + +{- $Newtype +Generic functions that automatically work for any @newtype@. +-} + +{- $Tuple +Functions for working with tuples. +-} + +{- $Type +Functions for inspecting and working with types. +-} diff --git a/src/Relude/Extra/Bifunctor.hs b/src/Relude/Extra/Bifunctor.hs --- a/src/Relude/Extra/Bifunctor.hs +++ b/src/Relude/Extra/Bifunctor.hs @@ -1,7 +1,12 @@ +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Extra.Bifunctor +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Useful combinators for bifunctors inside functors. This set of functions is useful when you want to work with types like these ones: @@ -12,37 +17,65 @@ baz :: Maybe (Either a b) qux :: Maybe (a, b) + +doo :: (a, a) +dee :: Either a a @ + +@since 0.1.0 -} module Relude.Extra.Bifunctor - ( bimapF - , firstF - , secondF - ) where + ( bimapBoth + , bimapF + , firstF + , secondF + ) where import Relude +{- | Maps a function over both elements of a bifunctor. + +>>> bimapBoth length ([True], [False, True]) +(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']) Just (True,2) + +@since 0.1.0 -} 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@. >>> firstF not $ Just (False, ['a', 'b']) Just (True,"ab") + +@since 0.1.0 -} firstF :: (Functor f, Bifunctor p) => (a -> c) -> f (p a b) -> f (p c b) firstF = fmap . first +{-# INLINE firstF #-} {- | Short for @fmap . second@. >>> secondF length $ Just (False, ['a', 'b']) Just (False,2) + +@since 0.1.0 -} secondF :: (Functor f, Bifunctor p) => (b -> d) -> f (p a b) -> f (p a d) secondF = fmap . second +{-# INLINE secondF #-} diff --git a/src/Relude/Extra/CallStack.hs b/src/Relude/Extra/CallStack.hs --- a/src/Relude/Extra/CallStack.hs +++ b/src/Relude/Extra/CallStack.hs @@ -1,15 +1,22 @@ +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Extra.CallStack +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Contains useful functions to work with GHC callstack. + +@since 0.2.0 -} module Relude.Extra.CallStack - ( ownName - , callerName - ) where + ( ownName + , callerName + ) where import Relude @@ -23,6 +30,8 @@ >>> bar :: HasCallStack => String; bar = foo >>> bar "foo" + +@since 0.2.0 -} ownName :: HasCallStack => String ownName = case getCallStack callStack of @@ -31,7 +40,7 @@ {- | This function returns the name of its caller of the caller function, but it requires that the caller function and caller of the caller function have -'HasCallStack' constraint. Otherwise, it returns @""@. It's useful for +'HasCallStack' constraint. Otherwise, it returns @""@. It's useful for logging: >>> log :: HasCallStack => String -> IO (); log s = putStrLn $ callerName ++ ":" ++ s @@ -40,6 +49,8 @@ greeting:Starting... Hello! greeting:Ending... + +@since 0.2.0 -} callerName :: HasCallStack => String callerName = case getCallStack callStack of diff --git a/src/Relude/Extra/Enum.hs b/src/Relude/Extra/Enum.hs --- a/src/Relude/Extra/Enum.hs +++ b/src/Relude/Extra/Enum.hs @@ -1,66 +1,27 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE Safe #-} {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Extra.Enum +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Mini @bounded-enum@ framework inside @relude@. + +@since 0.1.0 -} module Relude.Extra.Enum - ( universe - , inverseMap - , next - , prec - , safeToEnum - ) where + ( next + , prev + , safeToEnum + ) where import Relude -import qualified Data.Map.Strict as M --- $setup --- >>> :set -XTypeApplications - -{- | Returns all values of some 'Bounded' 'Enum' in ascending order. - ->>> data TrafficLight = Red | Blue | Green deriving (Show, Enum, Bounded) ->>> universe :: [TrafficLight] -[Red,Blue,Green] ->>> universe :: [Bool] -[False,True] --} -universe :: (Bounded a, Enum a) => [a] -universe = [minBound .. maxBound] - -{- | @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 -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)\). - -Usually you want to use 'inverseMap' to inverse 'show' function. - ->>> data Color = Red | Green | Blue deriving (Show, Enum, Bounded) ->>> parse = inverseMap show :: String -> Maybe Color ->>> parse "Red" -Just Red ->>> parse "Black" -Nothing --} -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 - {- | Like 'succ', but doesn't fail on 'maxBound'. Instead it returns 'minBound'. >>> next False @@ -69,25 +30,31 @@ False >>> succ True *** Exception: Prelude.Enum.Bool.succ: bad argument + +@since 0.1.0 -} -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 -True ->>> prec True +>>> prev True False +>>> prev False +True >>> 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 #-} {- | Returns 'Nothing' if given 'Int' outside range. @@ -99,6 +66,9 @@ Nothing >>> safeToEnum @Bool (-1) Nothing + +@since 0.1.0 -} 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 #-} diff --git a/src/Relude/Extra/Foldable.hs b/src/Relude/Extra/Foldable.hs new file mode 100644 --- /dev/null +++ b/src/Relude/Extra/Foldable.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE BangPatterns #-} + +{- | +Module : Relude.Extra.Foldable +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +Contains utility functions for working with tuples. + +@since 0.6.0.0 +-} + +module Relude.Extra.Foldable + ( foldlSC + , average + ) where + +import Relude + + +-- $setup + +{- | 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 #-} + +{- | Given a 'Foldable' of 'Fractional' elements, computes the average if +possible and returns 'Maybe' element. + +>>> average [42] +Just 42.0 +>>> average @Double [1, 2, 3, 4] +Just 2.5 +>>> average @Float [1.5, 2.5, 3 ,4] +Just 2.75 +>>> average [] +Nothing + +@since 1.0.0.0 +-} +average :: forall a f . (Foldable f, Fractional a) => f a -> Maybe a +average xs + | null xs = Nothing + | otherwise = Just + . uncurry (/) + . foldl' (\(!total, !count) x -> (total + x, count + 1)) (0,0) + $ xs +{-# INLINE average #-} diff --git a/src/Relude/Extra/Foldable1.hs b/src/Relude/Extra/Foldable1.hs --- a/src/Relude/Extra/Foldable1.hs +++ b/src/Relude/Extra/Foldable1.hs @@ -1,27 +1,58 @@ -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} +{-# LANGUAGE CPP #-} + +#if __GLASGOW_HASKELL__ >= 902 +{-# OPTIONS_GHC -Wno-operator-whitespace #-} +#endif + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + {- | -Copyright: (c) 2011-2015 Edward Kmett - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Extra.Foldable1 +Copyright : (c) 2011-2015 Edward Kmett + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +'Foldable1' is a typeclass like 'Data.Foldable.Foldable' but for non-empty +structures. For example, 'Relude.NonEmpty', 'Relude.Identity'. + +'Foldable1' has all type-safe and total methods like `head1`, `maximum1` in +contradiction with 'Data.Foldable.Foldable'. + +@since 0.3.0 -} module Relude.Extra.Foldable1 - ( Foldable1 (..) - , foldl1' - ) where + ( Foldable1 (..) + , foldl1' + , average1 + ) where import Relude hiding (Product (..), Sum (..)) -import Relude.Extra.Newtype (( #. )) +import Relude.Extra.Newtype ((#.)) 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. + +@since 0.3.0 -} class Foldable f => Foldable1 f where {-# MINIMAL foldMap1 #-} @@ -30,6 +61,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 @@ -43,13 +76,26 @@ fold1 :: Semigroup m => f m -> m fold1 = foldMap1 id - {- | Convert a non-empty data structre to a NonEmpty list. + {- | Combines the elements of a non-empty structure using a binary function @f@. + >>> foldr1 (+) 0 (1 :| [2, 3]) + 6 + >>> foldr1 (+) 1 $ Identity 3 + 4 + + @since 1.0.0.0 + -} + foldr1 :: (a -> b -> b) -> b -> f a -> b + foldr1 f accum as = appEndo (foldMap1 (Endo #. f) as) accum + {-# INLINE foldr1 #-} + + {- | Convert a non-empty data structure to a NonEmpty list. + >>> toNonEmpty (Identity 2) 2 :| [] -} toNonEmpty :: f a -> NonEmpty a - toNonEmpty = foldMap1 (:|[]) + toNonEmpty = foldMap1 (:| []) {- | The first element of a non-empty data structure. @@ -75,7 +121,7 @@ maximum1 :: Ord a => f a -> a maximum1 = SG.getMax #. foldMap1 SG.Max - {- | The smallest elemenet of a non-empty data structure. + {- | The smallest element of a non-empty data structure. >>> minimum1 (32 :| [64, 8, 128, 16]) 8 @@ -83,17 +129,46 @@ minimum1 :: Ord a => f a -> a minimum1 = SG.getMin #. foldMap1 SG.Min + {- | The largest element of a non-empty data structure + with respect to the given comparison function. + + >>> maximumOn1 abs (0 :| [2, 1, -3, -2]) + -3 + + @since 1.0.0.0 + -} + maximumOn1 :: Ord b => (a -> b) -> f a -> a + maximumOn1 f = maximumOn1 f . toNonEmpty + {-# INLINE maximumOn1 #-} + + {- | The smallest element of a non-empty data structure + with respect to the given comparison function. + + >>> minimumOn1 abs (0 :| [2, 1, -3, -2]) + 0 + + @since 1.0.0.0 + -} + minimumOn1 :: Ord b => (a -> b) -> f a -> a + minimumOn1 f = minimumOn1 f . toNonEmpty + {-# INLINE minimumOn1 #-} + +{- | + +@since 0.3.0 +-} instance Foldable1 NonEmpty where fold1 :: Semigroup m => NonEmpty m -> m 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 +185,28 @@ {-# INLINE maximum1 #-} {-# INLINE minimum1 #-} + maximumOn1 :: forall a b. Ord b => (a -> b) -> NonEmpty a -> a + maximumOn1 func = foldl1' $ cmpOn + where + cmpOn :: a -> a -> a + cmpOn a b = case func a `compare` func b of + GT -> a + _ -> b + {-# INLINE maximumOn1 #-} + minimumOn1 :: forall a b. Ord b => (a -> b) -> NonEmpty a -> a + minimumOn1 func = foldl1' $ cmpOn + where + cmpOn :: a -> a -> a + cmpOn a b = case func a `compare` func b of + LT -> a + _ -> b + {-# INLINE minimumOn1 #-} + +{- | + +@since 0.3.0 +-} instance Foldable1 Identity where foldMap1 :: Semigroup m => (a -> m) -> Identity a -> m foldMap1 = coerce @@ -121,7 +217,7 @@ {-# INLINE fold1 #-} toNonEmpty :: Identity a -> NonEmpty a - toNonEmpty = (:|[]) . coerce + toNonEmpty = (:| []) . coerce {-# INLINE toNonEmpty #-} head1 :: Identity a -> a @@ -140,6 +236,18 @@ minimum1 = coerce {-# INLINE minimum1 #-} + maximumOn1 :: Ord b => (a -> b) -> Identity a -> a + maximumOn1 = const coerce + {-# INLINE maximumOn1 #-} + + minimumOn1 :: Ord b => (a -> b) -> Identity a -> a + minimumOn1 = const coerce + {-# INLINE minimumOn1 #-} + +{- | + +@since 0.3.0 +-} instance Foldable1 ((,) c) where foldMap1 :: Semigroup m => (a -> m) -> (c, a) -> m foldMap1 f = f . snd @@ -150,7 +258,7 @@ {-# INLINE fold1 #-} toNonEmpty :: (c, a) -> NonEmpty a - toNonEmpty (_, y) = (y :| []) + toNonEmpty (_, y) = y :| [] {-# INLINE toNonEmpty #-} head1, last1 :: (c, a) -> a @@ -165,6 +273,16 @@ {-# INLINE maximum1 #-} {-# INLINE minimum1 #-} + maximumOn1, minimumOn1 :: Ord b => (a -> b) -> (c, a) -> a + maximumOn1 = const snd + minimumOn1 = const snd + {-# INLINE maximumOn1 #-} + {-# INLINE minimumOn1 #-} + +{- | + +@since 0.3.0 +-} instance (Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) where foldMap1 :: Semigroup m => (a -> m) -> Compose f g a -> m foldMap1 f = foldMap1 (foldMap1 f) . getCompose @@ -178,17 +296,94 @@ last1 = last1 . last1 . getCompose {-# INLINE last1 #-} +{- | + +@since 0.3.0 +-} instance (Foldable1 f, Foldable1 g) => Foldable1 (Product f g) where foldMap1 :: Semigroup m => (a -> m) -> Product f g a -> m foldMap1 f (Pair a b) = foldMap1 f a <> foldMap1 f b {-# INLINE foldMap1 #-} +{- | + +@since 0.3.0 +-} instance (Foldable1 f, Foldable1 g) => Foldable1 (Sum f g) where foldMap1 :: Semigroup m => (a -> m) -> Sum f g a -> m 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" + + foldr1 :: (Foldable1 f) => (a -> b -> b) -> b -> f a -> b + foldr1 _ _ = 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" + + maximumOn1 :: (Ord b, Foldable1 f) => (a -> b) -> f a -> a + maximumOn1 _ _ = error "Unreachable list instance of Foldable1" + + minimumOn1 :: (Ord b, Foldable1 f) => (a -> b) -> f a -> a + minimumOn1 _ _ = error "Unreachable list instance of Foldable1" + {- | Strictly folds non-empty structure with given function @f@: @ @@ -197,8 +392,54 @@ >>> foldl1' (++) ([1,2] :| [[3,4], [5,6]]) [1,2,3,4,5,6] + +@since 0.3.0 -} foldl1' :: (a -> a -> a) -> NonEmpty a -> a foldl1' _ (x :| []) = x foldl1' f (x :| (y:ys)) = foldl' f (f x y) ys {-# INLINE foldl1' #-} + +{- | Given a 'Foldable1' of 'Fractional' elements, computes the average if +possible and returns the resulting element. + + +>>> average1 (42 :| []) +42.0 +>>> average1 (1 :| [2,3,4]) +2.5 + +@since 1.0.0.0 +-} +average1 :: forall a f . (Foldable1 f, Fractional a) => f a -> a +average1 = uncurry (/) . foldl' (\(!total, !count) x -> (total + x, count + 1)) (0, 0) +{-# INLINE average1 #-} + +{- +Copyright 2011-2015 Edward Kmett + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +-} diff --git a/src/Relude/Extra/Group.hs b/src/Relude/Extra/Group.hs --- a/src/Relude/Extra/Group.hs +++ b/src/Relude/Extra/Group.hs @@ -1,28 +1,37 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Extra.Group +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Polymorphic grouping functions. + +@since 0.1.0 -} module Relude.Extra.Group - ( groupBy - , groupOneBy - ) where + ( groupBy + , groupOneBy + ) where import Relude import Relude.Extra.Map import Data.List.NonEmpty ((<|)) + {- | Groups elements using results of the given function as keys. >>> groupBy even [1..6] :: HashMap Bool (NonEmpty Int) fromList [(False,5 :| [3,1]),(True,6 :| [4,2])] + +@since 0.1.0 -} groupBy :: forall f t a . (Foldable f, DynamicMap t, Val t ~ NonEmpty a, Monoid t) => (a -> Key t) -> f a -> t @@ -39,6 +48,8 @@ >>> groupOneBy even [1 .. 6] :: HashMap Bool Int fromList [(False,1),(True,2)] + +@since 0.1.0 -} groupOneBy :: forall f t a . (Foldable f, DynamicMap t, Val t ~ a, Monoid t) => (a -> Key t) -> f a -> t diff --git a/src/Relude/Extra/Lens.hs b/src/Relude/Extra/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Relude/Extra/Lens.hs @@ -0,0 +1,276 @@ +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE Safe #-} + +{- | +Module : Relude.Extra.Lens +Copyright : (c) 2012-2016 Edward Kmett + (c) 2019-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +@since 0.5.0 + +This module aims to provide a minimal implementation of @lens@ package required +for basic usage. All functions are compatible with the real @lens@ package +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 +than @relude@. You should add the import of this module in the place of lenses +usage: + +@ +__import__ Relude.Extra.Lens +@ + +== Example + +To understand better how to use this module lets look at some simple example. +Let's say we have the user data type in our system: + +@ +__data__ User = User + { userName :: 'Text' + , userAge :: 'Int' + , userAddress :: Address + } __deriving__ ('Show') + +__data__ Address = Address + { addressCountry :: 'Text' + , addressCity :: 'Text' + , addressIndex :: 'Text' + } __deriving__ ('Show') +@ + +To create the lens for the @userName@ field we can use 'lens' function and manually writing getter and setter function: + +@ +nameL :: 'Lens'' User 'Text' +nameL = 'lens' getter setter + __where__ + getter :: User -> 'Text' + getter = userName + + setter :: User -> 'Text' -> User + setter user newName = user {userName = newName} +@ + +In this manner, we can create other lenses for our User data type. + +@ +ageL :: 'Lens'' User 'Int' +addressL :: 'Lens'' User Address +countryL :: 'Lens'' User 'Text' +cityL :: 'Lens'' User 'Text' +indexL :: 'Lens'' User 'Text' +@ + +/Note:/ here we are using composition of the lenses for @userAddress@ field. If we have + +@ +addressCityL :: 'Lens'' Address 'Text' +@ + +then + +@ +cityL = addressL . addressCityL +@ + +Let's say we have some sample user + +@ +user :: User +user = User + { userName = \"John\" + , userAge = 42 + , userAddress = Address + { addressCountry = \"UK\" + , addressCity = \"London\" + , addressIndex = \"XXX\" + } + } +@ + +To view the fields of the User data type we can use 'view' or '^.' + +@ +__>>>__ 'view' ageL user +42 +__>>>__ user '^.' cityL +\"London\" +@ + +If we want to change any of the user's data, we should use 'set' or '.~' + +@ +__>>>__ 'set' nameL \"Johnny\" user +__>>>__ user '&' indexL '.~' \"YYY\" +@ + +'over' or '%~' operator could be useful when, for example, you want to increase the age by one on the user's birthday: + +@ +__>>>__ 'over' ageL 'succ' user +__>>>__ user '&' ageL '%~' 'succ' +@ + +== Migration + +This module is not supposed to be the replacement for the @lens@ package. One of +the reasons why one would want to migrate to @lens@ or @microlens@ is that the +functional in @relude@ is limited to just vital lens functions. + +To migrate to @lens@ or @microlens@ package add the required library to the +dependencies list in the @.cabal@ file and replace the import from @relude@ +library + +@ +__import__ Relude.Extra.Lens +@ + +to the one of this correspondingly: + +- @lens@: + + @ + __import__ Control.Lens + @ + +- @microlens@: + + @ + __import__ Lens.Micro + @ + +And that's all! No need to change the types or implementation of the functions +you used @Relude.Extra.Lens@ in. + +== Links + +- [lens](https://hackage.haskell.org/package/lens) +- [microlens](https://hackage.haskell.org/package/microlens) +- [lens tutorial](http://hackage.haskell.org/package/lens-tutorial-1.0.3/docs/Control-Lens-Tutorial.html) +-} + +module Relude.Extra.Lens + ( Lens' + , lens + , view + , set + , over + , (^.) + , (.~) + , (%~) + ) 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 +'Identity' are functors, it can be used whenever a getter or a setter is needed. + + * @a@ is the type of the value inside of structure + * @s@ is the type of the whole structure + +@since 0.5.0 +-} +type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s + +{- | Creates 'Lens'' from the getter and setter. + +@since 0.5.0 +-} +lens :: (s -> a) -> (s -> a -> s) -> Lens' s a +lens getter setter = \f s -> setter s <$> f (getter s) +{-# INLINE lens #-} + +{- | Gets a value out of a structure using a getter. + +@since 0.5.0 +-} +view :: Lens' s a -> s -> a +view l = getConst . l Const +{-# INLINE view #-} + +{- | Sets the given value to the structure using a setter. + +@since 0.5.0 +-} +set :: Lens' s a -> a -> s -> s +set l a = runIdentity . l (const (Identity a)) +{-# INLINE set #-} + +{- | Applies the given function to the target. + +@since 0.5.0 +-} +over :: Lens' s a -> (a -> a) -> s -> s +over l fa = runIdentity . l (Identity . fa) +{-# INLINE over #-} + +{- | The operator form of 'view' with the arguments flipped. + +@since 0.5.0 +-} +infixl 8 ^. +(^.) :: s -> Lens' s a -> a +s ^. l = view l s +{-# INLINE (^.) #-} + +{- | The operator form of 'set'. + +@since 0.5.0 +-} +infixr 4 .~ +(.~) :: Lens' s a -> a -> s -> s +(.~) = set +{-# INLINE (.~) #-} + +{- | The operator form of 'over'. + +@since 0.5.0 +-} +infixr 4 %~ +(%~) :: Lens' s a -> (a -> a) -> s -> s +(%~) = over +{-# INLINE (%~) #-} + + +{- +Copyright 2012-2016 Edward Kmett + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +-} diff --git a/src/Relude/Extra/Map.hs b/src/Relude/Extra/Map.hs --- a/src/Relude/Extra/Map.hs +++ b/src/Relude/Extra/Map.hs @@ -1,36 +1,51 @@ -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Extra.Map +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Contains implementation of polymorhic type classes for data types 'Set' and +Contains implementation of polymorphic type classes for data types 'Set' and 'Map'. -} module Relude.Extra.Map - ( StaticMap (..) - , DynamicMap (..) - , (!?) - , notMember - , lookupDefault + ( StaticMap (..) + , DynamicMap (..) + , (!?) + , notMember + , lookupDefault - -- * To pairs - , toPairs - , keys - , elems - ) where + -- * To pairs + , toPairs + , keys + , elems + ) where +#if __GLASGOW_HASKELL__ >= 904 +import Data.Type.Equality (type (~)) +#endif import GHC.Exts (IsList (Item, toList)) -import Relude.Applicative (pure, (*>)) -import Relude.Base (Eq, Int, Ord, Type) +#if MIN_VERSION_hashable(1,4,0) +import Relude.Base (Ord, Type) +#else +import Relude.Base (Eq, Ord, Type) +#endif + 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) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS @@ -45,6 +60,8 @@ {- | Read-only map or set. Contains polymorphic functions which work for both sets and maps. + +@since 0.1.0 -} class StaticMap t where type Key t :: Type @@ -54,85 +71,146 @@ lookup :: Key t -> t -> Maybe (Val t) member :: Key t -> t -> Bool +{- | + +@since 0.1.0 +-} instance Ord k => StaticMap (Map k v) where 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 #-} +{- | + +@since 0.1.0 +-} +#if MIN_VERSION_hashable(1,4,0) +instance (Hashable k) => StaticMap (HashMap k v) where +#else instance (Eq k, Hashable k) => StaticMap (HashMap k v) where +#endif 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 #-} +{- | + +@since 0.1.0 +-} 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 #-} +{- | + +@since 0.1.0 +-} 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 #-} +{- | + +@since 0.1.0 +-} +#if MIN_VERSION_hashable(1,4,0) +instance (Hashable a) => StaticMap (HashSet a) where +#else instance (Eq a, Hashable a) => StaticMap (HashSet a) where +#endif 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 #-} +{- | + +@since 0.1.0 +-} 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 + +@since 0.1.0 +-} 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 + +@since 0.1.0 +-} 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" + +@since 0.1.0 -} lookupDefault :: StaticMap t => Val t -- ^ Default value to return. @@ -147,6 +225,8 @@ ---------------------------------------------------------------------------- {- | Modifiable Map. + +@since 0.1.0 -} class StaticMap t => DynamicMap t where -- insertions @@ -157,37 +237,50 @@ delete :: Key t -> t -> t alter :: (Maybe (Val t) -> Maybe (Val t)) -> Key t -> t -> t +{- | + +@since 0.1.0 +-} instance Ord k => DynamicMap (Map k v) where insert = M.insert - insertWith = M.insertWith - delete = M.delete - alter = M.alter - {-# INLINE insert #-} + insertWith = M.insertWith {-# INLINE insertWith #-} + delete = M.delete {-# INLINE delete #-} + alter = M.alter {-# INLINE alter #-} +{- | + +@since 0.1.0 +-} +#if MIN_VERSION_hashable(1,4,0) +instance (Hashable k) => DynamicMap (HashMap k v) where +#else instance (Eq k, Hashable k) => DynamicMap (HashMap k v) where +#endif insert = HM.insert - insertWith = HM.insertWith - delete = HM.delete - alter = HM.alter - {-# INLINE insert #-} + insertWith = HM.insertWith {-# INLINE insertWith #-} + delete = HM.delete {-# INLINE delete #-} + alter = HM.alter {-# INLINE alter #-} +{- | + +@since 0.1.0 +-} instance DynamicMap (IntMap v) where insert = IM.insert - insertWith = IM.insertWith - delete = IM.delete - alter = IM.alter - {-# INLINE insert #-} + insertWith = IM.insertWith {-# INLINE insertWith #-} + delete = IM.delete {-# INLINE delete #-} + alter = IM.alter {-# INLINE alter #-} ---------------------------------------------------------------------------- @@ -201,6 +294,8 @@ >>> toPairs (HashMap.fromList [('a', "xxx"), ('b', "yyy")]) [('a',"xxx"),('b',"yyy")] + +@since 0.1.0 -} toPairs :: (IsList t, Item t ~ (a, b)) => t -> [(a, b)] toPairs = toList @@ -209,6 +304,8 @@ >>> keys (HashMap.fromList [('a', "xxx"), ('b', "yyy")]) "ab" + +@since 0.1.0 -} keys :: (IsList t, Item t ~ (a, b)) => t -> [a] keys = map fst . toList @@ -217,6 +314,8 @@ >>> elems (HashMap.fromList [('a', "xxx"), ('b', "yyy")]) ["xxx","yyy"] + +@since 0.1.0 -} elems :: (IsList t, Item t ~ (a, b)) => t -> [b] elems = map snd . toList diff --git a/src/Relude/Extra/Newtype.hs b/src/Relude/Extra/Newtype.hs --- a/src/Relude/Extra/Newtype.hs +++ b/src/Relude/Extra/Newtype.hs @@ -1,27 +1,30 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Safe #-} {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Extra.Newtype +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Functions to ease work with newtypes. +Functions to ease work with @newtypes@. + +@since 0.2.0 -} module Relude.Extra.Newtype - ( un - , wrap - , under - , under2 -#if ( __GLASGOW_HASKELL__ != 802 ) - , underF2 -#endif - , (#.) - ) where + ( un + , wrap + , under + , under2 + , underF2 + , (#.) + ) where import Relude + -- $setup -- >>> :set -XTypeApplications -- >>> import Data.Semigroup (Max (..)) @@ -33,17 +36,21 @@ 5 >>> un (Size 5) == length ['a', 'x', 'b'] False + +@since 0.2.0 -} un :: forall a n . Coercible a n => n -> a un = coerce {-# INLINE un #-} -{- | Wraps value to @newtype@. Behaves exactly as 'un' but has more meaningnful +{- | Wraps value to @newtype@. Behaves exactly as 'un' but has more meaningful name in case you need to convert some value to @newtype@. >>> newtype Flag = Flag Bool deriving (Show, Eq) >>> wrap False == Flag True False + +@since 0.2.0 -} wrap :: forall n a . Coercible a n => a -> n wrap = coerce @@ -58,6 +65,8 @@ >>> newtype Bar = Bar String deriving Show >>> under (filter (== 'a')) (Bar "abacaba") Bar "aaaa" + +@since 0.2.0 -} under :: forall n a . Coercible a n => (n -> n) -> (a -> a) under = coerce @@ -70,12 +79,13 @@ 7 >>> under2 @All (<>) True False False + +@since 0.3.0 -} under2 :: forall n a . Coercible a n => (n -> n -> n) -> (a -> a -> a) under2 = coerce {-# INLINE under2 #-} -#if ( __GLASGOW_HASKELL__ != 802 ) {- | Version of 'under2' that works on @newtype@s parametrized by their representation. Provided for convenience. @@ -83,13 +93,17 @@ 7 >>> underF2 @Max (<>) 'p' 't' 't' + +@since 0.3.0 -} underF2 :: forall n a . Coercible a (n a) => (n a -> n a -> n a) -> (a -> a -> a) underF2 = coerce {-# INLINE underF2 #-} -#endif -{- | Coercible composition +{- | Coercible composition. This function allows to write more efficient +implementations of function compositions over @newtypes@. + +@since 0.3.0 -} (#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c) (#.) _f = coerce diff --git a/src/Relude/Extra/Tuple.hs b/src/Relude/Extra/Tuple.hs --- a/src/Relude/Extra/Tuple.hs +++ b/src/Relude/Extra/Tuple.hs @@ -1,44 +1,125 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE TupleSections #-} + {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Extra.Tuple +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Contains utility functions for working with tuples. + +@since 0.4.0 -} module Relude.Extra.Tuple - ( dupe - , mapToFst - , mapToSnd - , mapBoth - ) where + ( dup + , toFst + , toSnd + , fmapToFst + , fmapToSnd + , mapToFst + , mapToSnd + , traverseToFst + , traverseToSnd + , traverseBoth + ) where +import Relude.Function ((.)) +import Relude.Functor (Functor (..), (<$>)) +import Relude.Applicative (Applicative (..)) + + -- $setup -- >>> import Relude {- | Creates a tuple by pairing something with itself. ->>> dupe "foo" +>>> dup "foo" ("foo","foo") ->>> dupe () +>>> dup () ((),()) + +@since 0.6.0.0 -} -dupe :: a -> (a, a) -dupe a = (a, a) -{-# INLINE dupe #-} +dup :: a -> (a, a) +dup a = (a, a) +{-# INLINE dup #-} {- | Apply a function, with the result in the fst slot, and the value in the other. +A dual to 'toSnd'. +>>> toFst length [3, 1, 0, 2] +(4,[3,1,0,2]) +>>> toFst (+5) 10 +(15,10) + +@since 0.7.0.0 +-} +toFst :: (a -> b) -> a -> (b, a) +toFst f a = (f a, a) +{-# INLINE toFst #-} + +{- | Apply a function, with the result in the snd slot, +and the value in the other. + +A dual to 'toFst'. + +>>> toSnd length [3, 1, 0, 2] +([3,1,0,2],4) +>>> toSnd (+5) 10 +(10,15) + +@since 0.7.0.0 +-} +toSnd :: (a -> b) -> a -> (a, b) +toSnd f a = (a, f a) +{-# INLINE toSnd #-} + +{- | Like 'fmap', but also keep the original value in the snd position. + +A dual to 'fmapToSnd'. + +>>> fmapToFst show [3, 10, 2] +[("3",3),("10",10),("2",2)] + +@since 0.7.0.0 +-} +fmapToFst :: Functor f => (a -> b) -> f a -> f (b, a) +fmapToFst = fmap . toFst +{-# INLINE fmapToFst #-} + +{- | Like 'fmap', but also keep the original value in the fst position. + +A dual to 'fmapToFst'. + +>>> fmapToSnd show [3, 10, 2] +[(3,"3"),(10,"10"),(2,"2")] + +@since 0.7.0.0 +-} +fmapToSnd :: Functor f => (a -> b) -> f a -> f (a, b) +fmapToSnd = fmap . toSnd +{-# INLINE fmapToSnd #-} + +{- | Apply a function, with the result in the fst slot, +and the value in the other. + A dual to 'mapToSnd' >>> mapToFst (+1) 10 (11,10) + +@since 0.4.0 -} mapToFst :: (a -> b) -> a -> (b, a) -mapToFst f a = (f a, a) +mapToFst = toFst {-# INLINE mapToFst #-} +{-# DEPRECATED mapToFst "Use 'toFst' from [Tuple](\"Relude.Extra.Tuple\") instead" #-} {- | Apply a function, with the result in the second slot, and the value in the other. @@ -47,16 +128,58 @@ >>> mapToSnd (+1) 10 (10,11) + +@since 0.4.0 -} mapToSnd :: (a -> b) -> a -> (a, b) -mapToSnd f a = (a, f a) +mapToSnd = toSnd {-# INLINE mapToSnd #-} +{-# DEPRECATED mapToSnd "Use 'toSnd' from [Tuple](\"Relude.Extra.Tuple\") instead" #-} -{- | Maps a function over both elements of a tuple. +{- | Apply a function that returns a value inside of a functor, +with the output in the first slot, the input in the second, +and the entire tuple inside the functor. ->>> mapBoth ("Hello " <>) ("Alice", "Bob") -("Hello Alice","Hello Bob") + +A dual to 'traverseToSnd' + +>>> traverseToFst (Just . (+1)) 10 +Just (11,10) +>>> traverseToFst (const Nothing) 10 +Nothing + +@since 0.5.0 -} -mapBoth :: (a -> b) -> (a, a) -> (b, b) -mapBoth f (a1, a2) = (f a1, f a2) -{-# INLINE mapBoth #-} +traverseToFst :: Functor t => (a -> t b) -> a -> t (b, a) +traverseToFst f a = (,a) <$> f a +{-# INLINE traverseToFst #-} + +{- | Apply a function that returns a value inside of a functor, +with the output in the second slot, the input in the first, +and the entire tuple inside the functor. + +A dual to 'traverseToFst'. + +>>> traverseToSnd (Just . (+1)) 10 +Just (10,11) +>>> traverseToSnd (const Nothing) 10 +Nothing + +@since 0.5.0 +-} +traverseToSnd :: Functor t => (a -> t b) -> a -> t (a, b) +traverseToSnd f a = (a,) <$> f a +{-# INLINE traverseToSnd #-} + +{- | Maps a function that returns a value inside of +an applicative functor over both elements of a tuple, +with the entire tuple inside the applicative functor. + +>>> traverseBoth (Just . ("Hello " <>)) ("Alice", "Bob") +Just ("Hello Alice","Hello Bob") +>>> traverseBoth (const Nothing) ("Alice", "Bob") +Nothing +-} +traverseBoth :: Applicative t => (a -> t b) -> (a, a) -> t (b, b) +traverseBoth f (a1, a2) = (,) <$> f a1 <*> f a2 +{-# INLINE traverseBoth #-} diff --git a/src/Relude/Extra/Type.hs b/src/Relude/Extra/Type.hs --- a/src/Relude/Extra/Type.hs +++ b/src/Relude/Extra/Type.hs @@ -1,26 +1,47 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Extra.Type +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Contains useful functions to work with Types. +Contains useful utilities to work with Types. + +@since 0.4.0 -} module Relude.Extra.Type - ( typeName - ) where + ( typeName + , type (++) + , AllHave + , Elem + , Fst + , Snd + ) where import Relude -#if ( __GLASGOW_HASKELL__ >= 822 ) -import Type.Reflection (Typeable, typeRep) +import Type.Reflection (typeRep) + + +#if ( __GLASGOW_HASKELL__ >= 906 ) +-- $setup +-- >>> :set -XAllowAmbiguousTypes -XDataKinds -XExplicitNamespaces -XPolyKinds -XTypeFamilies -XTypeOperators -XUndecidableInstances +-- >>> :set -fprint-redundant-promotion-ticks #else -import Data.Typeable (Typeable, typeRep) +-- $setup +-- >>> :set -XAllowAmbiguousTypes -XDataKinds -XExplicitNamespaces -XPolyKinds -XTypeFamilies -XTypeOperators -XUndecidableInstances #endif {- | Gets a string representation of a type. @@ -35,11 +56,115 @@ "[Char]" >>> typeName @(Maybe Int) "Maybe Int" + +@since 0.4.0 -} typeName :: forall a. Typeable a => Text -#if ( __GLASGOW_HASKELL__ >= 822 ) typeName = show (typeRep @a) -#else -typeName = show (typeRep (Proxy @a)) -#endif {-# INLINE typeName #-} + +{- | Concatenates type-level lists. + +#if ( __GLASGOW_HASKELL__ >= 902 ) + +>>> :kind! '[ 'Just 5, 'Nothing] ++ '[ 'Just 3, 'Nothing, 'Just 1] +'[ 'Just 5, 'Nothing] ++ '[ 'Just 3, 'Nothing, 'Just 1] :: [Maybe + Natural] += '[ 'Just 5, 'Nothing, 'Just 3, 'Nothing, 'Just 1] + +>>> :kind! '[] ++ '[ 'Just 3, 'Nothing, 'Just 1] +'[] ++ '[ 'Just 3, 'Nothing, 'Just 1] :: [Maybe Natural] += '[ 'Just 3, 'Nothing, 'Just 1] + +#elif ( __GLASGOW_HASKELL__ >= 806 ) + +>>> :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] + +#endif + +@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 diff --git a/src/Relude/Extra/Validation.hs b/src/Relude/Extra/Validation.hs deleted file mode 100644 --- a/src/Relude/Extra/Validation.hs +++ /dev/null @@ -1,182 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE LambdaCase #-} - -{- | -Copyright: (c) 2014 Chris Allen, Edward Kmett - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik - -Monoidal 'Validation' sibling to 'Either'. --} - -module Relude.Extra.Validation - ( Validation(..) - , validationToEither - , eitherToValidation - ) where - -import Relude - --- $setup --- >>> :set -XTypeApplications -XOverloadedStrings - --- | 'Validation' is 'Either' with a Left that is a 'Monoid' -data Validation e a - = Failure e - | Success a - deriving (Eq, Ord, Show) - -instance Functor (Validation e) where - fmap :: (a -> b) -> Validation e a -> Validation e b - fmap _ (Failure e) = Failure e - fmap f (Success a) = Success (f a) - {-# INLINE fmap #-} - - (<$) :: a -> Validation e b -> Validation e a - x <$ Success _ = Success x - _ <$ Failure e = Failure e - {-# INLINE (<$) #-} - -{- | __Examples__ - ->>> 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 - ->>> fa <*> b -Success 21 - ->>> fa <*> c -Failure ["Not correct"] - ->>> c *> d *> b -Failure ["Not correct","Not correct either"] - ->>> liftA2 (+) a b -Success 8 - ->>> liftA2 (+) a c -Failure ["Not correct"] --} -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 - 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 - {-# 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 - {-# INLINE (<*) #-} - -instance (Semigroup e, Monoid e) => Alternative (Validation e) where - empty :: Validation e a - empty = Failure mempty - {-# INLINE empty #-} - - (<|>) :: Validation e a -> Validation e a -> Validation e a - s@Success{} <|> _ = s - _ <|> s@Success{} = s - Failure e <|> Failure e' = Failure (e <> e') - {-# INLINE (<|>) #-} - -instance Foldable (Validation e) where - fold :: Monoid m => Validation e m -> m - fold (Success a) = a - fold (Failure _) = mempty - {-# INLINE fold #-} - - foldMap :: Monoid m => (a -> m) -> Validation e a -> m - foldMap _ (Failure _) = mempty - foldMap f (Success a) = f a - {-# INLINE foldMap #-} - - foldr :: (a -> b -> b) -> b -> Validation e a -> b - foldr f x (Success a) = f a x - foldr _ x (Failure _) = x - {-# INLINE foldr #-} - -instance Traversable (Validation e) where - traverse :: Applicative f => (a -> f b) -> Validation e a -> f (Validation e b) - traverse f (Success a) = Success <$> f a - traverse _ (Failure e) = pure (Failure e) - {-# INLINE traverse #-} - - sequenceA :: Applicative f => Validation e (f a) -> f (Validation e a) - sequenceA = traverse id - {-# INLINE sequenceA #-} - -instance Bifunctor Validation where - bimap :: (e -> d) -> (a -> b) -> Validation e a -> Validation d b - bimap f _ (Failure e) = Failure (f e) - bimap _ g (Success a) = Success (g a) - {-# INLINE bimap #-} - - first :: (e -> d) -> Validation e a -> Validation d a - first f (Failure e) = Failure (f e) - first _ (Success a) = Success a - {-# INLINE first #-} - - second :: (a -> b) -> Validation e a -> Validation e b - second _ (Failure e) = Failure e - second g (Success a) = Success (g a) - {-# INLINE second #-} - -#if MIN_VERSION_base(4,10,0) -instance Bifoldable Validation where - bifoldMap :: Monoid m => (e -> m) -> (a -> m) -> Validation e a -> m - bifoldMap f _ (Failure e) = f e - bifoldMap _ g (Success a) = g a - {-# INLINE bifoldMap #-} - -instance Bitraversable Validation where - bitraverse :: Applicative f - => (e -> f d) -> (a -> f b) -> Validation e a -> f (Validation d b) - bitraverse f _ (Failure e) = Failure <$> f e - bitraverse _ g (Success a) = Success <$> g a - {-# INLINE bitraverse #-} -#endif - --- | Transform a 'Validation' into an 'Either'. -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'. -eitherToValidation :: Either e a -> Validation e a -eitherToValidation = \case - Left e -> Failure e - Right a -> Success a -{-# INLINE eitherToValidation #-} diff --git a/src/Relude/File.hs b/src/Relude/File.hs --- a/src/Relude/File.hs +++ b/src/Relude/File.hs @@ -1,33 +1,59 @@ +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.File +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Functions to work with files for 'Text', 'LText', 'ByteString' and 'LByteString' -types. +Lifted to 'MonadIO' families of file processing functions for the '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, +line-endings). If you want binary data, use 'ByteString' functions (they are +also faster since they don't check encoding). However, you can then decode that +data with the help of functions from the "Relude.String.Conversion" module, e. g. +'Relude.String.Conversion.decodeUtf8'. + +To be more precise, avoid the following functions: + +* 'readFileText' +* 'readFileLText' + +See the following blog post for more details: + +* [Beware of readFile by Michael Snoyman](https://www.snoyman.com/blog/2016/12/beware-of-readfile/) + +@since 0.3.0 -} module Relude.File - ( -- * Text - readFileText - , writeFileText - , appendFileText + ( -- * Text + readFileText + , writeFileText + , appendFileText - -- * Lazy Text - , readFileLText - , writeFileLText - , appendFileLText + -- * Lazy Text + , readFileLText + , writeFileLText + , appendFileLText - -- * ByteString - , readFileBS - , writeFileBS - , appendFileBS + -- * ByteString + , readFileBS + , writeFileBS + , appendFileBS - -- * Lazy ByteString - , readFileLBS - , writeFileLBS - , appendFileLBS - ) where + -- * Lazy ByteString + , readFileLBS + , writeFileLBS + , appendFileLBS + ) where import Relude.Base (FilePath, IO) import Relude.Function ((.)) @@ -39,23 +65,34 @@ import qualified Data.Text.IO as T import qualified Data.Text.Lazy.IO as LT + ---------------------------------------------------------------------------- -- Text ---------------------------------------------------------------------------- --- | Lifted version of 'T.readFile'. +{- | Lifted version of 'T.readFile'. + +@since 0.3.0 +-} readFileText :: MonadIO m => FilePath -> m Text readFileText = liftIO . T.readFile {-# SPECIALIZE readFileText :: FilePath -> IO Text #-} -{-# INLINE readFileText #-} +{-# INLINE readFileText #-} +{-# WARNING readFileText ["'readFileText' depends on the system's locale settings and can throw unexpected exceptions.", "Use 'readFileBS' instead."] #-} --- | Lifted version of 'T.writeFile'. +{- | Lifted version of 'T.writeFile'. + +@since 0.3.0 +-} writeFileText :: MonadIO m => FilePath -> Text -> m () writeFileText p = liftIO . T.writeFile p {-# SPECIALIZE writeFileText :: FilePath -> Text -> IO () #-} {-# INLINE writeFileText #-} --- | Lifted version of 'T.appendFile'. +{- | Lifted version of 'T.appendFile'. + +@since 0.3.0 +-} appendFileText :: MonadIO m => FilePath -> Text -> m () appendFileText p = liftIO . T.appendFile p {-# SPECIALIZE appendFileText :: FilePath -> Text -> IO () #-} @@ -65,19 +102,29 @@ -- Lazy Text ---------------------------------------------------------------------------- --- | Lifted version of 'LT.readFile'. +{- | Lifted version of 'LT.readFile'. + +@since 0.3.0 +-} readFileLText :: MonadIO m => FilePath -> m LText readFileLText = liftIO . LT.readFile {-# SPECIALIZE readFileLText :: FilePath -> IO LText #-} -{-# INLINE readFileLText #-} +{-# INLINE readFileLText #-} +{-# WARNING readFileLText ["'readFileLText' depends on the system's locale settings and can throw unexpected exceptions.", "Use 'readFileLBS' instead."] #-} --- | Lifted version of 'LT.writeFile'. +{- | Lifted version of 'LT.writeFile'. + +@since 0.3.0 +-} writeFileLText :: MonadIO m => FilePath -> LText -> m () writeFileLText p = liftIO . LT.writeFile p {-# SPECIALIZE writeFileLText :: FilePath -> LText -> IO () #-} {-# INLINE writeFileLText #-} --- | Lifted version of 'LT.appendFile'. +{- | Lifted version of 'LT.appendFile'. + +@since 0.3.0 +-} appendFileLText :: MonadIO m => FilePath -> LText -> m () appendFileLText p = liftIO . LT.appendFile p {-# SPECIALIZE appendFileLText :: FilePath -> LText -> IO () #-} @@ -87,19 +134,28 @@ -- ByteString ---------------------------------------------------------------------------- --- | Lifted version of 'BS.readFile'. +{- | Lifted version of 'BS.readFile'. + +@since 0.3.0 +-} readFileBS :: MonadIO m => FilePath -> m ByteString readFileBS = liftIO . BS.readFile {-# SPECIALIZE readFileBS :: FilePath -> IO ByteString #-} -{-# INLINE readFileBS #-} +{-# INLINE readFileBS #-} --- | Lifted version of 'BS.writeFile'. +{- | Lifted version of 'BS.writeFile'. + +@since 0.3.0 +-} writeFileBS :: MonadIO m => FilePath -> ByteString -> m () writeFileBS p = liftIO . BS.writeFile p {-# SPECIALIZE writeFileBS :: FilePath -> ByteString -> IO () #-} {-# INLINE writeFileBS #-} --- | Lifted version of 'BS.appendFile'. +{- | Lifted version of 'BS.appendFile'. + +@since 0.3.0 +-} appendFileBS :: MonadIO m => FilePath -> ByteString -> m () appendFileBS p = liftIO . BS.appendFile p {-# SPECIALIZE appendFileBS :: FilePath -> ByteString -> IO () #-} @@ -109,19 +165,28 @@ -- Lazy ByteString ---------------------------------------------------------------------------- --- | Lifted version of 'LBS.readFile'. +{- | Lifted version of 'LBS.readFile'. + +@since 0.3.0 +-} readFileLBS :: MonadIO m => FilePath -> m LByteString readFileLBS = liftIO . LBS.readFile {-# SPECIALIZE readFileLBS :: FilePath -> IO LByteString #-} -{-# INLINE readFileLBS #-} +{-# INLINE readFileLBS #-} --- | Lifted version of 'LBS.writeFile'. +{- | Lifted version of 'LBS.writeFile'. + +@since 0.3.0 +-} writeFileLBS :: MonadIO m => FilePath -> LByteString -> m () writeFileLBS p = liftIO . LBS.writeFile p {-# SPECIALIZE writeFileLBS :: FilePath -> LByteString -> IO () #-} {-# INLINE writeFileLBS #-} --- | Lifted version of 'LBS.appendFile'. +{- | Lifted version of 'LBS.appendFile'. + +@since 0.3.0 +-} appendFileLBS :: MonadIO m => FilePath -> LByteString -> m () appendFileLBS p = liftIO . LBS.appendFile p {-# SPECIALIZE appendFileLBS :: FilePath -> LByteString -> IO () #-} diff --git a/src/Relude/Foldable.hs b/src/Relude/Foldable.hs --- a/src/Relude/Foldable.hs +++ b/src/Relude/Foldable.hs @@ -1,15 +1,30 @@ +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Foldable +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -This module exports all 'Foldable' and 'Traversable' related stuff. +This module provides 'Foldable' and 'Traversable' related types and functions. -} module Relude.Foldable - ( module Relude.Foldable.Fold - , module Relude.Foldable.Reexport - ) where + ( module Relude.Foldable.Reexport + -- $reexport + , module Relude.Foldable.Fold + -- $fold + ) where import Relude.Foldable.Fold import Relude.Foldable.Reexport + +{- $reexport +Reexports types and functions from "Data.Foldable" and "Data.Traversable". +-} + +{- $fold +Type safe versions and additional functions to 'Foldable'. +-} diff --git a/src/Relude/Foldable/Fold.hs b/src/Relude/Foldable/Fold.hs --- a/src/Relude/Foldable/Fold.hs +++ b/src/Relude/Foldable/Fold.hs @@ -1,59 +1,70 @@ +{-# OPTIONS_GHC -Wno-redundant-constraints #-} + +{-# LANGUAGE CPP #-} + +#if __GLASGOW_HASKELL__ >= 902 +{-# OPTIONS_GHC -Wno-operator-whitespace #-} +#endif + {-# LANGUAGE DataKinds #-} -{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} - {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Foldable.Fold +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Fixes and additions to 'Foldable'. +Fixes and additions to 'Foldable'. Specifically: + +* Space-leak free 'sum' and 'product' +* 'elem' and 'notElem' are forbidden for 'Set' and 'HashSet' +* Additional combinators for common idioms -} module Relude.Foldable.Fold - ( flipfoldl' - , foldMapA - , asumMap - , foldMapM - , sum - , product + ( flipfoldl' + , asumMap + , foldMapA + , foldMapM - , elem - , notElem + , sum + , product - , allM - , anyM - , andM - , orM + , elem + , notElem - -- * Internals - , DisallowElem - , ElemErrorMessage - ) where + -- * Monadic functions + , allM + , anyM + , andM + , orM + ) where -import GHC.TypeLits (ErrorMessage (..), TypeError) +import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError) import Relude.Applicative (Alternative, Applicative (..), pure) -import Relude.Base (Constraint, Eq, IO, Num (..), 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, (.)) -import Relude.Functor ((<$>)) import Relude.Monad.Reexport (Monad (..)) -import Relude.Monoid (Alt(..), Monoid (..)) +import Relude.Monoid (Alt (..), Ap (..), Monoid (..), Semigroup) +import Relude.Numeric (Num (..)) import qualified Data.Foldable as F + -- $setup --- >>> :set -XOverloadedStrings -- >>> import Relude -- >>> import qualified Data.HashMap.Strict as HashMap @@ -61,34 +72,45 @@ >>> flipfoldl' (/) 5 [2,3] :: Rational 15 % 2 + +This function can be useful for constructing containers from lists. -} flipfoldl' :: Foldable f => (a -> b -> b) -> b -> f a -> b flipfoldl' f = foldl' (flip f) {-# INLINE flipfoldl' #-} -{- | Polymorphic version of @concatMapA@ function. +{- | Alternative version of 'Relude.Foldable.Reexport.asum' that takes a function to map over. +>>> asumMap (\x -> if x > 2 then Just x else Nothing) [1..4] +Just 3 + +@since 0.4.0 +-} +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 the 'concatMapA' function. + >>> foldMapA @[Int] (Just . replicate 3) [1..3] Just [1,1,1,2,2,2,3,3,3] --} -foldMapA :: forall b m f a . (Monoid b, Applicative m, Foldable f) => (a -> m b) -> f a -> m b -foldMapA f = foldr step (pure mempty) - where - step a mb = mappend <$> f a <*> mb -{-# INLINE foldMapA #-} -{- | Alternative version of @asum@ ->>> asumMap (\x -> if x > 2 then Just x else Nothing) [1..3] -Just 3 +@since 0.1.0 -} -asumMap :: (Foldable f, Alternative m) => (a -> m b) -> f a -> m b -asumMap f = getAlt . foldMap (Alt . f) -{-# INLINE asumMap #-} +foldMapA + :: forall b m f a . (Semigroup b, Monoid b, Applicative m, Foldable f) + => (a -> m b) + -> f a + -> m b +foldMapA = coerce (foldMap :: (a -> Ap m b) -> f a -> Ap m b) +{-# INLINE foldMapA #-} -{- | Polymorphic version of @concatMapM@ function. +{- | Polymorphic version of the 'Control.Monad.Extra.concatMapM' function. >>> foldMapM @[Int] (Just . replicate 3) [1..3] Just [1,1,1,2,2,2,3,3,3] + +@since 0.1.0 -} foldMapM :: forall b m f a . (Monoid b, Monad m, Foldable f) => (a -> m b) -> f a -> m b foldMapM f xs = foldr step return xs mempty @@ -120,17 +142,17 @@ 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 use - member :: ??? -- TODO + member :: Ord a => a -> Set a -> Bool ... Instead of notElem :: (Foldable t, Eq a) => a -> t a -> Bool use - notMember :: ??? -- TODO + not . member ... -} elem :: (Foldable f, DisallowElem f, Eq a) => a -> f a -> Bool @@ -143,17 +165,17 @@ 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 use - member :: ??? -- TODO + member :: Ord a => a -> Set a -> Bool ... Instead of notElem :: (Foldable t, Eq a) => a -> t a -> Bool use - notMember :: ??? -- TODO + not . member ... -} notElem :: (Foldable f, DisallowElem f, Eq a) => a -> f a -> Bool @@ -176,12 +198,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'. @@ -193,12 +212,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'. @@ -210,12 +226,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'. @@ -227,38 +240,37 @@ 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 ---------------------------------------------------------------------------- +{- | Type family that produces compile-time errors when 'elem' and 'notElem' +functions are used with 'Set' and 'HashSet'. +-} type family DisallowElem (f :: Type -> Type) :: Constraint where - DisallowElem Set = TypeError (ElemErrorMessage Set) - DisallowElem HashSet = TypeError (ElemErrorMessage HashSet) + DisallowElem Set = TypeError (ElemErrorMessage Set SetMemberType) + DisallowElem HashSet = TypeError (ElemErrorMessage HashSet HashSetMemberType) DisallowElem f = () -type family ElemErrorMessage (t :: k) :: ErrorMessage where - ElemErrorMessage t = - Text "Do not use 'elem' and 'notElem' methods from 'Foldable' on " :<>: ShowType t - :$$: Text "Suggestions:" - :$$: Text " Instead of" - :$$: Text " elem :: (Foldable t, Eq a) => a -> t a -> Bool" - :$$: Text " use" - :$$: Text " member :: ??? -- TODO" - :$$: Text "" - :$$: Text " Instead of" - :$$: Text " notElem :: (Foldable t, Eq a) => a -> t a -> Bool" - :$$: Text " use" - :$$: Text " notMember :: ??? -- TODO" - :$$: Text "" + +type family ElemErrorMessage (t :: k) (msg :: Symbol) :: ErrorMessage where + ElemErrorMessage t msg = + 'Text "Do not use 'elem' and 'notElem' methods from 'Foldable' on " ':<>: 'ShowType t + ':$$: 'Text "Suggestions:" + ':$$: 'Text " Instead of" + ':$$: 'Text " elem :: (Foldable t, Eq a) => a -> t a -> Bool" + ':$$: 'Text " use" + ':$$: 'Text " member :: " ':<>: 'Text msg + ':$$: 'Text "" + ':$$: 'Text " Instead of" + ':$$: 'Text " notElem :: (Foldable t, Eq a) => a -> t a -> Bool" + ':$$: 'Text " use" + ':$$: 'Text " not . member" + ':$$: 'Text "" + +type SetMemberType = "Ord a => a -> Set a -> Bool" +type HashSetMemberType = "(Eq a, Hashable a) => a -> HashSet a -> Bool" diff --git a/src/Relude/Foldable/Reexport.hs b/src/Relude/Foldable/Reexport.hs --- a/src/Relude/Foldable/Reexport.hs +++ b/src/Relude/Foldable/Reexport.hs @@ -1,30 +1,34 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Foldable.Reexport +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Reexports "Data.Foldable" and "Data.Traversable". -} module Relude.Foldable.Reexport - ( module Data.Foldable - , module Data.Traversable -#if MIN_VERSION_base(4,10,0) - , module Data.Bifoldable - , module Data.Bitraversable -#endif - ) where + ( -- * @Foldable@ reexports + module Data.Foldable + , module Data.Traversable + -- * @Bi@ reexports + , module Data.Bifoldable + , module Data.Bitraversable + ) where 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_) -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, bifoldl', bifoldlM, bifoldr', - bifoldrM, bifor_, bilength, binull, bior, bisequence_, - bitraverse_) -import Data.Bitraversable (Bitraversable (..), bifoldMapDefault, bifor, bimapDefault, bisequence) +#if MIN_VERSION_base(4,13,0) +import Data.Foldable (foldMap') #endif +import Data.Bifoldable (Bifoldable (..), biList, biall, biand, biany, biasum, bielem, bifind, + bifoldl', bifoldlM, bifoldr', bifoldrM, bifor_, bilength, binull, bior, + bisequence_, bitraverse_) +import Data.Bitraversable (Bitraversable (..), bifoldMapDefault, bifor, bimapDefault, bisequence) +import Data.Traversable (Traversable (..), forM, mapAccumL, mapAccumR) diff --git a/src/Relude/Function.hs b/src/Relude/Function.hs --- a/src/Relude/Function.hs +++ b/src/Relude/Function.hs @@ -1,25 +1,57 @@ +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Function +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -This module reexports very basic and primitive functions and function combinators. +This module reexports very basic and primitive functions and function +combinators. -} module Relude.Function - ( module Control.Arrow - , module Control.Category - , module Data.Function - , identity - ) where + ( -- * Reexports + -- ** "Data.Function" reexports + (.) + , ($) + , (&) + , id + , const + , flip + , fix + , on + -- ** "Control.Category" reexports + , (>>>) + , (<<<) + -- ** "Control.Arrow" reexports + , (&&&) + -- * Combinators + , identity + ) where + import Control.Arrow ((&&&)) 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 #-} diff --git a/src/Relude/Functor.hs b/src/Relude/Functor.hs --- a/src/Relude/Functor.hs +++ b/src/Relude/Functor.hs @@ -1,19 +1,33 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Functor +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Convenient functions to work with 'Functor'. -} module Relude.Functor - ( module Relude.Functor.Fmap - , module Relude.Functor.Reexport - ) where + ( module Relude.Functor.Reexport + -- $reexport + , module Relude.Functor.Fmap + -- $fmap + ) where import Relude.Functor.Fmap import Relude.Functor.Reexport + +{- $reexport +Reexports functionality for 'Functor' and 'Bifunctor' typeclasses. +-} + +{- $fmap +Additional useful combinators to work with 'Functor' type class. +For example, '<<$>>' and '??'. +-} diff --git a/src/Relude/Functor/Fmap.hs b/src/Relude/Functor/Fmap.hs --- a/src/Relude/Functor/Fmap.hs +++ b/src/Relude/Functor/Fmap.hs @@ -2,21 +2,24 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Functor.Fmap +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable This module contains useful functions to work with 'Functor' type class. -} module Relude.Functor.Fmap - ( (<<$>>) - , (<&>) - , flap - , (??) - ) where + ( (<<$>>) + , (<&>) + , flap + , (??) + ) where import Relude.Function ((.)) import Relude.Functor.Reexport (Functor (..)) @@ -27,7 +30,12 @@ #else --- | Flipped version of '<$>'. +{- | Flipped version of '<$>'. + +@ +f <$> a = a <&> f +@ +-} infixl 1 <&> (<&>) :: Functor f => f a -> (a -> b) -> f b as <&> f = f <$> as @@ -35,9 +43,9 @@ #endif -- $setup --- >>> import Relude.Base (negate, (*), (+)) -- >>> import Relude.Monad (Maybe (..)) -- >>> import Relude.List ((++)) +-- >>> import Relude.Numeric (negate, (*), (+)) {- | Alias for @fmap . fmap@. Convenient to work with two nested 'Functor's. @@ -53,6 +61,8 @@ >>> flap (++) "relude" "P" "Prelude" + +@since 0.3.0 -} flap :: Functor f => f (a -> b) -> a -> f b flap ff x = (\f -> f x) <$> ff @@ -65,6 +75,8 @@ >>> Just (+3) ?? 5 Just 8 + +@since 0.3.0 -} infixl 4 ?? (??) :: Functor f => f (a -> b) -> a -> f b diff --git a/src/Relude/Functor/Reexport.hs b/src/Relude/Functor/Reexport.hs --- a/src/Relude/Functor/Reexport.hs +++ b/src/Relude/Functor/Reexport.hs @@ -2,24 +2,30 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Functor.Reexport +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Reexports functionality regarding 'Functor' and 'Bifunctor' typeclasses. -} module Relude.Functor.Reexport - ( module Data.Bifunctor - , module Data.Functor - , module Data.Functor.Compose - , module Data.Functor.Identity + ( -- * Reexport Functor + module Data.Functor + , module Data.Functor.Compose + , module Data.Functor.Identity #if MIN_VERSION_base(4,12,0) - , module Data.Functor.Contravariant + , module Data.Functor.Contravariant #endif - ) where + + -- * Reexport Bifunctor + , module Data.Bifunctor + ) where import Data.Bifunctor (Bifunctor (..)) import Data.Functor (Functor (..), void, ($>), (<$>)) diff --git a/src/Relude/Lifted.hs b/src/Relude/Lifted.hs --- a/src/Relude/Lifted.hs +++ b/src/Relude/Lifted.hs @@ -1,23 +1,110 @@ +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Lifted +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Lifted versions of base functions. + +These functions are lifted in a sense that you can use them inside various +monad transformers without adding 'Relude.Monad.Reexport.liftIO' calls +explicitly. However, you still can use all these functions inside plain + t'Relude.Base.IO' monad as usual. + +=== Example + +==== @base@ + +With the @base@ function, you can easily work with these functions in the + t'Relude.Base.IO' monad: + +@ +__main__ :: t'Relude.Base.IO' () +__main__ = __do__ + x <- 'Data.Text.getLine' + 'Prelude.print' x +@ + +However, to work in t'Relude.Monad.Reexport.MonadIO' you already need to "lift" them: + +@ +__main__ :: t'Relude.Monad.Reexport.MonadIO' m => m () +__main__ = __do__ + x <- 'Relude.Monad.Reexport.liftIO' 'Data.Text.getLine' + 'Relude.Monad.Reexport.liftIO' ('Prelude.print' x) +@ + +==== @relude@ + +In the meantime, @relude@ provides these function that can work in t'Relude.Base.IO' +the same way: + +@ +__main__ :: t'Relude.Base.IO' () +__main__ = __do__ + x <- 'getLine' + 'print' x +@ + +But also allows you to work in the t'Relude.Monad.Reexport.MonadIO' monads more easily: + +@ +__main__ :: t'Relude.Monad.Reexport.MonadIO' m => m () +__main__ = __do__ + x <- 'getLine' + 'print' x +@ -} module Relude.Lifted - ( module Relude.Lifted.Concurrent - , module Relude.Lifted.Exit - , module Relude.Lifted.File - , module Relude.Lifted.IORef - , module Relude.Lifted.Terminal - ) where + ( module Relude.Lifted.Concurrent + -- $concurrent + , module Relude.Lifted.IORef + -- $ioref + , module Relude.Lifted.Exit + -- $exit + , module Relude.Lifted.File + -- $file + , module Relude.Lifted.Terminal + -- $terminal + , module Relude.Lifted.Handle + -- $handle + , module Relude.Lifted.Env + -- $env + ) where import Relude.Lifted.Concurrent import Relude.Lifted.Exit import Relude.Lifted.File import Relude.Lifted.IORef import Relude.Lifted.Terminal +import Relude.Lifted.Handle +import Relude.Lifted.Env + +{- $concurrent +Lifted 'MVar' and 'STM' functions. +-} +{- $exit +Lifted versions of functions that work with exit processes. +-} +{- $file +Lifted versions of functions working with files and common t'Relude.Base.IO'. +-} +{- $ioref +Lifted reexports from "Data.IORef" module. +-} +{- $terminal +Lifted functions to work with stdin and stdout. +-} +{- $handle +Lifted functions to work with t'Relude.Base.IO' 'Handle's. +-} +{- $env +Lifted functions to work with system environment. +-} diff --git a/src/Relude/Lifted/Concurrent.hs b/src/Relude/Lifted/Concurrent.hs --- a/src/Relude/Lifted/Concurrent.hs +++ b/src/Relude/Lifted/Concurrent.hs @@ -1,54 +1,84 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Lifted.Concurrent +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Lifted 'MVar' and 'STM' functions. -} module Relude.Lifted.Concurrent - ( -- * MVar - MVar - , newEmptyMVar - , newMVar - , putMVar - , readMVar - , swapMVar - , takeMVar - , tryPutMVar - , tryReadMVar - , tryTakeMVar + ( -- * MVar + MVar + , newEmptyMVar + , newMVar + , putMVar + , readMVar + , swapMVar + , takeMVar + , tryPutMVar + , tryReadMVar + , tryTakeMVar - -- * STM - , STM - , TVar - , atomically - , newTVarIO - , readTVarIO - , STM.modifyTVar' - , STM.newTVar - , STM.readTVar - , STM.writeTVar - ) where + -- * STM + , STM + , atomically + , STM.throwSTM + , STM.catchSTM + -- * TVar + , TVar + , newTVarIO + , readTVarIO + , STM.modifyTVar' + , STM.newTVar + , STM.readTVar + , STM.writeTVar + + -- * TMVar + , TMVar + , STM.newTMVar + , STM.newEmptyTMVar + , newTMVarIO + , newEmptyTMVarIO + , STM.takeTMVar + , STM.putTMVar + , STM.readTMVar + , STM.tryReadTMVar + , STM.swapTMVar + , STM.tryTakeTMVar + , STM.tryPutTMVar + , STM.isEmptyTMVar + , STM.mkWeakTMVar + ) where + import Control.Concurrent.MVar (MVar) +import Control.Concurrent.STM.TMVar (TMVar) 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.TMVar as STM (isEmptyTMVar, mkWeakTMVar, newEmptyTMVar, + newEmptyTMVarIO, newTMVar, newTMVarIO, + putTMVar, readTMVar, swapTMVar, takeTMVar, + tryPutTMVar, tryReadTMVar, tryTakeTMVar) import qualified Control.Concurrent.STM.TVar as STM (modifyTVar', newTVar, newTVarIO, readTVar, readTVarIO, writeTVar) -import qualified Control.Monad.STM as STM (atomically) +import qualified Control.Monad.STM as STM (atomically, catchSTM, throwSTM) + ---------------------------------------------------------------------------- -- Lifted Control.Concurrent.MVar ---------------------------------------------------------------------------- @@ -57,46 +87,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 +145,28 @@ 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 #-} + +-- | Lifted to 'MonadIO' version of 'STM.newTMVarIO'. +newTMVarIO :: MonadIO m => a -> m (TMVar a) +newTMVarIO = liftIO . STM.newTMVarIO +{-# INLINE newTMVarIO #-} +{-# SPECIALIZE newTMVarIO :: a -> IO (TMVar a) #-} + +-- | Lifted to 'MonadIO' version of 'STM.newEmptyTMVarIO'. +newEmptyTMVarIO :: MonadIO m => m (TMVar a) +newEmptyTMVarIO = liftIO STM.newEmptyTMVarIO +{-# INLINE newEmptyTMVarIO #-} +{-# SPECIALIZE newEmptyTMVarIO :: IO (TMVar a) #-} diff --git a/src/Relude/Lifted/Env.hs b/src/Relude/Lifted/Env.hs new file mode 100644 --- /dev/null +++ b/src/Relude/Lifted/Env.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE Safe #-} + +{- | +Module : Relude.Lifted.Env +Copyright : (c) 2020-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +Lifted functions to work with system environment. + +@since 1.0.0.0 +-} + +module Relude.Lifted.Env + ( getArgs + , lookupEnv + ) where + +import Relude.Base (IO) +import Relude.Function ((.)) +import Relude.Monad.Reexport (MonadIO (..), Maybe) +import Relude.String.Reexport (String) + +import qualified System.Environment as ENV (getArgs, lookupEnv) + +{- | Lifted version of 'System.Environment.getArgs'. + +@since 1.0.0.0 +-} +getArgs :: MonadIO m => m [String] +getArgs = liftIO ENV.getArgs +{-# SPECIALIZE getArgs :: IO [String] #-} +{-# INLINE getArgs #-} + +{- | Lifted version of 'System.Environment.lookupEnv'. + +@since 1.0.0.0 +-} +lookupEnv :: MonadIO m => String -> m (Maybe String) +lookupEnv = liftIO . ENV.lookupEnv +{-# SPECIALIZE lookupEnv :: String -> IO (Maybe String) #-} +{-# INLINE lookupEnv #-} diff --git a/src/Relude/Lifted/Exit.hs b/src/Relude/Lifted/Exit.hs --- a/src/Relude/Lifted/Exit.hs +++ b/src/Relude/Lifted/Exit.hs @@ -1,21 +1,24 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Lifted.Exit +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Lifted versions of functions that work with exit processes. -} module Relude.Lifted.Exit - ( exitWith - , exitFailure - , exitSuccess - , die - ) where + ( exitWith + , exitFailure + , exitSuccess + , die + ) where import Control.Monad.Trans (MonadIO, liftIO) import Data.String (String) @@ -23,22 +26,44 @@ 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 #-} diff --git a/src/Relude/Lifted/File.hs b/src/Relude/Lifted/File.hs --- a/src/Relude/Lifted/File.hs +++ b/src/Relude/Lifted/File.hs @@ -1,22 +1,32 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Lifted.File +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Lifted versions of functions working with files and common IO. -} module Relude.Lifted.File - ( readFile - , writeFile - , appendFile - ) where + ( readFile +#if ( __GLASGOW_HASKELL__ >= 900 ) + , readFile' +#endif + , writeFile + , 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 @@ -26,6 +36,19 @@ readFile = liftIO . IO.readFile {-# SPECIALIZE readFile :: FilePath -> IO String #-} {-# INLINE readFile #-} +{-# WARNING readFile ["'readFile' depends on the system's locale settings and can throw unexpected exceptions.", "Use 'readFileBS' or 'readFileLBS' instead."] #-} + +#if ( __GLASGOW_HASKELL__ >= 900 ) +{- | Lifted version of 'IO.readFile''. Strict version of 'readFile'. + +@since 1.0.0.0 +-} +readFile' :: MonadIO m => FilePath -> m String +readFile' = liftIO . IO.readFile' +{-# SPECIALIZE readFile' :: FilePath -> IO String #-} +{-# INLINE readFile' #-} +{-# WARNING readFile' ["readFile' depends on the system's locale settings and can throw unexpected exceptions.", "Use 'readFileBS' or 'readFileLBS' instead."] #-} +#endif -- | Lifted version of 'IO.writeFile'. writeFile :: MonadIO m => FilePath -> String -> m () diff --git a/src/Relude/Lifted/Handle.hs b/src/Relude/Lifted/Handle.hs new file mode 100644 --- /dev/null +++ b/src/Relude/Lifted/Handle.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE Safe #-} + +{- | +Module : Relude.Lifted.Handle +Copyright : (c) 2020-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +Lifted functions to work with 'IO' 'Handle's. + +@since 1.0.0.0 +-} + +module Relude.Lifted.Handle + ( hFlush + , hIsEOF + , hSetBuffering + , hGetBuffering + , Handle + , stdin + , stdout + , stderr + , withFile + , BufferMode (..) + ) where + +import Relude.Base (IO) +import Relude.Function ((.)) +import Relude.Bool (Bool (..)) +import Relude.Monad.Reexport (MonadIO (..)) +import qualified System.IO as IO (Handle, hFlush, hIsEOF, hSetBuffering, hGetBuffering, BufferMode) +import System.IO (Handle, stdin, stdout, stderr, withFile, BufferMode (..)) + +{- | Lifted version of 'IO.hFlush'. + +@since 1.0.0.0 +-} +hFlush :: MonadIO m => IO.Handle -> m () +hFlush = liftIO . IO.hFlush +{-# SPECIALIZE hFlush :: IO.Handle -> IO () #-} +{-# INLINE hFlush #-} + +{- | Lifted version of 'IO.hIsEOF'. + +@since 1.0.0.0 +-} +hIsEOF :: MonadIO m => IO.Handle -> m Bool +hIsEOF = liftIO . IO.hIsEOF +{-# SPECIALIZE hIsEOF :: IO.Handle -> IO Bool #-} +{-# INLINE hIsEOF #-} + +{- | Lifted version of 'IO.hSetBuffering'. + +@since 1.0.0.0 +-} +hSetBuffering :: MonadIO m => IO.Handle -> IO.BufferMode -> m () +hSetBuffering h = liftIO . IO.hSetBuffering h +{-# SPECIALIZE hSetBuffering :: IO.Handle -> IO.BufferMode -> IO () #-} +{-# INLINE hSetBuffering #-} + +{- | Lifted version of 'IO.hGetBuffering'. + +@since 1.0.0.0 +-} +hGetBuffering :: MonadIO m => IO.Handle -> m IO.BufferMode +hGetBuffering = liftIO . IO.hGetBuffering +{-# SPECIALIZE hGetBuffering :: IO.Handle -> IO IO.BufferMode #-} +{-# INLINE hGetBuffering #-} diff --git a/src/Relude/Lifted/IORef.hs b/src/Relude/Lifted/IORef.hs --- a/src/Relude/Lifted/IORef.hs +++ b/src/Relude/Lifted/IORef.hs @@ -1,70 +1,185 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Lifted.IORef +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Lifted reexports from 'Data.IORef' module. +Lifted reexports from "Data.IORef" module. -} module Relude.Lifted.IORef - ( IORef - , atomicModifyIORef - , atomicModifyIORef' - , atomicWriteIORef - , modifyIORef - , modifyIORef' - , newIORef - , readIORef - , writeIORef - ) where + ( IORef + , atomicModifyIORef + , atomicModifyIORef' + , atomicModifyIORef_ + , atomicModifyIORef'_ + , atomicWriteIORef + , modifyIORef + , modifyIORef' + , newIORef + , readIORef + , writeIORef + ) where import Control.Monad.Trans (MonadIO, liftIO) 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 + +* To avoid space-leaks, see 'modifyIORef'' for stricter updates +* For atomic updates, see 'atomicModifyIORef' +-} 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 + +* For lazier updates, see 'modifyIORef' +* For atomic updates, see 'atomicModifyIORef'' +-} 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 + +* To avoid space-leaks, see 'atomicModifyIORef'' for stricter updates +* If you are not interested in the return value, see 'atomicModifyIORef_' +-} 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 + +* For lazier updates, see 'atomicModifyIORef' +* If you are not interested in the return value, see 'atomicModifyIORef'_' +-} 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'. +{- | Version of 'atomicModifyIORef' that discards return value. Useful +when you want to update 'IORef' but not interested in the returning +result. + +>>> ref <- newIORef 42 +>>> atomicModifyIORef_ ref (`div` 2) +>>> readIORef ref +21 + +@since 0.7.0.0 +-} +atomicModifyIORef_ :: MonadIO m => IORef a -> (a -> a) -> m () +atomicModifyIORef_ ref f = atomicModifyIORef ref $ \a -> (f a, ()) +{-# INLINE atomicModifyIORef_ #-} +{-# SPECIALIZE atomicModifyIORef_ :: IORef a -> (a -> a) -> IO () #-} + +{- | Version of 'atomicModifyIORef'' that discards return value. Useful +when you want to update 'IORef' but not interested in the returning +result. + +>>> ref <- newIORef 42 +>>> atomicModifyIORef'_ ref (`div` 2) +>>> readIORef ref +21 + +@since 0.7.0.0 +-} +atomicModifyIORef'_ :: MonadIO m => IORef a -> (a -> a) -> m () +atomicModifyIORef'_ ref f = atomicModifyIORef' ref $ \a -> (f a, ()) +{-# INLINE atomicModifyIORef'_ #-} +{-# SPECIALIZE atomicModifyIORef'_ :: IORef a -> (a -> a) -> IO () #-} + +{- | 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 () #-} diff --git a/src/Relude/Lifted/Terminal.hs b/src/Relude/Lifted/Terminal.hs --- a/src/Relude/Lifted/Terminal.hs +++ b/src/Relude/Lifted/Terminal.hs @@ -1,27 +1,33 @@ -{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE Safe #-} {- | -Copyright: (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Lifted.Terminal +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Lifted functions to work with stdin and stdout. + +@since 0.3.0 -} module Relude.Lifted.Terminal - ( getLine - , print - , putStr - , putStrLn - ) where + ( getLine + , print + , putStr + , 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 diff --git a/src/Relude/List.hs b/src/Relude/List.hs --- a/src/Relude/List.hs +++ b/src/Relude/List.hs @@ -1,19 +1,125 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.List +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Utility functions to work with lists. +Utility functions to work with lists and 'NonEmpty' lists. -} module Relude.List - ( module Relude.List.NonEmpty - , module Relude.List.Reexport - ) where + ( module Relude.List.Reexport + -- $reexport + , module Relude.List.NonEmpty + -- $nonempty + , (!!?) + , maybeAt + , partitionWith + ) where + +import Relude.Base ((<)) +import Relude.Bool (otherwise) +import Relude.Function (flip, (.)) import Relude.List.NonEmpty import Relude.List.Reexport +import Relude.Monad (Either, Maybe (..), partitionEithers) +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 (!!?) #-} + +{- | '!!?' with its arguments flipped. + +Get element from list using index value starting from `0`. + +>>> maybeAt 0 [] +Nothing + +>>> maybeAt 3 ["a", "b", "c"] +Nothing + +>>> maybeAt (-1) [1, 2, 3] +Nothing + +>>> maybeAt 2 ["a", "b", "c"] +Just "c" + +@since 1.0.0.0 +-} +maybeAt :: Int -> [a] -> Maybe a +maybeAt = flip (!!?) +{-# INLINE maybeAt #-} + +{- | Partitions a list based on the result of function which produces an Either +value. List of all elements producing Left are extracted, in order, to the first +element of the output tuple. Similarly, a list of all elements producing Right +are extracted to the second element of output. + +>>> :{ + divideEvenOrShow :: Int -> Either Int String + divideEvenOrShow n + | even n = Left $ n `div` 2 + | otherwise = Right $ "Odd: " <> show n + :} + +>>> partitionWith divideEvenOrShow [1 .. 6] +([1,2,3],["Odd: 1","Odd: 3","Odd: 5"]) + +@since 1.0.0.0 +-} +partitionWith :: (a -> Either b c) -> [a] -> ([b], [c]) +partitionWith f = partitionEithers . map f +{-# INLINE partitionWith #-} + +{- $reexport +Most of the "Data.List" types and function. + +Note, that list partial functions (e.g. 'Data.List.head') are not exported from +"Data.List". +Instead @relude@ provides safe functions that work with +'Data.List.NonEmpty.NonEmpty'. You can find them in the +"Relude.List.NonEmpty" module instead. +-} + +{- $nonempty +Reexports from "Data.List.NonEmpty" and additional safe functions to work with +list type in terms of 'NonEmpty'. +-} diff --git a/src/Relude/List/NonEmpty.hs b/src/Relude/List/NonEmpty.hs --- a/src/Relude/List/NonEmpty.hs +++ b/src/Relude/List/NonEmpty.hs @@ -1,36 +1,124 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 902 +{-# OPTIONS_GHC -Wno-operator-whitespace #-} +#endif + +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.List.NonEmpty +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -This module contains safe functions to work with list type in terms of 'NonEmpty'. +This module contains reexports from "Data.List.NonEmpty" and safe functions to +work with list type in terms of '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. + ++------------+--------------+-----------------------+ +| | @base@ | @relude@ | ++============+==============+=======================+ +| __'head'__ | @[a] -> a@ | @'NonEmpty' a -> a@ | ++------------+--------------+-----------------------+ +| __'tail'__ | @[a] -> [a]@ | @'NonEmpty' a -> [a]@ | ++------------+--------------+-----------------------+ +| __'last'__ | @[a] -> a@ | @'NonEmpty' a -> a@ | ++------------+--------------+-----------------------+ +| __'init'__ | @[a] -> [a]@ | @'NonEmpty' a -> [a]@ | ++------------+--------------+-----------------------+ + +@relude@ also provides custom type error for better experience with transition +from lists to 'NonEmpty' with those functions. + + +Let's examine the behaviour of the @relude@ list functions comparing to the +corresponding @base@ one on the example of the 'head' function: + ++-----------------+-----------------------------------------+ +| | 'head' | ++=================+=========================================+ +| __@base@__ | @[a] -> a@ | ++-----------------+-----------------------------------------+ +| __@relude@__ | @'NonEmpty' a -> a@ | ++-----------------+-----------------------------------------+ +| Example | @> 'Data.List.head' [1..5]@ | +| with list +-----------------------------------------+ +| __@base@__ | @1@ | ++-----------------+-----------------------------------------+ +| Example | @> 'Data.List.head' []@ | +| with empty list +-----------------------------------------+ +| __@base@__ |@*** Exception: Prelude.head: empty list@| ++-----------------+-----------------------------------------+ +| Example |@> 'head' $ 1 :| [2..5]@ | +| with 'NonEmpty' +-----------------------------------------+ +| __@relude@__ | @1@ | ++-----------------+-----------------------------------------+ +| Example | @> 'viaNonEmpty' 'head' [1..5]@ | +| with list +-----------------------------------------+ +| __@relude@__ | @'Just' 1@ | ++-----------------+-----------------------------------------+ +| Example |@> 'viaNonEmpty' 'head' []@ | +| with empty list +-----------------------------------------+ +| __@relude@__ | @'Nothing'@ | ++-----------------+-----------------------------------------+ + +@since 0.2.0 -} module Relude.List.NonEmpty - ( viaNonEmpty - , whenNotNull - , whenNotNullM - ) where + ( -- * Reexports from "DataList.NonEmpty" + NonEmpty (..) + , nonEmpty + , head + , tail + , last + , init + -- * Combinators + , viaNonEmpty + , whenNotNull + , whenNotNullM + ) where + +import Data.List.NonEmpty (NonEmpty (..), nonEmpty) +#if __GLASGOW_HASKELL__ >= 904 +import Data.Type.Equality (type (~)) +#endif +import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError) + import Relude.Applicative (Applicative, pass) +import Relude.Base (Constraint, Type) import Relude.Function ((.)) import Relude.Functor (fmap) -import Relude.List.Reexport (NonEmpty (..), nonEmpty) import Relude.Monad (Maybe (..), Monad (..)) +import qualified Data.List.NonEmpty as NE (head, init, last, tail) + + -- $setup -- >>> import Relude -{- | For safe work with lists using functinons for 'NonEmpty'. +{- | For safe work with lists using functions for 'NonEmpty'. >>> viaNonEmpty head [1] Just 1 >>> viaNonEmpty head [] Nothing + +@since 0.1.0 -} viaNonEmpty :: (NonEmpty a -> b) -> [a] -> Maybe b viaNonEmpty f = fmap f . nonEmpty @@ -41,7 +129,6 @@ >>> whenNotNull [] $ \(b :| _) -> print (not b) >>> whenNotNull [False,True] $ \(b :| _) -> print (not b) True - -} whenNotNull :: Applicative f => [a] -> (NonEmpty a -> f ()) -> f () whenNotNull [] _ = pass @@ -52,3 +139,187 @@ whenNotNullM :: Monad m => m [a] -> (NonEmpty a -> m ()) -> m () whenNotNullM ml f = ml >>= \l -> whenNotNull l f {-# INLINE whenNotNullM #-} + + +-- | 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 #-} diff --git a/src/Relude/List/Reexport.hs b/src/Relude/List/Reexport.hs --- a/src/Relude/List/Reexport.hs +++ b/src/Relude/List/Reexport.hs @@ -1,25 +1,48 @@ {-# LANGUAGE Trustworthy #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.List.Reexport +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Reexports most of the "Data.List" and "Data.List.NonEmpty". +Reexports most of the "Data.List". -} module Relude.List.Reexport - ( module Data.List - , module Data.List.NonEmpty - , module GHC.Exts - ) where + ( -- * List + module Data.List + , cycle + , sortWith + ) where -import Data.List (break, cycle, drop, dropWhile, filter, genericDrop, genericLength, - genericReplicate, genericSplitAt, genericTake, group, inits, intercalate, - 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 (break, drop, dropWhile, filter, genericDrop, genericLength, genericReplicate, + genericSplitAt, genericTake, group, inits, intercalate, intersperse, isPrefixOf, + iterate, map, permutations, repeat, replicate, reverse, scanl, scanl', scanl1, + scanr, scanr1, sort, sortBy, sortOn, span, splitAt, subsequences, tails, take, + takeWhile, transpose, uncons, unfoldr, unzip, unzip3, zip, zip3, zipWith, (++)) import GHC.Exts (sortWith) + + +-- $setup +-- >>> import Relude + +{- | Creates an infinite list from a finite list by appending the list +to itself infinite times (i.e. by cycling the list). Unlike @cycle@ +from "Data.List", this implementation doesn't throw error on empty +lists, but returns an empty list instead. + +>>> cycle [] +[] +>>> take 10 $ cycle [1,2,3] +[1,2,3,1,2,3,1,2,3,1] +-} +cycle :: [a] -> [a] +cycle [] = [] +cycle xs = cycledList + where + cycledList = xs ++ cycledList diff --git a/src/Relude/Monad.hs b/src/Relude/Monad.hs --- a/src/Relude/Monad.hs +++ b/src/Relude/Monad.hs @@ -1,23 +1,90 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Monad +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Reexporting useful monadic stuff. -} module Relude.Monad - ( module Relude.Monad.Either - , module Relude.Monad.Maybe - , module Relude.Monad.Reexport - , module Relude.Monad.Trans - ) where + ( module Relude.Monad.Reexport + -- $reexport + , module Relude.Monad.Maybe + -- $maybe + , module Relude.Monad.Either + -- $either + , module Relude.Monad.Trans + -- $trans + , chainedTo + , infinitely + ) where import Relude.Monad.Either import Relude.Monad.Maybe import Relude.Monad.Reexport import Relude.Monad.Trans +import Control.Applicative (Applicative) +import Relude.Base (Void) + + +-- $setup +-- >>> import Relude + +{- | For chaining monadic operations in forward applications using '(&)' +Named version of '=<<'. + +>>> Just [ 1 :: Int ] & chainedTo (viaNonEmpty head) +Just 1 +>>> Nothing & chainedTo (viaNonEmpty head) +Nothing + +@since 0.5.0 +-} +chainedTo :: Monad m => (a -> m b) -> m a -> m b +chainedTo = (=<<) +{-# INLINE chainedTo #-} + +{- | Repeat a monadic action indefinitely. + +This is a more type safe version of 'forever', which has a convenient +but unsafe type. + +Consider the following two examples. In the @getIntForever@ functions, it +falsely expects 'Int' as the result of the 'forever' function. But it would need +to wait *forever* to get that, and this mistake won't be caught by the type +system and compiler: + +@ +getIntForever :: IO Int +getIntForever = do + i <- forever $ do ... + pure i +@ + +In contrast, using 'infinitely' instead of 'forever' in 'foo' is a type error. + +@since 1.0.0.0 +-} +infinitely :: Applicative f => f a -> f Void +infinitely = forever +{-# INLINE infinitely #-} + +{- $reexport +Reexports functions to work with different monads. +-} +{- $maybe +Provided new combinators to work with 'Relude.Monad.Reexport.Maybe' data type. +-} +{- $either +Provided new combinators to work with 'Relude.Monad.Reexport.Either' data type. +-} +{- $trans +Monad transformers functions and combinators. +-} diff --git a/src/Relude/Monad/Either.hs b/src/Relude/Monad/Either.hs --- a/src/Relude/Monad/Either.hs +++ b/src/Relude/Monad/Either.hs @@ -1,151 +1,200 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE Safe #-} - {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Monad.Either +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Utilites to work with @Either@ data type. +Utilities to work with 'Relude.Monad.Reexport.Either' data type. -} module Relude.Monad.Either - ( fromLeft - , fromRight - , maybeToLeft - , maybeToRight - , leftToMaybe - , rightToMaybe - , whenLeft - , whenLeft_ - , whenLeftM - , whenLeftM_ - , whenRight - , whenRight_ - , whenRightM - , whenRightM_ - ) where + ( -- * Combinators + fromLeft + , fromRight + , maybeToLeft + , maybeToRight + , leftToMaybe + , rightToMaybe + , whenLeft + , whenLeft_ + -- * Monadic combinators + , whenLeftM + , whenLeftM_ + , whenRight + , whenRight_ + , whenRightM + , whenRightM_ + ) where + import Control.Applicative (Applicative) import Control.Monad (Monad (..)) +import Data.Either (fromLeft, fromRight) import Data.Function (const) import Data.Maybe (Maybe (..), maybe) 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) -#else --- | Extracts value from 'Left' or return given default value. --- --- >>> fromLeft 0 (Left 3) --- 3 --- >>> fromLeft 0 (Right 5) --- 0 -fromLeft :: a -> Either a b -> a -fromLeft _ (Left a) = a -fromLeft a (Right _) = a --- | Extracts value from 'Right' or return given default value. --- --- >>> fromRight 0 (Left 3) --- 0 --- >>> fromRight 0 (Right 5) --- 5 -fromRight :: b -> Either a b -> b -fromRight b (Left _) = b -fromRight _ (Right b) = b -#endif - -- $setup --- >>> import Relude.Bool (Bool (..)) +-- >>> import Relude +{- | For convenient work with 'MonadFail'. + +@since 0.1.0 +-} instance IsString str => MonadFail (Either str) where + fail :: String -> Either str a fail = Left . fromString + {-# INLINE fail #-} --- | 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_ #-} diff --git a/src/Relude/Monad/Maybe.hs b/src/Relude/Monad/Maybe.hs --- a/src/Relude/Monad/Maybe.hs +++ b/src/Relude/Monad/Maybe.hs @@ -1,28 +1,38 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Monad.Maybe +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Utility functions to work with 'Data.Maybe' data type as monad. +Utility functions to work with 'Relude.Monad.Reexport.Maybe' data type as monad. -} module Relude.Monad.Maybe - ( (?:) - , whenJust - , whenJustM - , whenNothing - , whenNothing_ - , whenNothingM - , whenNothingM_ - ) where + ( -- * Combinators + (?:) + , whenJust + , whenJustM + , whenNothing + , whenNothing_ + -- * Monadic combinators + , 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 +43,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.Foldable.Reexport.for_' for 'Maybe'. It's used for code readability. + Also helps to avoid space leaks: . >>> 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 'whenNothing'. + +>>> 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 'whenNothing_'. + +>>> 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 #-} diff --git a/src/Relude/Monad/Reexport.hs b/src/Relude/Monad/Reexport.hs --- a/src/Relude/Monad/Reexport.hs +++ b/src/Relude/Monad/Reexport.hs @@ -1,43 +1,50 @@ {-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Monad.Reexport +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Reexports functions to work with monads. -} module Relude.Monad.Reexport - ( -- * Reexport transformers - module Control.Monad.Except - , module Control.Monad.Reader - , module Control.Monad.State.Strict - , module Control.Monad.Trans - , module Control.Monad.Trans.Identity - , module Control.Monad.Trans.Maybe + ( -- * Reexport MonadIO + MonadIO (liftIO) - -- * Reexport monadic functions - , module Control.Monad - , module Control.Monad.Fail + -- * Reexport transformers + , module Control.Monad.Except + , module Control.Monad.Reader + , module Control.Monad.State.Strict + , module Control.Monad.Trans + , module Control.Monad.Trans.Identity + , module Control.Monad.Trans.Maybe - -- * Reexport 'Maybe' - , module Data.Maybe + -- * Reexport monadic functions + , module Control.Monad + , module Control.Monad.Fail - -- * Reexport 'Either' - , module Data.Either - ) where + -- * Reexport 'Maybe' + , module Data.Maybe + -- * Reexport 'Either' + , module Data.Either + ) where + -- Monad transformers +import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Except (ExceptT (..), runExceptT) import Control.Monad.Reader (MonadReader, Reader, ReaderT (..), ask, asks, local, reader, runReader, withReader, withReaderT) import Control.Monad.State.Strict (MonadState, State, StateT (..), evalState, evalStateT, execState, execStateT, get, gets, modify, modify', put, runState, state, withState) -import Control.Monad.Trans (MonadIO, MonadTrans, lift, liftIO) +import Control.Monad.Trans (MonadTrans, lift) import Control.Monad.Trans.Identity (IdentityT (runIdentityT)) import Control.Monad.Trans.Maybe (MaybeT (..), exceptToMaybeT, maybeToExceptT) diff --git a/src/Relude/Monad/Trans.hs b/src/Relude/Monad/Trans.hs --- a/src/Relude/Monad/Trans.hs +++ b/src/Relude/Monad/Trans.hs @@ -1,50 +1,104 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Monad.Trans +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Monad transformers utilities. -} module Relude.Monad.Trans - ( -- * Convenient functions to work with 'Reader' monad - usingReader - , usingReaderT + ( -- * Convenient functions to work with 'Reader' monad + usingReader + , usingReaderT + , etaReaderT - -- * Convenient functions to work with 'State' monad - , evaluatingState - , evaluatingStateT - , executingState - , executingStateT - , usingState - , usingStateT - -- * Lifted to Transformers - , hoistMaybe - , hoistEither - ) where + -- * Convenient functions to work with 'State' monad + , evaluatingState + , evaluatingStateT + , executingState + , executingStateT + , usingState + , usingStateT -import Prelude (flip, fst, snd) + -- * Lifted to Transformers + , hoistMaybe + , hoistEither + ) where +import GHC.Exts (oneShot) + import Relude.Applicative (Applicative (pure)) +import Relude.Container.Reexport (fst, snd) +import Relude.Function (flip, (.)) import Relude.Functor (Functor, (<$>)) -import Relude.Monad.Reexport (Either, ExceptT (..), Maybe, MaybeT (..), Reader, ReaderT, State, +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@. +{- | This function helps with optimizing performance when working with +the 'ReaderT' transformer. If you have code like below, that is +called in a loop + +@ +step :: Instruction -> 'ReaderT' Config IO Result +step instruction = __case__ instruction __of__ + Add -> __do__ stuff ... + Del -> __do__ stuff ... +@ + +you can improve performance of your Haskell applications by using +'etaReaderT' in the following way: + +@ +step :: Instruction -> 'ReaderT' Config IO Result +step instruction = 'etaReaderT' $ __case__ instruction __of__ + Add -> __do__ stuff ... + Del -> __do__ stuff ... +@ + +For a detailed explanation, refer to the following blog post: + +* + +@since 0.7.0.0 +-} +etaReaderT :: ReaderT r m a -> ReaderT r m a +etaReaderT = ReaderT . oneShot . runReaderT +{-# INLINE etaReaderT #-} + +{- | 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,37 +108,46 @@ 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 --- | Lift a 'Maybe' to the 'MaybeT' monad +@since 0.3.0 +-} hoistMaybe :: Applicative m => Maybe a -> MaybeT m a hoistMaybe m = MaybeT (pure m) {-# INLINE hoistMaybe #-} --- | Lift a 'Either' to the 'ExceptT' monad +{- | Lift a 'Either' to the 'ExceptT' monad + +@since 0.3.0 +-} hoistEither :: Applicative m => Either e a -> ExceptT e m a hoistEither e = ExceptT (pure e) {-# INLINE hoistEither #-} diff --git a/src/Relude/Monoid.hs b/src/Relude/Monoid.hs --- a/src/Relude/Monoid.hs +++ b/src/Relude/Monoid.hs @@ -1,35 +1,148 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +#if !MIN_VERSION_base(4,12,0) +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE Trustworthy #-} +#else +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Monoid +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Reexports functions to work with monoids plus adds extra useful functions. -} +#endif module Relude.Monoid - ( module Data.Monoid - , module Data.Semigroup - , maybeToMonoid - ) where + ( -- * Reexports + module Data.Monoid + , module Data.Semigroup + , Ap (..) + + -- * Combinators + , maybeToMonoid + , memptyIfFalse + , memptyIfTrue + ) where + +#if MIN_VERSION_base(4,12,0) +import Data.Monoid (Ap (..)) +#endif import Data.Monoid (All (..), Alt (..), Any (..), Dual (..), Endo (..), First (..), Last (..), Monoid (..), Product (..), Sum (..)) -import Data.Semigroup (Option (..), Semigroup (sconcat, stimes, (<>)), WrappedMonoid, cycle1, - mtimesDefault, stimesIdempotent, stimesIdempotentMonoid, stimesMonoid) +import Data.Semigroup (Semigroup (sconcat, stimes, (<>)), WrappedMonoid, cycle1, mtimesDefault, + stimesIdempotent, stimesIdempotentMonoid, stimesMonoid) +import Relude.Bool.Reexport (Bool (..)) import Relude.Monad.Reexport (Maybe, fromMaybe) +#if !MIN_VERSION_base(4,12,0) +import GHC.Generics (Generic1) + +import Relude.Applicative (Alternative, Applicative (..), liftA2) +import Relude.Base (Eq, Generic, Ord, Show) +import Relude.Enum (Bounded (..), Enum) +import Relude.Function (($), (.)) +import Relude.Functor.Reexport (Functor (..)) +import Relude.Monad.Reexport (Monad, MonadFail, MonadPlus) +import Relude.Numeric (Num (..)) +import Relude.String.Reexport (Read) +#endif + + -- $setup --- >>> import Relude.Base (Int) -- >>> 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.Monad.Reexport.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 #-} + +{- | Returns the given value in case of the given predicate is satisfied +(is 'True'). Otherwise, it returns 'mempty'. + +>>> memptyIfFalse True (Just "Hello") +Just "Hello" +>>> memptyIfFalse False "Doesn't matter" +"" + +@since 0.7.0.0 +-} +memptyIfFalse :: Monoid m => Bool -> m -> m +memptyIfFalse p val = if p then val else mempty +{-# INLINE memptyIfFalse #-} + + +{- | Returns the given value in case of the given predicate is unsatisfied +(is 'False'). Otherwise, it returns 'mempty'. + +>>> memptyIfTrue True (Just "Hello") +Nothing +>>> memptyIfTrue False "Does matter" +"Does matter" + +@since 0.7.0.0 +-} +memptyIfTrue :: Monoid m => Bool -> m -> m +memptyIfTrue p val = if p then mempty else val +{-# INLINE memptyIfTrue #-} + +#if !MIN_VERSION_base(4,12,0) +-- | This data type witnesses the lifting of a 'Monoid' into an +-- 'Applicative' pointwise. +-- +-- @since 0.5.0 +newtype Ap f a = Ap { getAp :: f a } + deriving ( Alternative + , Applicative + , Enum + , Eq + , Functor + , Generic + , Generic1 + , Monad + , MonadFail + , MonadPlus + , Ord + , Read + , Show + ) + +-- | @since 0.5.0 +instance (Applicative f, Semigroup a) => Semigroup (Ap f a) where + (Ap x) <> (Ap y) = Ap $ liftA2 (<>) x y + +-- | @since 0.5.0 +instance (Applicative f, Semigroup a, Monoid a) => Monoid (Ap f a) where + mempty = Ap $ pure mempty + mappend = (<>) + +-- | @since 0.5.0 +instance (Applicative f, Bounded a) => Bounded (Ap f a) where + minBound = pure minBound + maxBound = pure maxBound + +-- | @since 0.5.0 +instance (Applicative f, Num a) => Num (Ap f a) where + (+) = liftA2 (+) + (*) = liftA2 (*) + negate = fmap negate + fromInteger = pure . fromInteger + abs = fmap abs + signum = fmap signum +#endif diff --git a/src/Relude/Nub.hs b/src/Relude/Nub.hs --- a/src/Relude/Nub.hs +++ b/src/Relude/Nub.hs @@ -1,9 +1,15 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Nub +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Functions to remove duplicates from a list. @@ -17,61 +23,112 @@ * Lists which consist of many same elements - Here are some recomendations for usage of particular functions based on benchmarking resutls. + Here are some recommendations for usage of particular functions based on benchmarking results. * 'hashNub' is faster than 'ordNub' when there're not so many different values in the list. * 'hashNub' is the fastest with 'Data.Text.Text'. + * 'intNub' is faster when you work with lists of 'Int's. + + * 'intNubOn' is fast with the lists of type that can have fixed number representations. + * 'sortNub' has better performance than 'ordNub' but should be used when sorting is also needed. * 'unstableNub' has better performance than 'hashNub' but doesn't save the original order. -} module Relude.Nub - ( hashNub - , ordNub - , sortNub - , unstableNub - ) where + ( hashNub + , ordNub +#if MIN_VERSION_containers(0,6,0) + , ordNubOn + , intNub + , intNubOn +#endif + + , sortNub + , unstableNub + ) where + +#if !MIN_VERSION_hashable(1,4,0) import Data.Eq (Eq) +#endif import Data.Hashable (Hashable) import Data.HashSet as HashSet import Data.Ord (Ord) -import Prelude ((.)) +import Prelude (Int, (.)) import qualified Data.Set as Set +#if MIN_VERSION_containers(0,6,0) +import qualified Data.Containers.ListUtils as Containers +#endif -{- | Like 'Prelude.nub' but runs in \( O(n \log n) \) time and requires 'Ord'. +-- $setup +-- >>> import Prelude (div, fromEnum) + +{- | Removes duplicate elements from a list, keeping only the first occurrence of +the element. + +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] +#if MIN_VERSION_containers(0,6,0) +ordNub = Containers.nubOrd +{-# INLINE ordNub #-} +#else 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 #-} +#endif + +#if MIN_VERSION_containers(0,6,0) +{- | Similar to 'ordNub' but performs nub through the mapped list on the given +function. + +>>> ordNubOn (`div` 10) [3, 3, 3, 13, 2, 22, -1, 1, 66] +[3,13,22,-1,66] + +@since 1.0.0.0 +-} +ordNubOn :: forall b a . (Ord b) => (a -> b) -> [a] -> [a] +ordNubOn = Containers.nubOrdOn +{-# INLINE ordNubOn #-} +#endif + {- | Like 'Prelude.nub' but runs in \( O(n \log_{16} n) \) time and requires 'Hashable'. >>> hashNub [3, 3, 3, 2, 2, -1, 1] [3,2,-1,1] -} -hashNub :: (Eq a, Hashable a) => [a] -> [a] +#if MIN_VERSION_hashable(1,4,0) +hashNub :: forall a . (Hashable a) => [a] -> [a] +#else +hashNub :: forall a . (Eq a, Hashable a) => [a] -> [a] +#endif 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 +138,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. @@ -88,5 +146,40 @@ [1,2,3,-1] -} +#if MIN_VERSION_hashable(1,4,0) +unstableNub :: (Hashable a) => [a] -> [a] +#else unstableNub :: (Eq a, Hashable a) => [a] -> [a] +#endif unstableNub = HashSet.toList . HashSet.fromList +{-# INLINE unstableNub #-} + + +#if MIN_VERSION_containers(0,6,0) +{- | Removes duplicate elements from a list, keeping only the first occurance of +the element. + +Like 'Prelude.nub' but runs in \( O (n \min (n, int\_bits )) \) time and requires 'Ord'. + +>>> intNub [3, 3, 3, 2, 2, -1, 1] +[3,2,-1,1] + +@since 1.0.0.0 +-} +intNub :: [Int] -> [Int] +intNub = Containers.nubInt + +{-# INLINE intNub #-} + +{- | Similar to 'intNub' but works on lists of any types by performing "nubbing" through 'Int's. + +>>> intNubOn fromEnum "ababbbcdaffee" +"abcdfe" + +@since 1.0.0.0 +-} +intNubOn :: (a -> Int) -> [a] -> [a] +intNubOn = Containers.nubIntOn +{-# INLINE intNubOn #-} + +#endif diff --git a/src/Relude/Numeric.hs b/src/Relude/Numeric.hs new file mode 100644 --- /dev/null +++ b/src/Relude/Numeric.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE Trustworthy #-} + +{- | +Module : Relude.Numeric +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +Provides numerical data types and functions. + +@since 0.5.0 +-} + +module Relude.Numeric + ( -- * Reexports + module Data.Bits + , module Data.Int + , module Data.Word + , module GHC.Base + , module GHC.Float + , module GHC.Num + , module GHC.Real + , module Numeric.Natural + -- * Combinators + , integerToBounded + , integerToNatural + ) where + +import Data.Bits (toIntegralSized, xor) +import Data.Int (Int, Int16, Int32, Int64, Int8) +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 (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, (^), (^^)) +import Numeric.Natural (Natural) + +import Relude.Base ((<), (>)) +import Relude.Bool (otherwise) +import Relude.Enum (Bounded (..)) +import Relude.Function (($)) +import Relude.Monad (Maybe (..)) + + +-- $setup +-- import Relude.Monad (Maybe (..)) + +{- | Transforms an integer number to a bounded integral. +It returns `Nothing` for integers outside the bound of the return type. + +>>> integerToBounded @Int 42 +Just 42 + +>>> integerToBounded @Int8 1024 +Nothing + +>>> integerToBounded @Int (toInteger (minBound :: Int)) +Just (-9223372036854775808) +>>> integerToBounded @Int $ (toInteger (minBound :: Int)) - 1 +Nothing + +>>> integerToBounded @Int (toInteger (maxBound :: Int)) +Just 9223372036854775807 +>>> integerToBounded @Int $ (toInteger (maxBound :: Int)) + 1 +Nothing + +If you want to convert 'Int' or 'Word' to a bounded type, take a look at +'toIntegralSized' function instead. + +@since 0.5.0 +-} +integerToBounded :: forall a. (Integral a, Bounded a) => Integer -> Maybe a +integerToBounded n + | n < toInteger (minBound @a) = Nothing + | n > toInteger (maxBound @a) = Nothing + | otherwise = Just (fromIntegral n) +{-# INLINE integerToBounded #-} + +{- | Transforms an integer number to a natural. +Only non-negative integers are considered natural, everything else will return `Nothing`. + +>>> integerToNatural (-1) +Nothing + +>>> integerToNatural 0 +Just 0 + +>>> integerToNatural 10 +Just 10 + +@since 0.5.0 +-} +integerToNatural :: Integer -> Maybe Natural +integerToNatural n + | n < 0 = Nothing + | otherwise = Just $ fromIntegral n +{-# INLINE integerToNatural #-} diff --git a/src/Relude/Print.hs b/src/Relude/Print.hs --- a/src/Relude/Print.hs +++ b/src/Relude/Print.hs @@ -1,32 +1,35 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Print +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable Functions like 'Prelude.putStr' and 'Prelude.putStrLn' but for 'Text', 'LText', 'ByteString' and 'LByteString'. -} module Relude.Print - ( -- * 'Text' & 'LText' - putText - , putTextLn - , putLText - , putLTextLn + ( -- * 'Text' & 'LText' + putText + , putTextLn + , putLText + , putLTextLn - -- * 'ByteString' & 'LByteString' - , putBS - , putBSLn - , putLBS - , putLBSLn - ) where + -- * 'ByteString' & 'LByteString' + , putBS + , putBSLn + , putLBS + , putLBSLn + ) where import Relude.Function ((.)) import Relude.Monad.Reexport (MonadIO (..)) @@ -42,25 +45,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 +90,50 @@ -- ByteString ---------------------------------------------------------------------------- --- | Lifted version of 'BS.putStr'. +{- | Lifted version of 'BS.putStr'. + +>>> putBS ("Hello, world!" :: ByteString) +Hello, world! + +@since 0.3.0 +-} 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! + +@since 0.3.0 +-} 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! + +@since 0.3.0 +-} 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! + +@since 0.3.0 +-} putLBSLn :: MonadIO m => LByteString -> m () putLBSLn = liftIO . LBS.putStrLn {-# SPECIALIZE putLBSLn :: LByteString -> Base.IO () #-} diff --git a/src/Relude/String.hs b/src/Relude/String.hs --- a/src/Relude/String.hs +++ b/src/Relude/String.hs @@ -1,17 +1,59 @@ +{-# LANGUAGE Safe #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.String +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Type classes for convertion between different string representations. +Type classes for conversion between different string representations. + +The table below represents the @relude@ concept of conversion between the following types: + +* 'Text' +* 'String' +* 'ByteString' +* 'LText' +* 'LByteString' +* 'ShortByteString' + + ++-----------------------+---------------------+--------------+--------------+--------------------+------------------------+--------------------------+ +| From \\ To | 'Text' | 'String' | 'ByteString' | 'LText' | 'LByteString' | 'ShortByteString' | ++=======================+=====================+==============+==============+====================+========================+==========================+ +| __'Text'__ | ~ | 'toString' | 'encodeUtf8' | 'toLazy'/'toLText' | 'encodeUtf8' | 'encodeUtf8' | ++-----------------------+---------------------+--------------+--------------+--------------------+------------------------+--------------------------+ +| __'String'__ | 'toText' | ~ | 'encodeUtf8' | 'toLText' | 'encodeUtf8' | 'encodeUtf8' | ++-----------------------+---------------------+--------------+--------------+--------------------+------------------------+--------------------------+ +| __'ByteString'__ | 'decodeUtf8' | 'decodeUtf8' | ~ | 'decodeUtf8' | 'toLazy' | 'toShort' | ++-----------------------+---------------------+--------------+--------------+--------------------+------------------------+--------------------------+ +| __'LText'__ | 'toStrict'/'toText' | 'toString' | 'encodeUtf8' | ~ | 'encodeUtf8' | 'encodeUtf8' | ++-----------------------+---------------------+--------------+--------------+--------------------+------------------------+--------------------------+ +| __'LByteString'__ | 'decodeUtf8' | 'decodeUtf8' | 'toStrict' | 'decodeUtf8' | ~ | @'toShort' . 'toStrict'@ | ++-----------------------+---------------------+--------------+--------------+--------------------+------------------------+--------------------------+ +| __'ShortByteString'__ | 'decodeUtf8' | 'decodeUtf8' | 'fromShort' | 'decodeUtf8' |@'toLazy' . 'fromShort'@| ~ | ++-----------------------+---------------------+--------------+--------------+--------------------+------------------------+--------------------------+ -} module Relude.String - ( module Relude.String.Conversion - , module Relude.String.Reexport - ) where + ( module Relude.String.Reexport + -- $reexport + , module Relude.String.Conversion + -- $conversion + ) where import Relude.String.Conversion import Relude.String.Reexport + +{- $reexport +Reexport data types and functions to work with 'Text', 'ByteString', +'ShortByteString'. +-} +{- $conversion +Conversion functions between 'Text', 'String', 'ByteString'. +Also some read|show helper functions. +-} diff --git a/src/Relude/String/Conversion.hs b/src/Relude/String/Conversion.hs --- a/src/Relude/String/Conversion.hs +++ b/src/Relude/String/Conversion.hs @@ -1,64 +1,77 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE ExplicitForAll #-} + +#if __GLASGOW_HASKELL__ >= 902 +{-# OPTIONS_GHC -Wno-operator-whitespace #-} +#endif + +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.String.Conversion +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable 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 - ( -- * Convenient type aliases - LText - , LByteString + ( -- * Convenient type aliases + LText + , LByteString - -- * Conversion type classes - , ConvertUtf8 (..) - , ToString (..) - , ToLText (..) - , ToText (..) - , LazyStrict (..) - , fromLazy - , fromStrict + -- * Conversion type classes + , ConvertUtf8 (..) + , ToText (..) + , ToLText (..) + , ToString (..) + , LazyStrict (..) + , fromLazy + , fromStrict - -- * Show and read functions - , readEither - , show - ) where + -- * Show and read functions + , readEither + , 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'. @@ -93,103 +106,438 @@ >>> decodeUtf8 @Text @ByteString "\208\208\176\209\130\208\176\208\186" "\65533\65533\1090\1072\1082" #endif + +#if MIN_VERSION_text(2,0,2) >>> decodeUtf8Strict @Text @ByteString "\208\208\176\209\130\208\176\208\186" - Left Cannot decode byte '\xd0': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream + Left Cannot decode byte '\xd0': ...: Invalid UTF-8 stream +#elif MIN_VERSION_text(2,0,0) + >>> decodeUtf8Strict @Text @ByteString "\208\208\176\209\130\208\176\208\186" + Left Cannot decode byte '\xd0': ...: Invalid UTF-8 stream +#else + >>> decodeUtf8Strict @Text @ByteString "\208\208\176\209\130\208\176\208\186" + Left Cannot decode byte '\xd0': ...: Invalid UTF-8 stream +#endif -} 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" -readEither :: (ToString a, Read b) => a -> Either Text b -readEither = first toText . Text.Read.readEither . toString +{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only. --- | Generalized version of 'Prelude.show'. +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 + ) + +{- | Version of 'Text.Read.readEither' that returns 'Text' in case of the parse +error. + +>>> readEither @Int "123" +Right 123 +>>> readEither @Int "aa" +Left "Prelude.read: no parse" +-} +readEither :: (Read a) => String -> Either Text a +readEither = first toText . Text.Read.readEither +{-# INLINEABLE readEither #-} + +{- | 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. --- | Type class for lazy-strict conversions. +@since 0.1.0 +-} class LazyStrict l s | l -> s, s -> l where - toLazy :: s -> l + toLazy :: s -> l toStrict :: l -> s -- | Alias for 'toStrict' function. @@ -207,13 +555,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 #-} diff --git a/src/Relude/String/Reexport.hs b/src/Relude/String/Reexport.hs --- a/src/Relude/String/Reexport.hs +++ b/src/Relude/String/Reexport.hs @@ -1,31 +1,227 @@ +{-# LANGUAGE CPP #-} + +#if __GLASGOW_HASKELL__ >= 902 +{-# OPTIONS_GHC -Wno-operator-whitespace #-} +#endif + +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.String.Reexport +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -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 + ( -- * String + module Data.String + , module Text.Read - -- * Text - , module Data.Text - , module Data.Text.Encoding - , module Data.Text.Encoding.Error - , module Text.Read + -- * Text + , Text + , lines + , unlines + , words + , unwords + , module Data.Text.Encoding + , module Data.Text.Encoding.Error - -- * ByteString - , module Data.ByteString - ) where + -- * 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) +#if __GLASGOW_HASKELL__ >= 904 +import Data.Type.Equality (type (~)) +#endif +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 #-} diff --git a/src/Relude/Unsafe.hs b/src/Relude/Unsafe.hs --- a/src/Relude/Unsafe.hs +++ b/src/Relude/Unsafe.hs @@ -1,36 +1,78 @@ {-# LANGUAGE Unsafe #-} {- | -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT -Maintainer: Kowainik +Module : Relude.Unsafe +Copyright : (c) 2016 Stephen Diehl + (c) 2016-2018 Serokell + (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Unsafe functions to work with lists and '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. +__⚠️ Warning ⚠️__ +This module contains unsafe partial functions. They are unavoidable +sometimes, but we encourage you to use safer analogues: + ++-----------------------------------+---------------------------------------------------------------------+ +| __Partial__ | __Total__ | ++===================================+=====================================================================+ +| @'head' :: [a] -> a@ | @'Relude.List.NonEmpty.head' :: NonEmpty a -> a@ | ++-----------------------------------+---------------------------------------------------------------------+ +| @'tail' :: [a] -> [a]@ | @'Relude.List.NonEmpty.tail' :: NonEmpty a -> [a]@ | ++-----------------------------------+---------------------------------------------------------------------+ +| @'read' :: Read a => String -> a@ | @'Relude.String.Reexport.readMaybe' :: Read a => String -> Maybe a@ | ++-----------------------------------+---------------------------------------------------------------------+ +| @'fromJust' :: Maybe a -> a@ | @'Relude.Monad.Reexport.fromMaybe' :: a -> Maybe a -> a@ | ++-----------------------------------+---------------------------------------------------------------------+ + +This module is intended to be imported qualified and it is not +included in default prelude exports. + @ -import qualified Relude.Unsafe as Unsafe +__import qualified__ Relude.Unsafe as Unsafe foo :: [a] -> a -foo = Unsafe.head +foo = Unsafe.'head' @ -} module Relude.Unsafe - ( module Data.List - , module Data.Maybe - , at - ) where + ( -- * Unsafe list functions + head + , tail + , last + , init + , (!!) + , at + -- * Unsafe 'Data.Maybe.Maybe' functions + , fromJust + -- * Unsafe "Text.Read" functions + , read + ) where import Data.List (head, init, last, tail, (!!)) import Data.Maybe (fromJust) +import Text.Read (read) -import Relude.Base (Int) 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 useful 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 (!!) diff --git a/test/Doctest.hs b/test/Doctest.hs --- a/test/Doctest.hs +++ b/test/Doctest.hs @@ -1,16 +1,18 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} - 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 + $ "-XHaskell2010" + : "-XInstanceSigs" + : "-XNoImplicitPrelude" + : "-XOverloadedStrings" + : "-XScopedTypeVariables" + : "-XTypeApplications" + : sourceFiles diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,17 +1,19 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} - -module Main where +module Main (main) where import Relude -import Test.Tasty (defaultMain) +import Hedgehog (checkParallel) +import System.IO (hSetEncoding, utf8) +import Test.Relude.Property (hedgehogTestList) -import Test.Relude.Property (hedgehogTestTree) 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 diff --git a/test/Test/Relude/Container/One.hs b/test/Test/Relude/Container/One.hs new file mode 100644 --- /dev/null +++ b/test/Test/Relude/Container/One.hs @@ -0,0 +1,114 @@ +module Test.Relude.Container.One + ( oneProps + ) where + +import Relude + +import Hedgehog (Gen, Group (..), Property, forAll, property, (===)) + +import Test.Relude.Gen (genInt, genUtf8Text) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Short as SBS +import qualified Data.IntSet as IntSet +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + + +oneProps :: Group +oneProps = Group "'One' typeclass property tests" + [ ( "length (one @[a] x) ≡ 1", oneListProp) + , ( "length (one @(NonEmpty a) x) ≡ 1", oneNonEmptyProp) + , ( "length (one @(Seq a) x) ≡ 1", oneSeqProp) + , ( "length (one @Text x) ≡ 1", oneTextProp) + , ( "length (one @LText x) ≡ 1", oneLTextProp) + , ( "length (one @ByteString x) ≡ 1", oneByteStringProp) + , ( "length (one @LByteString x) ≡ 1", oneLByteStringProp) + , ( "length (one @ShortByteString x) ≡ 1", oneShortByteStringProp) + , ( "length (one @(Map k v) x) ≡ 1", oneMapProp) + , ( "length (one @(HashMap k v) x) ≡ 1", oneHashMapProp) + , ( "length (one @(IntMap v) x) ≡ 1", oneIntMapProp) + , ( "length (one @(Set a) x) ≡ 1", oneSetProp) + , ( "length (one @(HashSet a) x) ≡ 1", oneHashSetProp) + , ( "length (one @(IntSet x) ≡ 1", oneIntSetProp) + ] + +oneListProp :: Property +oneListProp = property $ do + x <- forAll genInt + length (one @[Int] x) === 1 + +oneNonEmptyProp :: Property +oneNonEmptyProp = property $ do + x <- forAll genInt + length (one @(NonEmpty Int) x) === 1 + +oneSeqProp :: Property +oneSeqProp = property $ do + x <- forAll genInt + length (one @(Seq Int) x) === 1 + +oneTextProp :: Property +oneTextProp = property $ do + x <- forAll Gen.unicode + T.length (one @Text x) === 1 + +oneLTextProp :: Property +oneLTextProp = property $ do + x <- forAll Gen.unicode + TL.length (one @LText x) === 1 + +oneByteStringProp :: Property +oneByteStringProp = property $ do + x <- forAll genWord8 + BS.length (one @ByteString x) === 1 + +oneLByteStringProp :: Property +oneLByteStringProp = property $ do + x <- forAll genWord8 + LBS.length (one @LByteString x) === 1 + +oneShortByteStringProp :: Property +oneShortByteStringProp = property $ do + x <- forAll genWord8 + SBS.length (one @ShortByteString x) === 1 + +oneMapProp :: Property +oneMapProp = property $ do + k <- forAll genUtf8Text + v <- forAll genInt + length (one @(Map Text Int) (k, v)) === 1 + +oneHashMapProp :: Property +oneHashMapProp = property $ do + k <- forAll genUtf8Text + v <- forAll genInt + length (one @(HashMap Text Int) (k, v)) === 1 + +oneIntMapProp :: Property +oneIntMapProp = property $ do + k <- forAll genInt + v <- forAll genUtf8Text + length (one @(IntMap Text) (k, v)) === 1 + +oneSetProp :: Property +oneSetProp = property $ do + v <- forAll genUtf8Text + length (one @(Set Text) v) === 1 + +oneHashSetProp :: Property +oneHashSetProp = property $ do + v <- forAll genUtf8Text + length (one @(HashSet Text) v) === 1 + +oneIntSetProp :: Property +oneIntSetProp = property $ do + v <- forAll genInt + IntSet.size (one v) === 1 + + +genWord8 :: Gen Word8 +genWord8 = Gen.word8 Range.constantBounded diff --git a/test/Test/Relude/Gen.hs b/test/Test/Relude/Gen.hs new file mode 100644 --- /dev/null +++ b/test/Test/Relude/Gen.hs @@ -0,0 +1,36 @@ +module Test.Relude.Gen + ( genInt + -- * Strings + , genUtf8String + , genUtf8Text + , genUtf8ByteString + -- * Lists + , genIntList + , genBoolList + ) where + +import Relude + +import Hedgehog (Gen) + +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + + +genInt :: Gen Int +genInt = Gen.enumBounded + +genUtf8String :: Gen String +genUtf8String = Gen.string (Range.linear 0 1000) Gen.unicode + +genUtf8Text :: Gen Text +genUtf8Text = Gen.text (Range.linear 0 1000) Gen.unicode + +genUtf8ByteString :: Gen ByteString +genUtf8ByteString = Gen.utf8 (Range.linear 0 1000) Gen.unicode + +genIntList :: Gen [Int] +genIntList = Gen.list (Range.linear 0 1000) Gen.enumBounded + +genBoolList :: Gen [Bool] +genBoolList = Gen.list (Range.linear 0 1000) Gen.bool diff --git a/test/Test/Relude/Property.hs b/test/Test/Relude/Property.hs --- a/test/Test/Relude/Property.hs +++ b/test/Test/Relude/Property.hs @@ -1,68 +1,56 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} - module Test.Relude.Property - ( hedgehogTestTree + ( hedgehogTestList ) where import Relude import Data.List (nub) -import Hedgehog (Gen, Property, assert, forAll, property, (===)) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Hedgehog +import Hedgehog (Group (..), Property, assert, forAll, property, (===)) -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range +import Test.Relude.Container.One (oneProps) +import Test.Relude.Gen (genBoolList, genIntList, genUtf8ByteString, genUtf8String, genUtf8Text) -hedgehogTestTree :: TestTree -hedgehogTestTree = testGroup "Tests" [utfProps, listProps, boolMProps] +hedgehogTestList :: [Group] +hedgehogTestList = + [ utfProps + , listProps + , logicProps + , oneProps + ] + ---------------------------------------------------------------------------- -- 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 - -utf8Text :: Gen Text -utf8Text = Gen.text (Range.linear 0 1000) Gen.unicode - -utf8Bytes :: Gen ByteString -utf8Bytes = Gen.utf8 (Range.linear 0 1000) Gen.unicode - -- "\65534" fails, but this is from BU.toString -- > import qualified Data.ByteString.UTF8 as BU -- > BU.toString (BU.fromString "\65534") == "\65533" -- > True prop_StringToBytes :: Property prop_StringToBytes = property $ do - str <- forAll utf8String + str <- forAll genUtf8String assert $ str == decodeUtf8 @_ @ByteString (encodeUtf8 str) && str == decodeUtf8 @_ @LByteString (encodeUtf8 str) prop_TextToBytes :: Property prop_TextToBytes = property $ do - txt <- forAll utf8Text + txt <- forAll genUtf8Text assert $ txt == decodeUtf8 @_ @ByteString (encodeUtf8 txt) && txt == decodeUtf8 @_ @LByteString (encodeUtf8 txt) -- "\239\191\190" fails, but this is the same as "\65534" :: String prop_BytesTo :: Property prop_BytesTo = property $ do - utf <- forAll utf8Bytes + utf <- forAll genUtf8ByteString assert $ utf == encodeUtf8 @String (decodeUtf8 utf) && utf == encodeUtf8 @Text (decodeUtf8 utf) && utf == encodeUtf8 @LText (decodeUtf8 utf) @@ -71,17 +59,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 - prop_ordNubCorrect :: Property prop_ordNubCorrect = property $ do xs <- forAll genIntList @@ -106,13 +91,10 @@ -- logicM ---------------------------------------------------------------------------- -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 +logicProps :: Group +logicProps = Group "lifted logic function property tests" + [ ("andM:", prop_andM) + , ("orM:", prop_orM) ] prop_andM :: Property