diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -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 ===== diff --git a/src/Container.hs b/src/Container.hs new file mode 100644 --- /dev/null +++ b/src/Container.hs @@ -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 diff --git a/src/Container/Class.hs b/src/Container/Class.hs new file mode 100644 --- /dev/null +++ b/src/Container/Class.hs @@ -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: +-- + +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) +-- :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) +-- :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 (#.) #-} diff --git a/src/Container/Reexport.hs b/src/Container/Reexport.hs new file mode 100644 --- /dev/null +++ b/src/Container/Reexport.hs @@ -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) diff --git a/src/Containers.hs b/src/Containers.hs deleted file mode 100644 --- a/src/Containers.hs +++ /dev/null @@ -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: --- - -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) --- :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) --- :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 (#.) #-} diff --git a/src/Monad.hs b/src/Monad.hs --- a/src/Monad.hs +++ b/src/Monad.hs @@ -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 diff --git a/src/Universum.hs b/src/Universum.hs --- a/src/Universum.hs +++ b/src/Universum.hs @@ -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 (..)) diff --git a/universum.cabal b/universum.cabal --- a/universum.cabal +++ b/universum.cabal @@ -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,