module Universum.Container.Class
(
ToList (..)
, ToPairs (..)
, Container (..)
, sum
, product
, mapM_
, forM_
, traverse_
, for_
, sequenceA_
, sequence_
, asum
, One(..)
) where
import Data.Coerce (Coercible, coerce)
import Prelude hiding (all, and, any, elem, foldMap, foldl, foldr, mapM_, notElem, or, product,
sequence_, sum)
import Universum.Applicative (Alternative (..), Const, ZipList, pass)
import Universum.Base (Constraint, Word8)
import Universum.Container.Reexport (HashMap, HashSet, Hashable, IntMap, IntSet, Map, Seq, Set,
Vector)
import Universum.Functor (Identity)
import Universum.Monad.Reexport (fromMaybe)
import Universum.Monoid (All (..), Any (..), Dual, First (..), Last, Product, Sum)
#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
import Universum.Monoid (NonEmpty)
#endif
import qualified Data.Foldable as Foldable
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 HashSet
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Map as M
import qualified Data.Set as Set
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
type family ElementDefault (t :: *) :: * where
ElementDefault (f a) = a
class ToList t where
type Element t :: *
type Element t = ElementDefault t
toList :: t -> [Element t]
default toList :: (Foldable f, t ~ f a, Element t ~ a) => t -> [Element t]
toList = Foldable.toList
null :: t -> Bool
null = List.null . toList
instance ToList T.Text where
type Element T.Text = Char
toList = T.unpack
null = T.null
instance ToList TL.Text where
type Element TL.Text = Char
toList = TL.unpack
null = TL.null
instance ToList BS.ByteString where
type Element BS.ByteString = Word8
toList = BS.unpack
null = BS.null
instance ToList BSL.ByteString where
type Element BSL.ByteString = Word8
toList = BSL.unpack
null = BSL.null
instance ToList IntSet where
type Element IntSet = Int
toList = IS.toList
null = IS.null
instance ToList [a]
instance ToList (Maybe a)
instance ToList (Either a b)
instance ToList (Identity a)
instance ToList (Const a b)
#if __GLASGOW_HASKELL__ >= 800
instance ToList (Dual a)
instance ToList (First a)
instance ToList (Last a)
instance ToList (Product a)
instance ToList (Sum a)
instance ToList (NonEmpty a)
instance ToList (ZipList a)
#endif
instance ToList (HashMap k v)
instance ToList (HashSet v)
instance ToList (IntMap v)
instance ToList (Map k v)
instance ToList (Set v)
instance ToList (Seq a)
instance ToList (Vector a)
class ToPairs t where
type Key t :: *
type Val t :: *
toPairs :: t -> [(Key t, Val t)]
keys :: t -> [Key t]
keys = map fst . toPairs
elems :: t -> [Val t]
elems = map snd . toPairs
instance ToPairs (HashMap k v) where
type Key (HashMap k v) = k
type Val (HashMap k v) = v
toPairs = HM.toList
keys = HM.keys
elems = HM.elems
instance ToPairs (IntMap v) where
type Key (IntMap v) = Int
type Val (IntMap v) = v
toPairs = IM.toList
keys = IM.keys
elems = IM.elems
instance ToPairs (Map k v) where
type Key (Map k v) = k
type Val (Map k v) = v
toPairs = M.toList
keys = M.keys
elems = M.elems
class ToList t => Container t where
type ElementConstraint t :: * -> Constraint
type ElementConstraint t = Eq
foldr :: (Element t -> b -> b) -> b -> t -> b
default foldr :: (Foldable f, t ~ f a, Element t ~ a) => (Element t -> b -> b) -> b -> t -> b
foldr = Foldable.foldr
foldl :: (b -> Element t -> b) -> b -> t -> b
default foldl :: (Foldable f, t ~ f a, Element t ~ a) => (b -> Element t -> b) -> b -> t -> b
foldl = Foldable.foldl
foldl' :: (Element t -> b -> b) -> b -> t -> b
default foldl' :: (Foldable f, t ~ f a, Element t ~ a) => (Element t -> b -> b) -> b -> t -> b
foldl' f = Foldable.foldl' (flip f)
length :: t -> Int
default length :: (Foldable f, t ~ f a, Element t ~ a) => t -> Int
length = Foldable.length
elem :: ElementConstraint t (Element t) => Element t -> t -> Bool
default elem :: ( Foldable f
, t ~ f a
, Element t ~ a
, ElementConstraint t ~ Eq
, ElementConstraint t (Element t)
) => Element t -> t -> Bool
elem = Foldable.elem
maximum :: Ord (Element t) => t -> Element t
default maximum :: (Foldable f, t ~ f a, Element t ~ a, Ord (Element t)) => t -> Element t
maximum = Foldable.maximum
minimum :: Ord (Element t) => t -> Element t
default minimum :: (Foldable f, t ~ f a, Element t ~ a, Ord (Element t)) => t -> Element t
minimum = Foldable.minimum
foldMap :: Monoid m => (Element t -> m) -> t -> m
foldMap f = foldr (mappend . f) mempty
fold :: Monoid (Element t) => t -> Element t
fold = foldMap id
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
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)
notElem :: ElementConstraint t (Element t) => Element t -> t -> Bool
notElem x = not . elem x
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))
safeHead :: t -> Maybe (Element t)
safeHead = foldr (\x _ -> Just x) Nothing
instance Container T.Text where
foldr = T.foldr
foldl = T.foldl
foldl' f = T.foldl' (flip f)
foldr1 = T.foldr1
foldl1 = T.foldl1
length = T.length
elem c = T.isInfixOf (T.singleton c)
maximum = T.maximum
minimum = T.minimum
all = T.all
any = T.any
find = T.find
safeHead = fmap fst . T.uncons
instance Container TL.Text where
foldr = TL.foldr
foldl = TL.foldl
foldl' f = TL.foldl' (flip f)
foldr1 = TL.foldr1
foldl1 = TL.foldl1
length = fromIntegral . TL.length
elem c s = TL.isInfixOf (TL.singleton c) s
maximum = TL.maximum
minimum = TL.minimum
all = TL.all
any = TL.any
find = TL.find
safeHead = fmap fst . TL.uncons
instance Container BS.ByteString where
foldr = BS.foldr
foldl = BS.foldl
foldl' f = BS.foldl' (flip f)
foldr1 = BS.foldr1
foldl1 = BS.foldl1
length = BS.length
elem = BS.elem
notElem = BS.notElem
maximum = BS.maximum
minimum = BS.minimum
all = BS.all
any = BS.any
find = BS.find
safeHead = fmap fst . BS.uncons
instance Container BSL.ByteString where
foldr = BSL.foldr
foldl = BSL.foldl
foldl' f = BSL.foldl' (flip f)
foldr1 = BSL.foldr1
foldl1 = BSL.foldl1
length = fromIntegral . BSL.length
elem = BSL.elem
notElem = BSL.notElem
maximum = BSL.maximum
minimum = BSL.minimum
all = BSL.all
any = BSL.any
find = BSL.find
safeHead = fmap fst . BSL.uncons
instance Container IntSet where
foldr = IS.foldr
foldl = IS.foldl
foldl' f = IS.foldl' (flip f)
length = IS.size
elem = IS.member
maximum = IS.findMax
minimum = IS.findMin
safeHead = fmap fst . IS.minView
instance Container (Set v) where
type ElementConstraint (Set v) = Ord
elem = Set.member
notElem = Set.notMember
class (Eq a, Hashable a) => CanHash a
instance (Eq a, Hashable a) => CanHash a
instance Container (HashSet v) where
type ElementConstraint (HashSet v) = CanHash
elem = HashSet.member
instance Container [a]
instance Container (Const a b)
#if __GLASGOW_HASKELL__ >= 800
instance Container (Dual a)
instance Container (First a)
instance Container (Last a)
instance Container (Product a)
instance Container (Sum a)
instance Container (NonEmpty a)
instance Container (ZipList a)
#endif
instance Container (HashMap k v)
instance Container (IntMap v)
instance Container (Map k v)
instance Container (Seq a)
instance Container (Vector a)
sum :: (Container t, Num (Element t)) => t -> Element t
sum = foldl' (+) 0
product :: (Container t, Num (Element t)) => t -> Element t
product = foldl' (*) 1
traverse_
:: (Container t, Applicative f)
=> (Element t -> f b) -> t -> f ()
traverse_ f = foldr ((*>) . f) pass
for_
:: (Container t, Applicative f)
=> t -> (Element t -> f b) -> f ()
for_ = flip traverse_
mapM_
:: (Container t, Monad m)
=> (Element t -> m b) -> t -> m ()
mapM_ f= foldr ((>>) . f) pass
forM_
:: (Container t, Monad m)
=> t -> (Element t -> m b) -> m ()
forM_ = flip mapM_
sequenceA_
:: (Container t, Applicative f, Element t ~ f a)
=> t -> f ()
sequenceA_ = foldr (*>) pass
sequence_
:: (Container t, Monad m, Element t ~ m a)
=> t -> m ()
sequence_ = foldr (>>) pass
asum
:: (Container t, Alternative f, Element t ~ f a)
=> t -> f a
asum = foldr (<|>) empty
#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
class One x where
type OneItem x
one :: OneItem x -> x
instance One [a] where
type OneItem [a] = a
one = (:[])
#if ( __GLASGOW_HASKELL__ >= 800 )
instance One (NE.NonEmpty a) where
type OneItem (NE.NonEmpty a) = a
one = (NE.:|[])
#endif
instance One (SEQ.Seq a) where
type OneItem (SEQ.Seq a) = a
one = (SEQ.empty SEQ.|>)
instance One T.Text where
type OneItem T.Text = Char
one = T.singleton
instance One TL.Text where
type OneItem TL.Text = Char
one = TL.singleton
instance One BS.ByteString where
type OneItem BS.ByteString = Word8
one = BS.singleton
instance One BSL.ByteString where
type OneItem BSL.ByteString = Word8
one = BSL.singleton
instance One (M.Map k v) where
type OneItem (M.Map k v) = (k, v)
one = uncurry M.singleton
instance Hashable k => One (HM.HashMap k v) where
type OneItem (HM.HashMap k v) = (k, v)
one = uncurry HM.singleton
instance One (IM.IntMap v) where
type OneItem (IM.IntMap v) = (Int, v)
one = uncurry IM.singleton
instance One (Set v) where
type OneItem (Set v) = v
one = Set.singleton
instance Hashable v => One (HashSet v) where
type OneItem (HashSet v) = v
one = HashSet.singleton
instance One IntSet where
type OneItem IntSet = Int
one = IS.singleton
instance One (Vector a) where
type OneItem (Vector a) = a
one = V.singleton
instance VU.Unbox a => One (VU.Vector a) where
type OneItem (VU.Vector a) = a
one = VU.singleton
instance VP.Prim a => One (VP.Vector a) where
type OneItem (VP.Vector a) = a
one = VP.singleton
instance VS.Storable a => One (VS.Vector a) where
type OneItem (VS.Vector a) = a
one = VS.singleton
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
(#.) _f = coerce