diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,22 @@ +Unreleased +===== + +1.7.3 +===== + +* [#236](https://github.com/serokell/universum/issues/236): + Add `updateMVar'` and `updateTVar'`. +* [#244](https://github.com/serokell/universum/issues/244) + Add `ToPairs` instances for `[(k, v)]` and `NonEmpty (k, v)`. + +* [#238](https://github.com/serokell/universum/pull/238): + Add `fromList`. + +1.7.2 (rev1) +===== + +* Permit `text-1.2.5.0`. + 1.7.2 ===== diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -151,7 +151,7 @@ [`Container` type class](https://github.com/serokell/universum/blob/b6353285859e9ed3544bddbf55d70237330ad64a/src/Universum/Container/Class.hs#L180) but that restricts the usage of functions like `length` over `Maybe`, `Either`, `Identity` and tuples. We're also using _GHC 8_ feature of - [custom compile-time errors](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#custom-compile-time-errors) + [custom compile-time errors](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_errors.html) to produce [more helpful messages](https://github.com/serokell/universum/blob/54a742c10720f11c739f2d268365d723924b83a9/src/Containers.hs#L474). * As a consequence of previous point, some functions like `traverse_`, `forM_`, `sequenceA_`, etc. @@ -345,20 +345,3 @@ 9. Since vanilla `show` from the `Show` class is not available, your custom `Show` instances will fail to compile. You can `import qualified Text.Show` to bring vanilla `show` to scope with qualified name. It will not conflict with `show` from `universum` and your `Show` instances will compile successfully. - - -Projects that use Universum [↑](#structure-of-this-tutorial) ---------------------------- - -Please submit a PR if you are using Universum! - -| λ | -|---| -| [cardano-report-server](https://github.com/input-output-hk/cardano-report-server) | -| [cardano-sl](https://github.com/input-output-hk/cardano-sl) | -| [importify](https://github.com/serokell/importify) | -| [log-warper](https://github.com/serokell/log-warper) | -| [orgstat](https://github.com/volhovm/orgstat) | -| [tintin](https://github.com/theam/tintin) | -| [require](https://theam.github.io/require/) | -| [ariadne](https://github.com/serokell/ariadne) | diff --git a/benchmark/Main.hs b/benchmark/Main.hs --- a/benchmark/Main.hs +++ b/benchmark/Main.hs @@ -110,10 +110,11 @@ ] ] where + super10 :: [()] -> Bool super10 = null - ... (: []) ... Unsafe.head ... pure ... Unsafe.head + ... ((: []) ... Unsafe.head ... pure ... Unsafe.head ... (: [(), (), (), ()]) ... Unsafe.head ... (: []) ... Unsafe.head - ... (: [()]) ... Unsafe.head ... (: [(), ()]) ... Unsafe.head + ... (: [()]) ... Unsafe.head ... (: [(), ()]) ... Unsafe.head :: [()] -> [()]) norm10 = null . (: []) . Unsafe.head . pure . Unsafe.head diff --git a/src/Universum/Container/Class.hs b/src/Universum/Container/Class.hs --- a/src/Universum/Container/Class.hs +++ b/src/Universum/Container/Class.hs @@ -11,6 +11,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} +{-# OPTIONS_GHC -Wno-unused-type-patterns #-} -- | Reimagined approach for 'Foldable' type hierarchy. Forbids usages -- of 'length' function and similar over 'Maybe' and other potentially unsafe @@ -22,6 +23,7 @@ module Universum.Container.Class ( -- * Foldable-like classes and methods ToPairs (..) + , FromList (..) , Container (..) , checkingNotNull @@ -47,13 +49,14 @@ import Prelude hiding (all, and, any, elem, foldMap, foldl, foldr, mapM_, notElem, null, or, print, product, sequence_, sum) -import Universum.Applicative (Alternative (..), Const, ZipList, pass) -import Universum.Base (Word8) +import Universum.Applicative (Alternative (..), Const, ZipList (..), pass) +import Universum.Base (HasCallStack, Word8) import Universum.Container.Reexport (HashMap, HashSet, Hashable, IntMap, IntSet, Map, Seq, Set, Vector) import Universum.Functor (Identity) import Universum.Monoid (All (..), Any (..), Dual, First (..), Last, Product, Sum) +import qualified GHC.Exts as Exts import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError) import qualified Data.List.NonEmpty as NE @@ -163,6 +166,80 @@ {-# INLINE keys #-} elems = M.elems {-# INLINE elems #-} + +instance ToPairs [(k, v)] where + type Key [(k, v)] = k + type Val [(k, v)] = v + toPairs = id + {-# INLINE toPairs #-} + +instance ToPairs (NonEmpty (k, v)) where + type Key (NonEmpty (k, v)) = k + type Val (NonEmpty (k, v)) = v + toPairs = NE.toList + {-# INLINE toPairs #-} + +---------------------------------------------------------------------------- +-- FromList +---------------------------------------------------------------------------- + +-- | Type class for data types that can be constructed from a list. +class FromList l where + type ListElement l :: Type + type ListElement l = Exts.Item l + + type FromListC l :: Exts.Constraint + type FromListC l = () + + {- | Make a value from list. + + For simple types like '[]' and 'Set': + + @ + 'toList' . 'fromList' ≡ id + 'fromList' . 'toList' ≡ id + @ + + For map-like types: + + @ + 'toPairs' . 'fromList' ≡ id + 'fromList' . 'toPairs' ≡ id + @ + + -} + fromList :: FromListC l => [ListElement l] -> l + default fromList + :: (Exts.IsList l, Exts.Item l ~ a, ListElement l ~ a) + => [ListElement l] -> l + fromList = Exts.fromList + +instance FromList [a] +instance FromList (Vector a) +instance FromList (Seq a) +instance FromList (ZipList a) where + type ListElement (ZipList a) = a + fromList = ZipList +instance FromList (NonEmpty a) where + type FromListC (NonEmpty a) = HasCallStack + fromList l = case l of + [] -> error "empty list" + x : xs -> x NE.:| xs + +instance FromList IntSet +instance Ord a => FromList (Set a) +instance (Eq k, Hashable k) => FromList (HashMap k v) +instance FromList (IntMap v) +instance Ord k => FromList (Map k v) + +instance FromList T.Text +instance FromList TL.Text +instance FromList BS.ByteString where + type ListElement BS.ByteString = Word8 + fromList = BS.pack +instance FromList BSL.ByteString where + type ListElement BSL.ByteString = Word8 + fromList = BSL.pack ---------------------------------------------------------------------------- -- Containers (e.g. tuples and Maybe aren't containers) diff --git a/src/Universum/Lifted/Concurrent.hs b/src/Universum/Lifted/Concurrent.hs --- a/src/Universum/Lifted/Concurrent.hs +++ b/src/Universum/Lifted/Concurrent.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE Safe #-} -- | Concurrency useful and common functions. @@ -14,6 +15,7 @@ , tryPutMVar , tryReadMVar , tryTakeMVar + , updateMVar' -- * STM , STM @@ -22,6 +24,7 @@ , newTVarIO , readTVarIO , STM.modifyTVar' + , updateTVar' , STM.newTVar , STM.readTVar , STM.writeTVar @@ -29,14 +32,18 @@ import Control.Concurrent.MVar (MVar) import Control.Concurrent.STM.TVar (TVar) +import Control.Monad (return) import Control.Monad.STM (STM) +import Control.Monad.State (StateT (..)) import Control.Monad.Trans (MonadIO, liftIO) import Data.Bool (Bool) import Data.Function (($), (.)) import Data.Maybe (Maybe) +import System.IO (IO) -import qualified Control.Concurrent.MVar as CCM (newEmptyMVar, newMVar, putMVar, readMVar, swapMVar, - takeMVar, tryPutMVar, tryReadMVar, tryTakeMVar) +import qualified Control.Concurrent.MVar as CCM (modifyMVar, newEmptyMVar, newMVar, putMVar, + readMVar, swapMVar, takeMVar, tryPutMVar, + tryReadMVar, tryTakeMVar) import qualified Control.Concurrent.STM.TVar as STM (modifyTVar', newTVar, newTVarIO, readTVar, readTVarIO, writeTVar) import qualified Control.Monad.STM as STM (atomically) @@ -108,3 +115,26 @@ readTVarIO :: MonadIO m => TVar a -> m a readTVarIO = liftIO . STM.readTVarIO {-# INLINE readTVarIO #-} + +---------------------------------------------------------------------------- +-- Common helpers +---------------------------------------------------------------------------- + +-- | Like 'modifyMVar', but modification is specified as a 'State' computation. +-- +-- This method is strict in produced @s@ value. +updateMVar' :: MonadIO m => MVar s -> StateT s IO a -> m a +updateMVar' var (StateT f) = + liftIO . CCM.modifyMVar var $ \s -> do + (a, !s') <- f s + return (s', a) +{-# INLINE updateMVar' #-} + +-- | Like 'modifyTVar\'', but modification is specified as a 'State' monad. +updateTVar' :: TVar s -> StateT s STM a -> STM a +updateTVar' var (StateT f) = do + s <- STM.readTVar var + (a, !s') <- f s + STM.writeTVar var s' + return a +{-# INLINE updateTVar' #-} diff --git a/src/Universum/Nub.hs b/src/Universum/Nub.hs --- a/src/Universum/Nub.hs +++ b/src/Universum/Nub.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Safe #-} +{-# LANGUAGE CPP #-} {-| Functions to remove duplicates from a list. @@ -30,7 +31,9 @@ , unstableNub ) where +#if !MIN_VERSION_hashable(1,4,0) import Data.Eq (Eq) +#endif import Data.Hashable (Hashable) import Data.HashSet as HashSet import Data.Ord (Ord) @@ -55,7 +58,11 @@ -- -- >>> hashNub [3, 3, 3, 2, 2, -1, 1] -- [3,2,-1,1] +#if MIN_VERSION_hashable(1,4,0) +hashNub :: (Hashable a) => [a] -> [a] +#else hashNub :: (Eq a, Hashable a) => [a] -> [a] +#endif hashNub = go HashSet.empty where go _ [] = [] @@ -75,5 +82,9 @@ -- -- >>> unstableNub [3, 3, 3, 2, 2, -1, 1] -- [1,2,3,-1] +#if MIN_VERSION_hashable(1,4,0) +unstableNub :: (Hashable a) => [a] -> [a] +#else unstableNub :: (Eq a, Hashable a) => [a] -> [a] +#endif unstableNub = HashSet.toList . HashSet.fromList diff --git a/src/Universum/String/Conversion.hs b/src/Universum/String/Conversion.hs --- a/src/Universum/String/Conversion.hs +++ b/src/Universum/String/Conversion.hs @@ -180,8 +180,22 @@ {- [Note toString-toText-rewritting] -We can do even better if take rules defined in 'Data.Text' into account. +We can do even better than above if take rules defined in 'Data.Text' into +account. +Note ON MAINTENANCE: whenever you need to update the used version of @text@ package, +you have to check whether the comment below is still valid. +However, you can cut down by looking at the diff between versions of @text@, and +seeing if implementation of any of these functions have changed: + * pack + * unpack + * streamList + * unstreamList + * safe + * any RULES definition (if some is added, this counts) +If none of mentioned have changed, then it is safe to assume that everything +is still fine. + Quoting investigation of @int-index: If we look at @unpack@ and @pack@ they are defined as @@ -259,7 +273,7 @@ -} {- The opposite rule is safe to have because 'T.safe' /is/ the identity -function for strings made up from valid characters, and text is guaranteed +function for strings made up from valid characters, and 'Text' is guaranteed to have only valid ones. However, for this case there is no @unstream (stream s) = id@ rule, so we don't delve deep into internals. As long as @stream@ and @unstream@ diff --git a/src/Universum/VarArg.hs b/src/Universum/VarArg.hs --- a/src/Universum/VarArg.hs +++ b/src/Universum/VarArg.hs @@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Safe #-} {-# LANGUAGE TypeFamilies #-} @@ -49,12 +48,12 @@ infixl 8 ... -instance (a ~ c, r ~ b) => +instance {-# INCOHERENT #-} (a ~ c, r ~ b) => SuperComposition (a -> b) c r where f ... g = f g {-# INLINE (...) #-} -instance (SuperComposition (a -> b) d r1, r ~ (c -> r1)) => +instance {-# INCOHERENT #-} (SuperComposition (a -> b) d r1, r ~ (c -> r1)) => SuperComposition (a -> b) (c -> d) r where (f ... g) c = f ... g c {-# INLINE (...) #-} diff --git a/universum.cabal b/universum.cabal --- a/universum.cabal +++ b/universum.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: universum -version: 1.7.2 +version: 1.7.3 synopsis: Custom prelude used in Serokell description: See README.md file for more details. homepage: https://github.com/serokell/universum @@ -15,8 +15,9 @@ bug-reports: https://github.com/serokell/universum/issues tested-with: GHC == 8.4.4 , GHC == 8.6.5 - , GHC == 8.8.3 - , GHC == 8.10.1 + , GHC == 8.8.4 + , GHC == 8.10.7 + , GHC == 9.0.1 extra-doc-files: CHANGES.md , CONTRIBUTING.md , README.md @@ -102,7 +103,7 @@ , stm -- Make sure that "toString-toText-rewritting" note -- is still valid when bumping this constraint. - , text >= 1.0.0.0 && <= 1.2.4.1 + , text >= 1.0.0.0 && <= 1.2.5.0 , transformers , unordered-containers , utf8-string @@ -125,7 +126,7 @@ , text , hedgehog , tasty - , tasty-hedgehog + , tasty-hedgehog < 1.2.0.0 if impl(ghc >= 8.10.1) ghc-options: -Wno-missing-safe-haskell-mode