relude (empty) → 0.1.0
raw patch · 53 files changed
+3664/−0 lines, 53 filesdep +Globdep +basedep +bytestringsetup-changed
Dependencies added: Glob, base, bytestring, containers, deepseq, doctest, gauge, ghc-prim, hashable, hedgehog, mtl, relude, semigroups, stm, tasty, tasty-hedgehog, text, transformers, unordered-containers, utf8-string
Files
- CHANGELOG.md +51/−0
- CONTRIBUTING.md +50/−0
- LICENSE +20/−0
- README.md +311/−0
- Setup.hs +2/−0
- benchmark/Main.hs +94/−0
- relude.cabal +184/−0
- src/Relude.hs +102/−0
- src/Relude/Applicative.hs +50/−0
- src/Relude/Base.hs +113/−0
- src/Relude/Bool.hs +12/−0
- src/Relude/Bool/Guard.hs +74/−0
- src/Relude/Bool/Reexport.hs +16/−0
- src/Relude/Container.hs +16/−0
- src/Relude/Container/One.hs +132/−0
- src/Relude/Container/Reexport.hs +32/−0
- src/Relude/Debug.hs +96/−0
- src/Relude/DeepSeq.hs +43/−0
- src/Relude/Exception.hs +76/−0
- src/Relude/Extra/Bifunctor.hs +16/−0
- src/Relude/Extra/Enum.hs +53/−0
- src/Relude/Extra/Group.hs +49/−0
- src/Relude/Extra/Map.hs +217/−0
- src/Relude/Foldable.hs +9/−0
- src/Relude/Foldable/Fold.hs +243/−0
- src/Relude/Foldable/Reexport.hs +9/−0
- src/Relude/Function.hs +20/−0
- src/Relude/Functor.hs +11/−0
- src/Relude/Functor/Fmap.hs +29/−0
- src/Relude/Functor/Reexport.hs +24/−0
- src/Relude/Lifted.hs +22/−0
- src/Relude/Lifted/Concurrent.hs +117/−0
- src/Relude/Lifted/Exit.hs +48/−0
- src/Relude/Lifted/File.hs +58/−0
- src/Relude/Lifted/IORef.hs +69/−0
- src/Relude/List.hs +18/−0
- src/Relude/List/Reexport.hs +25/−0
- src/Relude/List/Safe.hs +75/−0
- src/Relude/Monad.hs +22/−0
- src/Relude/Monad/Either.hs +145/−0
- src/Relude/Monad/Maybe.hs +96/−0
- src/Relude/Monad/Reexport.hs +53/−0
- src/Relude/Monad/Trans.hs +74/−0
- src/Relude/Monoid.hs +34/−0
- src/Relude/Nub.hs +92/−0
- src/Relude/Print.hs +88/−0
- src/Relude/String.hs +16/−0
- src/Relude/String/Conversion.hs +219/−0
- src/Relude/String/Reexport.hs +30/−0
- src/Relude/Unsafe.hs +42/−0
- test/Doctest.hs +16/−0
- test/Spec.hs +18/−0
- test/Test/Relude/Property.hs +133/−0
+ CHANGELOG.md view
@@ -0,0 +1,51 @@+Change log+==========++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):+ Remove `microlens` from dependencies.+* [#10](https://github.com/kowainik/relude/issues/10):+ Remove `VarArg` module.+* [#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):+ Remove `TypeOps` module and `type-operators` dependency.+* [#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):+ 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):+ Add `LazyStrict` type class for conversions.+* `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):+ Add `viaNonEmpty` function.+* [#21](https://github.com/kowainik/relude/issues/21):+ Add `MonadFail` instance for `Either`.+* [#17](https://github.com/kowainik/relude/issues/17):+ Add `foldMapA` and `foldMapM` functions.+* [#4](https://github.com/kowainik/relude/issues/4):+ Rename package to `Relude`.+* [#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):+ 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
+ CONTRIBUTING.md view
@@ -0,0 +1,50 @@+# 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/
+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)+Copyright (c) 2016-2017, Stephen Diehl, 2017, 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+deal in the Software without restriction, including without limitation the+rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+sell copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS+IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,311 @@+Relude+=========++[](https://travis-ci.org/kowainik/relude)+[](https://hackage.haskell.org/package/relude)+[](http://stackage.org/lts/package/relude)+[](http://stackage.org/nightly/package/relude)+[](https://opensource.org/licenses/MIT)++`relude` is a custom prelude based on `universum`. `relude` tries to achieve the following goals:++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.++This README contains introduction to `Relude` and a tutorial on how to use it.++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-)++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).++Motivation [↑](#structure-of-this-tutorial)+------------------------------------------++We decided to base `relude` on `universum` due to the following reasons:++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 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.++Unlike `universum`, we are:++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.++Get started [↑](#structure-of-this-tutorial)+--------------------------------------------++If you want to start using `relude` in your project and explore it with the help+of compiler, set everything up according to the instructions below.++### `base-noprelude`++This is the recommended way to use custom prelude. It requires you to perform+the following steps:++1. Replace `base` dependency with corresponding version of `base-noprelude` in+ 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++ 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!++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.++### Per-file configuration++Disable the built-in prelude 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:++```haskell+default-extensions: NoImplicitPrelude+```++Then add the following import to your modules:++```haskell+import Relude+```++Difference from Prelude [↑](#structure-of-this-tutorial)+--------------------------------------------------------++* `head`, `tail`, `last`, `init` work with `NonEmpty a` instead of `[a]`.+* `undefined` triggers a compiler warning, because you probably don't want to+ leave `undefined` in your code. Either use `throwIO`, `Except`, `error` or+ `bug`.+* Multiple sorting functions are available without imports:+ + `sortBy :: (a -> a -> Ordering) -> [a] -> [a]`: sorts list using given custom comparator.+ + `sortWith :: Ord b => (a -> b) -> [a] -> [a]`: sorts a list based on some property of its elements.+ + `sortOn :: Ord b => (a -> b) -> [a] -> [a]`: just like `sortWith`, but more+ time-efficient if function is calculated slowly (though less+ space-efficient). So you should write `sortOn length` (would sort elements+ by length) but `sortWith fst` (would sort list of pairs by first element).+* Functions `sum` and `product` are strict now, which makes them more efficient.+* 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.++Reexports [↑](#structure-of-this-tutorial)+------------------------------------------++### Commonly used libraries++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).++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).++`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`.++We also reexport big chunks of these libraries: `mtl`, `stm`.++[`Bifunctor`](http://hackage.haskell.org/package/base-4.9.1.0/docs/Data-Bifunctor.html)+type class with useful instances is exported.++* `first` and `second` functions apply a function to first/second part of a tuple (for tuples).+* `bimap` takes two functions and applies them to first and second parts respectively.++### Text++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.++### Debugging and `undefined`s++`trace`, `traceM`, `traceShow`, etc. are available by default. GHC will warn you+if you accidentally leave them in code, however (same for `undefined`).++We also have `data Undefined = Undefined` (which, too, comes with warnings).++### Exceptions++TODO: write about reexports, `Bug` and `Exc` pattern.++What's new? [↑](#structure-of-this-tutorial)+--------------------------------------------++Finally, we can move to part describing the new cool features we bring with `relude`.++* 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:+ ```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:++ ```haskell+ case mbX of+ Nothing -> return ()+ Just x -> f x+ ```++ After:++ ```haskell+ whenJust mbX $ \x ->+ f x+ ```++* `for_` for loops. There's also `forM_` but `for_` looks a bit nicer.++ ```haskell+ for_ [1..10] $ \i -> do+ ...+ ```++* `andM`, `allM`, `anyM`, `orM` are monadic version of corresponding functions from `base`.++* Conversions between `Either` and `Maybe` like `rightToMaybe` and `maybeToLeft`+ with clear semantic.+* `using(Reader|State)[T]` functions as aliases for `flip run(Reader|State)[T]`.+* [`One` type class](src/Relude/Container/One.hs)+ for creating singleton containers. Even monomorhpic ones like `Text`.+* [`StaticMap` and `DynamicMap`type classes](src/Relude/Extra/Map.hs) as a+ general interface for `Map`-like data structures.+* `evaluateWHNF` and `evaluateNF` functions as clearer and lifted aliases for+ `evaluate` and `evaluate . force`.+* `MonadFail` instance for `Either`.++Migration guide [↑](#structure-of-this-tutorial)+------------------------------------------------++In order to replace default `Prelude` with `relude` you should start with instructions given in+[_get started_](#get-started-) section.++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:+ 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`.+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+ 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 ()`++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmark/Main.hs view
@@ -0,0 +1,94 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++module Main where++import Relude hiding (show)++import Data.List (nub)+import Gauge (Benchmark, bench, bgroup, nf)+import Gauge.Main (defaultMain)+import Prelude (show)++import qualified Data.HashSet as HashSet (insert)+import qualified Data.List.NonEmpty as NonEmpty (group, head)+import qualified Relude.Unsafe as Unsafe++main :: IO ()+main = defaultMain+ [ bgroupList listOfSmall "small"+ , bgroupList listOfBig "big"+ , bgroupList (nStrings 'z') "small str"+ , bgroupList (nStrings 'c') "big str"+ , bgroupFold+ ]++bgroupList :: forall a . (Ord a, Hashable a, NFData a)+ => (Int -> [a])+ -> String+ -> Benchmark+bgroupList f name = bgroup name $ map ($ f)+ [ bgroupNubAll 100+ , bgroupNubAll 500+ , bgroupNubAll 1000+ , bgroupNubHugeList 5000+ , bgroupNubHugeList 500000+ , bgroupNubHugeList 1000000+ ]+ where+ bgroupNubAll :: Int -> (Int -> [a]) -> Benchmark+ bgroupNubAll = bgroupNub True++ bgroupNubHugeList :: Int -> (Int -> [a]) -> Benchmark+ bgroupNubHugeList = bgroupNub False++ bgroupNub :: Bool -> Int -> (Int -> [a]) -> Benchmark+ bgroupNub isNub n listOf = bgroup (show n) nubBenchs+ where+ listN :: [a]+ listN = listOf n++ nubBenchs :: [Benchmark]+ nubBenchs =+ (if isNub+ then (:) (bench "nub" $ nf nub listN)+ else id)+ [ bench "ordNub" $ nf ordNub (listN :: [a])+ , bench "hashNub" $ nf hashNub (listN :: [a])+ , bench "sortNub" $ nf sortNub (listN :: [a])+ , bench "hashSet" $ nf unstableNub (listN :: [a])+ , bench "groupSort" $ nf groupSort (listN :: [a])+ , bench "safeSort" $ nf safeSort (listN :: [a])+ ]++ groupSort :: [a] -> [a]+ groupSort = map Unsafe.head . group . sort++ safeSort :: [a] -> [a]+ safeSort = map NonEmpty.head . NonEmpty.group . sort++listOfSmall :: Int -> [Int]+listOfSmall n = let part = n `div` 100 in concat $ replicate part [1..100]++listOfBig :: Int -> [Int]+listOfBig n = let part = n `div` 2 in [1..part] ++ [1..part]++allStrings :: Char -> [String]+allStrings ch = [ c : s | s <- "" : allStrings ch, c <- ['a'..ch] ]++nStrings :: Char -> Int -> [Text]+nStrings ch n = take n $ map toText $ allStrings ch++-- | Checks that 'foldl'' is implemented efficiently for 'Relude.List'+bgroupFold :: Benchmark+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+ ]
+ relude.cabal view
@@ -0,0 +1,184 @@+name: relude+version: 0.1.0+synopsis: Custom prelude from Kowainik+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.++homepage: https://github.com/kowainik/relude+bug-reports: https://github.com/kowainik/relude/issues+license: MIT+license-file: LICENSE+author: Stephen Diehl, @serokell, Kowainik+maintainer: Kowainik <xrom.xkov@gmail.com>+copyright: 2016 Stephen Diehl, 2016-2018 Serokell, 2018 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++source-repository head+ type: git+ location: git@github.com:kowainik/relude.git++library+ hs-source-dirs: src+ exposed-modules:+ Relude+ Relude.Applicative+ Relude.Base+ Relude.Bool+ Relude.Bool.Guard+ Relude.Bool.Reexport+ Relude.Container+ Relude.Container.One+ Relude.Container.Reexport+ Relude.Debug+ Relude.DeepSeq+ Relude.Exception+ Relude.Foldable+ Relude.Foldable.Fold+ Relude.Foldable.Reexport+ Relude.Function+ Relude.Functor+ Relude.Functor.Fmap+ Relude.Functor.Reexport+ Relude.Lifted+ Relude.Lifted.Concurrent+ Relude.Lifted.Exit+ Relude.Lifted.File+ Relude.Lifted.IORef+ Relude.List+ Relude.List.Reexport+ Relude.List.Safe+ Relude.Monad+ Relude.Monad.Either+ Relude.Monad.Maybe+ Relude.Monad.Reexport+ Relude.Monad.Trans+ Relude.Monoid+ Relude.Nub+ 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.Unsafe+++ 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++ default-language: Haskell2010+ default-extensions: NoImplicitPrelude+ OverloadedStrings++test-suite relude-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs++ other-modules: Test.Relude.Property++ build-depends: base >= 4.8 && < 5+ , relude+ , bytestring+ , text+ , utf8-string+ , hedgehog+ , tasty+ , tasty-hedgehog++ ghc-options: -Wall -threaded+ default-language: Haskell2010+ default-extensions: NoImplicitPrelude++test-suite relude-doctest+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Doctest.hs++ build-depends: base >= 4.8 && < 5+ , doctest+ , Glob++ ghc-options: -threaded+ default-language: Haskell2010++benchmark relude-benchmark+ 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+ , relude+ , containers+ , gauge+ , unordered-containers+ if impl(ghc == 7.10.3)+ build-depends: semigroups >= 0.18++ default-extensions: NoImplicitPrelude+ ScopedTypeVariables
+ src/Relude.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE Trustworthy #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++{- | 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.++@+\{\-\# LANGUAGE NoImplicitPrelude \#\-\}++__import__ "Relude"+@++This documentation section contains description of internal module structure to+help navigate between modules, search for interesting functionalities and+understand where you need to put your new changes.++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.+-}++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++import Relude.Applicative+import Relude.Base+import Relude.Bool+import Relude.Container+import Relude.Debug+import Relude.DeepSeq+import Relude.Exception+import Relude.Foldable+import Relude.Function+import Relude.Functor+import Relude.Lifted+import Relude.List+import Relude.Monad+import Relude.Monoid+import Relude.Nub+import Relude.Print+import Relude.String
+ src/Relude/Applicative.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Convenient utils to work with 'Applicative'. There were more functions in this module+-- (see <https://www.stackage.org/haddock/lts-8.9/protolude-0.1.10/Applicative.html protolude version>)+-- but only convenient ans most used are left.++module Relude.Applicative+ ( module Control.Applicative+ , pass+ ) where++import Control.Applicative (Alternative (..), Applicative (..), Const (..), ZipList (..), liftA2,+ liftA3, optional, (<**>))++-- $setup+-- >>> import Relude.Monad (Maybe)++-- | Shorter alias for @pure ()@.+--+-- >>> pass :: Maybe ()+-- Just ()+pass :: Applicative f => f ()+pass = pure ()++{-+orAlt :: (Alternative f, Monoid a) => f a -> f a+orAlt f = f <|> pure mempty++orEmpty :: Alternative f => Bool -> a -> f a+orEmpty b a = if b then pure a else empty++eitherA :: Alternative f => f a -> f b -> f (Either a b)+eitherA a b = (Left <$> a) <|> (Right <$> b)++purer :: (Applicative f, Applicative g) => a -> f (g a)+purer = pure . pure++liftAA2 :: (Applicative f, Applicative g) => (a -> b -> c) -> f (g a) -> f (g b) -> f (g c)+liftAA2 = liftA2 . liftA2++(<<*>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b)+(<<*>>) = liftA2 (<*>)+-}
+ src/Relude/Base.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE Unsafe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Reexports from @GHC.*@ modules of <https://www.stackage.org/lts-8.9/package/base-4.9.1.0 base>+-- 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++ -- * Types for type-level computation+ , module Data.Coerce+ , module Data.Kind+ , module Data.Proxy+ , module Data.Typeable+ , module Data.Void++ , module GHC.Base+ , module GHC.Enum+ , module GHC.Float+ , module GHC.Generics+ , module GHC.Num+ , module GHC.Real+ , module GHC.Show++#if MIN_VERSION_base(4,10,0)+ , module GHC.TypeNats+#else+ , module GHC.TypeLits+#endif++ , module GHC.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)++-- Base typeclasses+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 (..))+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.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 $!
+ src/Relude/Bool.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE Safe #-}++-- | 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++import Relude.Bool.Guard+import Relude.Bool.Reexport
+ src/Relude/Bool/Guard.hs view
@@ -0,0 +1,74 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | This module contains monadic predicates.++module Relude.Bool.Guard+ ( guardM+ , ifM+ , unlessM+ , whenM+ ) where++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.Function (($))+-- >>> import Relude.Monad (Maybe (..))+-- >>> import Relude.Print (putTextLn)++-- | 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+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 :)"+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+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+-- @+guardM :: MonadPlus m => m Bool -> m ()+guardM f = f >>= guard+{-# INLINE guardM #-}
+ src/Relude/Bool/Reexport.hs view
@@ -0,0 +1,16 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | This module reexports functions to work with 'Bool' type.++module Relude.Bool.Reexport+ ( module Control.Monad+ , module Data.Bool+ ) where++import Control.Monad (guard, unless, when)+import Data.Bool (Bool (..), bool, not, otherwise, (&&), (||))
+ src/Relude/Container.hs view
@@ -0,0 +1,16 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | This module exports all container-related stuff.++module Relude.Container+ ( module Relude.Container.One+ , module Relude.Container.Reexport+ ) where++import Relude.Container.One+import Relude.Container.Reexport
+ src/Relude/Container/One.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++{- | Typeclass for creating structures from singleton element.+-}++module Relude.Container.One+ ( One (..)+ ) where++import Relude.Base (Char, Int, Word8)+import Relude.Container.Reexport (HashMap, HashSet, Hashable, IntMap, IntSet, Map, Set, uncurry)++import qualified Data.List.NonEmpty as NE++import qualified Data.Sequence as SEQ++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL++import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HashSet+import qualified Data.IntMap as IM+import qualified Data.IntSet as IS+import qualified Data.Map as M+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++{- | 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.++>>> one True :: [Bool]+[True]+>>> one 'a' :: Text+"a"+>>> one (3, "hello") :: HashMap Int String+fromList [(3,"hello")]+-}+class One x where+ type OneItem x+ -- | Create a list, map, 'Text', etc from a single element.+ one :: OneItem x -> x++-- Lists++instance One [a] where+ type OneItem [a] = a+ one = (:[])+ {-# INLINE one #-}++instance One (NE.NonEmpty a) where+ type OneItem (NE.NonEmpty a) = a+ one = (NE.:|[])+ {-# INLINE one #-}++instance One (SEQ.Seq a) where+ type OneItem (SEQ.Seq a) = a+ one = (SEQ.empty SEQ.|>)+ {-# INLINE one #-}++-- Monomorphic sequences++instance One T.Text where+ type OneItem T.Text = Char+ one = T.singleton+ {-# INLINE one #-}++instance One TL.Text where+ type OneItem TL.Text = Char+ one = TL.singleton+ {-# INLINE one #-}++instance One BS.ByteString where+ type OneItem BS.ByteString = Word8+ one = BS.singleton+ {-# INLINE one #-}++instance One BSL.ByteString where+ type OneItem BSL.ByteString = Word8+ one = BSL.singleton+ {-# INLINE one #-}++-- Maps++instance One (Map k v) where+ type OneItem (Map k v) = (k, v)+ one = uncurry M.singleton+ {-# INLINE one #-}++instance Hashable k => One (HashMap k v) where+ type OneItem (HashMap k v) = (k, v)+ one = uncurry HM.singleton+ {-# INLINE one #-}++instance One (IntMap v) where+ type OneItem (IntMap v) = (Int, v)+ one = uncurry IM.singleton+ {-# INLINE one #-}++-- Sets++instance One (Set v) where+ type OneItem (Set v) = v+ one = Set.singleton+ {-# INLINE one #-}++instance Hashable v => One (HashSet v) where+ type OneItem (HashSet v) = v+ one = HashSet.singleton+ {-# INLINE one #-}++instance One IntSet where+ type OneItem IntSet = Int+ one = IS.singleton+ {-# INLINE one #-}
+ src/Relude/Container/Reexport.hs view
@@ -0,0 +1,32 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | This module reexports all container related stuff from 'Prelude'.++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++import Data.Hashable (Hashable (hashWithSalt))+import Data.HashMap.Strict (HashMap)+import Data.HashSet (HashSet)+import Data.IntMap.Strict (IntMap)+import Data.IntSet (IntSet)+import Data.Map.Strict (Map)+import Data.Sequence (Seq)+import Data.Set (Set)+import Data.Tuple (curry, fst, snd, swap, uncurry)+import GHC.Exts (IsList (fromList, fromListN))
+ src/Relude/Debug.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Trustworthy #-}++#if ( __GLASGOW_HASKELL__ >= 804 )+{-# LANGUAGE TypeInType #-}+#endif++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | 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+ ( Undefined (..)+ , error+ , trace+ , traceM+ , traceId+ , traceShow+ , traceShowId+ , traceShowM+ , undefined+ ) where++import Control.Monad (Monad, return)+import Data.Data (Data)+import Data.Text (Text, unpack)+import Data.Typeable (Typeable)+import GHC.Exts (RuntimeRep, TYPE)+import GHC.Generics (Generic)+import System.IO.Unsafe (unsafePerformIO)++import Relude.Base (HasCallStack)++import Relude.Applicative (pass)+import Relude.Print (Print, putStrLn)++import qualified Prelude as P++-- | Generalized over string version of 'Debug.Trace.trace' that leaves warnings.+{-# 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)++-- | Version of 'Debug.Trace.traceShow' that leaves warning.+{-# 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.+{-# 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++-- | Version of 'Debug.Trace.traceM' that leaves warning and takes 'Text'.+{-# 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'.+{-# WARNING traceId "'traceId' remains in code" #-}+traceId :: Text -> Text+traceId s = trace s s++-- | 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)++-- | 'P.undefined' that leaves warning in code on every usage.+{-# WARNING undefined "'undefined' function remains in code (or use 'error')" #-}+undefined :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack => a+undefined = P.undefined
+ src/Relude/DeepSeq.hs view
@@ -0,0 +1,43 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | 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+ ( module Control.DeepSeq+ , evaluateNF+ , evaluateNF_+ , evaluateWHNF+ , evaluateWHNF_+ ) where++import Control.DeepSeq (NFData (..), deepseq, force, ($!!))++import Relude.Base (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.+evaluateWHNF :: MonadIO m => a -> m a+evaluateWHNF = liftIO . Control.Exception.Base.evaluate++-- | Like 'evaluateWNHF' but discards value.+evaluateWHNF_ :: MonadIO m => a -> m ()+evaluateWHNF_ what = (`seq` ()) <$!> evaluateWHNF what++-- | Alias for @evaluateWHNF . force@ with clearer name.+evaluateNF :: (NFData a, MonadIO m) => a -> m a+evaluateNF = evaluateWHNF . force++-- | Alias for @evaluateWHNF . rnf@. Similar to 'evaluateNF'+-- but discards resulting value.+evaluateNF_ :: (NFData a, MonadIO m) => a -> m ()+evaluateNF_ = evaluateWHNF . rnf
+ src/Relude/Exception.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE ViewPatterns #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Re-exports most useful functionality from 'safe-exceptions'. Also+-- provides some functions to work with exceptions over 'MonadError'.++module Relude.Exception+ ( module Control.Exception++ , Bug (..)+ , bug+ , pattern Exc+ ) where++import Control.Exception (Exception (..), SomeException (..))+import Data.List ((++))+import GHC.Show (Show)+import GHC.Stack (CallStack, HasCallStack, callStack, prettyCallStack)++import Relude.Function ((.))+import Relude.Monad (Maybe (..))++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.+data Bug = Bug SomeException CallStack+ deriving (Show)++instance Exception Bug where+ 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.+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+writing something like this:++@+isNonCriticalExc e+ | Just (_ :: NodeAttackedError) <- fromException e = True+ | Just DialogUnexpected{} <- fromException e = True+ | otherwise = False+@++you can use 'Exc' pattern synonym:++@+isNonCriticalExc = \case+ Exc (_ :: NodeAttackedError) -> True -- matching all exceptions of type 'NodeAttackedError'+ Exc DialogUnexpected{} -> True+ _ -> False+@++This pattern is bidirectional. You can use @Exc e@ instead of @toException e@.+-}+pattern Exc :: Exception e => e -> SomeException+pattern Exc e <- (fromException -> Just e)+ where+ Exc e = toException e
+ src/Relude/Extra/Bifunctor.hs view
@@ -0,0 +1,16 @@+module Relude.Extra.Bifunctor+ ( bimapF+ , firstF+ , secondF+ ) where++import Relude++bimapF :: (Functor f, Bifunctor p) => (a -> c) -> (b -> d) -> f (p a b) -> f (p c d)+bimapF f g = fmap (bimap f g)++firstF :: (Functor f, Bifunctor p) => (a -> c) -> f (p a b) -> f (p c b)+firstF = fmap . first++secondF :: (Functor f, Bifunctor p) => (b -> d) -> f (p a b) -> f (p a d)+secondF = fmap . second
+ src/Relude/Extra/Enum.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Relude.Extra.Enum+ ( universe+ , next+ , safeToEnum+ ) where++import Relude++-- $setup+-- >>> :set -XTypeApplications++{- | Returns all values of some 'Bounded' 'Enum' in ascending order.++>>> data TrafficLight = Red | Blue | Green deriving (Show, Enum, Bounded)+>>> universe :: [TrafficLight]+[Red,Blue,Green]+>>> universe :: [Bool]+[False,True]+-}+universe :: (Bounded a, Enum a) => [a]+universe = [minBound .. maxBound]++{- | Like 'succ', but doesn't fail on 'maxBound'. Instead it returns 'minBound'.++>>> next False+True+>>> next True+False+>>> succ True+*** Exception: Prelude.Enum.Bool.succ: bad argument++-}+next :: (Eq a, Bounded a, Enum a) => a -> a+next e+ | e == maxBound = minBound+ | otherwise = succ e++{- | Returns 'Nothing' if given 'Int' outside range.++>>> safeToEnum @Bool 0+Just False+>>> safeToEnum @Bool 1+Just True+>>> safeToEnum @Bool 2+Nothing+>>> safeToEnum @Bool (-1)+Nothing+-}+safeToEnum :: forall a . (Bounded a, Enum a) => Int -> Maybe a+safeToEnum i = guard (fromEnum @a minBound <= i && i <= fromEnum @a maxBound) *> Just (toEnum i)
+ src/Relude/Extra/Group.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++{-+Copyright: (c) 2017-2018 Serokelll+ (c) 2018 Kowainik+License: MIT+-}++module Relude.Extra.Group+ ( 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])]+-}+groupBy :: forall f t a . (Foldable f, DynamicMap t, Val t ~ NonEmpty a, Monoid t)+ => (a -> Key t) -> f a -> t+groupBy f = flipfoldl' hmGroup mempty+ where+ hmGroup :: a -> t -> t+ hmGroup x =+ let val :: Maybe (NonEmpty a) -> NonEmpty a+ val Nothing = one x+ val (Just xs) = x <| xs+ in alter (Just . val) (f x)++{- | Similar to 'groupBy' but keeps only one element as value.++>>> groupOneBy even [1 .. 6] :: HashMap Bool Int+fromList [(False,1),(True,2)]+-}+groupOneBy :: forall f t a . (Foldable f, DynamicMap t, Val t ~ a, Monoid t)+ => (a -> Key t) -> f a -> t+groupOneBy f = flipfoldl' hmGroup mempty+ where+ hmGroup :: a -> t -> t+ hmGroup val m = let key = f val in+ case lookup key m of+ Nothing -> insert key val m+ Just _ -> m
+ src/Relude/Extra/Map.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE TypeFamilies #-}++{- | Contains implememtation of polymorhic type classes for things like 'Set'+and 'Map'.+-}++module Relude.Extra.Map+ ( StaticMap (..)+ , DynamicMap (..)+ , (!?)+ , notMember+ , lookupDefault++ -- * To pairs+ , toPairs+ , keys+ , elems+ ) where++import GHC.Exts (IsList (Item, toList))++import Relude.Applicative (pure, (*>))+import Relude.Base (Eq, Int, Ord, Type)+import Relude.Bool (Bool, guard, not)+import Relude.Container.Reexport (HashMap, HashSet, Hashable, IntMap, IntSet, Map, Set, fst, snd)+import Relude.Function ((.))+import Relude.List (map)+import Relude.Monad.Reexport (Maybe (..), fromMaybe)++import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HS+import qualified Data.IntMap as IM+import qualified Data.IntSet as IS+import qualified Data.Map.Strict as M+import qualified Data.Set as S++----------------------------------------------------------------------------+-- Static Map+----------------------------------------------------------------------------++{- | Read-only map or set. Contains polymorhic functions which work for both+sets and maps.+-}+class StaticMap t where+ type Key t :: Type+ type Val t :: Type++ size :: t -> Int+ lookup :: Key t -> t -> Maybe (Val t)+ member :: Key t -> t -> Bool++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+ {-# INLINE size #-}+ {-# INLINE lookup #-}+ {-# INLINE member #-}++instance (Eq k, Hashable k) => StaticMap (HashMap k v) where+ type Key (HashMap k v) = k+ type Val (HashMap k v) = v++ size = HM.size+ lookup = HM.lookup+ member = HM.member+ {-# INLINE size #-}+ {-# INLINE lookup #-}+ {-# INLINE member #-}++instance StaticMap (IntMap v) where+ type Key (IntMap v) = Int+ type Val (IntMap v) = v++ size = IM.size+ lookup = IM.lookup+ member = IM.member+ {-# INLINE size #-}+ {-# INLINE lookup #-}+ {-# INLINE member #-}++instance Ord a => StaticMap (Set a) where+ type Key (Set a) = a+ type Val (Set a) = a++ size = S.size+ member = S.member+ lookup k m = guard (member k m) *> pure k+ {-# INLINE size #-}+ {-# INLINE lookup #-}+ {-# INLINE member #-}++instance (Eq a, Hashable a) => StaticMap (HashSet a) where+ type Key (HashSet a) = a+ type Val (HashSet a) = a++ size = HS.size+ member = HS.member+ lookup k m = guard (member k m) *> pure k+ {-# INLINE size #-}+ {-# INLINE lookup #-}+ {-# INLINE member #-}++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+ {-# INLINE size #-}+ {-# INLINE lookup #-}+ {-# INLINE member #-}++-- | Operator version of 'lookup' function.+infixl 9 !?+(!?) :: StaticMap t => t -> Key t -> Maybe (Val t)+(!?) m k = lookup k m+{-# INLINE (!?) #-}++-- | Inverse of 'member' function.+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.+-}+lookupDefault :: StaticMap t+ => Val t -- ^ Default value to return.+ -> Key t -- ^ Key to search+ -> t -- ^ Container to search+ -> Val t+lookupDefault def k = fromMaybe def . lookup k+{-# INLINE lookupDefault #-}++----------------------------------------------------------------------------+-- Dynamic Map+----------------------------------------------------------------------------++{- | Modifiable Map.+-}+class StaticMap t => DynamicMap t where+ -- insertions+ insert :: Key t -> Val t -> t -> t+ insertWith :: (Val t -> Val t -> Val t) -> Key t -> Val t -> t -> t++ -- deletions+ delete :: Key t -> t -> t+ alter :: (Maybe (Val t) -> Maybe (Val t)) -> Key t -> t -> t++instance Ord k => DynamicMap (Map k v) where+ insert = M.insert+ insertWith = M.insertWith+ delete = M.delete+ alter = M.alter++ {-# INLINE insert #-}+ {-# INLINE insertWith #-}+ {-# INLINE delete #-}+ {-# INLINE alter #-}++instance (Eq k, Hashable k) => DynamicMap (HashMap k v) where+ insert = HM.insert+ insertWith = HM.insertWith+ delete = HM.delete+ alter = HM.alter++ {-# INLINE insert #-}+ {-# INLINE insertWith #-}+ {-# INLINE delete #-}+ {-# INLINE alter #-}++instance DynamicMap (IntMap v) where+ insert = IM.insert+ insertWith = IM.insertWith+ delete = IM.delete+ alter = IM.alter++ {-# INLINE insert #-}+ {-# INLINE insertWith #-}+ {-# INLINE delete #-}+ {-# INLINE alter #-}++----------------------------------------------------------------------------+-- ToPairs+----------------------------------------------------------------------------++-- $setup+-- >>> import qualified Data.HashMap.Strict as HashMap++{- | Converts the structure to the list of the key-value pairs.++>>> toPairs (HashMap.fromList [('a', "xxx"), ('b', "yyy")])+[('a',"xxx"),('b',"yyy")]+-}+toPairs :: (IsList t, Item t ~ (a, b)) => t -> [(a, b)]+toPairs = toList++{- | Converts the structure to the list of the keys.++>>> keys (HashMap.fromList [('a', "xxx"), ('b', "yyy")])+"ab"+-}+keys :: (IsList t, Item t ~ (a, b)) => t -> [a]+keys = map fst . toList++{- | Converts the structure to the list of the values.++>>> elems (HashMap.fromList [('a', "xxx"), ('b', "yyy")])+["xxx","yyy"]+-}+elems :: (IsList t, Item t ~ (a, b)) => t -> [b]+elems = map snd . toList
+ src/Relude/Foldable.hs view
@@ -0,0 +1,9 @@+-- | This module exports all 'Foldable' and 'Traversable' related stuff.++module Relude.Foldable+ ( module Relude.Foldable.Fold+ , module Relude.Foldable.Reexport+ ) where++import Relude.Foldable.Fold+import Relude.Foldable.Reexport
+ src/Relude/Foldable/Fold.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}++-- | Fixes and additions to 'Foldable'.++module Relude.Foldable.Fold+ ( flipfoldl'+ , foldMapA+ , foldMapM+ , safeHead+ , sum+ , product++ , elem+ , notElem++ , allM+ , anyM+ , andM+ , orM+ ) where++import GHC.TypeLits (ErrorMessage (..), TypeError)++import Relude.Applicative (Applicative (..), pure)+import Relude.Base (Constraint, Eq, IO, Num (..), Type, ($!))+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 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 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++-}+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+{-# INLINE foldMapA #-}++foldMapM :: (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+{-# INLINE foldMapM #-}++{- | Stricter version of 'F.sum'.++>>> sum [1..10]+55+-}+sum :: forall a f . (Foldable f, Num a) => f a -> a+sum = foldl' (+) 0+{-# INLINE sum #-}++{- | Stricter version of 'F.product'.++>>> product [1..10]+3628800+-}+product :: forall a f . (Foldable f, Num a) => f a -> a+product = foldl' (*) 1+{-# INLINE product #-}++{- | Like 'F.elem' but doesn't work on 'Set' and 'HashSet' for performance reasons.++>>> elem 'x' ("abc" :: String)+False+>>> elem False (one True :: Set Bool)+...+ • 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+...+ Instead of+ notElem :: (Foldable t, Eq a) => a -> t a -> Bool+ use+ notMember :: ??? -- TODO+...+-}+elem :: (Foldable f, DisallowElem f, Eq a) => a -> f a -> Bool+elem = F.elem+{-# INLINE elem #-}++{- | Like 'F.notElem' but doesn't work on 'Set' and 'HashSet' for performance reasons.++>>> notElem 'x' ("abc" :: String)+True+>>> notElem False (one True :: Set Bool)+...+ • 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+...+ Instead of+ notElem :: (Foldable t, Eq a) => a -> t a -> Bool+ use+ notMember :: ??? -- TODO+...+-}+notElem :: (Foldable f, DisallowElem f, Eq a) => a -> f a -> Bool+notElem = F.notElem+{-# INLINE notElem #-}++{- | Monadic version of 'F.and'.++>>> andM [Just True, Just False]+Just False+>>> andM [Just True]+Just True+>>> andM [Just True, Just False, Nothing]+Just False+>>> andM [Just True, Nothing]+Nothing+>>> andM [putTextLn "1" >> pure True, putTextLn "2" >> pure False, putTextLn "3" >> pure True]+1+2+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++{- | Monadic version of 'F.or'.++>>> orM [Just True, Just False]+Just True+>>> orM [Just True, Nothing]+Just True+>>> orM [Nothing, Just True]+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++{- | Monadic version of 'F.all'.++>>> allM (readMaybe >=> pure . even) ["6", "10"]+Just True+>>> allM (readMaybe >=> pure . even) ["5", "aba"]+Just False+>>> allM (readMaybe >=> pure . even) ["aba", "10"]+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++{- | Monadic version of 'F.any'.++>>> anyM (readMaybe >=> pure . even) ["5", "10"]+Just True+>>> anyM (readMaybe >=> pure . even) ["10", "aba"]+Just True+>>> anyM (readMaybe >=> pure . even) ["aba", "10"]+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 #-}+{-# SPECIALIZE anyM :: (a -> IO Bool) -> [a] -> IO Bool #-}+{-# SPECIALIZE allM :: (a -> IO Bool) -> [a] -> IO Bool #-}++----------------------------------------------------------------------------+-- Type level tricks+----------------------------------------------------------------------------++type family DisallowElem (f :: Type -> Type) :: Constraint where+ DisallowElem Set = TypeError (ElemErrorMessage Set)+ DisallowElem HashSet = TypeError (ElemErrorMessage HashSet)+ 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 ""
+ src/Relude/Foldable/Reexport.hs view
@@ -0,0 +1,9 @@+module Relude.Foldable.Reexport+ ( module Data.Foldable+ , module Data.Traversable+ ) where++import Data.Foldable (Foldable (fold, foldMap, foldl', foldr, length, null, toList), all, and, any,+ asum, concat, concatMap, find, foldlM, forM_, for_, mapM_, or, sequenceA_,+ sequence_, traverse_)+import Data.Traversable (Traversable (..), forM, mapAccumL, mapAccumR)
+ src/Relude/Function.hs view
@@ -0,0 +1,20 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | This module reexports very basic and primitive functions and function combinators.++module Relude.Function+ ( module Data.Function+ , identity+ ) where++import Data.Function (const, fix, flip, id, on, ($), (&), (.))++-- | Renamed version of 'Prelude.id'.+identity :: a -> a+identity = id+{-# INLINE identity #-}
+ src/Relude/Functor.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE Safe #-}++-- | Convenient functions to work with 'Functor'.++module Relude.Functor+ ( module Relude.Functor.Fmap+ , module Relude.Functor.Reexport+ ) where++import Relude.Functor.Fmap+import Relude.Functor.Reexport
+ src/Relude/Functor/Fmap.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | This module contains useful functions to work with 'Functor' type class.++module Relude.Functor.Fmap+ ( (<<$>>)+ ) where++import Relude.Function ((.))+import Relude.Functor.Reexport (Functor (..))++-- $setup+-- >>> import Relude.Base (negate)+-- >>> import Relude.Monad (Maybe (..))++-- | Alias for @fmap . fmap@. Convenient to work with two nested 'Functor's.+--+-- >>> negate <<$>> Just [1,2,3]+-- Just [-1,-2,-3]+(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)+(<<$>>) = fmap . fmap+infixl 4 <<$>>
+ src/Relude/Functor/Reexport.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | This module reexports functionality regarding 'Functor' type class.++module Relude.Functor.Reexport+ ( module Control.Arrow+ , module Data.Bifunctor+ , module Data.Functor+ , module Data.Functor.Compose+ , module Data.Functor.Identity+ ) where++import Control.Arrow ((&&&))+import Data.Bifunctor (Bifunctor (..))+import Data.Functor (Functor (..), void, ($>), (<$>))+import Data.Functor.Compose (Compose (..))+import Data.Functor.Identity (Identity (..))
+ src/Relude/Lifted.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Lifted versions of base functions.++module Relude.Lifted+ ( module Relude.Lifted.Concurrent+ , module Relude.Lifted.Exit+ , module Relude.Lifted.File+ , module Relude.Lifted.IORef+ ) where++import Relude.Lifted.Concurrent+import Relude.Lifted.Exit+import Relude.Lifted.File+import Relude.Lifted.IORef
+ src/Relude/Lifted/Concurrent.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Concurrency useful and common functions.++module Relude.Lifted.Concurrent+ ( -- * 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++import Control.Concurrent.MVar (MVar)+import Control.Concurrent.STM.TVar (TVar)+import Control.Monad.STM (STM)+import Control.Monad.Trans (MonadIO, liftIO)+import Data.Bool (Bool)+import Data.Function (($), (.))+import Data.Maybe (Maybe)++import qualified Control.Concurrent.MVar as CCM (newEmptyMVar, newMVar, putMVar, readMVar, swapMVar,+ takeMVar, tryPutMVar, tryReadMVar, tryTakeMVar)+import qualified Control.Concurrent.STM.TVar as STM (modifyTVar', newTVar, newTVarIO, readTVar,+ readTVarIO, writeTVar)+import qualified Control.Monad.STM as STM (atomically)++----------------------------------------------------------------------------+-- Lifted Control.Concurrent.MVar+----------------------------------------------------------------------------++-- | Lifted to 'MonadIO' version of 'CCM.newEmptyMVar'.+newEmptyMVar :: MonadIO m => m (MVar a)+newEmptyMVar = liftIO CCM.newEmptyMVar+{-# INLINE newEmptyMVar #-}++-- | Lifted to 'MonadIO' version of 'CCM.newMVar'.+newMVar :: MonadIO m => a -> m (MVar a)+newMVar = liftIO . CCM.newMVar+{-# INLINE newMVar #-}++-- | Lifted to 'MonadIO' version of 'CCM.putMVar'.+putMVar :: MonadIO m => MVar a -> a -> m ()+putMVar m a = liftIO $ CCM.putMVar m a+{-# INLINE putMVar #-}++-- | Lifted to 'MonadIO' version of 'CCM.readMVar'.+readMVar :: MonadIO m => MVar a -> m a+readMVar = liftIO . CCM.readMVar+{-# INLINE readMVar #-}++-- | 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 #-}++-- | Lifted to 'MonadIO' version of 'CCM.takeMVar'.+takeMVar :: MonadIO m => MVar a -> m a+takeMVar = liftIO . CCM.takeMVar+{-# INLINE takeMVar #-}++-- | 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 #-}++-- | Lifted to 'MonadIO' version of 'CCM.tryReadMVar'.+tryReadMVar :: MonadIO m => MVar a -> m (Maybe a)+tryReadMVar = liftIO . CCM.tryReadMVar+{-# INLINE tryReadMVar #-}++-- | Lifted to 'MonadIO' version of 'CCM.tryTakeMVar'.+tryTakeMVar :: MonadIO m => MVar a -> m (Maybe a)+tryTakeMVar = liftIO . CCM.tryTakeMVar+{-# INLINE tryTakeMVar #-}++----------------------------------------------------------------------------+-- Lifted STM+----------------------------------------------------------------------------++-- | Lifted to 'MonadIO' version of 'STM.atomically'.+atomically :: MonadIO m => STM a -> m a+atomically = liftIO . STM.atomically+{-# INLINE atomically #-}++-- | Lifted to 'MonadIO' version of 'STM.newTVarIO'.+newTVarIO :: MonadIO m => a -> m (TVar a)+newTVarIO = liftIO . STM.newTVarIO+{-# INLINE newTVarIO #-}++-- | Lifted to 'MonadIO' version of 'STM.readTVarIO'.+readTVarIO :: MonadIO m => TVar a -> m a+readTVarIO = liftIO . STM.readTVarIO+{-# INLINE readTVarIO #-}
+ src/Relude/Lifted/Exit.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Lifted versions of functions that work with exit processes.++module Relude.Lifted.Exit+ ( 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'.+exitWith :: MonadIO m => ExitCode -> m a+exitWith a = liftIO (XIO.exitWith a)+{-# INLINE exitWith #-}++-- | Lifted version of 'System.Exit.exitFailure'.+exitFailure :: MonadIO m => m a+exitFailure = liftIO XIO.exitFailure+{-# INLINE exitFailure #-}++-- | Lifted version of 'System.Exit.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 #-}
+ src/Relude/Lifted/File.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Lifted versions of functions working with files and common IO.+-- All functions are specialized to 'Data.Text.Text'.++module Relude.Lifted.File+ ( appendFile+ , getLine+ , openFile+ , readFile+ , writeFile+ ) where++import Control.Monad.Trans (MonadIO, liftIO)+import Data.Text (Text)+import Prelude (FilePath)+import System.IO (Handle, IOMode)++import qualified Data.Text.IO as XIO+import qualified System.IO as XIO (openFile)++----------------------------------------------------------------------------+-- 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 'Data.Text.getLine'.+getLine :: MonadIO m => m Text+getLine = liftIO XIO.getLine+{-# INLINE getLine #-}++-- | Lifted version of 'Data.Text.readFile'.+readFile :: MonadIO m => FilePath -> m Text+readFile a = liftIO (XIO.readFile a)+{-# INLINE readFile #-}++-- | Lifted version of 'Data.Text.writeFile'.+writeFile :: MonadIO m => FilePath -> Text -> m ()+writeFile a b = liftIO (XIO.writeFile a b)+{-# 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'
+ src/Relude/Lifted/IORef.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Lifted reexports from 'Data.IORef' module.++module Relude.Lifted.IORef+ ( IORef+ , atomicModifyIORef+ , atomicModifyIORef'+ , atomicWriteIORef+ , modifyIORef+ , modifyIORef'+ , newIORef+ , readIORef+ , writeIORef+ ) where++import Control.Monad.Trans (MonadIO, liftIO)+import Data.Function (($), (.))+import Data.IORef (IORef)++import qualified Data.IORef as Ref (atomicModifyIORef, atomicModifyIORef', atomicWriteIORef,+ modifyIORef, modifyIORef', newIORef, readIORef, writeIORef)++-- | Lifted version of 'Ref.newIORef'.+newIORef :: MonadIO m => a -> m (IORef a)+newIORef = liftIO . Ref.newIORef+{-# INLINE newIORef #-}++-- | Lifted version of 'Ref.readIORef'.+readIORef :: MonadIO m => IORef a -> m a+readIORef = liftIO . Ref.readIORef+{-# INLINE readIORef #-}++-- | Lifted version of 'Ref.writeIORef'.+writeIORef :: MonadIO m => IORef a -> a -> m ()+writeIORef ref what = liftIO $ Ref.writeIORef ref what+{-# INLINE writeIORef #-}++-- | Lifted version of 'Ref.modifyIORef'.+modifyIORef :: MonadIO m => IORef a -> (a -> a) -> m ()+modifyIORef ref how = liftIO $ Ref.modifyIORef ref how+{-# INLINE modifyIORef #-}++-- | Lifted version of 'Ref.modifyIORef''.+modifyIORef' :: MonadIO m => IORef a -> (a -> a) -> m ()+modifyIORef' ref how = liftIO $ Ref.modifyIORef' ref how+{-# INLINE modifyIORef' #-}++-- | Lifted version of 'Ref.atomicModifyIORef'.+atomicModifyIORef :: MonadIO m => IORef a -> (a -> (a, b)) -> m b+atomicModifyIORef ref how = liftIO $ Ref.atomicModifyIORef ref how+{-# INLINE atomicModifyIORef #-}++-- | Lifted version of 'Ref.atomicModifyIORef''.+atomicModifyIORef' :: MonadIO m => IORef a -> (a -> (a, b)) -> m b+atomicModifyIORef' ref how = liftIO $ Ref.atomicModifyIORef' ref how+{-# INLINE atomicModifyIORef' #-}++-- | Lifted version of 'Ref.atomicWriteIORef'.+atomicWriteIORef :: MonadIO m => IORef a -> a -> m ()+atomicWriteIORef ref what = liftIO $ Ref.atomicWriteIORef ref what+{-# INLINE atomicWriteIORef #-}
+ src/Relude/List.hs view
@@ -0,0 +1,18 @@+{-+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+ ( module Relude.List.Reexport+ , module Relude.List.Safe+ ) where++import Relude.List.Reexport+import Relude.List.Safe
+ src/Relude/List/Reexport.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE Trustworthy #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | This module reexports functinons to work with list, 'NonEmpty' and String types.++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)++import GHC.Exts (sortWith)
+ src/Relude/List/Safe.hs view
@@ -0,0 +1,75 @@+{-# 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 #-}
+ src/Relude/Monad.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Reexporting useful monadic stuff.++module Relude.Monad+ ( module Relude.Monad.Either+ , module Relude.Monad.Maybe+ , module Relude.Monad.Reexport+ , module Relude.Monad.Trans+ ) where++import Relude.Monad.Either+import Relude.Monad.Maybe+import Relude.Monad.Reexport+import Relude.Monad.Trans
+ src/Relude/Monad/Either.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE Safe #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | 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++import Control.Applicative (Applicative)+import Control.Monad (Monad (..))+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)++-- $setup+-- >>> import Relude.Bool (Bool (..))++instance IsString str => MonadFail (Either str) where+ 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++-- | 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'.+--+-- >>> leftToMaybe (Left True)+-- Just True+-- >>> leftToMaybe (Right "aba")+-- Nothing+leftToMaybe :: Either l r -> Maybe l+leftToMaybe = either Just (const Nothing)++-- | 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++-- | 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++-- | 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++-- | 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 :: 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.+whenLeft_ :: Applicative f => Either l r -> (l -> f ()) -> f ()+whenLeft_ = whenLeft ()+{-# INLINE whenLeft_ #-}++-- | Monadic version of 'whenLeft'.+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_'.+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.+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.+whenRight_ :: Applicative f => Either l r -> (r -> f ()) -> f ()+whenRight_ = whenRight ()+{-# INLINE whenRight_ #-}++-- | Monadic version of 'whenRight'.+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_'.+whenRightM_ :: Monad m => m (Either l r) -> (r -> m ()) -> m ()+whenRightM_ me f = me >>= \e -> whenRight_ e f+{-# INLINE whenRightM_ #-}
+ src/Relude/Monad/Maybe.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Utility functions to work with 'Data.Maybe' data type as monad.++module Relude.Monad.Maybe+ ( (?:)+ , whenJust+ , whenJustM+ , whenNothing+ , whenNothing_+ , whenNothingM+ , whenNothingM_+ ) where++import Relude.Applicative (Applicative, pass, pure)+import Relude.Monad.Reexport (fromMaybe)+import Relude.Monad.Reexport (Maybe (..), Monad (..))++-- $setup+-- >>> import Relude.Bool (Bool (..), not)+-- >>> import Relude.Function (($))+-- >>> import Relude.Print (putTextLn, print)+-- >>> import Relude.String (readMaybe)++{- | Similar to 'fromMaybe' but with flipped arguments.++>>> readMaybe "True" ?: False+True++>>> 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.+Also helps to avoid space leaks:+<http://www.snoyman.com/blog/2017/01/foldable-mapm-maybe-and-recursive-functions Foldable.mapM_ space leak>.++>>> whenJust Nothing $ \b -> print (not b)+>>> whenJust (Just True) $ \b -> print (not b)+False++-}+whenJust :: Applicative f => Maybe a -> (a -> f ()) -> f ()+whenJust (Just x) f = f x+whenJust Nothing _ = pass+{-# INLINE whenJust #-}++-- | Monadic version of 'whenJust'.+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]+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!"+whenNothing_ :: Applicative f => Maybe a -> f () -> f ()+whenNothing_ Nothing m = m+whenNothing_ _ _ = pass+{-# INLINE whenNothing_ #-}++-- | Monadic version of 'whenNothing'.+whenNothingM :: Monad m => m (Maybe a) -> m a -> m a+whenNothingM mm action = mm >>= \m -> whenNothing m action+{-# INLINE whenNothingM #-}++-- | Monadic version of 'whenNothingM_'.+whenNothingM_ :: Monad m => m (Maybe a) -> m () -> m ()+whenNothingM_ mm action = mm >>= \m -> whenNothing_ m action+{-# INLINE whenNothingM_ #-}
+ src/Relude/Monad/Reexport.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | This module 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 monadic functions+ , module Control.Monad+ , module Control.Monad.Fail++ -- * Reexport 'Maybe'+ , module Data.Maybe++ -- * Reexport 'Either'+ , module Data.Either+ ) where++-- Monad transformers+import Control.Monad.Except (ExceptT (..), runExceptT)+import Control.Monad.Reader (MonadReader, Reader, ReaderT (..), ask, asks, local, reader, runReader)+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.Identity (IdentityT (runIdentityT))+import Control.Monad.Trans.Maybe (MaybeT (..), exceptToMaybeT, maybeToExceptT)++-- Control.Monad+import Control.Monad (Monad (return, (>>), (>>=)), MonadPlus (..), filterM, forever, join,+ mapAndUnzipM, mfilter, replicateM, replicateM_, zipWithM, zipWithM_, (<$!>),+ (<=<), (=<<), (>=>))+import Control.Monad.Fail (MonadFail (..))++-- Maybe+import Data.Maybe (Maybe (..), catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe,+ maybe, maybeToList)++-- Either+import Data.Either (Either (..), either, isLeft, isRight, lefts, partitionEithers, rights)
+ src/Relude/Monad/Trans.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE Safe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Monad transformers utilities.++module Relude.Monad.Trans+ ( -- * Convenient functions to work with 'Reader' monad+ usingReader+ , usingReaderT++ -- * Convenient functions to work with 'State' monad+ , evaluatingState+ , evaluatingStateT+ , executingState+ , executingStateT+ , usingState+ , usingStateT+ ) where++import Prelude (flip, fst, snd)++import Relude.Functor (Functor, (<$>))+import Relude.Monad.Reexport (Reader, ReaderT, State, StateT, runReader, runReaderT, runState,+ runStateT)++-- | Shorter and more readable alias for @flip runReaderT@.+usingReaderT :: r -> ReaderT r m a -> m a+usingReaderT = flip runReaderT+{-# INLINE usingReaderT #-}++-- | Shorter and more readable alias for @flip runReader@.+usingReader :: r -> Reader r a -> a+usingReader = flip runReader+{-# INLINE usingReader #-}++-- | Shorter and more readable alias for @flip runStateT@.+usingStateT :: s -> StateT s m a -> m (a, s)+usingStateT = flip runStateT+{-# INLINE usingStateT #-}++-- | Shorter and more readable alias for @flip runState@.+usingState :: s -> State s a -> (a, s)+usingState = flip runState+{-# INLINE usingState #-}++-- | 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.+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.+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.+executingState :: s -> State s a -> s+executingState s st = snd (usingState s st)+{-# INLINE executingState #-}
+ src/Relude/Monoid.hs view
@@ -0,0 +1,34 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | This module reexports functions to work with monoids plus adds extra useful functions.++module Relude.Monoid+ ( module Data.Monoid+ , module Data.Semigroup+ , maybeToMonoid+ ) where++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 Relude.Monad.Reexport (Maybe, fromMaybe)++-- $setup+-- >>> import Relude.Base (Int)+-- >>> import Relude.Monad (Maybe (..))++-- | Extracts 'Monoid' value from 'Maybe' returning 'mempty' if 'Nothing'.+--+-- >>> maybeToMonoid (Just [1,2,3] :: Maybe [Int])+-- [1,2,3]+-- >>> maybeToMonoid (Nothing :: Maybe [Int])+-- []+maybeToMonoid :: Monoid m => Maybe m -> m+maybeToMonoid = fromMaybe mempty
+ src/Relude/Nub.hs view
@@ -0,0 +1,92 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++{-| 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.+ There were two types of list to use:++ * Lists which consist of many different elements++ * Lists which consist of many same elements+++ Here are some recomendations for usage of particular functions based on benchmarking resutls.++ * 'hashNub' is faster than 'ordNub' when there're not so many different values in the list.++ * 'hashNub' is the fastest with 'Data.Text.Text'.++ * '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++import Data.Eq (Eq)+import Data.Hashable (Hashable)+import Data.HashSet as HashSet+import Data.Ord (Ord)+import Prelude ((.))++import qualified Data.Set as Set++{- | Like 'Prelude.nub' but runs in @O(n * log n)@ time and requires 'Ord'.++>>> ordNub [3, 3, 3, 2, 2, -1, 1]+[3,2,-1,1]++-}+ordNub :: (Ord a) => [a] -> [a]+ordNub = go Set.empty+ where+ go _ [] = []+ go s (x:xs) =+ if x `Set.member` s+ then go s xs+ else x : go (Set.insert x s) xs++{- | 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]+hashNub = go HashSet.empty+ where+ go _ [] = []+ go s (x:xs) =+ if x `HashSet.member` s+ then go s xs+ else x : go (HashSet.insert x s) xs++{- | Like 'ordNub' but also sorts a list.++>>> sortNub [3, 3, 3, 2, 2, -1, 1]+[-1,1,2,3]++-}+sortNub :: (Ord a) => [a] -> [a]+sortNub = Set.toList . Set.fromList++{- | Like 'hashNub' but has better performance and also doesn't save the order.++>>> unstableNub [3, 3, 3, 2, 2, -1, 1]+[1,2,3,-1]++-}+unstableNub :: (Eq a, Hashable a) => [a] -> [a]+unstableNub = HashSet.toList . HashSet.fromList
+ src/Relude/Print.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Trustworthy #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Generalization of 'Prelude.putStr' and 'Prelude.putStrLn' functions.++module Relude.Print+ ( Print (..)+ , print+ , putText+ , putTextLn+ , putLText+ , putLTextLn+ ) where++import Data.Function ((.))++import Relude.Monad.Reexport (MonadIO, liftIO)++import qualified Prelude (print, putStr, putStrLn)++import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BL++import qualified Data.Text as T+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 ()++instance Print T.Text where+ putStr = liftIO . T.putStr+ putStrLn = liftIO . T.putStrLn++instance Print TL.Text where+ putStr = liftIO . TL.putStr+ putStrLn = liftIO . TL.putStrLn++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++instance Print [Base.Char] where+ putStr = liftIO . Prelude.putStr+ putStrLn = liftIO . Prelude.putStrLn++-- | Lifted version of 'Prelude.print'.+print :: forall a m . (MonadIO m, Base.Show a) => a -> m ()+print = liftIO . Prelude.print++-- | 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 () #-}++-- | 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 () #-}++-- | 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 () #-}++-- | 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 () #-}
+ src/Relude/String.hs view
@@ -0,0 +1,16 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | Type classes for convertion between different string representations.++module Relude.String+ ( module Relude.String.Conversion+ , module Relude.String.Reexport+ ) where++import Relude.String.Conversion+import Relude.String.Reexport
+ src/Relude/String/Conversion.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | 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.++module Relude.String.Conversion+ ( -- * Convenient type aliases+ LText+ , LByteString++ -- * Conversion type classes+ , ConvertUtf8 (..)+ , ToString (..)+ , ToLText (..)+ , ToText (..)+ , LazyStrict (..)+ , fromLazy+ , fromStrict++ -- * Show and read functions+ , readEither+ , show+ ) where++import Data.Bifunctor (first)+import Data.Either (Either)+import Data.Function (id, (.))+import Data.String (String)++import Relude.Functor ((<$>))+import Relude.String.Reexport (ByteString, IsString, Read, Text, fromString)++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 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)++-- | Type synonym for 'Data.Text.Lazy.Text'.+type LText = LT.Text++-- | Type synonym for 'Data.ByteString.Lazy.ByteString'.+type LByteString = LB.ByteString+++-- | Type class for conversion to utf8 representation of text.+class ConvertUtf8 a b where+ -- | Encode as utf8 string (usually 'B.ByteString').+ --+ -- >>> encodeUtf8 @Text @ByteString "патак"+ -- "\208\191\208\176\209\130\208\176\208\186"+ encodeUtf8 :: a -> b++ -- | Decode from utf8 string.+ --+ -- >>> 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"+ -- патак+ decodeUtf8 :: b -> a++ {- | Decode as utf8 string but returning execption if byte sequence is malformed.++#if MIN_VERSION_text(1,2,3)+ >>> decodeUtf8 @Text @ByteString "\208\208\176\209\130\208\176\208\186"+ "\65533\1072\1090\1072\1082"+#else+ >>> decodeUtf8 @Text @ByteString "\208\208\176\209\130\208\176\208\186"+ "\65533\65533\1090\1072\1082"+#endif+ >>> 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+ -}+ decodeUtf8Strict :: b -> Either T.UnicodeException a++instance ConvertUtf8 String B.ByteString where+ encodeUtf8 = BU.fromString+ decodeUtf8 = BU.toString+ decodeUtf8Strict = (T.unpack <$>) . decodeUtf8Strict++instance ConvertUtf8 T.Text B.ByteString where+ encodeUtf8 = T.encodeUtf8+ decodeUtf8 = T.decodeUtf8With T.lenientDecode+ decodeUtf8Strict = T.decodeUtf8'++instance ConvertUtf8 LT.Text B.ByteString where+ encodeUtf8 = LB.toStrict . encodeUtf8+ decodeUtf8 = LT.decodeUtf8With T.lenientDecode . LB.fromStrict+ decodeUtf8Strict = decodeUtf8Strict . LB.fromStrict++instance ConvertUtf8 String LB.ByteString where+ encodeUtf8 = LBU.fromString+ decodeUtf8 = LBU.toString+ decodeUtf8Strict = (T.unpack <$>) . decodeUtf8Strict++instance ConvertUtf8 T.Text LB.ByteString where+ encodeUtf8 = LB.fromStrict . T.encodeUtf8+ decodeUtf8 = T.decodeUtf8With T.lenientDecode . LB.toStrict+ decodeUtf8Strict = T.decodeUtf8' . LB.toStrict++instance ConvertUtf8 LT.Text LB.ByteString where+ encodeUtf8 = LT.encodeUtf8+ decodeUtf8 = LT.decodeUtf8With T.lenientDecode+ decodeUtf8Strict = LT.decodeUtf8'++-- | Type class for converting other strings to 'T.Text'.+class ToText a where+ toText :: a -> T.Text++instance ToText String where+ toText = T.pack++instance ToText T.Text where+ toText = id++instance ToText LT.Text where+ toText = LT.toStrict++-- | Type class for converting other strings to 'LT.Text'.+class ToLText a where+ toLText :: a -> LT.Text++instance ToLText String where+ toLText = LT.pack++instance ToLText T.Text where+ toLText = LT.fromStrict++instance ToLText LT.Text where+ toLText = id++-- | Type class for converting other strings to 'String'.+class ToString a where+ toString :: a -> String++instance ToString String where+ toString = id++instance ToString T.Text where+ toString = T.unpack++instance ToString LT.Text where+ toString = LT.unpack++-- | 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++-- | Generalized version of 'Prelude.show'.+show :: forall b a . (Show.Show a, IsString b) => a -> b+show x = fromString (Show.show x)+{-# SPECIALIZE show :: Show.Show a => a -> Text #-}+{-# SPECIALIZE show :: Show.Show a => a -> LText #-}+{-# SPECIALIZE show :: Show.Show a => a -> ByteString #-}+{-# SPECIALIZE show :: Show.Show a => a -> LByteString #-}+{-# SPECIALIZE show :: Show.Show a => a -> String #-}+++-- | Type class for lazy-strict conversions.+class LazyStrict l s | l -> s, s -> l where+ toLazy :: s -> l+ toStrict :: l -> s++fromLazy :: LazyStrict l s => l -> s+fromLazy = toStrict+{-# INLINE fromLazy #-}+{-# SPECIALIZE fromLazy :: LByteString -> ByteString #-}+{-# SPECIALIZE fromLazy :: LText -> Text #-}++fromStrict :: LazyStrict l s => s -> l+fromStrict = toLazy+{-# INLINE fromStrict #-}+{-# SPECIALIZE fromStrict :: ByteString -> LByteString #-}+{-# SPECIALIZE fromStrict :: Text -> LText #-}++instance LazyStrict LByteString ByteString where+ toLazy = LB.fromStrict+ {-# INLINE toLazy #-}+ toStrict = LB.toStrict+ {-# INLINE toStrict #-}++instance LazyStrict LText Text where+ toLazy = LT.fromStrict+ {-# INLINE toLazy #-}+ toStrict = LT.toStrict+ {-# INLINE toStrict #-}
+ src/Relude/String/Reexport.hs view
@@ -0,0 +1,30 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++-- | This module reexports functions to work with 'Text' and 'ByteString' types.++module Relude.String.Reexport+ ( -- * String+ module Data.String++ -- * Text+ , module Data.Text+ , module Data.Text.Encoding+ , module Data.Text.Encoding.Error+ , module Text.Read++ -- * ByteString+ , module Data.ByteString+ ) where++import Data.ByteString (ByteString)+import Data.String (IsString (..))+import Data.Text (Text, lines, unlines, unwords, words)+import Data.Text.Encoding (decodeUtf8', decodeUtf8With)+import Data.Text.Encoding.Error (OnDecodeError, OnError, UnicodeException, lenientDecode,+ strictDecode)+import Text.Read (Read, readMaybe, reads)
+ src/Relude/Unsafe.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE Unsafe #-}++{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++{- | 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.++@+import qualified Relude.Unsafe as Unsafe++foo :: [a] -> a+foo = Unsafe.head+@++-}++module Relude.Unsafe+ ( head+ , tail+ , init+ , last+ , at+ , (!!)+ , fromJust+ ) where++import Data.List (head, init, last, tail, (!!))+import Data.Maybe (fromJust)++import Relude.Base (Int)+import Relude.Function (flip)++-- | Similar to '!!' but with flipped arguments.+at :: Int -> [a] -> a+at = flip (!!)
+ test/Doctest.hs view
@@ -0,0 +1,16 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++module Main (main) where++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)++main :: IO ()+main = do+ sourceFiles <- glob "src/**/*.hs"+ doctest $ "-XNoImplicitPrelude" : sourceFiles
+ test/Spec.hs view
@@ -0,0 +1,18 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++module Main where++import Relude++import Test.Tasty (defaultMain)++import Test.Relude.Property (hedgehogTestTree)++main :: IO ()+main = do+ defaultMain hedgehogTestTree
+ test/Test/Relude/Property.hs view
@@ -0,0 +1,133 @@+{-+Copyright: (c) 2016 Stephen Diehl+ (c) 20016-2018 Serokell+ (c) 2018 Kowainik+License: MIT+-}++module Test.Relude.Property+ ( hedgehogTestTree+ ) 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 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++hedgehogTestTree :: TestTree+hedgehogTestTree = testGroup "Tests" [utfProps, listProps, boolMProps]++utfProps :: TestTree+utfProps = testGroup "utf8 conversion property tests"+ [ testProperty "String to ByteString invertible" prop_StringToBytes+ , testProperty "Text to ByteString invertible" prop_TextToBytes+ , testProperty "ByteString to Text or String invertible" prop_BytesTo+ ]++unicode' :: MonadGen m => m U.Char+unicode' = do+ a <- Gen.unicode+ if elem a ['\65534', '\65535']+ then unicode'+ else return a++utf8String :: Gen U.String+utf8String = Gen.string (Range.linear 0 10000) unicode'++utf8Text :: Gen T.Text+utf8Text = Gen.text (Range.linear 0 10000) unicode'++utf8Bytes :: Gen B.ByteString+utf8Bytes = Gen.utf8 (Range.linear 0 10000) unicode'++-- "\65534" fails, but this is from BU.toString+-- > import qualified Data.ByteString.UTF8 as BU+-- > BU.toString (BU.fromString "\65534") == "\65533"+-- > True++prop_StringToBytes :: Property+prop_StringToBytes = property $ do+ str <- forAll utf8String+ assert $ str == (decodeUtf8 (encodeUtf8 str :: B.ByteString))+ && str == (decodeUtf8 (encodeUtf8 str :: LB.ByteString))+++prop_TextToBytes :: Property+prop_TextToBytes = property $ do+ txt <- forAll utf8Text+ assert $ txt == (decodeUtf8 (encodeUtf8 txt :: B.ByteString))+ && txt == (decodeUtf8 (encodeUtf8 txt :: LB.ByteString))++-- "\239\191\190" fails, but this is the same as "\65534" :: String+prop_BytesTo :: Property+prop_BytesTo = property $ do+ utf <- forAll utf8Bytes+ assert $ utf == (encodeUtf8 (decodeUtf8 utf :: U.String))+ && utf == (encodeUtf8 (decodeUtf8 utf :: T.Text))+ && utf == (encodeUtf8 (decodeUtf8 utf :: LT.Text))++-- ordNub++listProps :: TestTree+listProps = testGroup "list function property tests"+ [ testProperty "Hedgehog ordNub xs == nub xs" prop_ordNubCorrect+ , testProperty "Hedgehog hashNub xs == nub xs" prop_hashNubCorrect+ , testProperty "Hedgehog sortNub xs == sort $ nub xs" prop_sortNubCorrect+ , testProperty "Hedgehog sort $ unstableNub xs == sort $ nub xs" prop_unstableNubCorrect+ ]++genIntList :: Gen [U.Int]+genIntList = Gen.list (Range.linear 0 10000) Gen.enumBounded++prop_ordNubCorrect :: Property+prop_ordNubCorrect = property $ do+ xs <- forAll genIntList+ U.ordNub xs === nub xs++prop_hashNubCorrect :: Property+prop_hashNubCorrect = property $ do+ xs <- forAll genIntList+ U.hashNub xs === nub xs++prop_sortNubCorrect :: Property+prop_sortNubCorrect = property $ do+ xs <- forAll genIntList+ U.sortNub xs === (U.sort $ nub xs)++prop_unstableNubCorrect :: Property+prop_unstableNubCorrect = property $ do+ xs <- forAll genIntList+ (U.sort $ U.unstableNub xs) === (U.sort $ nub xs)+++-- logicM+-- this section needs a little more thought++genBoolList :: Gen [U.Bool]+genBoolList = Gen.list (Range.linear 0 1000) Gen.bool++boolMProps :: TestTree+boolMProps = testGroup "lifted logic function property tests"+ [ testProperty "Hedgehog andM" prop_andM+ , testProperty "Hedgehog orM" prop_orM+ ]++prop_andM :: Property+prop_andM = property $ do+ bs <- forAll genBoolList+ U.andM (return <$> bs) === ((return $ U.and bs) :: U.Maybe U.Bool)++prop_orM :: Property+prop_orM = property $ do+ bs <- forAll genBoolList+ U.orM (return <$> bs) === ((return $ U.or bs) :: U.Maybe U.Bool)