packages feed

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 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,