universum 0.8.0 → 0.9.0
raw patch · 8 files changed
+830/−702 lines, 8 filesdep ~basedep ~criterionPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, criterion
API changes (from Hackage documentation)
- Containers: all :: NontrivialContainer t => (Element t -> Bool) -> t -> Bool
- Containers: and :: (NontrivialContainer t, Element t ~ Bool) => t -> Bool
- Containers: any :: NontrivialContainer t => (Element t -> Bool) -> t -> Bool
- Containers: asum :: (NontrivialContainer t, Alternative f, Element t ~ f a) => t -> f a
- Containers: class Container t
- Containers: class Container t => NontrivialContainer t where foldMap f = foldr (mappend . f) mempty fold = foldMap id foldr' f z0 xs = foldl f' id xs z0 where f' k x z = k $! f x z foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure") (foldr mf Nothing xs) where mf x m = Just (case m of { Nothing -> x Just y -> f x y }) foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure") (foldl mf Nothing xs) where mf m y = Just (case m of { Nothing -> y Just x -> f x y }) notElem x = not . elem x all p = getAll #. foldMap (All #. p) any p = getAny #. foldMap (Any #. p) and = getAll #. foldMap All or = getAny #. foldMap Any find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing)) head = foldr (\ x _ -> Just x) Nothing
- Containers: class One x where type OneItem x where {
- Containers: elem :: (NontrivialContainer t, Eq (Element t)) => Element t -> t -> Bool
- Containers: find :: NontrivialContainer t => (Element t -> Bool) -> t -> Maybe (Element t)
- Containers: fold :: (NontrivialContainer t, Monoid (Element t)) => t -> Element t
- Containers: foldMap :: (NontrivialContainer t, Monoid m) => (Element t -> m) -> t -> m
- Containers: foldl :: NontrivialContainer t => (b -> Element t -> b) -> b -> t -> b
- Containers: foldl' :: NontrivialContainer t => (b -> Element t -> b) -> b -> t -> b
- Containers: foldl1 :: NontrivialContainer t => (Element t -> Element t -> Element t) -> t -> Element t
- Containers: foldr :: NontrivialContainer t => (Element t -> b -> b) -> b -> t -> b
- Containers: foldr' :: NontrivialContainer t => (Element t -> b -> b) -> b -> t -> b
- Containers: foldr1 :: NontrivialContainer t => (Element t -> Element t -> Element t) -> t -> Element t
- Containers: forM_ :: (NontrivialContainer t, Monad m) => t -> (Element t -> m b) -> m ()
- Containers: for_ :: (NontrivialContainer t, Applicative f) => t -> (Element t -> f b) -> f ()
- Containers: head :: NontrivialContainer t => t -> Maybe (Element t)
- Containers: instance (TypeError ...) => Containers.Container (a, b)
- Containers: instance (TypeError ...) => Containers.NontrivialContainer (Data.Either.Either a b)
- Containers: instance (TypeError ...) => Containers.NontrivialContainer (Data.Functor.Identity.Identity a)
- Containers: instance (TypeError ...) => Containers.NontrivialContainer (GHC.Base.Maybe a)
- Containers: instance (TypeError ...) => Containers.NontrivialContainer (a, b)
- Containers: instance Containers.Container Data.ByteString.Internal.ByteString
- Containers: instance Containers.Container Data.ByteString.Lazy.Internal.ByteString
- Containers: instance Containers.Container Data.IntSet.Base.IntSet
- Containers: instance Containers.Container Data.Text.Internal.Lazy.Text
- Containers: instance Containers.Container Data.Text.Internal.Text
- Containers: instance Containers.NontrivialContainer Data.ByteString.Internal.ByteString
- Containers: instance Containers.NontrivialContainer Data.ByteString.Lazy.Internal.ByteString
- Containers: instance Containers.NontrivialContainer Data.IntSet.Base.IntSet
- Containers: instance Containers.NontrivialContainer Data.Text.Internal.Lazy.Text
- Containers: instance Containers.NontrivialContainer Data.Text.Internal.Text
- Containers: instance Containers.One (Data.IntMap.Base.IntMap v)
- Containers: instance Containers.One (Data.List.NonEmpty.NonEmpty a)
- Containers: instance Containers.One (Data.Map.Base.Map k v)
- Containers: instance Containers.One (Data.Sequence.Seq a)
- Containers: instance Containers.One (Data.Set.Base.Set v)
- Containers: instance Containers.One (Data.Vector.Vector a)
- Containers: instance Containers.One Data.ByteString.Internal.ByteString
- Containers: instance Containers.One Data.ByteString.Lazy.Internal.ByteString
- Containers: instance Containers.One Data.IntSet.Base.IntSet
- Containers: instance Containers.One Data.Text.Internal.Lazy.Text
- Containers: instance Containers.One Data.Text.Internal.Text
- Containers: instance Containers.One [a]
- Containers: instance Data.Foldable.Foldable f => Containers.Container (f a)
- Containers: instance Data.Foldable.Foldable f => Containers.NontrivialContainer (f a)
- Containers: instance Data.Hashable.Class.Hashable k => Containers.One (Data.HashMap.Base.HashMap k v)
- Containers: instance Data.Hashable.Class.Hashable v => Containers.One (Data.HashSet.HashSet v)
- Containers: instance Data.Primitive.Types.Prim a => Containers.One (Data.Vector.Primitive.Vector a)
- Containers: instance Data.Vector.Unboxed.Base.Unbox a => Containers.One (Data.Vector.Unboxed.Base.Vector a)
- Containers: instance Foreign.Storable.Storable a => Containers.One (Data.Vector.Storable.Vector a)
- Containers: length :: NontrivialContainer t => t -> Int
- Containers: mapM_ :: (NontrivialContainer t, Monad m) => (Element t -> m b) -> t -> m ()
- Containers: maximum :: (NontrivialContainer t, Ord (Element t)) => t -> Element t
- Containers: minimum :: (NontrivialContainer t, Ord (Element t)) => t -> Element t
- Containers: notElem :: (NontrivialContainer t, Eq (Element t)) => Element t -> t -> Bool
- Containers: null :: Container t => t -> Bool
- Containers: one :: One x => OneItem x -> x
- Containers: or :: (NontrivialContainer t, Element t ~ Bool) => t -> Bool
- Containers: product :: (NontrivialContainer t, Num (Element t)) => t -> Element t
- Containers: sequenceA_ :: (NontrivialContainer t, Applicative f, Element t ~ f a) => t -> f ()
- Containers: sequence_ :: (NontrivialContainer t, Monad m, Element t ~ m a) => t -> m ()
- Containers: sum :: (NontrivialContainer t, Num (Element t)) => t -> Element t
- Containers: toList :: Container t => t -> [Element t]
- Containers: traverse_ :: (NontrivialContainer t, Applicative f) => (Element t -> f b) -> t -> f ()
- Containers: type family OneItem x;
- Containers: }
+ Container.Class: WrappedList :: (f a) -> WrappedList f a
+ Container.Class: all :: Container t => (Element t -> Bool) -> t -> Bool
+ Container.Class: and :: (Container t, Element t ~ Bool) => t -> Bool
+ Container.Class: any :: Container t => (Element t -> Bool) -> t -> Bool
+ Container.Class: asum :: (Container t, Alternative f, Element t ~ f a) => t -> f a
+ Container.Class: class ToList t => Container t where foldMap f = foldr (mappend . f) mempty fold = foldMap id foldr' f z0 xs = foldl f' id xs z0 where f' k x z = k $! f x z foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure") (foldr mf Nothing xs) where mf x m = Just (case m of { Nothing -> x Just y -> f x y }) foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure") (foldl mf Nothing xs) where mf m y = Just (case m of { Nothing -> y Just x -> f x y }) notElem x = not . elem x all p = getAll #. foldMap (All #. p) any p = getAny #. foldMap (Any #. p) and = getAll #. foldMap All or = getAny #. foldMap Any find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing)) head = foldr (\ x _ -> Just x) Nothing
+ Container.Class: class One x where type OneItem x where {
+ Container.Class: class ToList t where null = null . toList
+ Container.Class: elem :: (Container t, Eq (Element t)) => Element t -> t -> Bool
+ Container.Class: find :: Container t => (Element t -> Bool) -> t -> Maybe (Element t)
+ Container.Class: fold :: (Container t, Monoid (Element t)) => t -> Element t
+ Container.Class: foldMap :: (Container t, Monoid m) => (Element t -> m) -> t -> m
+ Container.Class: foldl :: Container t => (b -> Element t -> b) -> b -> t -> b
+ Container.Class: foldl' :: Container t => (b -> Element t -> b) -> b -> t -> b
+ Container.Class: foldl1 :: Container t => (Element t -> Element t -> Element t) -> t -> Element t
+ Container.Class: foldr :: Container t => (Element t -> b -> b) -> b -> t -> b
+ Container.Class: foldr' :: Container t => (Element t -> b -> b) -> b -> t -> b
+ Container.Class: foldr1 :: Container t => (Element t -> Element t -> Element t) -> t -> Element t
+ Container.Class: forM_ :: (Container t, Monad m) => t -> (Element t -> m b) -> m ()
+ Container.Class: for_ :: (Container t, Applicative f) => t -> (Element t -> f b) -> f ()
+ Container.Class: head :: Container t => t -> Maybe (Element t)
+ Container.Class: instance (TypeError ...) => Container.Class.Container (Data.Either.Either a b)
+ Container.Class: instance (TypeError ...) => Container.Class.Container (Data.Functor.Identity.Identity a)
+ Container.Class: instance (TypeError ...) => Container.Class.Container (GHC.Base.Maybe a)
+ Container.Class: instance (TypeError ...) => Container.Class.Container (a, b)
+ Container.Class: instance (TypeError ...) => Container.Class.ToList (a, b)
+ Container.Class: instance Container.Class.Container Data.ByteString.Internal.ByteString
+ Container.Class: instance Container.Class.Container Data.ByteString.Lazy.Internal.ByteString
+ Container.Class: instance Container.Class.Container Data.IntSet.Base.IntSet
+ Container.Class: instance Container.Class.Container Data.Text.Internal.Lazy.Text
+ Container.Class: instance Container.Class.Container Data.Text.Internal.Text
+ Container.Class: instance Container.Class.One (Data.IntMap.Base.IntMap v)
+ Container.Class: instance Container.Class.One (Data.List.NonEmpty.NonEmpty a)
+ Container.Class: instance Container.Class.One (Data.Map.Base.Map k v)
+ Container.Class: instance Container.Class.One (Data.Sequence.Seq a)
+ Container.Class: instance Container.Class.One (Data.Set.Base.Set v)
+ Container.Class: instance Container.Class.One (Data.Vector.Vector a)
+ Container.Class: instance Container.Class.One Data.ByteString.Internal.ByteString
+ Container.Class: instance Container.Class.One Data.ByteString.Lazy.Internal.ByteString
+ Container.Class: instance Container.Class.One Data.IntSet.Base.IntSet
+ Container.Class: instance Container.Class.One Data.Text.Internal.Lazy.Text
+ Container.Class: instance Container.Class.One Data.Text.Internal.Text
+ Container.Class: instance Container.Class.One [a]
+ Container.Class: instance Container.Class.ToList (f a) => Container.Class.Container (Container.Class.WrappedList f a)
+ Container.Class: instance Container.Class.ToList (f a) => Container.Class.ToList (Container.Class.WrappedList f a)
+ Container.Class: instance Container.Class.ToList Data.ByteString.Internal.ByteString
+ Container.Class: instance Container.Class.ToList Data.ByteString.Lazy.Internal.ByteString
+ Container.Class: instance Container.Class.ToList Data.IntSet.Base.IntSet
+ Container.Class: instance Container.Class.ToList Data.Text.Internal.Lazy.Text
+ Container.Class: instance Container.Class.ToList Data.Text.Internal.Text
+ Container.Class: instance Data.Foldable.Foldable f => Container.Class.Container (f a)
+ Container.Class: instance Data.Foldable.Foldable f => Container.Class.ToList (f a)
+ Container.Class: instance Data.Hashable.Class.Hashable k => Container.Class.One (Data.HashMap.Base.HashMap k v)
+ Container.Class: instance Data.Hashable.Class.Hashable v => Container.Class.One (Data.HashSet.HashSet v)
+ Container.Class: instance Data.Primitive.Types.Prim a => Container.Class.One (Data.Vector.Primitive.Vector a)
+ Container.Class: instance Data.Vector.Unboxed.Base.Unbox a => Container.Class.One (Data.Vector.Unboxed.Base.Vector a)
+ Container.Class: instance Foreign.Storable.Storable a => Container.Class.One (Data.Vector.Storable.Vector a)
+ Container.Class: length :: Container t => t -> Int
+ Container.Class: mapM_ :: (Container t, Monad m) => (Element t -> m b) -> t -> m ()
+ Container.Class: maximum :: (Container t, Ord (Element t)) => t -> Element t
+ Container.Class: minimum :: (Container t, Ord (Element t)) => t -> Element t
+ Container.Class: newtype WrappedList f a
+ Container.Class: notElem :: (Container t, Eq (Element t)) => Element t -> t -> Bool
+ Container.Class: null :: ToList t => t -> Bool
+ Container.Class: one :: One x => OneItem x -> x
+ Container.Class: or :: (Container t, Element t ~ Bool) => t -> Bool
+ Container.Class: product :: (Container t, Num (Element t)) => t -> Element t
+ Container.Class: sequenceA_ :: (Container t, Applicative f, Element t ~ f a) => t -> f ()
+ Container.Class: sequence_ :: (Container t, Monad m, Element t ~ m a) => t -> m ()
+ Container.Class: sum :: (Container t, Num (Element t)) => t -> Element t
+ Container.Class: toList :: ToList t => t -> [Element t]
+ Container.Class: traverse_ :: (Container t, Applicative f) => (Element t -> f b) -> t -> f ()
+ Container.Class: type NontrivialContainer t = Container t
+ Container.Class: type family OneItem x;
+ Container.Class: }
- Monad: allM :: (NontrivialContainer f, Monad m) => (Element f -> m Bool) -> f -> m Bool
+ Monad: allM :: (Container f, Monad m) => (Element f -> m Bool) -> f -> m Bool
- Monad: andM :: (NontrivialContainer f, Element f ~ m Bool, Monad m) => f -> m Bool
+ Monad: andM :: (Container f, Element f ~ m Bool, Monad m) => f -> m Bool
- Monad: anyM :: (NontrivialContainer f, Monad m) => (Element f -> m Bool) -> f -> m Bool
+ Monad: anyM :: (Container f, Monad m) => (Element f -> m Bool) -> f -> m Bool
- Monad: concatForM :: (Applicative f, Monoid m, NontrivialContainer (l m), Traversable l) => l a -> (a -> f m) -> f m
+ Monad: concatForM :: (Applicative f, Monoid m, Container (l m), Traversable l) => l a -> (a -> f m) -> f m
- Monad: concatMapM :: (Applicative f, Monoid m, NontrivialContainer (l m), Traversable l) => (a -> f m) -> l a -> f m
+ Monad: concatMapM :: (Applicative f, Monoid m, Container (l m), Traversable l) => (a -> f m) -> l a -> f m
- Monad: orM :: (NontrivialContainer f, Element f ~ m Bool, Monad m) => f -> m Bool
+ Monad: orM :: (Container f, Element f ~ m Bool, Monad m) => f -> m Bool
Files
- CHANGES.md +15/−0
- src/Container.hs +9/−0
- src/Container/Class.hs +743/−0
- src/Container/Reexport.hs +23/−0
- src/Containers.hs +0/−655
- src/Monad.hs +28/−28
- src/Universum.hs +4/−13
- universum.cabal +8/−6
CHANGES.md view
@@ -1,3 +1,18 @@+0.9.0+=====++* [#79](https://github.com/serokell/universum/issues/79):+ Import '(<>)' from Semigroup, not Monoid.+* Improve travis configartion.+* [#80](https://github.com/serokell/universum/issues/80):+ Rename `Container` to `ToList`, `NontrivialContainer` to `Container`.+ Keep `NontrivialContainer` as type alias.+* Rename `Containers` module to `Container.Class`.+* Move all container-related reexports from `Universum` to `Container.Reexport`.+* Add default implementation of `null` function.+* Add `WrappedList` newtype with instance of `Container`.+* Improve compile time error messages for disallowed instances.+ 0.8.0 =====
+ src/Container.hs view
@@ -0,0 +1,9 @@+-- | This module exports all container-related stuff.++module Container+ ( module Container.Class+ , module Container.Reexport+ ) where++import Container.Class+import Container.Reexport
+ src/Container/Class.hs view
@@ -0,0 +1,743 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstrainedClassMethods #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}++-- | Reimagined approach for 'Foldable' type hierarchy. Forbids usages+-- of 'length' function and similar over 'Maybe' and other potentially unsafe+-- data types. It was proposed to use @-XTypeApplication@ for such cases.+-- But this approach is not robust enough because programmers are human and can+-- easily forget to do this. For discussion see this topic:+-- <https://www.reddit.com/r/haskell/comments/60r9hu/proposal_suggest_explicit_type_application_for/ Suggest explicit type application for Foldable length and friends>++module Container.Class+ (+ -- * Foldable-like classes and methods+ Element+ , ToList(..)+ , Container(..)+ , NontrivialContainer++ , WrappedList (..)++ , sum+ , product++ , mapM_+ , forM_+ , traverse_+ , for_+ , sequenceA_+ , sequence_+ , asum++ -- * Others+ , One(..)+ ) where++import Control.Applicative (Alternative (..))+import Control.Monad.Identity (Identity)+import Data.Coerce (Coercible, coerce)+import Data.Foldable (Foldable)+import Data.Hashable (Hashable)+import Data.Maybe (fromMaybe)+import Data.Monoid (All (..), Any (..), First (..))+import Data.Word (Word8)+import Prelude hiding (Foldable (..), all, and, any, head, mapM_, notElem, or, sequence_)++#if __GLASGOW_HASKELL__ >= 800+import GHC.Err (errorWithoutStackTrace)+import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError)+#endif++#if ( __GLASGOW_HASKELL__ >= 800 )+import qualified Data.List.NonEmpty as NE+#endif++import qualified Data.Foldable as F++import qualified Data.List as List (null)++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 HS+import qualified Data.IntMap as IM+import qualified Data.IntSet as IS+import qualified Data.Map as M+import qualified Data.Set as S++import qualified Data.Vector as V+import qualified Data.Vector.Primitive as VP+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU++import Applicative (pass)++----------------------------------------------------------------------------+-- Containers (e.g. tuples aren't containers)+----------------------------------------------------------------------------++-- | Type of element for some container. Implemented as a type family because+-- some containers are monomorphic over element type (like 'T.Text', 'IS.IntSet', etc.)+-- so we can't implement nice interface using old higher-kinded types approach.+type family Element t++type instance Element (f a) = a+type instance Element T.Text = Char+type instance Element TL.Text = Char+type instance Element BS.ByteString = Word8+type instance Element BSL.ByteString = Word8+type instance Element IS.IntSet = Int++-- | Type class for data types that can be converted to List.+-- Fully compatible with 'Foldable'.+-- Contains very small and safe subset of 'Foldable' functions.+--+-- You can define 'Tolist' by just defining 'toList' function.+-- But the following law should be met:+--+-- @'null' ≡ 'List.null' . 'toList'@+--+class ToList t where+ {-# MINIMAL toList #-}+ -- | Convert container to list of elements.+ --+ -- >>> toList (Just True)+ -- [True]+ -- >>> toList @Text "aba"+ -- "aba"+ -- >>> :t toList @Text "aba"+ -- toList @Text "aba" :: [Char]+ toList :: t -> [Element t]++ -- | Checks whether container is empty.+ --+ -- >>> null @Text ""+ -- True+ -- >>> null @Text "aba"+ -- False+ null :: t -> Bool+ null = List.null . toList++-- | This instance makes 'ToList' compatible and overlappable by 'Foldable'.+instance {-# OVERLAPPABLE #-} Foldable f => ToList (f a) where+ toList = F.toList+ {-# INLINE toList #-}+ null = F.null+ {-# INLINE null #-}++instance ToList T.Text where+ toList = T.unpack+ {-# INLINE toList #-}+ null = T.null+ {-# INLINE null #-}++instance ToList TL.Text where+ toList = TL.unpack+ {-# INLINE toList #-}+ null = TL.null+ {-# INLINE null #-}++instance ToList BS.ByteString where+ toList = BS.unpack+ {-# INLINE toList #-}+ null = BS.null+ {-# INLINE null #-}++instance ToList BSL.ByteString where+ toList = BSL.unpack+ {-# INLINE toList #-}+ null = BSL.null+ {-# INLINE null #-}++instance ToList IS.IntSet where+ toList = IS.toList+ {-# INLINE toList #-}+ null = IS.null+ {-# INLINE null #-}++----------------------------------------------------------------------------+-- Additional operations that don't make much sense for e.g. Maybe+----------------------------------------------------------------------------++-- | A class for 'ToList's that aren't trivial like 'Maybe' (e.g. can hold+-- more than one value)+class ToList t => Container t where+ foldMap :: Monoid m => (Element t -> m) -> t -> m+ foldMap f = foldr (mappend . f) mempty+ {-# INLINE foldMap #-}++ fold :: Monoid (Element t) => t -> Element t+ fold = foldMap id++ foldr :: (Element t -> b -> b) -> b -> t -> b+ foldr' :: (Element t -> b -> b) -> b -> t -> b+ foldr' f z0 xs = foldl f' id xs z0+ where f' k x z = k $! f x z+ foldl :: (b -> Element t -> b) -> b -> t -> b+ foldl' :: (b -> Element t -> b) -> b -> t -> b+ foldr1 :: (Element t -> Element t -> Element t) -> t -> Element t+ foldr1 f xs =+#if __GLASGOW_HASKELL__ >= 800+ fromMaybe (errorWithoutStackTrace "foldr1: empty structure")+ (foldr mf Nothing xs)+#else+ fromMaybe (error "foldr1: empty structure")+ (foldr mf Nothing xs)+#endif+ where+ mf x m = Just (case m of+ Nothing -> x+ Just y -> f x y)+ foldl1 :: (Element t -> Element t -> Element t) -> t -> Element t+ foldl1 f xs =+#if __GLASGOW_HASKELL__ >= 800+ fromMaybe (errorWithoutStackTrace "foldl1: empty structure")+ (foldl mf Nothing xs)+#else+ fromMaybe (error "foldl1: empty structure")+ (foldl mf Nothing xs)+#endif+ where+ mf m y = Just (case m of+ Nothing -> y+ Just x -> f x y)++ length :: t -> Int++ elem :: Eq (Element t) => Element t -> t -> Bool++ notElem :: Eq (Element t) => Element t -> t -> Bool+ notElem x = not . elem x++ maximum :: Ord (Element t) => t -> Element t+ minimum :: Ord (Element t) => t -> Element t++ all :: (Element t -> Bool) -> t -> Bool+ all p = getAll #. foldMap (All #. p)+ any :: (Element t -> Bool) -> t -> Bool+ any p = getAny #. foldMap (Any #. p)++ and :: (Element t ~ Bool) => t -> Bool+ and = getAll #. foldMap All+ or :: (Element t ~ Bool) => t -> Bool+ or = getAny #. foldMap Any++ find :: (Element t -> Bool) -> t -> Maybe (Element t)+ find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing))++ head :: t -> Maybe (Element t)+ head = foldr (\x _ -> Just x) Nothing+ {-# INLINE head #-}++-- | To save backwards compatibility with previous naming.+type NontrivialContainer t = Container t++instance {-# OVERLAPPABLE #-} Foldable f => Container (f a) where+ foldMap = F.foldMap+ {-# INLINE foldMap #-}+ fold = F.fold+ {-# INLINE fold #-}+ foldr = F.foldr+ {-# INLINE foldr #-}+ foldr' = F.foldr'+ {-# INLINE foldr' #-}+ foldl = F.foldl+ {-# INLINE foldl #-}+ foldl' = F.foldl'+ {-# INLINE foldl' #-}+ foldr1 = F.foldr1+ {-# INLINE foldr1 #-}+ foldl1 = F.foldl1+ {-# INLINE foldl1 #-}+ length = F.length+ {-# INLINE length #-}+ elem = F.elem+ {-# INLINE elem #-}+ notElem = F.notElem+ {-# INLINE notElem #-}+ maximum = F.maximum+ {-# INLINE maximum #-}+ minimum = F.minimum+ {-# INLINE minimum #-}+ all = F.all+ {-# INLINE all #-}+ any = F.any+ {-# INLINE any #-}+ and = F.and+ {-# INLINE and #-}+ or = F.or+ {-# INLINE or #-}+ find = F.find+ {-# INLINE find #-}++instance Container T.Text where+ foldr = T.foldr+ {-# INLINE foldr #-}+ foldl = T.foldl+ {-# INLINE foldl #-}+ foldl' = T.foldl'+ {-# INLINE foldl' #-}+ foldr1 = T.foldr1+ {-# INLINE foldr1 #-}+ foldl1 = T.foldl1+ {-# INLINE foldl1 #-}+ length = T.length+ {-# INLINE length #-}+ elem c = T.isInfixOf (T.singleton c) -- there are rewrite rules for this+ {-# INLINE elem #-}+ maximum = T.maximum+ {-# INLINE maximum #-}+ minimum = T.minimum+ {-# INLINE minimum #-}+ all = T.all+ {-# INLINE all #-}+ any = T.any+ {-# INLINE any #-}+ find = T.find+ {-# INLINE find #-}+ head = fmap fst . T.uncons+ {-# INLINE head #-}++instance Container TL.Text where+ foldr = TL.foldr+ {-# INLINE foldr #-}+ foldl = TL.foldl+ {-# INLINE foldl #-}+ foldl' = TL.foldl'+ {-# INLINE foldl' #-}+ foldr1 = TL.foldr1+ {-# INLINE foldr1 #-}+ foldl1 = TL.foldl1+ {-# INLINE foldl1 #-}+ length = fromIntegral . TL.length+ {-# INLINE length #-}+ -- will be okay thanks to rewrite rules+ elem c s = TL.isInfixOf (TL.singleton c) s+ {-# INLINE elem #-}+ maximum = TL.maximum+ {-# INLINE maximum #-}+ minimum = TL.minimum+ {-# INLINE minimum #-}+ all = TL.all+ {-# INLINE all #-}+ any = TL.any+ {-# INLINE any #-}+ find = TL.find+ {-# INLINE find #-}+ head = fmap fst . TL.uncons+ {-# INLINE head #-}++instance Container BS.ByteString where+ foldr = BS.foldr+ {-# INLINE foldr #-}+ foldl = BS.foldl+ {-# INLINE foldl #-}+ foldl' = BS.foldl'+ {-# INLINE foldl' #-}+ foldr1 = BS.foldr1+ {-# INLINE foldr1 #-}+ foldl1 = BS.foldl1+ {-# INLINE foldl1 #-}+ length = BS.length+ {-# INLINE length #-}+ elem = BS.elem+ {-# INLINE elem #-}+ notElem = BS.notElem+ {-# INLINE notElem #-}+ maximum = BS.maximum+ {-# INLINE maximum #-}+ minimum = BS.minimum+ {-# INLINE minimum #-}+ all = BS.all+ {-# INLINE all #-}+ any = BS.any+ {-# INLINE any #-}+ find = BS.find+ {-# INLINE find #-}+ head = fmap fst . BS.uncons+ {-# INLINE head #-}++instance Container BSL.ByteString where+ foldr = BSL.foldr+ {-# INLINE foldr #-}+ foldl = BSL.foldl+ {-# INLINE foldl #-}+ foldl' = BSL.foldl'+ {-# INLINE foldl' #-}+ foldr1 = BSL.foldr1+ {-# INLINE foldr1 #-}+ foldl1 = BSL.foldl1+ {-# INLINE foldl1 #-}+ length = fromIntegral . BSL.length+ {-# INLINE length #-}+ elem = BSL.elem+ {-# INLINE elem #-}+ notElem = BSL.notElem+ {-# INLINE notElem #-}+ maximum = BSL.maximum+ {-# INLINE maximum #-}+ minimum = BSL.minimum+ {-# INLINE minimum #-}+ all = BSL.all+ {-# INLINE all #-}+ any = BSL.any+ {-# INLINE any #-}+ find = BSL.find+ {-# INLINE find #-}+ head = fmap fst . BSL.uncons+ {-# INLINE head #-}++instance Container IS.IntSet where+ foldr = IS.foldr+ {-# INLINE foldr #-}+ foldl = IS.foldl+ {-# INLINE foldl #-}+ foldl' = IS.foldl'+ {-# INLINE foldl' #-}+ length = IS.size+ {-# INLINE length #-}+ elem = IS.member+ {-# INLINE elem #-}+ maximum = IS.findMax+ {-# INLINE maximum #-}+ minimum = IS.findMin+ {-# INLINE minimum #-}+ head = fmap fst . IS.minView+ {-# INLINE head #-}++----------------------------------------------------------------------------+-- Wrapped List+----------------------------------------------------------------------------+-- | This can be useful if you want to use 'Container' methods for your data type+-- but you don't want to implement all methods of this type class for that.+newtype WrappedList f a = WrappedList (f a)++type instance Element (WrappedList f a) = a++instance ToList (f a) => ToList (WrappedList f a) where+ toList (WrappedList l) = toList l+ {-# INLINE toList #-}+ null (WrappedList l) = null l+ {-# INLINE null #-}++instance ToList (f a) => Container (WrappedList f a) where+ foldMap f = foldMap f . toList+ {-# INLINE foldMap #-}+ fold = fold . toList+ {-# INLINE fold #-}+ foldr f z = foldr f z . toList+ {-# INLINE foldr #-}+ foldr' f z = foldr' f z . toList+ {-# INLINE foldr' #-}+ foldl f z = foldl f z . toList+ {-# INLINE foldl #-}+ foldl' f z = foldl' f z . toList+ {-# INLINE foldl' #-}+ foldr1 f = foldr1 f . toList+ {-# INLINE foldr1 #-}+ foldl1 f = foldl1 f . toList+ {-# INLINE foldl1 #-}+ length = length . toList+ {-# INLINE length #-}+ elem x = elem x . toList+ {-# INLINE elem #-}+ notElem x = notElem x . toList+ {-# INLINE notElem #-}+ maximum = maximum . toList+ {-# INLINE maximum #-}+ minimum = minimum . toList+ {-# INLINE minimum #-}+ all p = all p . toList+ {-# INLINE all #-}+ any p = any p . toList+ {-# INLINE any #-}+ and = and . toList+ {-# INLINE and #-}+ or = or . toList+ {-# INLINE or #-}+ find p = find p . toList+ {-# INLINE find #-}+ head = head . toList+ {-# INLINE head #-}+++----------------------------------------------------------------------------+-- Derivative functions+----------------------------------------------------------------------------++-- | Stricter version of 'Prelude.sum'.+--+-- >>> sum [1..10]+-- 55+-- >>> sum (Just 3)+-- <interactive>:43:1: error:+-- • Do not use 'Foldable' methods on Maybe+-- • In the expression: sum (Just 3)+-- In an equation for ‘it’: it = sum (Just 3)+sum :: (Container t, Num (Element t)) => t -> Element t+sum = foldl' (+) 0++-- | Stricter version of 'Prelude.product'.+--+-- >>> product [1..10]+-- 3628800+-- >>> product (Right 3)+-- <interactive>:45:1: error:+-- • Do not use 'Foldable' methods on Either+-- • In the expression: product (Right 3)+-- In an equation for ‘it’: it = product (Right 3)+product :: (Container t, Num (Element t)) => t -> Element t+product = foldl' (*) 1++-- | Constrained to 'Container' version of 'Data.Foldable.traverse_'.+traverse_+ :: (Container t, Applicative f)+ => (Element t -> f b) -> t -> f ()+traverse_ f = foldr ((*>) . f) pass++-- | Constrained to 'Container' version of 'Data.Foldable.for_'.+for_+ :: (Container t, Applicative f)+ => t -> (Element t -> f b) -> f ()+for_ = flip traverse_+{-# INLINE for_ #-}++-- | Constrained to 'Container' version of 'Data.Foldable.mapM_'.+mapM_+ :: (Container t, Monad m)+ => (Element t -> m b) -> t -> m ()+mapM_ f= foldr ((>>) . f) pass++-- | Constrained to 'Container' version of 'Data.Foldable.forM_'.+forM_+ :: (Container t, Monad m)+ => t -> (Element t -> m b) -> m ()+forM_ = flip mapM_+{-# INLINE forM_ #-}++-- | Constrained to 'Container' version of 'Data.Foldable.sequenceA_'.+sequenceA_+ :: (Container t, Applicative f, Element t ~ f a)+ => t -> f ()+sequenceA_ = foldr (*>) pass++-- | Constrained to 'Container' version of 'Data.Foldable.sequence_'.+sequence_+ :: (Container t, Monad m, Element t ~ m a)+ => t -> m ()+sequence_ = foldr (>>) pass++-- | Constrained to 'Container' version of 'Data.Foldable.asum'.+asum+ :: (Container t, Alternative f, Element t ~ f a)+ => t -> f a+asum = foldr (<|>) empty+{-# INLINE asum #-}++----------------------------------------------------------------------------+-- Disallowed instances+----------------------------------------------------------------------------++#if __GLASGOW_HASKELL__ >= 800+type family DisallowInstance (z :: Symbol) :: ErrorMessage where+ DisallowInstance z = Text "Do not use 'Foldable' methods on " :<>: Text z+ :$$: Text "Suggestions:"+ :$$: Text " Instead of"+ :$$: Text " for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()"+ :$$: Text " use"+ :$$: Text " whenJust :: Applicative f => Maybe a -> (a -> f ()) -> f ()"+ :$$: Text " whenRight :: Applicative f => Either l r -> (r -> f ()) -> f ()"+ :$$: Text ""+ :$$: Text " Instead of"+ :$$: Text " fold :: (Foldable t, Monoid m) => t m -> m"+ :$$: Text " use"+ :$$: Text " maybeToMonoid :: Monoid m => Maybe m -> m"+ :$$: Text ""+#endif++#define DISALLOW_TO_LIST_8(t, z) \+ instance TypeError (DisallowInstance z) => \+ ToList (t) where { \+ toList = undefined; \+ null = undefined; } \++#define DISALLOW_CONTAINER_8(t, z) \+ instance TypeError (DisallowInstance z) => \+ Container (t) where { \+ foldr = undefined; \+ foldl = undefined; \+ foldl' = undefined; \+ length = undefined; \+ elem = undefined; \+ maximum = undefined; \+ minimum = undefined; } \++#define DISALLOW_TO_LIST_7(t) \+ instance ForbiddenFoldable (t) => ToList (t) where { \+ toList = undefined; \+ null = undefined; } \++#define DISALLOW_CONTAINER_7(t) \+ instance ForbiddenFoldable (t) => Container (t) where { \+ foldr = undefined; \+ foldl = undefined; \+ foldl' = undefined; \+ length = undefined; \+ elem = undefined; \+ maximum = undefined; \+ minimum = undefined; } \++#if __GLASGOW_HASKELL__ >= 800+DISALLOW_TO_LIST_8((a, b),"tuples")+DISALLOW_CONTAINER_8((a, b),"tuples")+DISALLOW_CONTAINER_8(Maybe a,"Maybe")+DISALLOW_CONTAINER_8(Identity a,"Identity")+DISALLOW_CONTAINER_8(Either a b,"Either")+#else+class ForbiddenFoldable a+DISALLOW_TO_LIST_7((a, b))+DISALLOW_CONTAINER_7((a, b))+DISALLOW_CONTAINER_7(Maybe a)+DISALLOW_CONTAINER_7(Identity a)+DISALLOW_CONTAINER_7(Either a b)+#endif++----------------------------------------------------------------------------+-- One+----------------------------------------------------------------------------++-- | Type class for types that can be created from one element. @singleton@+-- is lone name for this function. Also 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 #-}++#if ( __GLASGOW_HASKELL__ >= 800 )+instance One (NE.NonEmpty a) where+ type OneItem (NE.NonEmpty a) = a+ one = (NE.:|[])+ {-# INLINE one #-}+#endif++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 (M.Map k v) where+ type OneItem (M.Map k v) = (k, v)+ one = uncurry M.singleton+ {-# INLINE one #-}++instance Hashable k => One (HM.HashMap k v) where+ type OneItem (HM.HashMap k v) = (k, v)+ one = uncurry HM.singleton+ {-# INLINE one #-}++instance One (IM.IntMap v) where+ type OneItem (IM.IntMap v) = (Int, v)+ one = uncurry IM.singleton+ {-# INLINE one #-}++-- Sets++instance One (S.Set v) where+ type OneItem (S.Set v) = v+ one = S.singleton+ {-# INLINE one #-}++instance Hashable v => One (HS.HashSet v) where+ type OneItem (HS.HashSet v) = v+ one = HS.singleton+ {-# INLINE one #-}++instance One IS.IntSet where+ type OneItem IS.IntSet = Int+ one = IS.singleton+ {-# INLINE one #-}++-- Vectors++instance One (V.Vector a) where+ type OneItem (V.Vector a) = a+ one = V.singleton+ {-# INLINE one #-}++instance VU.Unbox a => One (VU.Vector a) where+ type OneItem (VU.Vector a) = a+ one = VU.singleton+ {-# INLINE one #-}++instance VP.Prim a => One (VP.Vector a) where+ type OneItem (VP.Vector a) = a+ one = VP.singleton+ {-# INLINE one #-}++instance VS.Storable a => One (VS.Vector a) where+ type OneItem (VS.Vector a) = a+ one = VS.singleton+ {-# INLINE one #-}++----------------------------------------------------------------------------+-- Utils+----------------------------------------------------------------------------++(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)+(#.) _f = coerce+{-# INLINE (#.) #-}
+ src/Container/Reexport.hs view
@@ -0,0 +1,23 @@+-- | This module reexports all container related stuff from 'Prelude'.++module 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.Vector+ ) where++import Data.Hashable (Hashable)+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.Vector (Vector)
− src/Containers.hs
@@ -1,655 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstrainedClassMethods #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}---- | Reimagined approach for 'Foldable' type hierarchy. Forbids usages--- of 'length' function and similar over 'Maybe' and other potentially unsafe--- data types. It was proposed to use @-XTypeApplication@ for such cases.--- But this approach is not robust enough because programmers are human and can--- easily forget to do this. For discussion see this topic:--- <https://www.reddit.com/r/haskell/comments/60r9hu/proposal_suggest_explicit_type_application_for/ Suggest explicit type application for Foldable length and friends>--module Containers- (- -- * Foldable-like classes and methods- Element- , Container(..)- , NontrivialContainer(..)-- , sum- , product-- , mapM_- , forM_- , traverse_- , for_- , sequenceA_- , sequence_- , asum-- -- * Others- , One(..)- ) where--import Control.Applicative (Alternative (..))-import Control.Monad.Identity (Identity)-import Data.Coerce (Coercible, coerce)-import Data.Foldable (Foldable)-import qualified Data.Foldable as F-import Data.Hashable (Hashable)-import Data.Maybe (fromMaybe)-import Data.Monoid (All (..), Any (..), First (..))-import Data.Word (Word8)-import Prelude hiding (Foldable (..), all, any, mapM_, sequence_)--#if __GLASGOW_HASKELL__ >= 800-import GHC.Err (errorWithoutStackTrace)-import GHC.TypeLits (ErrorMessage (..), TypeError)-#endif--#if ( __GLASGOW_HASKELL__ >= 800 )-import qualified Data.List.NonEmpty as NE-#endif--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 HS-import qualified Data.IntMap as IM-import qualified Data.IntSet as IS-import qualified Data.Map as M-import qualified Data.Set as S--import qualified Data.Vector as V-import qualified Data.Vector.Primitive as VP-import qualified Data.Vector.Storable as VS-import qualified Data.Vector.Unboxed as VU--import Applicative (pass)--------------------------------------------------------------------------------- Containers (e.g. tuples aren't containers)--------------------------------------------------------------------------------- | Type of element for some container. Implemented as a type family because--- some containers are monomorphic over element type (like 'T.Text', 'IS.IntSet', etc.)--- so we can't implement nice interface using old higher-kinded types approach.-type family Element t--type instance Element (f a) = a-type instance Element T.Text = Char-type instance Element TL.Text = Char-type instance Element BS.ByteString = Word8-type instance Element BSL.ByteString = Word8-type instance Element IS.IntSet = Int---- | Type class for container. Fully compatible with 'Foldable'.--- Contains very small and safe subset of 'Foldable' functions.-class Container t where- -- | Convert container to list of elements.- --- -- >>> toList (Just True)- -- [True]- -- >>> toList @Text "aba"- -- "aba"- -- >>> :t toList @Text "aba"- -- toList @Text "aba" :: [Char]- toList :: t -> [Element t]-- -- | Checks whether container is empty.- --- -- >>> null @Text ""- -- True- -- >>> null @Text "aba"- -- False- null :: t -> Bool---- | This instance makes 'Container' compatible and overlappable by 'Foldable'.-instance {-# OVERLAPPABLE #-} Foldable f => Container (f a) where- toList = F.toList- {-# INLINE toList #-}- null = F.null- {-# INLINE null #-}--instance Container T.Text where- toList = T.unpack- {-# INLINE toList #-}- null = T.null- {-# INLINE null #-}--instance Container TL.Text where- toList = TL.unpack- {-# INLINE toList #-}- null = TL.null- {-# INLINE null #-}--instance Container BS.ByteString where- toList = BS.unpack- {-# INLINE toList #-}- null = BS.null- {-# INLINE null #-}--instance Container BSL.ByteString where- toList = BSL.unpack- {-# INLINE toList #-}- null = BSL.null- {-# INLINE null #-}--instance Container IS.IntSet where- toList = IS.toList- {-# INLINE toList #-}- null = IS.null- {-# INLINE null #-}--------------------------------------------------------------------------------- Additional operations that don't make much sense for e.g. Maybe--------------------------------------------------------------------------------- | A class for 'Container's that aren't trivial like 'Maybe' (e.g. can hold--- more than one value)-class Container t => NontrivialContainer t where- foldMap :: Monoid m => (Element t -> m) -> t -> m- foldMap f = foldr (mappend . f) mempty- {-# INLINE foldMap #-}-- fold :: Monoid (Element t) => t -> Element t- fold = foldMap id-- foldr :: (Element t -> b -> b) -> b -> t -> b- foldr' :: (Element t -> b -> b) -> b -> t -> b- foldr' f z0 xs = foldl f' id xs z0- where f' k x z = k $! f x z- foldl :: (b -> Element t -> b) -> b -> t -> b- foldl' :: (b -> Element t -> b) -> b -> t -> b- foldr1 :: (Element t -> Element t -> Element t) -> t -> Element t- foldr1 f xs =-#if __GLASGOW_HASKELL__ >= 800- fromMaybe (errorWithoutStackTrace "foldr1: empty structure")- (foldr mf Nothing xs)-#else- fromMaybe (error "foldr1: empty structure")- (foldr mf Nothing xs)-#endif- where- mf x m = Just (case m of- Nothing -> x- Just y -> f x y)- foldl1 :: (Element t -> Element t -> Element t) -> t -> Element t- foldl1 f xs =-#if __GLASGOW_HASKELL__ >= 800- fromMaybe (errorWithoutStackTrace "foldl1: empty structure")- (foldl mf Nothing xs)-#else- fromMaybe (error "foldl1: empty structure")- (foldl mf Nothing xs)-#endif- where- mf m y = Just (case m of- Nothing -> y- Just x -> f x y)-- length :: t -> Int-- elem :: Eq (Element t) => Element t -> t -> Bool-- notElem :: Eq (Element t) => Element t -> t -> Bool- notElem x = not . elem x-- maximum :: Ord (Element t) => t -> Element t- minimum :: Ord (Element t) => t -> Element t-- all :: (Element t -> Bool) -> t -> Bool- all p = getAll #. foldMap (All #. p)- any :: (Element t -> Bool) -> t -> Bool- any p = getAny #. foldMap (Any #. p)-- and :: (Element t ~ Bool) => t -> Bool- and = getAll #. foldMap All- or :: (Element t ~ Bool) => t -> Bool- or = getAny #. foldMap Any-- find :: (Element t -> Bool) -> t -> Maybe (Element t)- find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing))-- head :: t -> Maybe (Element t)- head = foldr (\x _ -> Just x) Nothing- {-# INLINE head #-}--instance {-# OVERLAPPABLE #-} Foldable f => NontrivialContainer (f a) where- foldMap = F.foldMap- {-# INLINE foldMap #-}- fold = F.fold- {-# INLINE fold #-}- foldr = F.foldr- {-# INLINE foldr #-}- foldr' = F.foldr'- {-# INLINE foldr' #-}- foldl = F.foldl- {-# INLINE foldl #-}- foldl' = F.foldl'- {-# INLINE foldl' #-}- foldr1 = F.foldr1- {-# INLINE foldr1 #-}- foldl1 = F.foldl1- {-# INLINE foldl1 #-}- length = F.length- {-# INLINE length #-}- elem = F.elem- {-# INLINE elem #-}- notElem = F.notElem- {-# INLINE notElem #-}- maximum = F.maximum- {-# INLINE maximum #-}- minimum = F.minimum- {-# INLINE minimum #-}- all = F.all- {-# INLINE all #-}- any = F.any- {-# INLINE any #-}- and = F.and- {-# INLINE and #-}- or = F.or- {-# INLINE or #-}- find = F.find- {-# INLINE find #-}--instance NontrivialContainer T.Text where- foldr = T.foldr- {-# INLINE foldr #-}- foldl = T.foldl- {-# INLINE foldl #-}- foldl' = T.foldl'- {-# INLINE foldl' #-}- foldr1 = T.foldr1- {-# INLINE foldr1 #-}- foldl1 = T.foldl1- {-# INLINE foldl1 #-}- length = T.length- {-# INLINE length #-}- elem c = T.isInfixOf (T.singleton c) -- there are rewrite rules for this- {-# INLINE elem #-}- maximum = T.maximum- {-# INLINE maximum #-}- minimum = T.minimum- {-# INLINE minimum #-}- all = T.all- {-# INLINE all #-}- any = T.any- {-# INLINE any #-}- find = T.find- {-# INLINE find #-}- head = fmap fst . T.uncons- {-# INLINE head #-}--instance NontrivialContainer TL.Text where- foldr = TL.foldr- {-# INLINE foldr #-}- foldl = TL.foldl- {-# INLINE foldl #-}- foldl' = TL.foldl'- {-# INLINE foldl' #-}- foldr1 = TL.foldr1- {-# INLINE foldr1 #-}- foldl1 = TL.foldl1- {-# INLINE foldl1 #-}- length = fromIntegral . TL.length- {-# INLINE length #-}- -- will be okay thanks to rewrite rules- elem c s = TL.isInfixOf (TL.singleton c) s- {-# INLINE elem #-}- maximum = TL.maximum- {-# INLINE maximum #-}- minimum = TL.minimum- {-# INLINE minimum #-}- all = TL.all- {-# INLINE all #-}- any = TL.any- {-# INLINE any #-}- find = TL.find- {-# INLINE find #-}- head = fmap fst . TL.uncons- {-# INLINE head #-}--instance NontrivialContainer BS.ByteString where- foldr = BS.foldr- {-# INLINE foldr #-}- foldl = BS.foldl- {-# INLINE foldl #-}- foldl' = BS.foldl'- {-# INLINE foldl' #-}- foldr1 = BS.foldr1- {-# INLINE foldr1 #-}- foldl1 = BS.foldl1- {-# INLINE foldl1 #-}- length = BS.length- {-# INLINE length #-}- elem = BS.elem- {-# INLINE elem #-}- notElem = BS.notElem- {-# INLINE notElem #-}- maximum = BS.maximum- {-# INLINE maximum #-}- minimum = BS.minimum- {-# INLINE minimum #-}- all = BS.all- {-# INLINE all #-}- any = BS.any- {-# INLINE any #-}- find = BS.find- {-# INLINE find #-}- head = fmap fst . BS.uncons- {-# INLINE head #-}--instance NontrivialContainer BSL.ByteString where- foldr = BSL.foldr- {-# INLINE foldr #-}- foldl = BSL.foldl- {-# INLINE foldl #-}- foldl' = BSL.foldl'- {-# INLINE foldl' #-}- foldr1 = BSL.foldr1- {-# INLINE foldr1 #-}- foldl1 = BSL.foldl1- {-# INLINE foldl1 #-}- length = fromIntegral . BSL.length- {-# INLINE length #-}- elem = BSL.elem- {-# INLINE elem #-}- notElem = BSL.notElem- {-# INLINE notElem #-}- maximum = BSL.maximum- {-# INLINE maximum #-}- minimum = BSL.minimum- {-# INLINE minimum #-}- all = BSL.all- {-# INLINE all #-}- any = BSL.any- {-# INLINE any #-}- find = BSL.find- {-# INLINE find #-}- head = fmap fst . BSL.uncons- {-# INLINE head #-}--instance NontrivialContainer IS.IntSet where- foldr = IS.foldr- {-# INLINE foldr #-}- foldl = IS.foldl- {-# INLINE foldl #-}- foldl' = IS.foldl'- {-# INLINE foldl' #-}- length = IS.size- {-# INLINE length #-}- elem = IS.member- {-# INLINE elem #-}- maximum = IS.findMax- {-# INLINE maximum #-}- minimum = IS.findMin- {-# INLINE minimum #-}- head = fmap fst . IS.minView- {-# INLINE head #-}--------------------------------------------------------------------------------- Derivative functions--------------------------------------------------------------------------------- | Stricter version of 'Prelude.sum'.------ >>> sum [1..10]--- 55--- >>> sum (Just 3)--- <interactive>:43:1: error:--- • Do not use 'Foldable' methods on Maybe--- • In the expression: sum (Just 3)--- In an equation for ‘it’: it = sum (Just 3)-sum :: (NontrivialContainer t, Num (Element t)) => t -> Element t-sum = foldl' (+) 0---- | Stricter version of 'Prelude.product'.------ >>> product [1..10]--- 3628800--- >>> product (Right 3)--- <interactive>:45:1: error:--- • Do not use 'Foldable' methods on Either--- • In the expression: product (Right 3)--- In an equation for ‘it’: it = product (Right 3)-product :: (NontrivialContainer t, Num (Element t)) => t -> Element t-product = foldl' (*) 1---- | Constrained to 'NonTrivialContainer' version of 'Data.Foldable.traverse_'.-traverse_- :: (NontrivialContainer t, Applicative f)- => (Element t -> f b) -> t -> f ()-traverse_ f = foldr ((*>) . f) pass---- | Constrained to 'NonTrivialContainer' version of 'Data.Foldable.for_'.-for_- :: (NontrivialContainer t, Applicative f)- => t -> (Element t -> f b) -> f ()-for_ = flip traverse_-{-# INLINE for_ #-}---- | Constrained to 'NonTrivialContainer' version of 'Data.Foldable.mapM_'.-mapM_- :: (NontrivialContainer t, Monad m)- => (Element t -> m b) -> t -> m ()-mapM_ f= foldr ((>>) . f) pass---- | Constrained to 'NonTrivialContainer' version of 'Data.Foldable.forM_'.-forM_- :: (NontrivialContainer t, Monad m)- => t -> (Element t -> m b) -> m ()-forM_ = flip mapM_-{-# INLINE forM_ #-}---- | Constrained to 'NonTrivialContainer' version of 'Data.Foldable.sequenceA_'.-sequenceA_- :: (NontrivialContainer t, Applicative f, Element t ~ f a)- => t -> f ()-sequenceA_ = foldr (*>) pass---- | Constrained to 'NonTrivialContainer' version of 'Data.Foldable.sequence_'.-sequence_- :: (NontrivialContainer t, Monad m, Element t ~ m a)- => t -> m ()-sequence_ = foldr (>>) pass---- | Constrained to 'NonTrivialContainer' version of 'Data.Foldable.asum'.-asum- :: (NontrivialContainer t, Alternative f, Element t ~ f a)- => t -> f a-asum = foldr (<|>) empty-{-# INLINE asum #-}--------------------------------------------------------------------------------- Disallowed instances-------------------------------------------------------------------------------#define DISALLOW_CONTAINER_8(t, z) \- instance TypeError \- (Text "Do not use 'Foldable' methods on " :<>: Text z :$$: \- Text "NB. If you tried to use 'for_' on Maybe or Either, use 'whenJust' or 'whenRight' instead" ) => \- Container (t) where { \- toList = undefined; \- null = undefined; } \--#define DISALLOW_NONTRIVIAL_CONTAINER_8(t, z) \- instance TypeError \- (Text "Do not use 'Foldable' methods on " :<>: Text z :$$: \- Text "NB. If you tried to use 'for_' on Maybe or Either, use 'whenJust' or 'whenRight' instead" ) => \- NontrivialContainer (t) where { \- foldr = undefined; \- foldl = undefined; \- foldl' = undefined; \- length = undefined; \- elem = undefined; \- maximum = undefined; \- minimum = undefined; } \--#define DISALLOW_CONTAINER_7(t) \- instance ForbiddenFoldable (t) => Container (t) where { \- toList = undefined; \- null = undefined; } \--#define DISALLOW_NONTRIVIAL_CONTAINER_7(t) \- instance ForbiddenFoldable (t) => NontrivialContainer (t) where { \- foldr = undefined; \- foldl = undefined; \- foldl' = undefined; \- length = undefined; \- elem = undefined; \- maximum = undefined; \- minimum = undefined; } \--#if __GLASGOW_HASKELL__ >= 800-DISALLOW_CONTAINER_8((a, b),"tuples")-DISALLOW_NONTRIVIAL_CONTAINER_8((a, b),"tuples")-DISALLOW_NONTRIVIAL_CONTAINER_8(Maybe a,"Maybe")-DISALLOW_NONTRIVIAL_CONTAINER_8(Identity a,"Identity")-DISALLOW_NONTRIVIAL_CONTAINER_8(Either a b,"Either")-#else-class ForbiddenFoldable a-DISALLOW_CONTAINER_7((a, b))-DISALLOW_NONTRIVIAL_CONTAINER_7((a, b))-DISALLOW_NONTRIVIAL_CONTAINER_7(Maybe a)-DISALLOW_NONTRIVIAL_CONTAINER_7(Identity a)-DISALLOW_NONTRIVIAL_CONTAINER_7(Either a b)-#endif--------------------------------------------------------------------------------- One--------------------------------------------------------------------------------- | Type class for types that can be created from one element. @singleton@--- is lone name for this function. Also 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 #-}--#if ( __GLASGOW_HASKELL__ >= 800 )-instance One (NE.NonEmpty a) where- type OneItem (NE.NonEmpty a) = a- one = (NE.:|[])- {-# INLINE one #-}-#endif--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 (M.Map k v) where- type OneItem (M.Map k v) = (k, v)- one = uncurry M.singleton- {-# INLINE one #-}--instance Hashable k => One (HM.HashMap k v) where- type OneItem (HM.HashMap k v) = (k, v)- one = uncurry HM.singleton- {-# INLINE one #-}--instance One (IM.IntMap v) where- type OneItem (IM.IntMap v) = (Int, v)- one = uncurry IM.singleton- {-# INLINE one #-}---- Sets--instance One (S.Set v) where- type OneItem (S.Set v) = v- one = S.singleton- {-# INLINE one #-}--instance Hashable v => One (HS.HashSet v) where- type OneItem (HS.HashSet v) = v- one = HS.singleton- {-# INLINE one #-}--instance One IS.IntSet where- type OneItem IS.IntSet = Int- one = IS.singleton- {-# INLINE one #-}---- Vectors--instance One (V.Vector a) where- type OneItem (V.Vector a) = a- one = V.singleton- {-# INLINE one #-}--instance VU.Unbox a => One (VU.Vector a) where- type OneItem (VU.Vector a) = a- one = VU.singleton- {-# INLINE one #-}--instance VP.Prim a => One (VP.Vector a) where- type OneItem (VP.Vector a) = a- one = VP.singleton- {-# INLINE one #-}--instance VS.Storable a => One (VS.Vector a) where- type OneItem (VS.Vector a) = a- one = VS.singleton- {-# INLINE one #-}--------------------------------------------------------------------------------- Utils-------------------------------------------------------------------------------(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)-(#.) _f = coerce-{-# INLINE (#.) #-}
src/Monad.hs view
@@ -47,34 +47,34 @@ , (<$!>) ) where -import Monad.Either-import Monad.Maybe-import Monad.Trans+import Monad.Either+import Monad.Maybe+import Monad.Trans -import Base (IO, seq)-import Control.Applicative (Applicative (pure))-import Data.Function ((.))-import Data.Functor (fmap)-import Data.Traversable (Traversable (traverse))-import Prelude (Bool (..), Monoid, flip)+import Base (IO, seq)+import Control.Applicative (Applicative (pure))+import Data.Function ((.))+import Data.Functor (fmap)+import Data.Traversable (Traversable (traverse))+import Prelude (Bool (..), Monoid, flip) #if __GLASGOW_HASKELL__ >= 710-import Control.Monad hiding (fail, (<$!>))+import Control.Monad hiding (fail, (<$!>)) #else-import Control.Monad hiding (fail)+import Control.Monad hiding (fail) #endif #if __GLASGOW_HASKELL__ >= 800-import Control.Monad.Fail (MonadFail (..))+import Control.Monad.Fail (MonadFail (..)) #else-import Prelude (Maybe (Nothing), String)-import qualified Prelude as P (fail)-import Text.ParserCombinators.ReadP (ReadP)-import Text.ParserCombinators.ReadPrec (ReadPrec)+import Prelude (Maybe (Nothing), String)+import Text.ParserCombinators.ReadP (ReadP)+import Text.ParserCombinators.ReadPrec (ReadPrec)++import qualified Prelude as P (fail) #endif -import Containers (Element, NontrivialContainer, fold,- toList)+import Container (Container, Element, fold, toList) -- | Lifting bind into a monad. Generalized version of @concatMap@ -- that works with a monadic predicate. Old and simpler specialized to list@@ -101,7 +101,7 @@ concatMapM :: ( Applicative f , Monoid m- , NontrivialContainer (l m)+ , Container (l m) , Traversable l ) => (a -> f m) -> l a -> f m@@ -113,7 +113,7 @@ concatForM :: ( Applicative f , Monoid m- , NontrivialContainer (l m)+ , Container (l m) , Traversable l ) => l a -> (a -> f m) -> f m@@ -128,7 +128,7 @@ z `seq` return z {-# INLINE (<$!>) #-} --- | Monadic and constrained to 'NonTrivialContainer' version of 'Prelude.and'.+-- | Monadic and constrained to 'Container' version of 'Prelude.and'. -- -- >>> andM [Just True, Just False] -- Just False@@ -142,7 +142,7 @@ -- 1 -- 2 -- False-andM :: (NontrivialContainer f, Element f ~ m Bool, Monad m) => f -> m Bool+andM :: (Container f, Element f ~ m Bool, Monad m) => f -> m Bool andM = go . toList where go [] = pure True@@ -150,7 +150,7 @@ q <- p if q then go ps else pure False --- | Monadic and constrained to 'NonTrivialContainer' version of 'Prelude.or'.+-- | Monadic and constrained to 'Container' version of 'Prelude.or'. -- -- >>> orM [Just True, Just False] -- Just True@@ -158,7 +158,7 @@ -- Just True -- >>> orM [Nothing, Just True] -- Nothing-orM :: (NontrivialContainer f, Element f ~ m Bool, Monad m) => f -> m Bool+orM :: (Container f, Element f ~ m Bool, Monad m) => f -> m Bool orM = go . toList where go [] = pure False@@ -166,7 +166,7 @@ q <- p if q then pure True else go ps --- | Monadic and constrained to 'NonTrivialContainer' version of 'Prelude.all'.+-- | Monadic and constrained to 'Container' version of 'Prelude.all'. -- -- >>> allM (readMaybe >=> pure . even) ["6", "10"] -- Just True@@ -174,7 +174,7 @@ -- Just False -- >>> allM (readMaybe >=> pure . even) ["aba", "10"] -- Nothing-allM :: (NontrivialContainer f, Monad m) => (Element f -> m Bool) -> f -> m Bool+allM :: (Container f, Monad m) => (Element f -> m Bool) -> f -> m Bool allM p = go . toList where go [] = pure True@@ -182,7 +182,7 @@ q <- p x if q then go xs else pure False --- | Monadic and constrained to 'NonTrivialContainer' version of 'Prelude.any'.+-- | Monadic and constrained to 'Container' version of 'Prelude.any'. -- -- >>> anyM (readMaybe >=> pure . even) ["5", "10"] -- Just True@@ -190,7 +190,7 @@ -- Just True -- >>> anyM (readMaybe >=> pure . even) ["aba", "10"] -- Nothing-anyM :: (NontrivialContainer f, Monad m) => (Element f -> m Bool) -> f -> m Bool+anyM :: (Container f, Monad m) => (Element f -> m Bool) -> f -> m Bool anyM p = go . toList where go [] = pure False
src/Universum.hs view
@@ -32,7 +32,7 @@ import Applicative as X import Bool as X-import Containers as X+import Container as X import Debug as X import Exceptions as X import Functor as X@@ -74,29 +74,20 @@ #if ( __GLASGOW_HASKELL__ >= 800 ) import Data.List.NonEmpty as X (NonEmpty (..), nonEmpty)-import Data.Monoid as X-import Data.Semigroup as X (Option (..), Semigroup (sconcat, stimes),+import Data.Monoid as X hiding ((<>))+import Data.Semigroup as X (Option (..), Semigroup (sconcat, stimes, (<>)), WrappedMonoid, cycle1, mtimesDefault, stimesIdempotent, stimesIdempotentMonoid, stimesMonoid) #else-import Data.Monoid as X+import Data.Monoid as X hiding ((<>)) #endif -- Deepseq import Control.DeepSeq as X (NFData (..), deepseq, force, ($!!)) -- Data structures-import Data.Hashable as X (Hashable)-import Data.HashMap.Strict as X (HashMap)-import Data.HashSet as X (HashSet)-import Data.IntMap.Strict as X (IntMap)-import Data.IntSet as X (IntSet)-import Data.Map.Strict as X (Map)-import Data.Sequence as X (Seq)-import Data.Set as X (Set) import Data.Tuple as X (curry, fst, snd, swap, uncurry)-import Data.Vector as X (Vector) #if ( __GLASGOW_HASKELL__ >= 710 ) import Data.Proxy as X (Proxy (..))
universum.cabal view
@@ -1,5 +1,5 @@ name: universum-version: 0.8.0+version: 0.9.0 cabal-version: >=1.10 build-type: Simple license: MIT@@ -14,7 +14,7 @@ Custom prelude used in Serokell category: Prelude author: Stephen Diehl, @serokell-tested-with: GHC ==7.10.3 GHC ==8.0.1 GHC ==8.0.2 GHC ==8.2.1+tested-with: GHC ==7.10.3 GHC ==8.0.1 GHC ==8.0.2 GHC ==8.2.2 extra-source-files: CHANGES.md @@ -28,7 +28,9 @@ Applicative Base Bool- Containers+ Container+ Container.Class+ Container.Reexport Debug Exceptions Functor@@ -49,7 +51,7 @@ Monad.Maybe Monad.Trans build-depends:- base <4.11,+ base <4.10, bytestring <0.11, containers <0.6, deepseq <1.5,@@ -79,10 +81,10 @@ type: exitcode-stdio-1.0 main-is: Main.hs build-depends:- base <4.11,+ base <4.10, universum -any, containers <0.6,- criterion <1.3,+ criterion <1.2, deepseq <1.5, hashable <1.3, mtl <2.3,