diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,57 +1,551 @@ -Change log -========== +# Changelog -0.1.1 -===== +`relude` uses [PVP Versioning][1]. +The changelog is available [on GitHub][2]. -* [#44](https://github.com/kowainik/relude/issues/44) - Implement parser deriviation from pretty-printers +## 1.2.2.2 – Aug 5, 2025 -0.1.0 -===== +- Documentation improvements -* [#7](https://github.com/kowainik/relude/issues/7): +## 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): + Drop `utf8-string` dependency and improve performance of conversion functions. +- [#98](https://github.com/kowainik/relude/issues/98): + Reexport `Bifoldable` related stuff from `base`. +- [#99](https://github.com/kowainik/relude/issues/99): + Reexport `Bitraversable` related stuff from `base`. +- [#100](https://github.com/kowainik/relude/issues/100): + Add `Relude.Extra.Validation` with `Validation`data type. +- [#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) + Add `Relude.Extra.Tuple` module, containing + `dupe`, `mapToFst`, `mapToSnd`, and `mapBoth` functions. +- [#97](https://github.com/kowainik/relude/issues/97): + Add `(&&^)` and `(||^)` operators. +- [#81](https://github.com/kowainik/relude/issues/81): + Add `asumMap` to `Foldable` functions. +- [#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): + Add HLint rules for `One` typeclass. +- 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): + Use Dhall v3.0.0 for hlint file generation. + +## 0.3.0 + +- [#41](https://github.com/kowainik/relude/issues/41): + Add `Foldable1`. +- [#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`. + + **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): + Export `(>>>)` and `(<<<)` from `Control.Category`. +- [#59](https://github.com/kowainik/relude/issues/59): + Introduce `flap` function and its operator version `??`. +- [#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): + 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): + Add HLint rules for `put*` functions. +- [#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): + Add `under2` and `underF2` functions to `Relude.Extra.Newtype`. +- [#60](https://github.com/kowainik/relude/issues/60): + Add `hoistMaybe` and `hoistEither` functions. + +## 0.2.0 + +- [#43](https://github.com/kowainik/relude/issues/43): + Implement `Relude.Extra.Newtype` module. +- [#46](https://github.com/kowainik/relude/issues/46): + Add a function that returns its own name. +- [#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): + Speed up and refactor property tests. +- [#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 + +- [#44](https://github.com/kowainik/relude/issues/44): + Implement parser deriviation from pretty-printers. + +## 0.1.0 + +- [#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,50 +0,0 @@ -# Contributing to `relude` - -## :wave: Greetings Traveler! - -We're glad you're reading this, we really appreciate the effort you're -putting in. Thank you for your help in making this library awesome! :sparkles: - -### How to contribute - -#### Report bugs or feature request - -If you have found any bugs or have proposals on how to make this project better, -don't hesitate to create issues -[here](https://github.com/kowainik/relude/issues/new) in free format. - -#### Create a PR - -We love receiving pull requests from everyone. But, please, don't create a PR -without a corresponding issue. It's always better to discuss your future -work first. Even if such an issue exists it's still better to express your willing -to do that issue under comment section. Thus you will show that you're doing -that issue, and nobody else will accidentally do it in parallel with you. Furthermore you -also can discuss the best way to implement that issue! - -To get started with this you should first fork, then clone the repo: - - git clone git@github.com:your-username/relude.git - -Make your changes and consider the following check list to go through before submitting your pull request. - -#### :white_check_mark: Check list - -- [ ] Project compiles -- [ ] New/fixed features work as expected -- [ ] Old features do not break after the change -- [ ] `stylish-haskell` with config in this repo root was used to format code -- [ ] _Recommended:_ Commit messages are in the proper format. If the commit - addresses an issue start the first line of the commit with the issue number in - square parentheses. - + **_Example:_** `[#42] Short commit description` - -If you fix bugs or add new features, please add tests. - -After everything above is done, commit and push to your fork. -Now you are ready to [submit a pull request][pr]! - ----------- -Thanks for spending time on reading this contributing guide! :sparkling_heart: - -[pr]: https://github.com/kowainik/relude/compare/ diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,5 +1,5 @@ The MIT License (MIT) -Copyright (c) 2016-2017, Stephen Diehl, 2017, Serokell, 2018, Kowainik +Copyright (c) 2016, Stephen Diehl, 2016-2018, Serokell, 2018, Kowainik Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,311 +1,817 @@ -Relude -========= +# relude -[![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) [![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://opensource.org/licenses/MIT) -`relude` is a custom prelude based on `universum`. `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. - - _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 `bytestrng`) - 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. +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. -This README contains introduction to `Relude` and a tutorial on how to use it. +`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`: -Structure of this tutorial --------------------------- +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. [Motivation.](#motivation-) -2. [Get started.](#get-started-) -3. [Difference from `Prelude`.](#difference-from-prelude-) -4. [Reexports.](#reexports-) -5. [What's new?](#whats-new-) -6. [Migration guide.](#migration-guide-) +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). -Motivation [↑](#structure-of-this-tutorial) ------------------------------------------- +## When to use an alternative prelude? -We decided to base `relude` on `universum` due to the following reasons: +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) -1. `universum` helps to achieve our goals more than any other custom prelude. -2. We worked on `universum` a lot (just check contributors statistics) and we - know its internal structure. +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. -The motivation to create another alternative prelude instead of modifying -existing one is that it's hard to change preludes in any way. `relude` -uses approach with `Extra.*` modules which are not exported by default so it's -quite easy to bring something new (that satisfies `relude` goals) and let users -decide to use it or not. +Replacing default `Prelude` from `base` has the following _disadvantages_: -Unlike `universum`, we are: +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. -1. Not trying to replace `Foldable` with custom `Container` type class. We only - forbid `elem` and `notElem` functions for sets due to performance reasons. -2. Have less dependencies: no `vector`, no `microlens`, no `safe-exceptions`, no `type-operators`. -3. Have a lot of other different improvements. +However, using an alternative prelude, specifically `relude`, has the following +**advantages**: -Get started [↑](#structure-of-this-tutorial) --------------------------------------------- +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`. -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. +Taking into consideration all the above points, we put together our +recommendations when to use `relude`: -### `base-noprelude` +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. -This is the recommended way to use custom prelude. It requires you to perform -the following steps: +And when you may want to stay with the default standard: -1. Replace `base` dependency with corresponding version of `base-noprelude` in - your `.cabal` file. -2. Add the following `Prelude` module to your project (both to filesystem and to `exposed-modules`): - ```haskell - module Prelude - ( module Relude - ) where +1. When you write a small library that is supposed to be used by other people in + their projects. - import Relude - ``` -3. 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! +## Get started -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. +[[Back to the Table of Contents] ↑](#structure-of-this-tutorial) -### Per-file configuration +If you want to start using `relude` in your project, you can set the library up +for you by one of the following ways. -Disable the built-in prelude at the top of your file: +### 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. -* If you try to do something like `putStrLn "hi"`, you'll get an error message if - `OverloadedStrings` is enabled – it happens because the compiler doesn't know what - type to infer for the string. Use `putTextLn` in this case. -* Since `show` doesn't come from `Show` anymore, you 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` doesn't work on list of pairs. +[[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._ -### Commonly used 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: -First of all, we reexport some generally useful modules: `Control.Applicative`, -`Data.Traversable`, `Data.Monoid`, `Control.DeepSeq`, `Data.List`, and lots of -others. Just remove unneeded imports after importing `Relude` (you can use -`.hlint.yaml` file for this). +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: -Then, some commonly used types: `Map/HashMap/IntMap`, `Set/HashSet/IntSet`, -`Seq`, `Text` and `ByteString` (as well as synonyms `LText` and `LByteString` -for lazy versions). + ```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`](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 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 + +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`. -`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`. +[`Bifunctor`](http://hackage.haskell.org/package/base/docs/Data-Bifunctor.html) +type class with useful instances is exported. -We also reexport big chunks of these libraries: `mtl`, `stm`. +- `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. -[`Bifunctor`](http://hackage.haskell.org/package/base-4.9.1.0/docs/Data-Bifunctor.html) -type class with useful instances is exported. +`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. -* `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. +We also have `data Undefined = Undefined` (which also comes with the warning). -### Text +`relude` reexports `Exception` type from the `base` package and introduces the +`bug` function as an alternative to `error`. There is also a very convenient +`Exc` pattern-synonym to handle exceptions of different types. -We export `Text` and `LText`, 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. +See +[`Relude.Exception`](http://hackage.haskell.org/package/relude/docs/Relude-Exception.html) +module for details on exceptions. -### Debugging and `undefined`s +### containers & unordered-containers -`trace`, `traceM`, `traceShow`, etc. are available by default. GHC will warn you -if you accidentally leave them in code, however (same for `undefined`). +The following types from these two packages are exported: -We also have `data Undefined = Undefined` (which, too, comes with warnings). +- Maps: strict versions of `Map`, `HashMap`, `IntMap`. +- Sets: `Set`, `HashSet`, `IntSet`. +- Sequences: `Seq`. -### Exceptions +### text & bytestring -TODO: write about reexports, `Bug` and `Exc` pattern. +`relude` exports `Text` and `ByteString` (as well as their lazy versions — +`LText` and `LByteString`). -What's new? [↑](#structure-of-this-tutorial) --------------------------------------------- +Also, some functions now work +with `Text` instead of `String` – `words`, `lines`, etc. -Finally, we can move to part describing the new cool features we bring with `relude`. +In addition, `relude` provides specialised versions of the `IO` functions to +work with `Text` and `ByteString` — `readFileText`, `writeFileBS`, etc. -* Safe analogue for `head` function: `safeHead :: [a] -> Maybe a` or you can - use our `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: +`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`. + +### Deepseq + +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? + +[[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 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`. +- `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`. -* 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 +### Extra bonuses + +`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`: + + ```haskell + ghci> foo :: HasCallStack => String; foo = ownName + ghci> foo + "foo" + ``` + +- `Foldable1` typeclass that contains generalized interface for folding + non-empty structures like `NonEmpty`. +- [`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. -* `evaluateWHNF` and `evaluateNF` functions as clearer and lifted aliases for - `evaluate` and `evaluate . force`. -* `MonadFail` instance for `Either`. +- And much more! -Migration guide [↑](#structure-of-this-tutorial) ------------------------------------------------- +Explore `Extra` modules: [`Relude.Extra`](http://hackage.haskell.org/package/relude/docs/Relude-Extra.html) -In order to replace default `Prelude` with `relude` you should start with instructions given in -[_get started_](#get-started-) section. +## Migration guide +[[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`. - + `viaNonEmpty head l` is `safeHead 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 `putStr` and `putStrLn` with `putText` and `putTextLn`. - + 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`. -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 ()` + + - `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 (lang version 22.0.0). To +use it follow the steps below. + +First time: + +```shell +$ cabal v2-install dhall-yaml-1.2.10 +``` + +To generate `hlint` file: + +```shell +$ dhall-to-yaml-ng <<< './hlint/hlint.dhall' > .hlint.yaml +``` + +Check that you have generated valid `.hlint.yaml` file without parse errors: + +```shell +$ hlint test/Spec.hs +``` + +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) + +### Producing dependency graph + +Install `cabal-plan` first: + +```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,71 +1,151 @@ +cabal-version: 3.0 name: relude -version: 0.1.1 -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 -cabal-version: 1.24 -tested-with: GHC == 8.0.2 - , GHC == 8.2.2 - , GHC == 8.4.3 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 @@ -79,7 +159,9 @@ Relude.Container.Reexport Relude.Debug Relude.DeepSeq + Relude.Enum Relude.Exception + Relude.File Relude.Foldable Relude.Foldable.Fold Relude.Foldable.Reexport @@ -92,9 +174,12 @@ Relude.Lifted.Exit Relude.Lifted.File Relude.Lifted.IORef + Relude.Lifted.Terminal + Relude.Lifted.Handle + Relude.Lifted.Env Relude.List + Relude.List.NonEmpty Relude.List.Reexport - Relude.List.Safe Relude.Monad Relude.Monad.Either Relude.Monad.Maybe @@ -102,83 +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.Enum - Relude.Extra.Group - Relude.Extra.Map + 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 + 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 - ghc-options: -Wall -fwarn-implicit-prelude - build-depends: base >= 4.8 && < 5 - , bytestring - , containers - , deepseq - , ghc-prim >= 0.4.0.0 - , hashable - , mtl - , stm - , text - , transformers - , unordered-containers - , utf8-string + 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 && < 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.8 && < 5 + other-modules: Test.Relude.Gen + Test.Relude.Container.One + Test.Relude.Property + build-depends: base , relude , bytestring + , containers , text - , utf8-string - , hedgehog - , tasty - , tasty-hedgehog + , hedgehog >= 1.0 && < 1.6 - ghc-options: -Wall -threaded - default-language: Haskell2010 - default-extensions: NoImplicitPrelude + 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.8 && < 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 - default-language: Haskell2010 - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N hs-source-dirs: benchmark main-is: Main.hs - build-depends: base < 5 + + build-depends: base , relude - , containers - , gauge + , tasty-bench , unordered-containers - if impl(ghc == 7.10.3) - build-depends: semigroups >= 0.18 - 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,95 +1,142 @@ -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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 -{- | Main module that reexports all functionality allowed to use -without importing any other modules. Just add next lines to your -module to replace default 'Prelude' with better one. +@relude@ is a safe, performant, user-friendly and lightweight Haskell +standard library. +"Relude" is the main module that reexports all functionality provided by the library that will replace the default @Prelude@ in your project. + +== 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 @base@ "Prelude": + +@ +__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" @ -This documentation section contains description of internal module structure to +== 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. +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 __theme__. Name of the module should give you hints regarding what -this module contains. Some /themes/ contain a great amount of both reexported -functions and functions of our own. To make it easier to understand these huge -chunks of functions, all reexported stuff is moved into separate module with -name @Relude.SomeTheme.Reexport@ and our own functions and types are in -@Relude.SomeTheme.SomeName@. For example, see modules -"Relude.Container.Class" and "Relude.Container.Reexport". - -Below is a short description of what you can find under different modules: - -* __"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.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.Safe" from - @safe-exceptions@ package, 'bug' as better 'error', 'Exc' pattern synonym for - convenient pattern-matching on exceptions. -* __"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"__: monad transormers, combinators for 'Maybe' and 'Either'. -* __"Relude.Monoid"__: reexports from "Data.Monoid" and "Data.Semigroup". -* __"Relude.Nub"__: better versions of @nub@ function for list. -* __"Relude.Print"__: polymorphic 'putStrLn' function and functions to print 'Text'. -* __"Relude.String"__: reexports from @text@ and @bytestring@ packages with - conversion functions between different textual types. -* __"Relude.Unsafe"__: unsafe functions (produce 'error'). - Not exported by "Relude" module by default. +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 +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". -} 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.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 import Relude.Function import Relude.Functor @@ -98,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,50 +1,78 @@ {-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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,113 +1,81 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE Unsafe #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE Trustworthy #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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 @GHC.*@ modules of --- package. +Reexports from @Data.*@ and @GHC.*@ modules of + 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 + -- * Basic type classes + , module GHC.Base + , module GHC.Generics + , module GHC.Show - , ($!) - ) where +-- * 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 hiding (showSigned, (%)) import GHC.Show (Show) -#if MIN_VERSION_base(4,10,0) import GHC.TypeNats (CmpNat, KnownNat, Nat, SomeNat (..), natVal, someNatVal) -#else -import GHC.TypeLits (CmpNat, KnownNat, Nat, SomeNat (..), natVal, someNatVal) -#endif import GHC.ExecutionStack (getStackTrace, showStackTrace) import GHC.OverloadedLabels (IsLabel (..)) import GHC.Stack (CallStack, HasCallStack, callStack, currentCallStack, getCallStack, prettyCallStack, prettySrcLoc, withFrozenCallStack) - --- $setup --- >>> import Relude.Function (const, ($)) - --- | Stricter version of 'Data.Function.$' operator. --- Default Prelude defines this at the toplevel module, so we do as well. --- --- >>> const 3 $ Prelude.undefined --- 3 --- >>> const 3 $! Prelude.undefined --- *** Exception: Prelude.undefined --- CallStack (from HasCallStack): --- error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err --- ... -($!) :: (a -> b) -> a -> b -f $! x = let !vx = x in f vx -infixr 0 $! diff --git a/src/Relude/Bool.hs b/src/Relude/Bool.hs --- a/src/Relude/Bool.hs +++ b/src/Relude/Bool.hs @@ -1,12 +1,34 @@ {-# LANGUAGE Safe #-} --- | Convenient commonly used and very helpful functions to work with --- 'Bool' and also with monads. +{- | +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,74 +1,179 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# LANGUAGE Safe #-} --- | This module contains monadic predicates. +{- | +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.Bool.Reexport (Bool, guard, unless, when) +import Relude.Applicative (Alternative, Applicative (..), empty) +import Relude.Bool.Reexport (Bool (..), guard, unless, when) import Relude.Function (flip) import Relude.Monad (Monad, MonadPlus, (>>=)) + -- $setup -- >>> import Relude.Applicative (pure) -- >>> import Relude.Bool.Reexport (Bool (..)) +-- >>> import Relude.Debug (error) -- >>> 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 #-} + +{- | 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 (pure False) +{-# INLINE (&&^) #-} + +{- | 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 (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,16 +1,31 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# LANGUAGE Safe #-} --- | This module reexports functions to work with 'Bool' type. +{- | +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,16 +1,39 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# LANGUAGE Safe #-} --- | This module exports all container-related stuff. +{- | +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 --} +{- | +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,14 +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 -{- | Type class for types that can be created from one element. @singleton@ -is lone name for this function. Constructions of different type differ: -@:[]@ for lists, two arguments for Maps. Also some data types are monomorphic. +{- | Typeclass for data types that can be created from one element. +E.g. lists, non-empty containers, maps. >>> one True :: [Bool] [True] @@ -52,81 +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 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,24 +1,45 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# LANGUAGE Trustworthy #-} --- | This module reexports all container related stuff from 'Prelude'. +{- | +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 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,96 +1,312 @@ -{-# 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 -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# 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 #-} --- | Functions for debugging. If you left these functions in your code --- then warning is generated to remind you about left usages. Also some --- functions (and data types) are convenient for prototyping. +{- | +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 +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 - ( Undefined (..) - , error - , trace - , traceM - , traceId - , traceShow - , traceShowId - , traceShowM - , undefined - ) where + ( -- * Tracing + trace + , traceShow + , traceShowId + , traceShowWith + , traceId + , traceM + , traceShowM -import Control.Monad (Monad, return) + -- * Imprecise error + , error + , Undefined (..) + , undefined + ) where + import Data.Data (Data) -import Data.Text (Text, unpack) -import Data.Typeable (Typeable) +#if __GLASGOW_HASKELL__ >= 904 +import Data.Type.Equality (type (~)) +#endif import GHC.Exts (RuntimeRep, TYPE) -import GHC.Generics (Generic) -import System.IO.Unsafe (unsafePerformIO) +import GHC.TypeLits (ErrorMessage (..), TypeError) -import Relude.Base (HasCallStack) +import Relude.Applicative (Applicative) +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 Relude.Applicative (pass) -import Relude.Print (Print, putStrLn) +import qualified Debug.Trace as Debug +import qualified Prelude -import qualified Prelude as P --- | Generalized over string version of 'Debug.Trace.trace' that leaves warnings. +-- $setup +-- >>> import Relude +-- >>> :set -Wno-deprecations + +---------------------------------------------------------------------------- +-- trace +---------------------------------------------------------------------------- + +{- | 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" #-} -trace :: Print b => b -> a -> a -trace string expr = unsafePerformIO (do - putStrLn string - return expr) --- | 'P.error' that takes 'Text' as an argument. -error :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack - => Text -> a -error s = P.error (unpack s) +{- | Similar to 'trace' but prints a given value with the 'Show' +instance instead of a 'String'. --- | Version of 'Debug.Trace.traceShow' that leaves warning. +>>> increment l = map (+1) l +>>> increment [2, 3, 4] +[3,4,5] + +>>> increment l = traceShow l (map (+1) l) +>>> increment [2, 3, 4] +[2,3,4] +[3,4,5] + +* 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" #-} -traceShow :: P.Show a => a -> b -> b -traceShow a b = trace (P.show a) b --- | Version of 'Debug.Trace.traceShow' 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" #-} -traceShowId :: P.Show a => a -> a -traceShowId a = trace (P.show a) a --- | Version of 'Debug.Trace.traceShowM' that leaves warning. -{-# WARNING traceShowM "'traceShowM' remains in code" #-} -traceShowM :: (P.Show a, Monad m) => a -> m () -traceShowM a = trace (P.show a) pass +{- | 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 and takes 'Text'. +>>> 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" #-} -traceM :: (Monad m) => Text -> m () -traceM s = trace (unpack s) pass --- | Version of 'Debug.Trace.traceId' that leaves warning and takes 'Text'. +{-| +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" #-} -traceId :: Text -> Text -traceId s = trace s s +---------------------------------------------------------------------------- +-- error +---------------------------------------------------------------------------- + +{- | 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. -{-# WARNING Undefined "'Undefined' type remains in code" #-} data Undefined = Undefined - deriving (P.Eq, P.Ord, P.Show, P.Read, P.Enum, P.Bounded, Data, Typeable, Generic) + deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Data, Typeable, Generic) +{-# WARNING Undefined "'Undefined' type remains in code" #-} --- | 'P.undefined' that leaves warning in code on every usage. -{-# WARNING undefined "'undefined' function remains in code (or use 'error')" #-} +-- | 'Prelude.undefined' that leaves warning in code on every usage. undefined :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack => a -undefined = P.undefined +undefined = Prelude.undefined +{-# WARNING undefined "'undefined' function remains in code" #-} diff --git a/src/Relude/DeepSeq.hs b/src/Relude/DeepSeq.hs --- a/src/Relude/DeepSeq.hs +++ b/src/Relude/DeepSeq.hs @@ -1,43 +1,99 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# LANGUAGE Safe #-} --- | 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. +{- | +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 (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,25 +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 --} +{- | +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 ((++)) @@ -31,28 +39,33 @@ 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: @ +isNonCriticalExc :: SomeException -> Bool isNonCriticalExc e | Just (_ :: NodeAttackedError) <- fromException e = True | Just DialogUnexpected{} <- fromException e = True @@ -62,8 +75,9 @@ you can use 'Exc' pattern synonym: @ +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,16 +1,81 @@ +{-# LANGUAGE Safe #-} + +{- | +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: + +@ +foo :: IO (Either a b) +bar :: IO (a, b) + +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 new file mode 100644 --- /dev/null +++ b/src/Relude/Extra/CallStack.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE Safe #-} + +{- | +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 + +import Relude + +{- | This function returns the name of its caller function, but it requires +that the caller function has 'HasCallStack' constraint. Otherwise, it returns +@""@. + +>>> foo :: HasCallStack => String; foo = ownName +>>> foo +"foo" +>>> bar :: HasCallStack => String; bar = foo +>>> bar +"foo" + +@since 0.2.0 +-} +ownName :: HasCallStack => String +ownName = case getCallStack callStack of + _:caller:_ -> fst caller + _ -> "" + +{- | 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 +logging: + +>>> log :: HasCallStack => String -> IO (); log s = putStrLn $ callerName ++ ":" ++ s +>>> greeting :: HasCallStack => IO (); greeting = log "Starting..." >> putStrLn "Hello!" >> log "Ending..." +>>> greeting +greeting:Starting... +Hello! +greeting:Ending... + +@since 0.2.0 +-} +callerName :: HasCallStack => String +callerName = case getCallStack callStack of + _:_:caller:_ -> fst caller + _ -> "" 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,51 +1,26 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} - -module Relude.Extra.Enum - ( universe - , inverseMap - , next - , safeToEnum - ) where - -import Relude - -import qualified Data.Map.Strict as M +{-# LANGUAGE Safe #-} --- $setup --- >>> :set -XTypeApplications +{- | +Module : Relude.Extra.Enum +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable -{- | Returns all values of some 'Bounded' 'Enum' in ascending order. +Mini @bounded-enum@ framework inside @relude@. ->>> data TrafficLight = Red | Blue | Green deriving (Show, Enum, Bounded) ->>> universe :: [TrafficLight] -[Red,Blue,Green] ->>> universe :: [Bool] -[False,True] +@since 0.1.0 -} -universe :: (Bounded a, Enum a) => [a] -universe = [minBound .. maxBound] -{- | Creates a function that is the inverse of a given function @f@. +module Relude.Extra.Enum + ( next + , prev + , safeToEnum + ) where ->>> 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 = \x -> M.lookup x dict - where - dict :: M.Map k a - dict = M.fromList $ zip (map f univ) univ +import Relude - univ :: [a] - univ = universe {- | Like 'succ', but doesn't fail on 'maxBound'. Instead it returns 'minBound'. @@ -56,12 +31,31 @@ >>> 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'. + +>>> prev True +False +>>> prev False +True +>>> pred False +*** Exception: Prelude.Enum.Bool.pred: bad argument + +@since 0.6.0.0 +-} +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. >>> safeToEnum @Bool 0 @@ -72,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 new file mode 100644 --- /dev/null +++ b/src/Relude/Extra/Foldable1.hs @@ -0,0 +1,445 @@ +{-# 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 #-} + +{- | +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' + , average1 + ) where + +import Relude hiding (Product (..), Sum (..)) +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 #-} + + {- | Map each element of the non-empty structure to a semigroup, and combine the results. + + >>> 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 + + {- | Combine the elements of a non-empty structure using a semigroup. + + >>> fold1 (1 :| [2, 3, 4 :: SG.Sum Int]) + Sum {getSum = 10} + >>> fold1 (4 :| [5, 10 :: SG.Product Int]) + Product {getProduct = 200} + -} + fold1 :: Semigroup m => f m -> m + fold1 = foldMap1 id + + {- | 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 (:| []) + + {- | The first element of a non-empty data structure. + + >>> head1 (1 :| [2, 3, 4]) + 1 + -} + head1 :: f a -> a + head1 = SG.getFirst #. foldMap1 SG.First + + {- | The last element of a non-empty data structure. + + >>> last1 (1 :| [2, 3, 4]) + 4 + -} + last1 :: f a -> a + last1 = SG.getLast #. foldMap1 SG.Last + + {- | The largest element of a non-empty data structure. + + >>> maximum1 (32 :| [64, 8, 128, 16]) + 128 + -} + maximum1 :: Ord a => f a -> a + maximum1 = SG.getMax #. foldMap1 SG.Max + + {- | The smallest element of a non-empty data structure. + + >>> minimum1 (32 :| [64, 8, 128, 16]) + 8 + -} + 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 :: 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 #-} + + head1, last1 :: NonEmpty a -> a + head1 = head + last1 = last + {-# INLINE head1 #-} + {-# INLINE last1 #-} + + maximum1, minimum1 :: Ord a => NonEmpty a -> a + maximum1 = foldl1' max + minimum1 = foldl1' min + {-# 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 + {-# INLINE foldMap1 #-} + + fold1 :: Semigroup m => Identity m -> m + fold1 = coerce + {-# INLINE fold1 #-} + + toNonEmpty :: Identity a -> NonEmpty a + toNonEmpty = (:| []) . coerce + {-# INLINE toNonEmpty #-} + + head1 :: Identity a -> a + head1 = coerce + {-# INLINE head1 #-} + + last1 :: Identity a -> a + last1 = coerce + {-# INLINE last1 #-} + + maximum1 :: Ord a => Identity a -> a + maximum1 = coerce + {-# INLINE maximum1 #-} + + minimum1 :: Ord a => Identity a -> a + 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 + {-# INLINE foldMap1 #-} + + fold1 :: Semigroup m => (c, m) -> m + fold1 = snd + {-# INLINE fold1 #-} + + toNonEmpty :: (c, a) -> NonEmpty a + toNonEmpty (_, y) = y :| [] + {-# INLINE toNonEmpty #-} + + head1, last1 :: (c, a) -> a + head1 = snd + last1 = snd + {-# INLINE head1 #-} + {-# INLINE last1 #-} + + maximum1, minimum1 :: Ord a => (c, a) -> a + maximum1 = snd + minimum1 = snd + {-# 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 + {-# INLINE foldMap1 #-} + + head1 :: Compose f g a -> a + head1 = head1 . head1 . getCompose + {-# INLINE head1 #-} + + last1 :: Compose f g a -> a + 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@: + +@ +foldl1' f [x0, x1, x2 ...] = f (f x0 x1) x2 ... +@ + +>>> 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,26 +1,37 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -{- -Copyright: (c) 2017-2018 Serokelll - (c) 2018 Kowainik -License: MIT +{- | +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 @@ -37,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,31 +1,51 @@ -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -{- | Contains implememtation of polymorhic type classes for things like 'Set' -and 'Map'. +{- | +Module : Relude.Extra.Map +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +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 @@ -38,8 +58,10 @@ -- Static Map ---------------------------------------------------------------------------- -{- | Read-only map or set. Contains polymorhic functions which work for both +{- | 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 @@ -49,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. @@ -142,6 +225,8 @@ ---------------------------------------------------------------------------- {- | Modifiable Map. + +@since 0.1.0 -} class StaticMap t => DynamicMap t where -- insertions @@ -152,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 #-} ---------------------------------------------------------------------------- @@ -196,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 @@ -204,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 @@ -212,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 new file mode 100644 --- /dev/null +++ b/src/Relude/Extra/Newtype.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE Safe #-} + +{- | +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@. + +@since 0.2.0 +-} + +module Relude.Extra.Newtype + ( un + , wrap + , under + , under2 + , underF2 + , (#.) + ) where + +import Relude + + +-- $setup +-- >>> :set -XTypeApplications +-- >>> import Data.Semigroup (Max (..)) + +{- | Unwraps value from @newtype@. + +>>> newtype Size = Size Int deriving Show +>>> un @Int (Size 5) +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 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 +{-# INLINE wrap #-} + +{- | Applies function to the content of @newtype@. This function is not supposed +to be used on @newtype@s that are created with the help of smart constructors. + +>>> newtype Foo = Foo Bool deriving Show +>>> under not (Foo True) +Foo False +>>> 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 +{-# INLINE under #-} + +{- | Lift binary function for @newtype@s to work over underlying @newtype@ +representation. + +>>> under2 @(Sum Int) (<>) (3 :: Int) 4 +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 #-} + +{- | Version of 'under2' that works on @newtype@s parametrized by their +representation. Provided for convenience. + +>>> underF2 @Sum (<>) (3 :: Int) 4 +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 #-} + +{- | 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 +{-# INLINE (#.) #-} diff --git a/src/Relude/Extra/Tuple.hs b/src/Relude/Extra/Tuple.hs new file mode 100644 --- /dev/null +++ b/src/Relude/Extra/Tuple.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE TupleSections #-} + +{- | +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 + ( 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. + +>>> dup "foo" +("foo","foo") +>>> dup () +((),()) + +@since 0.6.0.0 +-} +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 = 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. + +A dual to 'mapToFst'. + +>>> mapToSnd (+1) 10 +(10,11) + +@since 0.4.0 +-} +mapToSnd :: (a -> b) -> a -> (a, b) +mapToSnd = toSnd +{-# INLINE mapToSnd #-} +{-# DEPRECATED mapToSnd "Use 'toSnd' from [Tuple](\"Relude.Extra.Tuple\") instead" #-} + +{- | 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. + + +A dual to 'traverseToSnd' + +>>> traverseToFst (Just . (+1)) 10 +Just (11,10) +>>> traverseToFst (const Nothing) 10 +Nothing + +@since 0.5.0 +-} +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 new file mode 100644 --- /dev/null +++ b/src/Relude/Extra/Type.hs @@ -0,0 +1,170 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +{- | +Module : Relude.Extra.Type +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +Contains useful utilities to work with Types. + +@since 0.4.0 +-} + +module Relude.Extra.Type + ( typeName + , type (++) + , AllHave + , Elem + , Fst + , Snd + ) where + +import Relude + +import Type.Reflection (typeRep) + + +#if ( __GLASGOW_HASKELL__ >= 906 ) +-- $setup +-- >>> :set -XAllowAmbiguousTypes -XDataKinds -XExplicitNamespaces -XPolyKinds -XTypeFamilies -XTypeOperators -XUndecidableInstances +-- >>> :set -fprint-redundant-promotion-ticks +#else +-- $setup +-- >>> :set -XAllowAmbiguousTypes -XDataKinds -XExplicitNamespaces -XPolyKinds -XTypeFamilies -XTypeOperators -XUndecidableInstances +#endif + +{- | Gets a string representation of a type. + +__NOTE:__ This must be used with __TypeApplications__ language extension. + +>>> typeName @() +"()" +>>> typeName @Int +"Int" +>>> typeName @String +"[Char]" +>>> typeName @(Maybe Int) +"Maybe Int" + +@since 0.4.0 +-} +typeName :: forall a. Typeable a => Text +typeName = show (typeRep @a) +{-# 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/File.hs b/src/Relude/File.hs new file mode 100644 --- /dev/null +++ b/src/Relude/File.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE Safe #-} + +{- | +Module : Relude.File +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +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 + + -- * Lazy Text + , readFileLText + , writeFileLText + , appendFileLText + + -- * ByteString + , readFileBS + , writeFileBS + , appendFileBS + + -- * Lazy ByteString + , readFileLBS + , writeFileLBS + , appendFileLBS + ) where + +import Relude.Base (FilePath, IO) +import Relude.Function ((.)) +import Relude.Monad.Reexport (MonadIO (..)) +import Relude.String (ByteString, LByteString, LText, Text) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text.IO as T +import qualified Data.Text.Lazy.IO as LT + + +---------------------------------------------------------------------------- +-- Text +---------------------------------------------------------------------------- + +{- | 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 #-} +{-# WARNING readFileText ["'readFileText' depends on the system's locale settings and can throw unexpected exceptions.", "Use 'readFileBS' instead."] #-} + +{- | 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'. + +@since 0.3.0 +-} +appendFileText :: MonadIO m => FilePath -> Text -> m () +appendFileText p = liftIO . T.appendFile p +{-# SPECIALIZE appendFileText :: FilePath -> Text -> IO () #-} +{-# INLINE appendFileText #-} + +---------------------------------------------------------------------------- +-- Lazy Text +---------------------------------------------------------------------------- + +{- | 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 #-} +{-# WARNING readFileLText ["'readFileLText' depends on the system's locale settings and can throw unexpected exceptions.", "Use 'readFileLBS' instead."] #-} + +{- | 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'. + +@since 0.3.0 +-} +appendFileLText :: MonadIO m => FilePath -> LText -> m () +appendFileLText p = liftIO . LT.appendFile p +{-# SPECIALIZE appendFileLText :: FilePath -> LText -> IO () #-} +{-# INLINE appendFileLText #-} + +---------------------------------------------------------------------------- +-- ByteString +---------------------------------------------------------------------------- + +{- | 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 #-} + +{- | 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'. + +@since 0.3.0 +-} +appendFileBS :: MonadIO m => FilePath -> ByteString -> m () +appendFileBS p = liftIO . BS.appendFile p +{-# SPECIALIZE appendFileBS :: FilePath -> ByteString -> IO () #-} +{-# INLINE appendFileBS #-} + +---------------------------------------------------------------------------- +-- Lazy ByteString +---------------------------------------------------------------------------- + +{- | 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 #-} + +{- | 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'. + +@since 0.3.0 +-} +appendFileLBS :: MonadIO m => FilePath -> LByteString -> m () +appendFileLBS p = liftIO . LBS.appendFile p +{-# SPECIALIZE appendFileLBS :: FilePath -> LByteString -> IO () #-} +{-# INLINE appendFileLBS #-} diff --git a/src/Relude/Foldable.hs b/src/Relude/Foldable.hs --- a/src/Relude/Foldable.hs +++ b/src/Relude/Foldable.hs @@ -1,9 +1,30 @@ --- | This module exports all 'Foldable' and 'Traversable' related stuff. +{-# LANGUAGE Safe #-} +{- | +Module : Relude.Foldable +Copyright : (c) 2018-2023 Kowainik +SPDX-License-Identifier : MIT +Maintainer : Kowainik +Stability : Stable +Portability : Portable + +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,75 +1,118 @@ +{-# 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 #-} +{- | +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 - , foldMapM - , safeHead - , sum - , product + ( flipfoldl' + , asumMap + , foldMapA + , foldMapM - , elem - , notElem + , sum + , product - , allM - , anyM - , andM - , orM - ) where + , elem + , notElem -import GHC.TypeLits (ErrorMessage (..), TypeError) + -- * Monadic functions + , allM + , anyM + , andM + , orM + ) where -import Relude.Applicative (Applicative (..), pure) -import Relude.Base (Constraint, Eq, IO, Num (..), Type, ($!)) -import Relude.Bool (Bool (..)) +import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError) + +import Relude.Applicative (Alternative, Applicative (..), pure) +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 (Maybe (..), Monad (..)) -import Relude.Monoid (Monoid (..)) +import Relude.Monad.Reexport (Monad (..)) +import Relude.Monoid (Alt (..), Ap (..), Monoid (..), Semigroup) +import Relude.Numeric (Num (..)) import qualified Data.Foldable as F + -- $setup --- >>> :set -XOverloadedStrings --- >>> import Relude.Base (String, Rational, even, (/)) --- >>> import Relude.Bool (when) --- >>> import Relude.Monad (Maybe (..), (>=>)) --- >>> import Relude.Print (print, putTextLn) --- >>> import Relude.String (Text, readMaybe) +-- >>> import Relude -- >>> import qualified Data.HashMap.Strict as HashMap -safeHead :: Foldable f => f a -> Maybe a -safeHead = foldr (\x _ -> Just x) Nothing -{-# INLINE safeHead #-} - {- | Similar to 'foldl'' but takes a function with its arguments flipped. >>> 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' #-} -foldMapA :: (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 +{- | 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] + +@since 0.1.0 +-} +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 #-} -foldMapM :: (Monoid b, Monad m, Foldable f) => (a -> m b) -> f a -> m b +{- | 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 where step x r z = f x >>= \y -> r $! z `mappend` y @@ -99,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 @@ -122,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 @@ -155,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'. @@ -172,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'. @@ -189,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'. @@ -206,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,9 +1,34 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} + +{- | +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 - ) 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_) +#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,20 +1,57 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# LANGUAGE Safe #-} --- | This module reexports very basic and primitive functions and function combinators. +{- | +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. +-} + module Relude.Function - ( 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,11 +1,33 @@ {-# LANGUAGE Safe #-} --- | Convenient functions to work with 'Functor'. +{- | +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 @@ -1,29 +1,84 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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. +This module contains useful functions to work with 'Functor' type class. +-} module Relude.Functor.Fmap - ( (<<$>>) - ) where + ( (<<$>>) + , (<&>) + , flap + , (??) + ) where import Relude.Function ((.)) import Relude.Functor.Reexport (Functor (..)) +import Data.Functor ((<$>)) +#if MIN_VERSION_base(4,11,0) +import Data.Functor ((<&>)) +#else + + +{- | Flipped version of '<$>'. + +@ +f <$> a = a <&> f +@ +-} +infixl 1 <&> +(<&>) :: Functor f => f a -> (a -> b) -> f b +as <&> f = f <$> as +{-# INLINE (<&>) #-} +#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. --- --- >>> negate <<$>> Just [1,2,3] --- Just [-1,-2,-3] +{- | Alias for @fmap . fmap@. Convenient to work with two nested 'Functor's. + +>>> negate <<$>> Just [1,2,3] +Just [-1,-2,-3] +-} +infixl 4 <<$>> (<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b) (<<$>>) = fmap . fmap -infixl 4 <<$>> +{-# INLINE (<<$>>) #-} + +{- | Takes a function in a 'Functor' context and applies it to a normal value. + +>>> flap (++) "relude" "P" +"Prelude" + +@since 0.3.0 +-} +flap :: Functor f => f (a -> b) -> a -> f b +flap ff x = (\f -> f x) <$> ff +{-# INLINE flap #-} + +{- | Operator version of the 'flap' function. + +>>> [(+2), (*3)] ?? 5 +[7,15] + +>>> Just (+3) ?? 5 +Just 8 + +@since 0.3.0 +-} +infixl 4 ?? +(??) :: Functor f => f (a -> b) -> a -> f b +(??) = flap +{-# INLINE (??) #-} 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 @@ -1,24 +1,39 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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 --- | This module reexports functionality regarding 'Functor' type class. +Reexports functionality regarding 'Functor' and 'Bifunctor' typeclasses. +-} module Relude.Functor.Reexport - ( module Control.Arrow - , module Data.Bifunctor - , module Data.Functor - , module Data.Functor.Compose - , module Data.Functor.Identity - ) where + ( -- * Reexport Functor + module Data.Functor + , module Data.Functor.Compose + , module Data.Functor.Identity +#if MIN_VERSION_base(4,12,0) + , module Data.Functor.Contravariant +#endif -import Control.Arrow ((&&&)) + -- * Reexport Bifunctor + , module Data.Bifunctor + ) where + import Data.Bifunctor (Bifunctor (..)) import Data.Functor (Functor (..), void, ($>), (<$>)) import Data.Functor.Compose (Compose (..)) import Data.Functor.Identity (Identity (..)) + +#if MIN_VERSION_base(4,12,0) +import Data.Functor.Contravariant (Comparison (..), Contravariant (..), Equivalence (..), Op (..), + Predicate (..), comparisonEquivalence, defaultComparison, + defaultEquivalence, phantom, ($<), (>$$<), (>$<)) +#endif diff --git a/src/Relude/Lifted.hs b/src/Relude/Lifted.hs --- a/src/Relude/Lifted.hs +++ b/src/Relude/Lifted.hs @@ -1,22 +1,110 @@ {-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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. +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 - ) 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,53 +1,84 @@ {-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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 --- | Concurrency useful and common functions. +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 ---------------------------------------------------------------------------- @@ -56,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 @@ -105,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,48 +1,69 @@ {-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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. +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) -import Prelude ((>>)) import System.Exit (ExitCode) -import System.IO (stderr) import qualified System.Exit as XIO -import qualified System.IO (hPutStrLn) --- | 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'. --- 'XIO.die' is available since base-4.8, but it's more convenient to --- redefine it instead of using CPP. -die :: MonadIO m => String -> m () -die err = liftIO (System.IO.hPutStrLn stderr err) >> exitFailure -{-# INLINE die #-} +{- | Lifted version of 'System.Exit.die'. + +>>> die "Goodbye!" +Goodbye! +*** Exception: ExitFailure 1 +-} +die :: MonadIO m => String -> m a +die err = liftIO (XIO.die err) 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,58 +1,63 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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. --- All functions are specialized to 'Data.Text.Text'. +Lifted versions of functions working with files and common IO. +-} module Relude.Lifted.File - ( appendFile - , getLine - , openFile - , readFile - , writeFile - ) where + ( readFile +#if ( __GLASGOW_HASKELL__ >= 900 ) + , readFile' +#endif + , writeFile + , appendFile + ) where -import Control.Monad.Trans (MonadIO, liftIO) -import Data.Text (Text) -import Prelude (FilePath) -import System.IO (Handle, IOMode) +import Relude.Base (FilePath, IO) +import Relude.Function ((.)) +import Relude.Monad.Reexport (MonadIO (..)) +import Relude.String (String) -import qualified Data.Text.IO as XIO -import qualified System.IO as XIO (openFile) +import qualified System.IO as IO ----------------------------------------------------------------------------- --- Text ----------------------------------------------------------------------------- --- | Lifted version of 'Data.Text.appendFile'. -appendFile :: MonadIO m => FilePath -> Text -> m () -appendFile a b = liftIO (XIO.appendFile a b) -{-# INLINE appendFile #-} +-- | Lifted version of 'IO.readFile'. +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."] #-} --- | Lifted version of 'Data.Text.getLine'. -getLine :: MonadIO m => m Text -getLine = liftIO XIO.getLine -{-# INLINE getLine #-} +#if ( __GLASGOW_HASKELL__ >= 900 ) +{- | Lifted version of 'IO.readFile''. Strict version of 'readFile'. --- | Lifted version of 'Data.Text.readFile'. -readFile :: MonadIO m => FilePath -> m Text -readFile a = liftIO (XIO.readFile a) -{-# INLINE 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 'Data.Text.writeFile'. -writeFile :: MonadIO m => FilePath -> Text -> m () -writeFile a b = liftIO (XIO.writeFile a b) +-- | Lifted version of 'IO.writeFile'. +writeFile :: MonadIO m => FilePath -> String -> m () +writeFile p= liftIO . IO.writeFile p +{-# SPECIALIZE writeFile :: FilePath -> String -> IO () #-} {-# INLINE writeFile #-} --- | Lifted version of 'System.IO.openFile'. -openFile :: MonadIO m => FilePath -> IOMode -> m Handle -openFile a b = liftIO (XIO.openFile a b) -{-# INLINE openFile #-} - --- 'withFile' can't be lifted into 'MonadIO', as it uses 'bracket' +-- | Lifted version of 'IO.appendFile'. +appendFile :: MonadIO m => FilePath -> String -> m () +appendFile p = liftIO . IO.appendFile p +{-# SPECIALIZE appendFile :: FilePath -> String -> IO () #-} +{-# INLINE appendFile #-} 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,69 +1,185 @@ {-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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 new file mode 100644 --- /dev/null +++ b/src/Relude/Lifted/Terminal.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE Safe #-} + +{- | +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 + +import Relude.Base (IO, Show) +import Relude.Function ((.)) +import Relude.Monad.Reexport (MonadIO (..)) +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 +getLine = liftIO TIO.getLine +{-# SPECIALIZE getLine :: IO Text #-} +{-# INLINE getLine #-} + +-- | Lifted version of 'Prelude.print'. +print :: forall a m . (MonadIO m, Show a) => a -> m () +print = liftIO . IO.print +{-# SPECIALIZE print :: Show a => a -> IO () #-} +{-# INLINE print #-} + +-- | Lifted version of 'IO.putStr'. +putStr :: MonadIO m => String -> m () +putStr = liftIO . IO.putStr +{-# SPECIALIZE putStr :: String -> IO () #-} +{-# INLINE putStr #-} + +-- | Lifted version of 'IO.putStrLn'. +putStrLn :: MonadIO m => String -> m () +putStrLn = liftIO . IO.putStrLn +{-# SPECIALIZE putStrLn :: String -> IO () #-} +{-# INLINE putStrLn #-} diff --git a/src/Relude/List.hs b/src/Relude/List.hs --- a/src/Relude/List.hs +++ b/src/Relude/List.hs @@ -1,18 +1,125 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} - {-# LANGUAGE Safe #-} --- | Utility functions to work with lists. +{- | +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 and 'NonEmpty' lists. +-} + module Relude.List - ( module Relude.List.Reexport - , module Relude.List.Safe - ) 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.List.Safe +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 new file mode 100644 --- /dev/null +++ b/src/Relude/List/NonEmpty.hs @@ -0,0 +1,325 @@ +{-# LANGUAGE CPP #-} + +#if __GLASGOW_HASKELL__ >= 902 +{-# OPTIONS_GHC -Wno-operator-whitespace #-} +#endif + +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +{- | +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 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 + ( -- * 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.Monad (Maybe (..), Monad (..)) + +import qualified Data.List.NonEmpty as NE (head, init, last, tail) + + +-- $setup +-- >>> import Relude + +{- | 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 +{-# INLINE viaNonEmpty #-} + +{- | Performs given action over 'NonEmpty' list if given list is non empty. + +>>> whenNotNull [] $ \(b :| _) -> print (not b) +>>> whenNotNull [False,True] $ \(b :| _) -> print (not b) +True +-} +whenNotNull :: Applicative f => [a] -> (NonEmpty a -> f ()) -> f () +whenNotNull [] _ = pass +whenNotNull (x:xs) f = f (x :| xs) +{-# INLINE whenNotNull #-} + +-- | Monadic version of 'whenNotNull'. +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 --} +{- | +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 --- | This module reexports functinons to work with list, 'NonEmpty' and String types. +Reexports most of the "Data.List". +-} module Relude.List.Reexport - ( module Data.List - , module Data.List.NonEmpty - , module GHC.Exts - ) 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, unfoldr, unzip, unzip3, zip, zip3, zipWith, (++)) -import Data.List.NonEmpty (NonEmpty (..), head, init, last, nonEmpty, tail) + ( -- * List + module Data.List + , cycle + , sortWith + ) where +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/List/Safe.hs b/src/Relude/List/Safe.hs deleted file mode 100644 --- a/src/Relude/List/Safe.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE Safe #-} - -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} - --- | This module contains safe functions to work with list type (mostly with 'NonEmpty'). - -module Relude.List.Safe - ( viaNonEmpty - , uncons - , whenNotNull - , whenNotNullM - ) where - -import Relude.Applicative (Applicative, pass) -import Relude.Function ((.)) -import Relude.Functor (fmap) -import Relude.List.Reexport (NonEmpty (..), nonEmpty) -import Relude.Monad (Maybe (..), Monad (..)) - --- $setup --- >>> import Relude.Applicative (pure) --- >>> import Relude.Base ((==)) --- >>> import Relude.Bool (Bool (..), not) --- >>> import Relude.Foldable (length) --- >>> import Relude.Function (($)) --- >>> import Relude.List.Reexport (head) --- >>> import Relude.Print (print) - -{- | For safe work with lists using functinons for 'NonEmpty'. - ->>> viaNonEmpty head [1] -Just 1 ->>> viaNonEmpty head [] -Nothing - --} -viaNonEmpty :: (NonEmpty a -> b) -> [a] -> Maybe b -viaNonEmpty f = fmap f . nonEmpty -{-# INLINE viaNonEmpty #-} - -{- | Destructuring list into its head and tail if possible. This function is total. - ->>> uncons [] -Nothing ->>> uncons [1..5] -Just (1,[2,3,4,5]) ->>> uncons (5 : [1..5]) >>= \(f, l) -> pure $ f == length l -Just True - --} -uncons :: [a] -> Maybe (a, [a]) -uncons [] = Nothing -uncons (x:xs) = Just (x, xs) - -{- | Performs given action over 'NonEmpty' list if given list is non empty. - ->>> whenNotNull [] $ \(b :| _) -> print (not b) ->>> whenNotNull [False,True] $ \(b :| _) -> print (not b) -True - --} -whenNotNull :: Applicative f => [a] -> (NonEmpty a -> f ()) -> f () -whenNotNull [] _ = pass -whenNotNull (x:xs) f = f (x :| xs) -{-# INLINE whenNotNull #-} - --- | Monadic version of 'whenNotNull'. -whenNotNullM :: Monad m => m [a] -> (NonEmpty a -> m ()) -> m () -whenNotNullM ml f = ml >>= \l -> whenNotNull l f -{-# INLINE whenNotNullM #-} diff --git a/src/Relude/Monad.hs b/src/Relude/Monad.hs --- a/src/Relude/Monad.hs +++ b/src/Relude/Monad.hs @@ -1,22 +1,90 @@ {-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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. +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,145 +1,200 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + {-# LANGUAGE Safe #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | +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 -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT +Utilities to work with 'Relude.Monad.Reexport.Either' data type. -} --- | Utilites to work with @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) + -- $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 - --- | 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 + {-# INLINE fail #-} --- | 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 +{- | Maps left part of 'Either' to 'Maybe'. --- | Maps left part of 'Either' to 'Maybe'. --- --- >>> leftToMaybe (Left True) --- Just True --- >>> leftToMaybe (Right "aba") --- Nothing +>>> 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,33 +1,40 @@ {-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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 (fromMaybe) -import Relude.Monad.Reexport (Maybe (..), Monad (..)) +import Relude.Foldable.Reexport (mapM) +import Relude.Function ((.)) +import Relude.Functor.Reexport (fmap) +import Relude.Monad.Reexport (Maybe (..), Monad (..), catMaybes, fromMaybe) + -- $setup --- >>> import Relude.Bool (Bool (..), not) --- >>> import Relude.Function (($)) --- >>> import Relude.Print (putTextLn, print) --- >>> import Relude.String (readMaybe) +-- >>> import Relude {- | Similar to 'fromMaybe' but with flipped arguments. @@ -36,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,41 +1,50 @@ {-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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 --- | This module reexports functions to work with monads. +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) +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,45 +1,104 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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. +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 - ) 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 (Reader, ReaderT, State, StateT, runReader, runReaderT, runState, - runStateT) +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 #-} @@ -49,26 +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 + +@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 + +@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,34 +1,148 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +#if !MIN_VERSION_base(4,12,0) +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE Trustworthy #-} +#else +{-# LANGUAGE Safe #-} --- | This module reexports functions to work with monoids plus adds extra useful functions. +{- | +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,12 +1,18 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# LANGUAGE CPP #-} +{-# LANGUAGE Safe #-} -{-| Functions to remove duplicates from a list. +{- | +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. + = Performance To check the performance there was done a bunch of benchmarks. Benchmarks were made on lists of 'Prelude.Int's and 'Data.Text.Text's. @@ -17,63 +23,114 @@ * 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 -{- | Like 'Prelude.nub' but runs in @O(n * log_16(n))@ time and requires 'Hashable'. +#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' but also sorts a list. +{- | Like 'ordNub' runs in \( O(n \log n) \) but also sorts a list. >>> sortNub [3, 3, 3, 2, 2, -1, 1] [-1,1,2,3] @@ -81,12 +138,48 @@ -} sortNub :: (Ord a) => [a] -> [a] sortNub = Set.toList . Set.fromList +{-# INLINE sortNub #-} -{- | Like 'hashNub' but has better performance and also doesn't save the order. +{- | Like 'hashNub' runs in \( O(n \log_{16} n) \) but has better performance; it doesn't save the order. >>> unstableNub [3, 3, 3, 2, 2, -1, 1] [1,2,3,-1] -} +#if MIN_VERSION_hashable(1,4,0) +unstableNub :: (Hashable a) => [a] -> [a] +#else unstableNub :: (Eq a, Hashable a) => [a] -> [a] +#endif unstableNub = HashSet.toList . HashSet.fromList +{-# 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,88 +1,140 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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 --- | Generalization of 'Prelude.putStr' and 'Prelude.putStrLn' functions. +Functions like 'Prelude.putStr' and 'Prelude.putStrLn' but for 'Text', 'LText', +'ByteString' and 'LByteString'. +-} module Relude.Print - ( Print (..) - , print - , putText - , putTextLn - , putLText - , putLTextLn - ) where - -import Data.Function ((.)) + ( -- * 'Text' & 'LText' + putText + , putTextLn + , putLText + , putLTextLn -import Relude.Monad.Reexport (MonadIO, liftIO) + -- * 'ByteString' & 'LByteString' + , putBS + , putBSLn + , putLBS + , putLBSLn + ) where -import qualified Prelude (print, putStr, putStrLn) +import Relude.Function ((.)) +import Relude.Monad.Reexport (MonadIO (..)) +import Relude.String (ByteString, LByteString, LText, Text) import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as BL - -import qualified Data.Text as T +import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Text.IO as T - -import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL - import qualified Relude.Base as Base --- | Polymorfic over string and lifted to 'MonadIO' printing functions. -class Print a where - putStr :: MonadIO m => a -> m () - putStrLn :: MonadIO m => a -> m () +---------------------------------------------------------------------------- +-- Text +---------------------------------------------------------------------------- -instance Print T.Text where - putStr = liftIO . T.putStr - putStrLn = liftIO . T.putStrLn +{- | Lifted version of 'T.putStr'. -instance Print TL.Text where - putStr = liftIO . TL.putStr - putStrLn = liftIO . TL.putStrLn +>>> putText "Hello, world!" +Hello, world! +-} +putText :: MonadIO m => Text -> m () +putText = liftIO . T.putStr +{-# SPECIALIZE putText :: Text -> Base.IO () #-} +{-# INLINE putText #-} -instance Print BS.ByteString where - putStr = liftIO . BS.putStr - putStrLn = liftIO . BS.putStrLn -instance Print BL.ByteString where - putStr = liftIO . BL.putStr - putStrLn = liftIO . BL.putStrLn +{- | Lifted version of 'T.putStrLn'. -instance Print [Base.Char] where - putStr = liftIO . Prelude.putStr - putStrLn = liftIO . Prelude.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 'Prelude.print'. -print :: forall a m . (MonadIO m, Base.Show a) => a -> m () -print = liftIO . Prelude.print +{- | Lifted version of 'TL.putStr'. --- | Specialized to 'T.Text' version of 'putStr' or forcing type inference. -putText :: MonadIO m => T.Text -> m () -putText = putStr -{-# SPECIALIZE putText :: T.Text -> Base.IO () #-} +>>> putLText "Hello, world!" +Hello, world! +-} +putLText :: MonadIO m => LText -> m () +putLText = liftIO . TL.putStr +{-# SPECIALIZE putLText :: LText -> Base.IO () #-} +{-# INLINE putLText #-} --- | Specialized to 'T.Text' version of 'putStrLn' or forcing type inference. -putTextLn :: MonadIO m => T.Text -> m () -putTextLn = putStrLn -{-# SPECIALIZE putTextLn :: T.Text -> Base.IO () #-} +{- | Lifted version of 'TL.putStrLn'. --- | Specialized to 'TL.Text' version of 'putStr' or forcing type inference. -putLText :: MonadIO m => TL.Text -> m () -putLText = putStr -{-# SPECIALIZE putLText :: TL.Text -> Base.IO () #-} +>>> putLTextLn "Hello, world!" +Hello, world! +-} +putLTextLn :: MonadIO m => LText -> m () +putLTextLn = liftIO . TL.putStrLn +{-# SPECIALIZE putLTextLn :: LText -> Base.IO () #-} +{-# INLINE putLTextLn #-} --- | Specialized to 'TL.Text' version of 'putStrLn' or forcing type inference. -putLTextLn :: MonadIO m => TL.Text -> m () -putLTextLn = putStrLn -{-# SPECIALIZE putLTextLn :: TL.Text -> Base.IO () #-} +---------------------------------------------------------------------------- +-- ByteString +---------------------------------------------------------------------------- + +{- | 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'. + +>>> 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'. + +>>> 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'. + +>>> putLBSLn ("Hello, world!" :: LByteString) +Hello, world! + +@since 0.3.0 +-} +putLBSLn :: MonadIO m => LByteString -> m () +putLBSLn = liftIO . LBS.putStrLn +{-# SPECIALIZE putLBSLn :: LByteString -> Base.IO () #-} +{-# INLINE putLBSLn #-} diff --git a/src/Relude/String.hs b/src/Relude/String.hs --- a/src/Relude/String.hs +++ b/src/Relude/String.hs @@ -1,16 +1,59 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# LANGUAGE Safe #-} --- | Type classes for convertion between different string representations. +{- | +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 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,68 +1,78 @@ {-# 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 --} +{- | +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. +This module implements type class which allow to have conversion to and from +'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.ByteString.Lazy.UTF8 as LBU -import qualified Data.ByteString.UTF8 as BU 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.Base (Int) --- >>> import Relude.Function (($)) --- >>> import Relude.Print (putStrLn) +-- >>> import Relude -- | Type synonym for 'Data.Text.Lazy.Text'. type LText = LT.Text @@ -83,7 +93,7 @@ -- -- >>> decodeUtf8 @Text @ByteString "\208\191\208\176\209\130\208\176\208\186" -- "\1087\1072\1090\1072\1082" - -- >>> putStrLn $ decodeUtf8 @Text @ByteString "\208\191\208\176\209\130\208\176\208\186" + -- >>> putTextLn $ decodeUtf8 @Text @ByteString "\208\191\208\176\209\130\208\176\208\186" -- патак decodeUtf8 :: b -> a @@ -96,110 +106,448 @@ >>> 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 - encodeUtf8 = BU.fromString - decodeUtf8 = BU.toString +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 + {-# INLINE decodeUtf8Strict #-} -instance ConvertUtf8 String LB.ByteString where - encodeUtf8 = LBU.fromString - decodeUtf8 = LBU.toString +{- | 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. fromLazy :: LazyStrict l s => l -> s fromLazy = toStrict {-# INLINE fromLazy #-} {-# SPECIALIZE fromLazy :: LByteString -> ByteString #-} {-# SPECIALIZE fromLazy :: LText -> Text #-} +-- | Alias for 'toLazy' function. fromStrict :: LazyStrict l s => s -> l fromStrict = toLazy {-# INLINE fromStrict #-} @@ -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,30 +1,227 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{-# LANGUAGE CPP #-} --- | This module reexports functions to work with 'Text' and 'ByteString' types. +#if __GLASGOW_HASKELL__ >= 902 +{-# OPTIONS_GHC -Wno-operator-whitespace #-} +#endif +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +{- | +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 '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,42 +1,78 @@ {-# LANGUAGE Unsafe #-} -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} +{- | +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 better don't 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 - ( head - , tail - , init - , last - , at - , (!!) - , fromJust - ) 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,18 +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 = do - defaultMain hedgehogTestTree + -- 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,133 +1,108 @@ -{- -Copyright: (c) 2016 Stephen Diehl - (c) 20016-2018 Serokell - (c) 2018 Kowainik -License: MIT --} - module Test.Relude.Property - ( hedgehogTestTree - ) where + ( hedgehogTestList + ) where import Relude import Data.List (nub) -import Hedgehog (Gen, MonadGen, Property, assert, forAll, property, (===)) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Hedgehog +import Hedgehog (Group (..), Property, assert, forAll, property, (===)) -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as LB -import qualified Data.Text as T -import qualified Data.Text.Lazy as LT -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range -import qualified Relude as U +import Test.Relude.Container.One (oneProps) +import Test.Relude.Gen (genBoolList, genIntList, genUtf8ByteString, genUtf8String, genUtf8Text) -hedgehogTestTree :: TestTree -hedgehogTestTree = testGroup "Tests" [utfProps, listProps, boolMProps] -utfProps :: TestTree -utfProps = testGroup "utf8 conversion property tests" - [ testProperty "String to ByteString invertible" prop_StringToBytes - , testProperty "Text to ByteString invertible" prop_TextToBytes - , testProperty "ByteString to Text or String invertible" prop_BytesTo +hedgehogTestList :: [Group] +hedgehogTestList = + [ utfProps + , listProps + , logicProps + , oneProps ] -unicode' :: MonadGen m => m U.Char -unicode' = do - a <- Gen.unicode - if elem a ['\65534', '\65535'] - then unicode' - else return a - -utf8String :: Gen U.String -utf8String = Gen.string (Range.linear 0 10000) unicode' - -utf8Text :: Gen T.Text -utf8Text = Gen.text (Range.linear 0 10000) unicode' +---------------------------------------------------------------------------- +-- utf8 conversion +---------------------------------------------------------------------------- -utf8Bytes :: Gen B.ByteString -utf8Bytes = Gen.utf8 (Range.linear 0 10000) unicode' +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) + ] -- "\65534" fails, but this is from BU.toString -- > import qualified Data.ByteString.UTF8 as BU -- > BU.toString (BU.fromString "\65534") == "\65533" -- > True - prop_StringToBytes :: Property prop_StringToBytes = property $ do - str <- forAll utf8String - assert $ str == (decodeUtf8 (encodeUtf8 str :: B.ByteString)) - && str == (decodeUtf8 (encodeUtf8 str :: LB.ByteString)) + str <- forAll genUtf8String + assert $ str == decodeUtf8 @_ @ByteString (encodeUtf8 str) + && str == decodeUtf8 @_ @LByteString (encodeUtf8 str) prop_TextToBytes :: Property prop_TextToBytes = property $ do - txt <- forAll utf8Text - assert $ txt == (decodeUtf8 (encodeUtf8 txt :: B.ByteString)) - && txt == (decodeUtf8 (encodeUtf8 txt :: LB.ByteString)) + 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 - assert $ utf == (encodeUtf8 (decodeUtf8 utf :: U.String)) - && utf == (encodeUtf8 (decodeUtf8 utf :: T.Text)) - && utf == (encodeUtf8 (decodeUtf8 utf :: LT.Text)) + utf <- forAll genUtf8ByteString + assert $ utf == encodeUtf8 @String (decodeUtf8 utf) + && utf == encodeUtf8 @Text (decodeUtf8 utf) + && utf == encodeUtf8 @LText (decodeUtf8 utf) +---------------------------------------------------------------------------- -- ordNub +---------------------------------------------------------------------------- -listProps :: TestTree -listProps = testGroup "list function property tests" - [ testProperty "Hedgehog ordNub xs == nub xs" prop_ordNubCorrect - , testProperty "Hedgehog hashNub xs == nub xs" prop_hashNubCorrect - , testProperty "Hedgehog sortNub xs == sort $ nub xs" prop_sortNubCorrect - , testProperty "Hedgehog sort $ unstableNub xs == sort $ nub xs" prop_unstableNubCorrect +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 [U.Int] -genIntList = Gen.list (Range.linear 0 10000) Gen.enumBounded - prop_ordNubCorrect :: Property prop_ordNubCorrect = property $ do xs <- forAll genIntList - U.ordNub xs === nub xs + ordNub xs === nub xs prop_hashNubCorrect :: Property prop_hashNubCorrect = property $ do xs <- forAll genIntList - U.hashNub xs === nub xs + hashNub xs === ordNub xs prop_sortNubCorrect :: Property prop_sortNubCorrect = property $ do xs <- forAll genIntList - U.sortNub xs === (U.sort $ nub xs) + sortNub xs === sort (ordNub xs) prop_unstableNubCorrect :: Property prop_unstableNubCorrect = property $ do xs <- forAll genIntList - (U.sort $ U.unstableNub xs) === (U.sort $ nub xs) - + sort (unstableNub xs) === sortNub xs +---------------------------------------------------------------------------- -- logicM --- this section needs a little more thought - -genBoolList :: Gen [U.Bool] -genBoolList = Gen.list (Range.linear 0 1000) Gen.bool +---------------------------------------------------------------------------- -boolMProps :: TestTree -boolMProps = testGroup "lifted logic function property tests" - [ testProperty "Hedgehog andM" prop_andM - , testProperty "Hedgehog orM" prop_orM +logicProps :: Group +logicProps = Group "lifted logic function property tests" + [ ("andM:", prop_andM) + , ("orM:", prop_orM) ] prop_andM :: Property prop_andM = property $ do bs <- forAll genBoolList - U.andM (return <$> bs) === ((return $ U.and bs) :: U.Maybe U.Bool) + andM (pure <$> bs) === pure @Maybe (and bs) prop_orM :: Property prop_orM = property $ do bs <- forAll genBoolList - U.orM (return <$> bs) === ((return $ U.or bs) :: U.Maybe U.Bool) + orM (pure <$> bs) === pure @Maybe (or bs)