diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,14 @@ +## 1.0.0 + +* Implement the cleanups described in [#95](https://github.com/snoyberg/mono-traversable/issues/95) + * Split out `Data.MinLen` to `minlen` package, and have `Data.NonNull` stand on its own + * Remove `Data.ByteVector` + * Split out extra typeclass instances to `mono-traversable-instances` +* Remove the `Eq` and `Ord` specific classes, and instead use rewrite rules +* Provide the `Data.MonoTraversable.Unprefixed` module +* Generalize `unwords` and `unlines` [#87](https://github.com/snoyberg/mono-traversable/pull/87) +* Add `tailMay` and `initMay` [#89](https://github.com/snoyberg/mono-traversable/issues/89) + ## 0.10.2 * Add `delete` and `deleteBy` methods to EqSequence [#94](https://github.com/snoyberg/mono-traversable/pull/94) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -9,7 +9,11 @@ * `IsSequence`, etc for operating over sequential data types * `IsSet`, `IsMap`, etc for unifying set and map APIs - * `MinLen` for making partial functions (head, tail) total + * `NonNull` for making partial functions (head, tail) total + +In addition to this package, the +[mono-traversable-instances](https://www.stackage.org/package/mono-traversable-instances) +pacakge provides a number of orphan instances. Using Typeclasses diff --git a/bench/sorting.hs b/bench/sorting.hs --- a/bench/sorting.hs +++ b/bench/sorting.hs @@ -18,7 +18,8 @@ mkGroup :: Int -> IO Benchmark mkGroup size = do - inputV <- MWC.withSystemRandom . MWC.asGenST $ flip MWC.uniformVector size + gen <- MWC.create + inputV <- MWC.uniformVector gen size let inputL = otoList (inputV :: V.Vector Int) inputVU = fromList inputL :: U.Vector Int return $ bgroup (show size) diff --git a/mono-traversable.cabal b/mono-traversable.cabal --- a/mono-traversable.cabal +++ b/mono-traversable.cabal @@ -1,5 +1,5 @@ name: mono-traversable -version: 0.10.2 +version: 1.0.0 synopsis: Type classes for mapping, folding, and traversing monomorphic containers description: Monomorphic variants of the Functor, Foldable, and Traversable typeclasses. If you understand Haskell's basic typeclasses, you understand mono-traversable. In addition to what you are used to, it adds on an IsSequence typeclass and has code for marking data structures as non-empty. homepage: https://github.com/snoyberg/mono-traversable @@ -16,28 +16,24 @@ library ghc-options: -Wall exposed-modules: Data.MonoTraversable + Data.MonoTraversable.Unprefixed Data.Containers Data.Sequences Data.NonNull - Data.MinLen - Data.ByteVector - other-modules: Data.GrowingAppend build-depends: base >= 4.5 && < 5 , containers >= 0.4 , unordered-containers >=0.2 , hashable , bytestring >= 0.9 , text >=0.11 - , semigroups >= 0.10 , transformers >=0.3 , vector >=0.10 - , semigroupoids >=3.0 - , comonad >=3.0.3 - , vector-instances , vector-algorithms >= 0.6 - , dlist >= 0.6 && < 1.0 - , dlist-instances == 0.1.* , split >= 0.2 + + if impl(ghc < 8.0) + build-depends: semigroups >= 0.10 + hs-source-dirs: src default-language: Haskell2010 @@ -47,6 +43,7 @@ hs-source-dirs: test other-modules: Spec default-language: Haskell2010 + ghc-options: -O0 build-depends: base , mono-traversable , bytestring diff --git a/src/Data/ByteVector.hs b/src/Data/ByteVector.hs deleted file mode 100644 --- a/src/Data/ByteVector.hs +++ /dev/null @@ -1,28 +0,0 @@ --- | Provides conversion functions between strict 'ByteString's and storable --- 'Vector's. -module Data.ByteVector - ( toByteVector - , fromByteVector - ) where - -import Data.ByteString.Internal (ByteString (PS)) -import Data.Vector.Storable (Vector, unsafeFromForeignPtr, - unsafeToForeignPtr) -import Data.Word (Word8) - --- | Convert a 'ByteString' into a storable 'Vector'. --- --- Since 0.6.1 -toByteVector :: ByteString -> Vector Word8 -toByteVector (PS fptr offset idx) = unsafeFromForeignPtr fptr offset idx -{-# INLINE toByteVector #-} - --- | Convert a storable 'Vector' into a 'ByteString'. --- --- Since 0.6.1 -fromByteVector :: Vector Word8 -> ByteString -fromByteVector v = - PS fptr offset idx - where - (fptr, offset, idx) = unsafeToForeignPtr v -{-# INLINE fromByteVector #-} diff --git a/src/Data/Containers.hs b/src/Data/Containers.hs --- a/src/Data/Containers.hs +++ b/src/Data/Containers.hs @@ -22,7 +22,7 @@ import qualified Data.HashSet as HashSet import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup) -import Data.MonoTraversable (MonoFunctor(..), MonoFoldable, MonoTraversable, Element) +import Data.MonoTraversable (MonoFunctor(..), MonoFoldable, MonoTraversable, Element, GrowingAppend, ofoldl', otoList) import Data.Function (on) import qualified Data.List as List import qualified Data.IntSet as IntSet @@ -32,11 +32,10 @@ import qualified Data.ByteString.Lazy as LByteString import qualified Data.ByteString as ByteString import Control.Arrow ((***)) -import Data.GrowingAppend import GHC.Exts (Constraint) -- | A container whose values are stored in Key-Value pairs. -class (Monoid set, Semigroup set, MonoFoldable set, Eq (ContainerKey set), GrowingAppend set) => SetContainer set where +class (Data.Monoid.Monoid set, Semigroup set, MonoFoldable set, Eq (ContainerKey set), GrowingAppend set) => SetContainer set where -- | The type of the key type ContainerKey set @@ -51,6 +50,14 @@ -- | Get the union of two containers. union :: set -> set -> set + -- | Combine a collection of @SetContainer@s, with left-most values overriding + -- when there are matching keys. + -- + -- @since 1.0.0 + unions :: (MonoFoldable mono, Element mono ~ set) => mono -> set + unions = ofoldl' union Data.Monoid.mempty + {-# INLINE unions #-} + -- | Get the difference of two containers. difference :: set -> set -> set @@ -71,6 +78,8 @@ {-# INLINE notMember #-} union = Map.union {-# INLINE union #-} + unions = Map.unions . otoList + {-# INLINE unions #-} difference = Map.difference {-# INLINE difference #-} intersection = Map.intersection @@ -89,6 +98,8 @@ {-# INLINE notMember #-} union = HashMap.union {-# INLINE union #-} + unions = HashMap.unions . otoList + {-# INLINE unions #-} difference = HashMap.difference {-# INLINE difference #-} intersection = HashMap.intersection @@ -107,6 +118,8 @@ {-# INLINE notMember #-} union = IntMap.union {-# INLINE union #-} + unions = IntMap.unions . otoList + {-# INLINE unions #-} difference = IntMap.difference {-# INLINE difference #-} intersection = IntMap.intersection @@ -122,6 +135,8 @@ {-# INLINE notMember #-} union = Set.union {-# INLINE union #-} + unions = Set.unions . otoList + {-# INLINE unions #-} difference = Set.difference {-# INLINE difference #-} intersection = Set.intersection diff --git a/src/Data/GrowingAppend.hs b/src/Data/GrowingAppend.hs deleted file mode 100644 --- a/src/Data/GrowingAppend.hs +++ /dev/null @@ -1,44 +0,0 @@ -module Data.GrowingAppend where - -import Data.MonoTraversable -import Data.Semigroup -import qualified Data.Sequence as Seq -import qualified Data.Vector as V -import qualified Data.Vector.Unboxed as U -import qualified Data.Vector.Storable as VS -import Data.Vector.Instances () -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import qualified Data.ByteString as S -import qualified Data.ByteString.Lazy as L -import qualified Data.List.NonEmpty as NE -import qualified Data.Map as Map -import qualified Data.HashMap.Strict as HashMap -import Data.Hashable (Hashable) -import qualified Data.Set as Set -import qualified Data.HashSet as HashSet -import qualified Data.IntSet as IntSet -import qualified Data.IntMap as IntMap -import qualified Data.DList as DList -import Data.DList.Instances () - --- | olength (x <> y) >= max (olength x) (olength y) -class (Semigroup mono, MonoFoldable mono) => GrowingAppend mono - -instance GrowingAppend (Seq.Seq a) -instance GrowingAppend [a] -instance GrowingAppend (V.Vector a) -instance U.Unbox a => GrowingAppend (U.Vector a) -instance VS.Storable a => GrowingAppend (VS.Vector a) -instance GrowingAppend S.ByteString -instance GrowingAppend L.ByteString -instance GrowingAppend T.Text -instance GrowingAppend TL.Text -instance GrowingAppend (NE.NonEmpty a) -instance Ord k => GrowingAppend (Map.Map k v) -instance (Eq k, Hashable k) => GrowingAppend (HashMap.HashMap k v) -instance Ord v => GrowingAppend (Set.Set v) -instance (Eq v, Hashable v) => GrowingAppend (HashSet.HashSet v) -instance GrowingAppend IntSet.IntSet -instance GrowingAppend (IntMap.IntMap v) -instance GrowingAppend (DList.DList a) diff --git a/src/Data/MinLen.hs b/src/Data/MinLen.hs deleted file mode 100644 --- a/src/Data/MinLen.hs +++ /dev/null @@ -1,516 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Data.MinLen - ( -- * Type level naturals - -- ** Peano numbers - -- $peanoNumbers - Zero (..) - , Succ (..) - , TypeNat (..) - , AddNat - , MaxNat - -- * Minimum length newtype wrapper - , MinLen - , unMinLen - , toMinLenZero - , toMinLen - , unsafeToMinLen - , mlcons - , mlappend - , mlunion - , head - , last - , tailML - , initML - , GrowingAppend - , ofoldMap1 - , ofold1 - , ofoldr1 - , ofoldl1' - , maximum - , minimum - , maximumBy - , minimumBy - ) where - -import Prelude (Num (..), Maybe (..), Int, Ordering (..), Eq, Ord (..), Read, Show, Functor (..), ($), flip, const, Bool (..), otherwise) -import Data.Data (Data) -import Data.Typeable (Typeable) -import Control.Category -import Data.MonoTraversable -import Data.Sequences -import Data.Monoid (Monoid (..)) -import Data.Semigroup (Semigroup (..)) -import Data.GrowingAppend -import Control.Monad (liftM) -import Control.Monad.Trans.State.Strict (evalState, state) - --- $peanoNumbers --- are a simple way to --- represent natural numbers (0, 1, 2...) using only a 'Zero' value and a --- successor function ('Succ'). Each application of 'Succ' increases the number --- by 1, so @Succ Zero@ is 1, @Succ (Succ Zero)@ is 2, etc. - --- | 'Zero' is the base value for the Peano numbers. -data Zero = Zero - --- | 'Succ' represents the next number in the sequence of natural numbers. --- --- It takes a @nat@ (a natural number) as an argument. --- --- 'Zero' is a @nat@, allowing @'Succ' 'Zero'@ to represent 1. --- --- 'Succ' is also a @nat@, so it can be applied to itself, allowing --- @'Succ' ('Succ' 'Zero')@ to represent 2, --- @'Succ' ('Succ' ('Succ' 'Zero'))@ to represent 3, and so on. -data Succ nat = Succ nat - --- | Type-level natural number utility typeclass -class TypeNat nat where - -- | Turn a type-level natural number into a number - -- - -- @ - -- > 'toValueNat' 'Zero' - -- 0 - -- > 'toValueNat' ('Succ' ('Succ' ('Succ' 'Zero'))) - -- 3 - -- @ - toValueNat :: Num i => nat -> i - - -- | Get a data representation of a natural number type - -- - -- @ - -- > 'typeNat' :: 'Succ' ('Succ' 'Zero') - -- Succ (Succ Zero) -- Errors because Succ and Zero have no Show typeclass, - -- -- But this is what it would look like if it did. - -- @ - typeNat :: nat - -instance TypeNat Zero where - toValueNat Zero = 0 - typeNat = Zero -instance TypeNat nat => TypeNat (Succ nat) where - toValueNat (Succ nat) = 1 + toValueNat nat - typeNat = Succ typeNat - --- | Adds two type-level naturals. --- --- See the 'mlappend' type signature for an example. --- --- @ --- > :t 'typeNat' :: 'AddNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero') --- --- 'typeNat' :: 'AddNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero') --- :: 'Succ' ('Succ' ('Succ' 'Zero')) --- @ -type family AddNat x y -type instance AddNat Zero y = y -type instance AddNat (Succ x) y = AddNat x (Succ y) - --- | Calculates the maximum of two type-level naturals. --- --- See the 'mlunion' type signature for an example. --- --- @ --- > :t 'typeNat' :: 'MaxNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero') --- --- 'typeNat' :: 'MaxNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero') --- :: 'Succ' ('Succ' 'Zero') --- @ -type family MaxNat x y -type instance MaxNat Zero y = y -type instance MaxNat x Zero = x -type instance MaxNat (Succ x) (Succ y) = Succ (MaxNat x y) - --- | A wrapper around a container which encodes its minimum length in the type system. --- This allows functions like 'head' and 'maximum' to be made safe without using 'Maybe'. --- --- The length, @nat@, is encoded as a , --- which starts with the 'Zero' constructor and is made one larger with each application --- of 'Succ' ('Zero' for 0, @'Succ' 'Zero'@ for 1, @'Succ' ('Succ' 'Zero')@ for 2, etc.). --- Functions which require at least one element, then, are typed with @Succ nat@, --- where @nat@ is either 'Zero' or any number of applications of 'Succ': --- --- @ --- 'head' :: 'MonoTraversable' mono => 'MinLen' ('Succ' nat) mono -> 'Element' mono --- @ --- --- The length is also a , --- i.e. it is only used on the left hand side of the type and doesn't exist at runtime. --- Notice how @'Succ' 'Zero'@ isn't included in the printed output: --- --- @ --- > 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) --- 'Just' ('MinLen' {unMinLen = [1,2,3]}) --- @ --- --- You can still use GHCI's @:i@ command to see the phantom type information: --- --- @ --- > let xs = 'mlcons' 1 $ 'toMinLenZero' [] --- > :i xs --- xs :: 'Num' t => 'MinLen' ('Succ' 'Zero') [t] --- @ -newtype MinLen nat mono = - MinLen { - unMinLen :: mono -- ^ Get the monomorphic container out of a 'MinLen' wrapper. - } deriving (Eq, Ord, Read, Show, Data, Typeable) - -type instance Element (MinLen nat mono) = Element mono -deriving instance MonoFunctor mono => MonoFunctor (MinLen nat mono) -deriving instance MonoFoldable mono => MonoFoldable (MinLen nat mono) -deriving instance MonoFoldableEq mono => MonoFoldableEq (MinLen nat mono) -deriving instance MonoFoldableOrd mono => MonoFoldableOrd (MinLen nat mono) -instance MonoTraversable mono => MonoTraversable (MinLen nat mono) where - otraverse f (MinLen x) = fmap MinLen (otraverse f x) - {-# INLINE otraverse #-} - omapM f (MinLen x) = liftM MinLen (omapM f x) - {-# INLINE omapM #-} -deriving instance GrowingAppend mono => GrowingAppend (MinLen nat mono) - --- | This function is unsafe, and must not be exposed from this module. -unsafeMap :: (mono -> mono) -> MinLen nat mono -> MinLen nat mono -unsafeMap f (MinLen x) = MinLen (f x) - -instance GrowingAppend mono => Semigroup (MinLen nat mono) where - MinLen x <> MinLen y = MinLen (x <> y) - -instance SemiSequence seq => SemiSequence (MinLen nat seq) where - type Index (MinLen nat seq) = Index seq - - intersperse e = unsafeMap $ intersperse e - reverse = unsafeMap reverse - find f = find f . unMinLen - cons x = unsafeMap $ cons x - snoc xs x = unsafeMap (flip snoc x) xs - sortBy f = unsafeMap $ sortBy f - -instance MonoPointed mono => MonoPointed (MinLen Zero mono) where - opoint = MinLen . opoint - {-# INLINE opoint #-} -instance MonoPointed mono => MonoPointed (MinLen (Succ Zero) mono) where - opoint = MinLen . opoint - {-# INLINE opoint #-} - --- | Get the 'typeNat' of a 'MinLen' container. -natProxy :: TypeNat nat => MinLen nat mono -> nat -natProxy _ = typeNat - --- | Types a container as having a minimum length of zero. This is useful when combined with other 'MinLen' --- functions that increase the size of the container. --- --- ==== __Examples__ --- --- @ --- > 1 \`mlcons` 'toMinLenZero' [] --- 'MinLen' {unMinLen = [1]} --- @ -toMinLenZero :: (MonoFoldable mono) => mono -> MinLen Zero mono -toMinLenZero = MinLen - --- | Attempts to add a 'MinLen' constraint to a monomorphic container. --- --- ==== __Examples__ --- --- @ --- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) --- > xs --- 'Just' ('MinLen' {unMinLen = [1,2,3]}) --- --- > :i xs --- xs :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) --- @ --- --- @ --- > 'toMinLen' [] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) --- 'Nothing' --- @ -toMinLen :: (MonoFoldable mono, TypeNat nat) => mono -> Maybe (MinLen nat mono) -toMinLen mono = - case ocompareLength mono (toValueNat nat :: Int) of - LT -> Nothing - _ -> Just res' - where - nat = natProxy res' - res' = MinLen mono - --- | __Unsafe__ --- --- Although this function itself cannot cause a segfault, it breaks the --- safety guarantees of 'MinLen' and can lead to a segfault when using --- otherwise safe functions. --- --- ==== __Examples__ --- --- @ --- > let xs = 'unsafeToMinLen' [] :: 'MinLen' ('Succ' 'Zero') ['Int'] --- > 'olength' xs --- 0 --- > 'head' xs --- *** Exception: Data.MonoTraversable.headEx: empty --- @ -unsafeToMinLen :: mono -> MinLen nat mono -unsafeToMinLen = MinLen - -infixr 5 `mlcons` - --- | Adds an element to the front of a list, increasing its minimum length by 1. --- --- ==== __Examples__ --- --- @ --- > let xs = 'unsafeToMinLen' [1,2,3] :: 'MinLen' ('Succ' 'Zero') ['Int'] --- > 0 \`mlcons` xs --- 'MinLen' {unMinLen = [0,1,2,3]} --- @ -mlcons :: IsSequence seq => Element seq -> MinLen nat seq -> MinLen (Succ nat) seq -mlcons e (MinLen seq) = MinLen (cons e seq) -{-# INLINE mlcons #-} - --- | Concatenate two sequences, adding their minimum lengths together. --- --- ==== __Examples__ --- --- @ --- > let xs = 'unsafeToMinLen' [1,2,3] :: 'MinLen' ('Succ' 'Zero') ['Int'] --- > xs \`mlappend` xs --- 'MinLen' {unMinLen = [1,2,3,1,2,3]} --- @ -mlappend :: IsSequence seq => MinLen x seq -> MinLen y seq -> MinLen (AddNat x y) seq -mlappend (MinLen x) (MinLen y) = MinLen (x `mappend` y) -{-# INLINE mlappend #-} - --- | Return the first element of a monomorphic container. --- --- Safe version of 'headEx', only works on monomorphic containers wrapped in a --- @'MinLen' ('Succ' nat)@. -head :: MonoFoldable mono => MinLen (Succ nat) mono -> Element mono -head = headEx . unMinLen -{-# INLINE head #-} - --- | Return the last element of a monomorphic container. --- --- Safe version of 'lastEx', only works on monomorphic containers wrapped in a --- @'MinLen' ('Succ' nat)@. -last :: MonoFoldable mono => MinLen (Succ nat) mono -> Element mono -last = lastEx . unMinLen -{-# INLINE last #-} - --- | Returns all but the first element of a sequence, reducing its 'MinLen' by 1. --- --- Safe, only works on sequences wrapped in a @'MinLen' ('Succ' nat)@. --- --- ==== __Examples__ --- --- @ --- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) --- > 'fmap' 'tailML' xs --- 'Just' ('MinLen' {unMinLen = [2,3]}) --- @ -tailML :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq -tailML = MinLen . tailEx . unMinLen - --- | Returns all but the last element of a sequence, reducing its 'MinLen' by 1. --- --- Safe, only works on sequences wrapped in a @'MinLen' ('Succ' nat)@. --- --- ==== __Examples__ --- --- @ --- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) --- > 'fmap' 'initML' xs --- 'Just' ('MinLen' {unMinLen = [1,2]}) --- @ -initML :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq -initML = MinLen . initEx . unMinLen - --- | Joins two semigroups, keeping the larger 'MinLen' of the two. --- --- ==== __Examples__ --- --- @ --- > let xs = 'unsafeToMinLen' [1] :: 'MinLen' ('Succ' 'Zero') ['Int'] --- > let ys = xs \`mlunion` xs --- > ys --- 'MinLen' {unMinLen = [1,1]} --- --- > :i ys --- ys :: 'MinLen' ('Succ' 'Zero') ['Int'] --- @ -mlunion :: GrowingAppend mono => MinLen x mono -> MinLen y mono -> MinLen (MaxNat x y) mono -mlunion (MinLen x) (MinLen y) = MinLen (x <> y) - --- | Map each element of a monomorphic container to a semigroup, and combine the --- results. --- --- Safe version of 'ofoldMap1Ex', only works on monomorphic containers wrapped in a --- @'MinLen' ('Succ' nat)@. --- --- ==== __Examples__ --- --- @ --- > let xs = ("hello", 1 :: 'Integer') \`mlcons` (" world", 2) \`mlcons` ('toMinLenZero' []) --- > 'ofoldMap1' 'fst' xs --- "hello world" --- @ -ofoldMap1 :: (MonoFoldable mono, Semigroup m) => (Element mono -> m) -> MinLen (Succ nat) mono -> m -ofoldMap1 f = ofoldMap1Ex f . unMinLen -{-# INLINE ofoldMap1 #-} - --- | Join a monomorphic container, whose elements are 'Semigroup's, together. --- --- Safe, only works on monomorphic containers wrapped in a @'MinLen' ('Succ' nat)@. --- --- ==== __Examples__ --- --- @ --- > let xs = "a" \`mlcons` "b" \`mlcons` "c" \`mlcons` ('toMinLenZero' []) --- > xs --- 'MinLen' {unMinLen = ["a","b","c"]} --- --- > 'ofold1' xs --- "abc" --- @ -ofold1 :: (MonoFoldable mono, Semigroup (Element mono)) => MinLen (Succ nat) mono -> Element mono -ofold1 = ofoldMap1 id -{-# INLINE ofold1 #-} - --- | Right-associative fold of a monomorphic container with no base element. --- --- Safe version of 'ofoldr1Ex', only works on monomorphic containers wrapped in a --- @'MinLen' ('Succ' nat)@. --- --- @'foldr1' f = "Prelude".'Prelude.foldr1' f . 'otoList'@ --- --- ==== __Examples__ --- --- @ --- > let xs = "a" \`mlcons` "b" \`mlcons` "c" \`mlcons` ('toMinLenZero' []) --- > 'ofoldr1' (++) xs --- "abc" --- @ -ofoldr1 :: MonoFoldable mono - => (Element mono -> Element mono -> Element mono) - -> MinLen (Succ nat) mono - -> Element mono -ofoldr1 f = ofoldr1Ex f . unMinLen -{-# INLINE ofoldr1 #-} - --- | Strict left-associative fold of a monomorphic container with no base --- element. --- --- Safe version of 'ofoldl1Ex'', only works on monomorphic containers wrapped in a --- @'MinLen' ('Succ' nat)@. --- --- @'foldl1'' f = "Prelude".'Prelude.foldl1'' f . 'otoList'@ --- --- ==== __Examples__ --- --- @ --- > let xs = "a" \`mlcons` "b" \`mlcons` "c" \`mlcons` ('toMinLenZero' []) --- > 'ofoldl1'' (++) xs --- "abc" --- @ -ofoldl1' :: MonoFoldable mono - => (Element mono -> Element mono -> Element mono) - -> MinLen (Succ nat) mono - -> Element mono -ofoldl1' f = ofoldl1Ex' f . unMinLen -{-# INLINE ofoldl1' #-} - --- | Get the maximum element of a monomorphic container. --- --- Safe version of 'maximumEx', only works on monomorphic containers wrapped in a --- @'MinLen' ('Succ' nat)@. --- --- ==== __Examples__ --- --- @ --- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) --- > 'fmap' 'maximum' xs --- 'Just' 3 --- @ -maximum :: MonoFoldableOrd mono - => MinLen (Succ nat) mono - -> Element mono -maximum = maximumEx . unMinLen -{-# INLINE maximum #-} - --- | Get the minimum element of a monomorphic container. --- --- Safe version of 'minimumEx', only works on monomorphic containers wrapped in a --- @'MinLen' ('Succ' nat)@. --- --- ==== __Examples__ --- --- @ --- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) --- > 'fmap' 'minimum' xs --- 'Just' 1 --- @ -minimum :: MonoFoldableOrd mono - => MinLen (Succ nat) mono - -> Element mono -minimum = minimumEx . unMinLen -{-# INLINE minimum #-} - --- | Get the maximum element of a monomorphic container, --- using a supplied element ordering function. --- --- Safe version of 'maximumByEx', only works on monomorphic containers wrapped in a --- @'MinLen' ('Succ' nat)@. -maximumBy :: MonoFoldable mono - => (Element mono -> Element mono -> Ordering) - -> MinLen (Succ nat) mono - -> Element mono -maximumBy cmp = maximumByEx cmp . unMinLen -{-# INLINE maximumBy #-} - --- | Get the minimum element of a monomorphic container, --- using a supplied element ordering function. --- --- Safe version of 'minimumByEx', only works on monomorphic containers wrapped in a --- @'MinLen' ('Succ' nat)@. -minimumBy :: MonoFoldable mono - => (Element mono -> Element mono -> Ordering) - -> MinLen (Succ nat) mono - -> Element mono -minimumBy cmp = minimumByEx cmp . unMinLen -{-# INLINE minimumBy #-} - --- | 'oextract' is 'head'. --- --- For @'oextend' f@, the new 'mono' is populated by applying @f@ to --- successive 'tail's of the original 'mono'. --- --- For example, for @'MinLen' ('Succ' 'Zero') ['Int']@, or --- @'NonNull' ['Int']@: --- --- @ --- 'oextend' f [1,2,3,4,5] = [ f [1, 2, 3, 4, 5] --- , f [2, 3, 4, 5] --- , f [3, 4, 5] --- , f [4, 5] --- , f [5] --- ] --- @ --- --- Meant to be a direct analogy to the instance for 'NonEmpty' @a@. --- -instance IsSequence mono - => MonoComonad (MinLen (Succ Zero) mono) where - oextract = head - oextend f (MinLen mono) = MinLen - . flip evalState mono - . ofor mono - . const - . state - $ \mono' -> (f (MinLen mono'), tailEx mono') diff --git a/src/Data/MonoTraversable.hs b/src/Data/MonoTraversable.hs --- a/src/Data/MonoTraversable.hs +++ b/src/Data/MonoTraversable.hs @@ -26,7 +26,11 @@ import Control.Applicative import Control.Category +#if MIN_VERSION_base(4,8,0) +import Control.Monad (Monad (..)) +#else import Control.Monad (Monad (..), liftM) +#endif import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Foldable as F @@ -36,7 +40,6 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Traversable -import Data.Traversable.Instances () import Data.Word (Word8) import Data.Int (Int, Int64) import GHC.Exts (build) @@ -63,15 +66,6 @@ import Data.Vector (Vector) import Control.Monad.Trans.Maybe (MaybeT (..)) import Control.Monad.Trans.List (ListT) -import Control.Monad.Trans.Identity (IdentityT) -import Data.Functor.Apply (MaybeApply (..), WrappedApplicative) -import Control.Comonad (Cokleisli, Comonad, extract, extend) -import Control.Comonad.Store (StoreT) -import Control.Comonad.Env (EnvT) -import Control.Comonad.Traced (TracedT) -#if !MIN_VERSION_comonad(5,0,0) -import Data.Functor.Coproduct (Coproduct) -#endif import Control.Monad.Trans.Writer (WriterT) import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT) import Control.Monad.Trans.State (StateT(..)) @@ -79,11 +73,9 @@ import Control.Monad.Trans.RWS (RWST(..)) import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST(..)) import Control.Monad.Trans.Reader (ReaderT) -import Control.Monad.Trans.Error (ErrorT(..)) import Control.Monad.Trans.Cont (ContT) import Data.Functor.Compose (Compose) import Data.Functor.Product (Product) -import Data.Semigroupoid.Static (Static) import Data.Set (Set) import qualified Data.Set as Set import Data.HashSet (HashSet) @@ -95,8 +87,7 @@ import qualified Data.IntSet as IntSet import Data.Semigroup (Semigroup, Option (..), Arg) import qualified Data.ByteString.Unsafe as SU -import Data.DList (DList) -import qualified Data.DList as DL +import Control.Monad.Trans.Identity (IdentityT) -- | Type family for getting the type of the elements -- of a monomorphic container. @@ -111,7 +102,6 @@ type instance Element (Maybe a) = a type instance Element (Tree a) = a type instance Element (Seq a) = a -type instance Element (DList a) = a type instance Element (ViewL a) = a type instance Element (ViewR a) = a type instance Element (IntMap a) = a @@ -130,9 +120,6 @@ type instance Element (HashSet e) = e type instance Element (Vector a) = a type instance Element (WrappedArrow a b c) = c -type instance Element (MaybeApply f a) = a -type instance Element (WrappedApplicative f a) = a -type instance Element (Cokleisli w a b) = b type instance Element (MaybeT m a) = a type instance Element (ListT m a) = a type instance Element (IdentityT m a) = a @@ -143,20 +130,12 @@ type instance Element (RWST r w s m a) = a type instance Element (Strict.RWST r w s m a) = a type instance Element (ReaderT r m a) = a -type instance Element (ErrorT e m a) = a type instance Element (ContT r m a) = a type instance Element (Compose f g a) = a type instance Element (Product f g a) = a -type instance Element (Static f a b) = b type instance Element (U.Vector a) = a type instance Element (VS.Vector a) = a type instance Element (Arg a b) = b -type instance Element (EnvT e w a) = a -type instance Element (StoreT s w a) = a -type instance Element (TracedT m w a) = a -#if !MIN_VERSION_comonad(5,0,0) -type instance Element (Coproduct f g a) = a -#endif -- | Monomorphic containers that can be mapped over. class MonoFunctor mono where @@ -184,7 +163,6 @@ instance MonoFunctor (Maybe a) instance MonoFunctor (Tree a) instance MonoFunctor (Seq a) -instance MonoFunctor (DList a) instance MonoFunctor (ViewL a) instance MonoFunctor (ViewR a) instance MonoFunctor (IntMap a) @@ -200,16 +178,7 @@ instance MonoFunctor (HashMap k v) instance MonoFunctor (Vector a) instance MonoFunctor (Arg a b) -instance Functor w => MonoFunctor (EnvT e w a) -instance Functor w => MonoFunctor (StoreT s w a) -instance Functor w => MonoFunctor (TracedT m w a) -#if !MIN_VERSION_comonad(5,0,0) -instance (Functor f, Functor g) => MonoFunctor (Coproduct f g a) -#endif instance Arrow a => MonoFunctor (WrappedArrow a b c) -instance Functor f => MonoFunctor (MaybeApply f a) -instance Functor f => MonoFunctor (WrappedApplicative f a) -instance MonoFunctor (Cokleisli w a b) instance Functor m => MonoFunctor (MaybeT m a) instance Functor m => MonoFunctor (ListT m a) instance Functor m => MonoFunctor (IdentityT m a) @@ -220,11 +189,9 @@ instance Functor m => MonoFunctor (RWST r w s m a) instance Functor m => MonoFunctor (Strict.RWST r w s m a) instance Functor m => MonoFunctor (ReaderT r m a) -instance Functor m => MonoFunctor (ErrorT e m a) instance Functor m => MonoFunctor (ContT r m a) instance (Functor f, Functor g) => MonoFunctor (Compose f g a) instance (Functor f, Functor g) => MonoFunctor (Product f g a) -instance Functor f => MonoFunctor (Static f a b) instance U.Unbox a => MonoFunctor (U.Vector a) where omap = U.map {-# INLINE omap #-} @@ -295,28 +262,38 @@ -- | Map each element of a monomorphic container to an action, -- evaluate these actions from left to right, and ignore the results. - otraverse_ :: (MonoFoldable mono, Applicative f) => (Element mono -> f b) -> mono -> f () + otraverse_ :: Applicative f => (Element mono -> f b) -> mono -> f () otraverse_ f = ofoldr ((*>) . f) (pure ()) {-# INLINE otraverse_ #-} -- | 'ofor_' is 'otraverse_' with its arguments flipped. - ofor_ :: (MonoFoldable mono, Applicative f) => mono -> (Element mono -> f b) -> f () + ofor_ :: Applicative f => mono -> (Element mono -> f b) -> f () ofor_ = flip otraverse_ {-# INLINE ofor_ #-} -- | Map each element of a monomorphic container to a monadic action, -- evaluate these actions from left to right, and ignore the results. - omapM_ :: (MonoFoldable mono, Monad m) => (Element mono -> m ()) -> mono -> m () +#if MIN_VERSION_base(4,8,0) + omapM_ :: Applicative m => (Element mono -> m ()) -> mono -> m () + omapM_ = otraverse_ +#else + omapM_ :: Monad m => (Element mono -> m ()) -> mono -> m () omapM_ f = ofoldr ((>>) . f) (return ()) +#endif {-# INLINE omapM_ #-} -- | 'oforM_' is 'omapM_' with its arguments flipped. - oforM_ :: (MonoFoldable mono, Monad m) => mono -> (Element mono -> m ()) -> m () +#if MIN_VERSION_base(4,8,0) + oforM_ :: Applicative m => mono -> (Element mono -> m ()) -> m () oforM_ = flip omapM_ +#else + oforM_ :: Monad m => mono -> (Element mono -> m ()) -> m () + oforM_ = flip omapM_ +#endif {-# INLINE oforM_ #-} -- | Monadic fold over the elements of a monomorphic container, associating to the left. - ofoldlM :: (MonoFoldable mono, Monad m) => (a -> Element mono -> m a) -> a -> mono -> m a + ofoldlM :: Monad m => (a -> Element mono -> m a) -> a -> mono -> m a ofoldlM f z0 xs = ofoldr f' return xs z0 where f' x k z = f z x >>= k {-# INLINE ofoldlM #-} @@ -327,7 +304,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See 'Data.MinLen.ofoldMap1' from "Data.MinLen" for a total version of this function./ + -- /See 'Data.NonNull.ofoldMap1' from "Data.NonNull" for a total version of this function./ ofoldMap1Ex :: Semigroup m => (Element mono -> m) -> mono -> m ofoldMap1Ex f = fromMaybe (Prelude.error "Data.MonoTraversable.ofoldMap1Ex") . getOption . ofoldMap (Option . Just . f) @@ -337,7 +314,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See 'Data.MinLen.ofoldr1Ex' from "Data.MinLen" for a total version of this function./ + -- /See 'Data.NonNull.ofoldr1Ex' from "Data.NonNull" for a total version of this function./ ofoldr1Ex :: (Element mono -> Element mono -> Element mono) -> mono -> Element mono default ofoldr1Ex :: (t a ~ mono, a ~ Element (t a), F.Foldable t) => (a -> a -> a) -> mono -> a @@ -350,7 +327,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See 'Data.MinLen.ofoldl1Ex'' from "Data.MinLen" for a total version of this function./ + -- /See 'Data.NonNull.ofoldl1Ex'' from "Data.NonNull" for a total version of this function./ ofoldl1Ex' :: (Element mono -> Element mono -> Element mono) -> mono -> Element mono default ofoldl1Ex' :: (t a ~ mono, a ~ Element (t a), F.Foldable t) => (a -> a -> a) -> mono -> a @@ -362,7 +339,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See 'Data.MinLen.head' from "Data.MinLen" for a total version of this function./ + -- /See 'Data.NonNull.head' from "Data.NonNull" for a total version of this function./ headEx :: mono -> Element mono headEx = ofoldr const (Prelude.error "Data.MonoTraversable.headEx: empty") {-# INLINE headEx #-} @@ -372,7 +349,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See 'Data.MinLen.last from "Data.MinLen" for a total version of this function./ + -- /See 'Data.NonNull.last from "Data.NonNull" for a total version of this function./ lastEx :: mono -> Element mono lastEx = ofoldl1Ex' (flip const) {-# INLINE lastEx #-} @@ -393,7 +370,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See 'Data.MinLen.maximiumBy' from "Data.MinLen" for a total version of this function./ + -- /See 'Data.NonNull.maximiumBy' from "Data.NonNull" for a total version of this function./ maximumByEx :: (Element mono -> Element mono -> Ordering) -> mono -> Element mono maximumByEx f = ofoldl1Ex' go @@ -410,7 +387,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See 'Data.MinLen.minimumBy' from "Data.MinLen" for a total version of this function./ + -- /See 'Data.NonNull.minimumBy' from "Data.NonNull" for a total version of this function./ minimumByEx :: (Element mono -> Element mono -> Ordering) -> mono -> Element mono minimumByEx f = ofoldl1Ex' go @@ -435,11 +412,28 @@ let start = Unsafe.unsafeForeignPtrToPtr fptr `plusPtr` offset end = start `plusPtr` len loop ptr - | ptr >= end = Unsafe.inlinePerformIO (touchForeignPtr fptr) `seq` return () - | otherwise = do - _ <- f (Unsafe.inlinePerformIO (peek ptr)) + | ptr >= end = evil (touchForeignPtr fptr) `seq` +#if MIN_VERSION_base(4,8,0) + pure () +#else + return () +#endif + | otherwise = +#if MIN_VERSION_base(4,8,0) + f (evil (peek ptr)) *> loop (ptr `plusPtr` 1) +#else + f (evil (peek ptr)) >> + loop (ptr `plusPtr` 1) +#endif loop start + where +#if MIN_VERSION_bytestring(0,10,6) + evil = Unsafe.accursedUnutterablePerformIO +#else + evil = Unsafe.inlinePerformIO +#endif + {-# INLINE evil #-} ofoldr1Ex = S.foldr1 ofoldl1Ex' = S.foldl1' headEx = S.head @@ -459,6 +453,8 @@ {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# INLINE unsafeHead #-} +{-# RULES "strict ByteString: ofoldMap = concatMap" ofoldMap = S.concatMap #-} + instance MonoFoldable L.ByteString where ofoldMap f = ofoldr (mappend . f) mempty ofoldr = L.foldr @@ -486,6 +482,8 @@ {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} +{-# RULES "lazy ByteString: ofoldMap = concatMap" ofoldMap = L.concatMap #-} + instance MonoFoldable T.Text where ofoldMap f = ofoldr (mappend . f) mempty ofoldr = T.foldr @@ -511,6 +509,8 @@ {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} +{-# RULES "strict Text: ofoldMap = concatMap" ofoldMap = T.concatMap #-} + instance MonoFoldable TL.Text where ofoldMap f = ofoldr (mappend . f) mempty ofoldr = TL.foldr @@ -535,6 +535,8 @@ {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} +{-# RULES "lazy Text: ofoldMap = concatMap" ofoldMap = TL.concatMap #-} + instance MonoFoldable IntSet where ofoldMap f = ofoldr (mappend . f) mempty ofoldr = IntSet.foldr @@ -561,7 +563,11 @@ | i Prelude.<= 0 = GT | otherwise = ocompareLength xs (i - 1) instance MonoFoldable (Maybe a) where +#if MIN_VERSION_base(4,8,0) + omapM_ _ Nothing = pure () +#else omapM_ _ Nothing = return () +#endif omapM_ f (Just x) = f x {-# INLINE omapM_ #-} instance MonoFoldable (Tree a) @@ -610,11 +616,6 @@ {-# INLINE minimumByEx #-} instance MonoFoldable (Set e) instance MonoFoldable (HashSet e) -instance MonoFoldable (DList a) where - otoList = DL.toList - headEx = DL.head - {-# INLINE otoList #-} - {-# INLINE headEx #-} instance U.Unbox a => MonoFoldable (U.Vector a) where ofoldMap f = ofoldr (mappend . f) mempty @@ -700,7 +701,11 @@ ofoldr1Ex _ (Right x) = x ofoldl1Ex' _ (Left _) = Prelude.error "ofoldl1Ex' on Either" ofoldl1Ex' _ (Right x) = x +#if MIN_VERSION_base(4,8,0) + omapM_ _ (Left _) = pure () +#else omapM_ _ (Left _) = return () +#endif omapM_ f (Right x) = f x {-# INLINE ofoldMap #-} {-# INLINE ofoldr #-} @@ -720,7 +725,6 @@ instance F.Foldable f => MonoFoldable (IdentityT f a) instance F.Foldable f => MonoFoldable (WriterT w f a) instance F.Foldable f => MonoFoldable (Strict.WriterT w f a) -instance F.Foldable f => MonoFoldable (ErrorT e f a) instance (F.Foldable f, F.Foldable g) => MonoFoldable (Compose f g a) instance (F.Foldable f, F.Foldable g) => MonoFoldable (Product f g a) @@ -768,186 +772,109 @@ oor = oany id {-# INLINE oor #-} --- | A typeclass for monomorphic containers that are 'Monoid's. -class (MonoFoldable mono, Monoid mono) => MonoFoldableMonoid mono where -- FIXME is this really just MonoMonad? - -- | Map a function over a monomorphic container and combine the results. - oconcatMap :: (Element mono -> mono) -> mono -> mono - oconcatMap = ofoldMap - {-# INLINE oconcatMap #-} -instance (MonoFoldable (t a), Monoid (t a)) => MonoFoldableMonoid (t a) -- FIXME -instance MonoFoldableMonoid S.ByteString where - oconcatMap = S.concatMap - {-# INLINE oconcatMap #-} -instance MonoFoldableMonoid L.ByteString where - oconcatMap = L.concatMap - {-# INLINE oconcatMap #-} -instance MonoFoldableMonoid T.Text where - oconcatMap = T.concatMap - {-# INLINE oconcatMap #-} -instance MonoFoldableMonoid TL.Text where - oconcatMap = TL.concatMap - {-# INLINE oconcatMap #-} +-- | Synonym for 'ofoldMap' +-- +-- @since 1.0.0 +oconcatMap :: (MonoFoldable mono, Monoid m) => (Element mono -> m) -> mono -> m +oconcatMap = ofoldMap --- | A typeclass for monomorphic containers whose elements --- are an instance of 'Eq'. -class (MonoFoldable mono, Eq (Element mono)) => MonoFoldableEq mono where - -- | Checks if the monomorphic container includes the supplied element. - oelem :: Element mono -> mono -> Bool - oelem e = List.elem e . otoList +-- | Monoidally combine all values in the container +-- +-- @since 1.0.0 +ofold :: (MonoFoldable mono, Monoid (Element mono)) => mono -> Element mono +ofold = ofoldMap id +{-# INLINE ofold #-} - -- | Checks if the monomorphic container does not include the supplied element. - onotElem :: Element mono -> mono -> Bool - onotElem e = List.notElem e . otoList - {-# INLINE oelem #-} - {-# INLINE onotElem #-} +-- | Synonym for 'ofold' +-- +-- @since 1.0.0 +oconcat :: (MonoFoldable mono, Monoid (Element mono)) => mono -> Element mono +oconcat = ofold +{-# INLINE oconcat #-} -instance Eq a => MonoFoldableEq (Seq.Seq a) -instance Eq a => MonoFoldableEq (V.Vector a) -instance (Eq a, U.Unbox a) => MonoFoldableEq (U.Vector a) -instance (Eq a, VS.Storable a) => MonoFoldableEq (VS.Vector a) -instance Eq a => MonoFoldableEq (NonEmpty a) -instance MonoFoldableEq T.Text -instance MonoFoldableEq TL.Text -instance MonoFoldableEq IntSet -instance Eq a => MonoFoldableEq (Maybe a) -instance Eq a => MonoFoldableEq (Tree a) -instance Eq a => MonoFoldableEq (ViewL a) -instance Eq a => MonoFoldableEq (ViewR a) -instance Eq a => MonoFoldableEq (IntMap a) -instance Eq a => MonoFoldableEq (Option a) -instance Eq a => MonoFoldableEq (Identity a) -instance Eq v => MonoFoldableEq (Map k v) -instance Eq v => MonoFoldableEq (HashMap k v) -instance Eq a => MonoFoldableEq (HashSet a) -instance Eq a => MonoFoldableEq (DList a) -instance Eq b => MonoFoldableEq (Either a b) -instance Eq b => MonoFoldableEq (a, b) -instance Eq a => MonoFoldableEq (Const m a) -instance (Eq a, F.Foldable f) => MonoFoldableEq (MaybeT f a) -instance (Eq a, F.Foldable f) => MonoFoldableEq (ListT f a) -instance (Eq a, F.Foldable f) => MonoFoldableEq (IdentityT f a) -instance (Eq a, F.Foldable f) => MonoFoldableEq (WriterT w f a) -instance (Eq a, F.Foldable f) => MonoFoldableEq (Strict.WriterT w f a) -instance (Eq a, F.Foldable f) => MonoFoldableEq (ErrorT e f a) -instance (Eq a, F.Foldable f, F.Foldable g) => MonoFoldableEq (Compose f g a) -instance (Eq a, F.Foldable f, F.Foldable g) => MonoFoldableEq (Product f g a) +-- | Synonym for 'ofoldlM' +-- +-- @since 1.0.0 +ofoldM :: (MonoFoldable mono, Monad m) => (a -> Element mono -> m a) -> a -> mono -> m a +ofoldM = ofoldlM +{-# INLINE ofoldM #-} -instance Eq a => MonoFoldableEq [a] where - oelem = List.elem - onotElem = List.notElem - {-# INLINE oelem #-} - {-# INLINE onotElem #-} +-- | Perform all actions in the given container +-- +-- @since 1.0.0 +#if MIN_VERSION_base(4,8,0) +osequence_ :: (Applicative m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m () +#else +osequence_ :: (Monad m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m () +#endif +osequence_ = omapM_ id +{-# INLINE osequence_ #-} -instance MonoFoldableEq S.ByteString where - oelem = S.elem - onotElem = S.notElem - {-# INLINE oelem #-} - {-# INLINE onotElem #-} +-- | Checks if the monomorphic container includes the supplied element. +oelem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool +oelem e = List.elem e . otoList +{-# INLINE [0] oelem #-} -instance MonoFoldableEq L.ByteString where - oelem = L.elem - onotElem = L.notElem - {-# INLINE oelem #-} - {-# INLINE onotElem #-} +-- | Checks if the monomorphic container does not include the supplied element. +onotElem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool +onotElem e = List.notElem e . otoList +{-# INLINE [0] onotElem #-} -instance (Eq a, Ord a) => MonoFoldableEq (Set a) where - oelem = Set.member - onotElem = Set.notMember - {-# INLINE oelem #-} - {-# INLINE onotElem #-} +{-# RULES "strict ByteString elem" oelem = S.elem #-} +{-# RULES "strict ByteString notElem" oelem = S.notElem #-} +{-# RULES "lazy ByteString elem" oelem = L.elem #-} +{-# RULES "lazy ByteString notElem" oelem = L.notElem #-} --- | A typeclass for monomorphic containers whose elements --- are an instance of 'Ord'. -class (MonoFoldable mono, Ord (Element mono)) => MonoFoldableOrd mono where - -- | Get the minimum element of a monomorphic container. - -- - -- Note: this is a partial function. On an empty 'MonoFoldable', it will - -- throw an exception. - -- - -- /See 'Data.MinLen.maximum' from "Data.MinLen" for a total version of this function./ - maximumEx :: mono -> Element mono - maximumEx = maximumByEx compare - {-# INLINE maximumEx #-} +{-# RULES "Set elem" forall (k :: Ord k => k). oelem k = Set.member k #-} +{-# RULES "Set notElem" forall (k :: Ord k => k). oelem k = Set.notMember k #-} - -- | Get the maximum element of a monomorphic container. - -- - -- Note: this is a partial function. On an empty 'MonoFoldable', it will - -- throw an exception. - -- - -- /See 'Data.MinLen.minimum' from "Data.MinLen" for a total version of this function./ - minimumEx :: mono -> Element mono - minimumEx = minimumByEx compare - {-# INLINE minimumEx #-} +-- | Get the minimum element of a monomorphic container. +-- +-- Note: this is a partial function. On an empty 'MonoFoldable', it will +-- throw an exception. +-- +-- /See 'Data.NonNull.maximum' from "Data.NonNull" for a total version of this function./ +maximumEx :: (MonoFoldable mono, Ord (Element mono)) => mono -> Element mono +maximumEx = maximumByEx compare +{-# INLINE [0] maximumEx #-} -instance MonoFoldableOrd S.ByteString where - maximumEx = S.maximum - {-# INLINE maximumEx #-} - minimumEx = S.minimum - {-# INLINE minimumEx #-} -instance MonoFoldableOrd L.ByteString where - maximumEx = L.maximum - {-# INLINE maximumEx #-} - minimumEx = L.minimum - {-# INLINE minimumEx #-} -instance MonoFoldableOrd T.Text where - maximumEx = T.maximum - {-# INLINE maximumEx #-} - minimumEx = T.minimum - {-# INLINE minimumEx #-} -instance MonoFoldableOrd TL.Text where - maximumEx = TL.maximum - {-# INLINE maximumEx #-} - minimumEx = TL.minimum - {-# INLINE minimumEx #-} -instance MonoFoldableOrd IntSet -instance Ord a => MonoFoldableOrd [a] -instance Ord a => MonoFoldableOrd (Maybe a) -instance Ord a => MonoFoldableOrd (Tree a) -instance Ord a => MonoFoldableOrd (Seq a) -instance Ord a => MonoFoldableOrd (ViewL a) -instance Ord a => MonoFoldableOrd (ViewR a) -instance Ord a => MonoFoldableOrd (IntMap a) -instance Ord a => MonoFoldableOrd (Option a) -instance Ord a => MonoFoldableOrd (NonEmpty a) -instance Ord a => MonoFoldableOrd (Identity a) -instance Ord v => MonoFoldableOrd (Map k v) -instance Ord v => MonoFoldableOrd (HashMap k v) -instance Ord a => MonoFoldableOrd (Vector a) where - maximumEx = V.maximum - minimumEx = V.minimum - {-# INLINE maximumEx #-} - {-# INLINE minimumEx #-} -instance Ord e => MonoFoldableOrd (Set e) -instance Ord e => MonoFoldableOrd (HashSet e) -instance (U.Unbox a, Ord a) => MonoFoldableOrd (U.Vector a) where - maximumEx = U.maximum - minimumEx = U.minimum - {-# INLINE maximumEx #-} - {-# INLINE minimumEx #-} -instance (Ord a, VS.Storable a) => MonoFoldableOrd (VS.Vector a) where - maximumEx = VS.maximum - minimumEx = VS.minimum - {-# INLINE maximumEx #-} - {-# INLINE minimumEx #-} -instance Ord b => MonoFoldableOrd (Either a b) where -instance Ord a => MonoFoldableOrd (DList a) -instance Ord b => MonoFoldableOrd (a, b) -instance Ord a => MonoFoldableOrd (Const m a) -instance (Ord a, F.Foldable f) => MonoFoldableOrd (MaybeT f a) -instance (Ord a, F.Foldable f) => MonoFoldableOrd (ListT f a) -instance (Ord a, F.Foldable f) => MonoFoldableOrd (IdentityT f a) -instance (Ord a, F.Foldable f) => MonoFoldableOrd (WriterT w f a) -instance (Ord a, F.Foldable f) => MonoFoldableOrd (Strict.WriterT w f a) -instance (Ord a, F.Foldable f) => MonoFoldableOrd (ErrorT e f a) -instance (Ord a, F.Foldable f, F.Foldable g) => MonoFoldableOrd (Compose f g a) -instance (Ord a, F.Foldable f, F.Foldable g) => MonoFoldableOrd (Product f g a) +-- | Get the maximum element of a monomorphic container. +-- +-- Note: this is a partial function. On an empty 'MonoFoldable', it will +-- throw an exception. +-- +-- /See 'Data.NonNull.minimum' from "Data.NonNull" for a total version of this function./ +minimumEx :: (MonoFoldable mono, Ord (Element mono)) => mono -> Element mono +minimumEx = minimumByEx compare +{-# INLINE [0] minimumEx #-} +{-# RULES "strict ByteString maximumEx" maximumEx = S.maximum #-} +{-# RULES "strict ByteString minimumEx" minimumEx = S.minimum #-} + +{-# RULES "lazy ByteString maximumEx" maximumEx = L.maximum #-} +{-# RULES "lazy ByteString minimumEx" minimumEx = L.minimum #-} + +{-# RULES "strict Text maximumEx" maximumEx = T.maximum #-} +{-# RULES "strict Text minimumEx" minimumEx = T.minimum #-} + +{-# RULES "lazy Text maximumEx" maximumEx = TL.maximum #-} +{-# RULES "lazy Text minimumEx" minimumEx = TL.minimum #-} + +{-# RULES "boxed Vector maximumEx" maximumEx = V.maximum #-} +{-# RULES "boxed Vector minimumEx" minimumEx = V.minimum #-} + +{-# RULES "unboxed Vector maximumEx" forall (u :: U.Unbox a => U.Vector a). maximumEx u = U.maximum u #-} +{-# RULES "unboxed Vector minimumEx" forall (u :: U.Unbox a => U.Vector a). minimumEx u = U.minimum u #-} + +{-# RULES "storable Vector maximumEx" forall (v :: VS.Storable a => VS.Vector a). maximumEx v = VS.maximum v #-} +{-# RULES "storable Vector minimumEx" forall (v :: VS.Storable a => VS.Vector a). minimumEx v = VS.minimum v #-} + -- | Safe version of 'maximumEx'. -- -- Returns 'Nothing' instead of throwing an exception when -- encountering an empty monomorphic container. -maximumMay :: MonoFoldableOrd mono => mono -> Maybe (Element mono) +maximumMay :: (MonoFoldable mono, Ord (Element mono)) => mono -> Maybe (Element mono) maximumMay mono | onull mono = Nothing | otherwise = Just (maximumEx mono) @@ -970,7 +897,7 @@ -- -- Returns 'Nothing' instead of throwing an exception when -- encountering an empty monomorphic container. -minimumMay :: MonoFoldableOrd mono => mono -> Maybe (Element mono) +minimumMay :: (MonoFoldable mono, Ord (Element mono)) => mono -> Maybe (Element mono) minimumMay mono | onull mono = Nothing | otherwise = Just (minimumEx mono) @@ -1001,32 +928,45 @@ -- | Map each element of a monomorphic container to a monadic action, -- evaluate these actions from left to right, and -- collect the results. +#if MIN_VERSION_base(4,8,0) + omapM :: Applicative m => (Element mono -> m (Element mono)) -> mono -> m mono + omapM = otraverse +#else omapM :: Monad m => (Element mono -> m (Element mono)) -> mono -> m mono default omapM :: (Traversable t, mono ~ t a, a ~ Element mono, Monad m) => (Element mono -> m (Element mono)) -> mono -> m mono omapM = mapM +#endif {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable S.ByteString where otraverse f = fmap S.pack . traverse f . S.unpack - omapM f = liftM S.pack . mapM f . S.unpack {-# INLINE otraverse #-} +#if !MIN_VERSION_base(4,8,0) + omapM f = liftM S.pack . mapM f . S.unpack {-# INLINE omapM #-} +#endif instance MonoTraversable L.ByteString where otraverse f = fmap L.pack . traverse f . L.unpack - omapM f = liftM L.pack . mapM f . L.unpack {-# INLINE otraverse #-} +#if !MIN_VERSION_base(4,8,0) + omapM f = liftM L.pack . mapM f . L.unpack {-# INLINE omapM #-} +#endif instance MonoTraversable T.Text where otraverse f = fmap T.pack . traverse f . T.unpack - omapM f = liftM T.pack . mapM f . T.unpack {-# INLINE otraverse #-} +#if !MIN_VERSION_base(4,8,0) + omapM f = liftM T.pack . mapM f . T.unpack {-# INLINE omapM #-} +#endif instance MonoTraversable TL.Text where otraverse f = fmap TL.pack . traverse f . TL.unpack - omapM f = liftM TL.pack . mapM f . TL.unpack {-# INLINE otraverse #-} +#if !MIN_VERSION_base(4,8,0) + omapM f = liftM TL.pack . mapM f . TL.unpack {-# INLINE omapM #-} +#endif instance MonoTraversable [a] instance MonoTraversable (Maybe a) instance MonoTraversable (Tree a) @@ -1036,28 +976,40 @@ instance MonoTraversable (IntMap a) instance MonoTraversable (Option a) instance MonoTraversable (NonEmpty a) -instance MonoTraversable (DList a) where - otraverse f = fmap DL.fromList . traverse f . DL.toList - omapM f = liftM DL.fromList . mapM f . DL.toList instance MonoTraversable (Identity a) instance MonoTraversable (Map k v) instance MonoTraversable (HashMap k v) instance MonoTraversable (Vector a) instance U.Unbox a => MonoTraversable (U.Vector a) where + -- FIXME do something more efficient otraverse f = fmap U.fromList . traverse f . U.toList +#if MIN_VERSION_base(4,8,0) + omapM = otraverse +#else omapM = U.mapM +#endif {-# INLINE otraverse #-} {-# INLINE omapM #-} instance VS.Storable a => MonoTraversable (VS.Vector a) where + -- FIXME do something more efficient otraverse f = fmap VS.fromList . traverse f . VS.toList +#if MIN_VERSION_base(4,8,0) + omapM = otraverse +#else omapM = VS.mapM +#endif {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable (Either a b) where otraverse _ (Left a) = pure (Left a) otraverse f (Right b) = fmap Right (f b) +#if MIN_VERSION_base(4,8,0) + omapM _ (Left a) = pure (Left a) + omapM f (Right b) = fmap Right (f b) +#else omapM _ (Left a) = return (Left a) omapM f (Right b) = liftM Right (f b) +#endif {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable (a, b) @@ -1067,7 +1019,6 @@ instance Traversable f => MonoTraversable (IdentityT f a) instance Traversable f => MonoTraversable (WriterT w f a) instance Traversable f => MonoTraversable (Strict.WriterT w f a) -instance Traversable f => MonoTraversable (ErrorT e f a) instance (Traversable f, Traversable g) => MonoTraversable (Compose f g a) instance (Traversable f, Traversable g) => MonoTraversable (Product f g a) @@ -1077,7 +1028,11 @@ {-# INLINE ofor #-} -- | 'oforM' is 'omapM' with its arguments flipped. +#if MIN_VERSION_base(4,8,0) +oforM :: (MonoTraversable mono, Applicative f) => mono -> (Element mono -> f (Element mono)) -> f mono +#else oforM :: (MonoTraversable mono, Monad f) => mono -> (Element mono -> f (Element mono)) -> f mono +#endif oforM = flip omapM {-# INLINE oforM #-} @@ -1144,7 +1099,6 @@ instance MonoPointed (NonEmpty a) instance MonoPointed (Identity a) instance MonoPointed (Vector a) -instance MonoPointed (DList a) instance MonoPointed (IO a) instance MonoPointed (ZipList a) instance MonoPointed (r -> a) @@ -1153,7 +1107,6 @@ instance Monad m => MonoPointed (WrappedMonad m a) instance Applicative m => MonoPointed (ListT m a) instance Applicative m => MonoPointed (IdentityT m a) -instance Applicative f => MonoPointed (WrappedApplicative f a) instance Arrow a => MonoPointed (WrappedArrow a b c) instance (Monoid w, Applicative m) => MonoPointed (WriterT w m a) instance (Monoid w, Applicative m) => MonoPointed (Strict.WriterT w m a) @@ -1161,8 +1114,6 @@ instance MonoPointed (ContT r m a) instance (Applicative f, Applicative g) => MonoPointed (Compose f g a) instance (Applicative f, Applicative g) => MonoPointed (Product f g a) -instance MonoPointed (Cokleisli w a b) -instance Applicative f => MonoPointed (Static f a b) -- Not Applicative instance MonoPointed (Seq a) where @@ -1186,12 +1137,6 @@ instance Hashable a => MonoPointed (HashSet a) where opoint = HashSet.singleton {-# INLINE opoint #-} -instance Applicative m => MonoPointed (ErrorT e m a) where - opoint = ErrorT . pure . Right - {-# INLINE opoint #-} -instance MonoPointed (MaybeApply f a) where - opoint = MaybeApply . Right - {-# INLINE opoint #-} instance Applicative f => MonoPointed (MaybeT f a) where opoint = MaybeT . fmap Just . pure {-# INLINE opoint #-} @@ -1243,30 +1188,6 @@ -- glimpsed from the given function. oextend :: (mono -> Element mono) -> mono -> mono - default oextract :: (Comonad w, (w a) ~ mono, Element (w a) ~ a) - => mono -> Element mono - oextract = extract - {-# INLINE oextract #-} - default oextend :: (Comonad w, (w a) ~ mono, Element (w a) ~ a) - => (mono -> Element mono) -> mono -> mono - oextend = extend - {-# INLINE oextend #-} - --- Comonad -instance MonoComonad (Tree a) -instance MonoComonad (NonEmpty a) -instance MonoComonad (Identity a) -instance Monoid m => MonoComonad (m -> a) -instance MonoComonad (e, a) -instance MonoComonad (Arg a b) -instance Comonad w => MonoComonad (IdentityT w a) -instance Comonad w => MonoComonad (EnvT e w a) -instance Comonad w => MonoComonad (StoreT s w a) -instance (Comonad w, Monoid m) => MonoComonad (TracedT m w a) -#if !MIN_VERSION_comonad(5,0,0) -instance (Comonad f, Comonad g) => MonoComonad (Coproduct f g a) -#endif - -- Not Comonad instance MonoComonad (ViewL a) where oextract ~(x :< _) = x @@ -1288,3 +1209,57 @@ EmptyR -> Seq.empty ys :> y -> ys Seq.|> y ) :> f w + +-- | Containers which, when two values are combined, the combined length is no +-- less than the larger of the two inputs. In code: +-- +-- @ +-- olength (x <> y) >= max (olength x) (olength y) +-- @ +-- +-- This class has no methods, and is simply used to assert that this law holds, +-- in order to provide guarantees of correctness (see, for instance, +-- "Data.NonNull"). +-- +-- This should have a @Semigroup@ superclass constraint, however, due to +-- @Semigroup@ only recently moving to base, some packages do not provide +-- instances. +class MonoFoldable mono => GrowingAppend mono + +instance GrowingAppend (Seq.Seq a) +instance GrowingAppend [a] +instance GrowingAppend (V.Vector a) +instance U.Unbox a => GrowingAppend (U.Vector a) +instance VS.Storable a => GrowingAppend (VS.Vector a) +instance GrowingAppend S.ByteString +instance GrowingAppend L.ByteString +instance GrowingAppend T.Text +instance GrowingAppend TL.Text +instance GrowingAppend (NonEmpty a) +instance Ord k => GrowingAppend (Map k v) +instance (Eq k, Hashable k) => GrowingAppend (HashMap k v) +instance Ord v => GrowingAppend (Set.Set v) +instance (Eq v, Hashable v) => GrowingAppend (HashSet.HashSet v) +instance GrowingAppend IntSet.IntSet +instance GrowingAppend (IntMap v) + +-- | 'intercalate' @seq seqs@ inserts @seq@ in between @seqs@ and +-- concatenates the result. +-- +-- @since 1.0.0 +ointercalate :: (MonoFoldable mono, Monoid (Element mono)) + => Element mono + -> mono + -> Element mono +ointercalate x = mconcat . List.intersperse x . otoList +{-# INLINE [0] ointercalate #-} +{-# RULES "ointercalate list" forall x. + ointercalate x = List.intercalate x . otoList #-} +{-# RULES "intercalate ByteString" forall x. + ointercalate x = S.intercalate x . otoList #-} +{-# RULES "intercalate LByteString" forall x. + ointercalate x = L.intercalate x . otoList #-} +{-# RULES "intercalate Text" forall x. + ointercalate x = T.intercalate x . otoList #-} +{-# RULES "intercalate LText" forall x. + ointercalate x = TL.intercalate x . otoList #-} diff --git a/src/Data/MonoTraversable/Unprefixed.hs b/src/Data/MonoTraversable/Unprefixed.hs new file mode 100644 --- /dev/null +++ b/src/Data/MonoTraversable/Unprefixed.hs @@ -0,0 +1,235 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +-- | The functions in "Data.MonoTraversable" are all prefixed with the letter +-- @o@ to avoid conflicts with their polymorphic counterparts. This module +-- exports the same identifiers without the prefix, for all cases where the +-- monomorphic variant loses no generality versus the polymorphic version. For +-- example, 'olength' is just as general as @Data.Foldable.length@, so we +-- export @length = length@. By contrast, 'omap' cannot fully subsume @fmap@ or +-- @map@, so we do not provide such an export. +-- +-- @since 1.0.0 +module Data.MonoTraversable.Unprefixed where + +import Data.Int (Int64) +import Data.MonoTraversable +import Data.Semigroup (Semigroup) +import Data.Monoid (Monoid) +import Control.Applicative (Applicative) + +-- | Synonym for 'ofoldMap' +-- +-- @since 1.0.0 +foldMap :: (MonoFoldable mono, Data.Monoid.Monoid m) => (Element mono -> m) -> mono -> m +foldMap = ofoldMap + +-- | Synonym for 'ofoldr' +-- +-- @since 1.0.0 +foldr :: MonoFoldable mono => (Element mono -> b -> b) -> b -> mono -> b +foldr = ofoldr + +-- | Synonym for 'ofoldl'' +-- +-- @since 1.0.0 +foldl' :: MonoFoldable mono => (a -> Element mono -> a) -> a -> mono -> a +foldl' = ofoldl' + +-- | Synonym for 'otoList' +-- +-- @since 1.0.0 +toList :: MonoFoldable mono => mono -> [Element mono] +toList = otoList + +-- | Synonym for 'oall' +-- +-- @since 1.0.0 +all :: MonoFoldable mono => (Element mono -> Bool) -> mono -> Bool +all = oall + +-- | Synonym for 'oany' +-- +-- @since 1.0.0 +any :: MonoFoldable mono => (Element mono -> Bool) -> mono -> Bool +any = oany + +-- | Synonym for 'onull' +-- +-- @since 1.0.0 +null :: MonoFoldable mono => mono -> Bool +null = onull + +-- | Synonym for 'olength' +-- +-- @since 1.0.0 +length :: MonoFoldable mono => mono -> Int +length = olength + +-- | Synonym for 'olength64' +-- +-- @since 1.0.0 +length64 :: MonoFoldable mono => mono -> Int64 +length64 = olength64 + +-- | Synonym for 'ocompareLength' +-- +-- @since 1.0.0 +compareLength :: (MonoFoldable mono, Integral i) => mono -> i -> Ordering +compareLength = ocompareLength + +-- | Synonym for 'otraverse_' +-- +-- @since 1.0.0 +traverse_ :: (MonoFoldable mono, Control.Applicative.Applicative f) => (Element mono -> f b) -> mono -> f () +traverse_ = otraverse_ + +-- | Synonym for 'ofor_' +-- +-- @since 1.0.0 +for_ :: (MonoFoldable mono, Applicative f) => mono -> (Element mono -> f b) -> f () +for_ = ofor_ + +-- | Synonym for 'omapM_' +-- +-- @since 1.0.0 +#if MIN_VERSION_base(4,8,0) +mapM_ :: (MonoFoldable mono, Applicative m) + => (Element mono -> m ()) -> mono -> m () +#else +mapM_ :: (MonoFoldable mono, Monad m) + => (Element mono -> m ()) -> mono -> m () +#endif +mapM_ = omapM_ + +-- | Synonym for 'oforM_' +-- +-- @since 1.0.0 +#if MIN_VERSION_base(4,8,0) +forM_ :: (MonoFoldable mono, Applicative m) + => mono -> (Element mono -> m ()) -> m () +#else +forM_ :: (MonoFoldable mono, Monad m) + => mono -> (Element mono -> m ()) -> m () +#endif +forM_ = oforM_ + +-- | Synonym for 'ofoldlM' +-- +-- @since 1.0.0 +foldlM :: (MonoFoldable mono, Monad m) + => (a -> Element mono -> m a) + -> a + -> mono + -> m a +foldlM = ofoldlM + +-- | Synonym for 'ofoldMap1Ex' +-- +-- @since 1.0.0 +foldMap1Ex :: (MonoFoldable mono, Semigroup m) + => (Element mono -> m) + -> mono + -> m +foldMap1Ex = ofoldMap1Ex + +-- | Synonym for 'ofoldr1Ex' +-- +-- @since 1.0.0 +foldr1Ex :: MonoFoldable mono + => (Element mono -> Element mono -> Element mono) + -> mono + -> Element mono +foldr1Ex = ofoldr1Ex + +-- | Synonym for 'ofoldl1Ex'' +-- +-- @since 1.0.0 +foldl1Ex' :: MonoFoldable mono + => (Element mono -> Element mono -> Element mono) + -> mono + -> Element mono +foldl1Ex' = ofoldl1Ex' + +-- | Synonym for 'osum' +-- +-- @since 1.0.0 +sum :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono +sum = osum + +-- | Synonym for 'oproduct' +-- +-- @since 1.0.0 +product :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono +product = oproduct + +-- | Synonym for 'oand' +-- +-- @since 1.0.0 +and :: (MonoFoldable mono, Element mono ~ Bool) => mono -> Bool +and = oand + +-- | Synonym for 'oor' +-- +-- @since 1.0.0 +or :: (MonoFoldable mono, Element mono ~ Bool) => mono -> Bool +or = oor + +-- | Synonym for 'oconcatMap' +-- +-- @since 1.0.0 +concatMap :: (MonoFoldable mono, Monoid m) => (Element mono -> m) -> mono -> m +concatMap = oconcatMap + +-- | Synonym for 'oelem' +-- +-- @since 1.0.0 +elem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool +elem = oelem + +-- | Synonym for 'onotElem' +-- +-- @since 1.0.0 +notElem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool +notElem = onotElem + +-- | Synonym for 'opoint' +-- +-- @since 1.0.0 +point :: MonoPointed mono => Element mono -> mono +point = opoint + +-- | Synonym for 'ointercalate' +-- +-- @since 1.0.0 +intercalate :: (MonoFoldable mono, Monoid (Element mono)) + => Element mono -> mono -> Element mono +intercalate = ointercalate + +-- | Synonym for 'ofold' +-- +-- @since 1.0.0 +fold :: (MonoFoldable mono, Monoid (Element mono)) => mono -> Element mono +fold = ofold + +-- | Synonym for 'oconcat' +-- +-- @since 1.0.0 +concat :: (MonoFoldable mono, Monoid (Element mono)) => mono -> Element mono +concat = oconcat + +-- | Synonym for 'ofoldM' +-- +-- @since 1.0.0 +foldM :: (MonoFoldable mono, Monad m) => (a -> Element mono -> m a) -> a -> mono -> m a +foldM = ofoldM + +-- | Synonym for 'osequence_' +-- +-- @since 1.0.0 +#if MIN_VERSION_base(4,8,0) +sequence_ :: (Applicative m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m () +#else +sequence_ :: (Monad m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m () +#endif +sequence_ = osequence_ diff --git a/src/Data/NonNull.hs b/src/Data/NonNull.hs --- a/src/Data/NonNull.hs +++ b/src/Data/NonNull.hs @@ -1,14 +1,14 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} --- | Warning, this is Experimental! --- --- "Data.NonNull" attempts to extend the concepts from +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +-- | "Data.NonNull" extends the concepts from -- "Data.List.NonEmpty" to any 'MonoFoldable'. -- --- 'NonNull' is a typeclass for a container with 1 or more elements. --- "Data.List.NonEmpty" and 'NotEmpty a' are members of the typeclass +-- 'NonNull' is a newtype wrapper for a container with 1 or more elements. module Data.NonNull ( NonNull , fromNullable @@ -35,45 +35,99 @@ , minimumBy , (<|) , toMinList + , GrowingAppend ) where import Prelude hiding (head, tail, init, last, reverse, seq, filter, replicate, maximum, minimum) import Control.Arrow (second) import Control.Exception.Base (Exception, throw) +#if !MIN_VERSION_base(4,8,0) +import Control.Monad (liftM) +#endif import Data.Data import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) -import Data.MinLen import Data.MonoTraversable import Data.Sequences +import Data.Semigroup (Semigroup (..)) +import Control.Monad.Trans.State.Strict (evalState, state) data NullError = NullError String deriving (Show, Typeable) instance Exception NullError -- | A monomorphic container that is not null. -type NonNull mono = MinLen (Succ Zero) mono +newtype NonNull mono = NonNull + { toNullable :: mono + -- ^ __Safely__ convert from a non-null monomorphic container to a nullable monomorphic container. + } + deriving (Eq, Ord, Read, Show, Data, Typeable) +type instance Element (NonNull mono) = Element mono +deriving instance MonoFunctor mono => MonoFunctor (NonNull mono) +deriving instance MonoFoldable mono => MonoFoldable (NonNull mono) +instance MonoTraversable mono => MonoTraversable (NonNull mono) where + otraverse f (NonNull x) = fmap NonNull (otraverse f x) + {-# INLINE otraverse #-} +#if !MIN_VERSION_base(4,8,0) + omapM f (NonNull x) = liftM NonNull (omapM f x) + {-# INLINE omapM #-} +#endif +instance GrowingAppend mono => GrowingAppend (NonNull mono) +instance (Semigroup mono, GrowingAppend mono) => Semigroup (NonNull mono) where + NonNull x <> NonNull y = NonNull (x <> y) + +instance SemiSequence seq => SemiSequence (NonNull seq) where + type Index (NonNull seq) = Index seq + + intersperse e = unsafeMap $ intersperse e + reverse = unsafeMap reverse + find f = find f . toNullable + cons x = unsafeMap $ cons x + snoc xs x = unsafeMap (flip snoc x) xs + sortBy f = unsafeMap $ sortBy f + +-- | This function is unsafe, and must not be exposed from this module. +unsafeMap :: (mono -> mono) -> NonNull mono -> NonNull mono +unsafeMap f (NonNull x) = NonNull (f x) + +instance MonoPointed mono => MonoPointed (NonNull mono) where + opoint = NonNull . opoint + {-# INLINE opoint #-} +instance IsSequence mono => MonoComonad (NonNull mono) where + oextract = head + oextend f (NonNull mono) = NonNull + . flip evalState mono + . ofor mono + . const + . state + $ \mono' -> (f (NonNull mono'), tailEx mono') + -- | __Safely__ convert from an __unsafe__ monomorphic container to a __safe__ -- non-null monomorphic container. fromNullable :: MonoFoldable mono => mono -> Maybe (NonNull mono) -fromNullable = toMinLen +fromNullable mono + | onull mono = Nothing + | otherwise = Just (NonNull mono) -- | __Unsafely__ convert from an __unsafe__ monomorphic container to a __safe__ -- non-null monomorphic container. -- -- Throws an exception if the monomorphic container is empty. -nonNull :: MonoFoldable mono => mono -> NonNull mono -nonNull nullable = - fromMaybe (throw $ NullError "Data.NonNull.nonNull (NonNull default): expected non-null") +-- +-- @since 1.0.0 +impureNonNull :: MonoFoldable mono => mono -> NonNull mono +impureNonNull nullable = + fromMaybe (throw $ NullError "Data.NonNull.impureNonNull (NonNull default): expected non-null") $ fromNullable nullable --- | __Safely__ convert from a non-null monomorphic container to a nullable monomorphic container. -toNullable :: NonNull mono -> mono -toNullable = unMinLen +-- | Old synonym for 'impureNonNull' +nonNull :: MonoFoldable mono => mono -> NonNull mono +nonNull = impureNonNull +{-# DEPRECATED nonNull "Please use the more explicit impureNonNull instead" #-} -- | __Safely__ convert from a 'NonEmpty' list to a non-null monomorphic container. fromNonEmpty :: IsSequence seq => NE.NonEmpty (Element seq) -> NonNull seq -fromNonEmpty = nonNull . fromList . NE.toList +fromNonEmpty = impureNonNull . fromList . NE.toList {-# INLINE fromNonEmpty #-} -- | Specializes 'fromNonEmpty' to lists only. @@ -139,3 +193,157 @@ -- | Prepend an element to a non-null 'SemiSequence'. (<|) :: SemiSequence seq => Element seq -> NonNull seq -> NonNull seq x <| y = ncons x (toNullable y) + +-- | Return the first element of a monomorphic container. +-- +-- Safe version of 'headEx', only works on monomorphic containers wrapped in a +-- 'NonNull'. +head :: MonoFoldable mono => NonNull mono -> Element mono +head = headEx . toNullable +{-# INLINE head #-} + +-- | Return the last element of a monomorphic container. +-- +-- Safe version of 'lastEx', only works on monomorphic containers wrapped in a +-- 'NonNull'. +last :: MonoFoldable mono => NonNull mono -> Element mono +last = lastEx . toNullable +{-# INLINE last #-} + +-- | Map each element of a monomorphic container to a semigroup, and combine the +-- results. +-- +-- Safe version of 'ofoldMap1Ex', only works on monomorphic containers wrapped in a +-- 'NonNull'. +-- +-- ==== __Examples__ +-- +-- @ +-- > let xs = ncons ("hello", 1 :: 'Integer') [(" world", 2)] +-- > 'ofoldMap1' 'fst' xs +-- "hello world" +-- @ +ofoldMap1 :: (MonoFoldable mono, Semigroup m) => (Element mono -> m) -> NonNull mono -> m +ofoldMap1 f = ofoldMap1Ex f . toNullable +{-# INLINE ofoldMap1 #-} + +-- | Join a monomorphic container, whose elements are 'Semigroup's, together. +-- +-- Safe, only works on monomorphic containers wrapped in a 'NonNull'. +-- +-- ==== __Examples__ +-- +-- @ +-- > let xs = ncons "a" ["b", "c"] +-- > xs +-- 'NonNull' {toNullable = ["a","b","c"]} +-- +-- > 'ofold1' xs +-- "abc" +-- @ +ofold1 :: (MonoFoldable mono, Semigroup (Element mono)) => NonNull mono -> Element mono +ofold1 = ofoldMap1 id +{-# INLINE ofold1 #-} + +-- | Right-associative fold of a monomorphic container with no base element. +-- +-- Safe version of 'ofoldr1Ex', only works on monomorphic containers wrapped in a +-- 'NonNull'. +-- +-- @'foldr1' f = "Prelude".'Prelude.foldr1' f . 'otoList'@ +-- +-- ==== __Examples__ +-- +-- @ +-- > let xs = ncons "a" ["b", "c"] +-- > 'ofoldr1' (++) xs +-- "abc" +-- @ +ofoldr1 :: MonoFoldable mono + => (Element mono -> Element mono -> Element mono) + -> NonNull mono + -> Element mono +ofoldr1 f = ofoldr1Ex f . toNullable +{-# INLINE ofoldr1 #-} + +-- | Strict left-associative fold of a monomorphic container with no base +-- element. +-- +-- Safe version of 'ofoldl1Ex'', only works on monomorphic containers wrapped in a +-- 'NonNull'. +-- +-- @'foldl1'' f = "Prelude".'Prelude.foldl1'' f . 'otoList'@ +-- +-- ==== __Examples__ +-- +-- @ +-- > let xs = ncons "a" ["b", "c"] +-- > 'ofoldl1'' (++) xs +-- "abc" +-- @ +ofoldl1' :: MonoFoldable mono + => (Element mono -> Element mono -> Element mono) + -> NonNull mono + -> Element mono +ofoldl1' f = ofoldl1Ex' f . toNullable +{-# INLINE ofoldl1' #-} + +-- | Get the maximum element of a monomorphic container. +-- +-- Safe version of 'maximumEx', only works on monomorphic containers wrapped in a +-- 'NonNull'. +-- +-- ==== __Examples__ +-- +-- @ +-- > let xs = ncons 1 [2, 3 :: Int] +-- > 'maximum' xs +-- 3 +-- @ +maximum :: (MonoFoldable mono, Ord (Element mono)) + => NonNull mono + -> Element mono +maximum = maximumEx . toNullable +{-# INLINE maximum #-} + +-- | Get the minimum element of a monomorphic container. +-- +-- Safe version of 'minimumEx', only works on monomorphic containers wrapped in a +-- 'NonNull'. +-- +-- ==== __Examples__ +-- +-- @ +-- > let xs = ncons 1 [2, 3 :: Int] +-- > 'minimum' xs +-- 1 +-- @ +minimum :: (MonoFoldable mono, Ord (Element mono)) + => NonNull mono + -> Element mono +minimum = minimumEx . toNullable +{-# INLINE minimum #-} + +-- | Get the maximum element of a monomorphic container, +-- using a supplied element ordering function. +-- +-- Safe version of 'maximumByEx', only works on monomorphic containers wrapped in a +-- 'NonNull'. +maximumBy :: MonoFoldable mono + => (Element mono -> Element mono -> Ordering) + -> NonNull mono + -> Element mono +maximumBy cmp = maximumByEx cmp . toNullable +{-# INLINE maximumBy #-} + +-- | Get the minimum element of a monomorphic container, +-- using a supplied element ordering function. +-- +-- Safe version of 'minimumByEx', only works on monomorphic containers wrapped in a +-- 'NonNull'. +minimumBy :: MonoFoldable mono + => (Element mono -> Element mono -> Ordering) + -> NonNull mono + -> Element mono +minimumBy cmp = minimumByEx cmp . toNullable +{-# INLINE minimumBy #-} diff --git a/src/Data/Sequences.hs b/src/Data/Sequences.hs --- a/src/Data/Sequences.hs +++ b/src/Data/Sequences.hs @@ -3,11 +3,13 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ConstraintKinds #-} --- | Warning: This module should be considered highly experimental. +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +-- | Abstractions over sequential data structures, like lists and vectors. module Data.Sequences where import Data.Maybe (fromJust, isJust) -import Data.Monoid (Monoid, mappend, mconcat, mempty) +import Data.Monoid (Monoid, mconcat, mempty) import Data.MonoTraversable import Data.Int (Int64, Int) import qualified Data.List as List @@ -23,23 +25,24 @@ import Control.Arrow ((***), first, second) import Control.Monad (liftM) import qualified Data.Sequence as Seq -import qualified Data.DList as DList import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Storable as VS import Data.String (IsString) import qualified Data.List.NonEmpty as NE import qualified Data.ByteString.Unsafe as SU -import Data.GrowingAppend -import Data.Vector.Instances () import qualified Data.Vector.Generic as VG import qualified Data.Vector.Algorithms.Merge as VAM import Data.Ord (comparing) +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy.Encoding as TL +import Data.Text.Encoding.Error (lenientDecode) +import Data.Word (Word8) --- | 'SemiSequence' was created to share code between 'IsSequence' and 'MinLen'. +-- | 'SemiSequence' was created to share code between 'IsSequence' and 'NonNull'. -- -- @Semi@ means 'SemiGroup' --- A 'SemiSequence' can accomodate a 'SemiGroup' such as 'NonEmpty' or 'MinLen' +-- A 'SemiSequence' can accomodate a 'SemiGroup' such as 'NonEmpty' or 'NonNull' -- A Monoid should be able to fill out 'IsSequence'. -- -- 'SemiSequence' operations maintain the same type because they all maintain the same number of elements or increase them. @@ -48,6 +51,10 @@ -- This type-changing function exists on 'NonNull' as 'nfilter' -- -- 'filter' and other such functions are placed in 'IsSequence' +-- +-- /NOTE/: Like 'GrowingAppend', ideally we'd have a @Semigroup@ superclass +-- constraint here, but that would pull in more dependencies to this package +-- than desired. class (Integral (Index seq), GrowingAppend seq) => SemiSequence seq where -- | The type of the index of a sequence. type Index seq @@ -368,6 +375,18 @@ tailEx :: seq -> seq tailEx = snd . maybe (error "Data.Sequences.tailEx") id . uncons + -- | Safe version of 'tailEx'. + -- + -- Returns 'Nothing' instead of throwing an exception when encountering + -- an empty monomorphic container. + -- + -- @since 1.0.0 + tailMay :: seq -> Maybe seq + tailMay seq + | onull seq = Nothing + | otherwise = Just (tailEx seq) + {-# INLINE tailMay #-} + -- | __Unsafe__ -- -- Get the init of a sequence, throw an exception if the sequence is empty. @@ -379,6 +398,18 @@ initEx :: seq -> seq initEx = fst . maybe (error "Data.Sequences.initEx") id . unsnoc + -- | Safe version of 'initEx'. + -- + -- Returns 'Nothing' instead of throwing an exception when encountering + -- an empty monomorphic container. + -- + -- @since 1.0.0 + initMay :: IsSequence seq => seq -> Maybe seq + initMay seq + | onull seq = Nothing + | otherwise = Just (initEx seq) + {-# INLINE initMay #-} + -- | Equivalent to 'tailEx'. unsafeTail :: seq -> seq unsafeTail = tailEx @@ -410,13 +441,6 @@ unsafeIndex :: seq -> Index seq -> Element seq unsafeIndex = indexEx - -- | 'intercalate' @seq seqs@ inserts @seq@ in between @seqs@ and - -- concatenates the result. - -- - -- Since 0.9.3 - intercalate :: seq -> [seq] -> seq - intercalate = defaultIntercalate - -- | 'splitWhen' splits a sequence into components delimited by separators, -- where the predicate returns True for a separator element. The resulting -- components do not contain the separators. Two adjacent separators result @@ -478,12 +502,6 @@ defaultSortBy f = fromList . sortBy f . otoList {-# INLINE defaultSortBy #-} --- | Default 'intercalate' -defaultIntercalate :: (IsSequence seq) => seq -> [seq] -> seq -defaultIntercalate _ [] = mempty -defaultIntercalate s (seq:seqs) = mconcat (seq : List.map (s `mappend`) seqs) -{-# INLINE defaultIntercalate #-} - -- | Use 'splitWhen' from "Data.List.Split" defaultSplitWhen :: IsSequence seq => (Element seq -> Bool) -> seq -> [seq] defaultSplitWhen f = List.map fromList . List.splitWhen f . otoList @@ -566,7 +584,6 @@ where (matches, nonMatches) = partition ((== f head) . f) tail groupAllOn _ [] = [] - intercalate = List.intercalate splitWhen = List.splitWhen {-# INLINE fromList #-} {-# INLINE break #-} @@ -585,7 +602,6 @@ {-# INLINE replicateM #-} {-# INLINE groupBy #-} {-# INLINE groupAllOn #-} - {-# INLINE intercalate #-} {-# INLINE splitWhen #-} instance SemiSequence (NE.NonEmpty a) where @@ -643,7 +659,6 @@ unsafeTail = SU.unsafeTail splitWhen f s | S.null s = [S.empty] | otherwise = S.splitWith f s - intercalate = S.intercalate {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} @@ -664,7 +679,6 @@ {-# INLINE initEx #-} {-# INLINE unsafeTail #-} {-# INLINE splitWhen #-} - {-# INLINE intercalate #-} index bs i | i >= S.length bs = Nothing @@ -710,7 +724,6 @@ tailEx = T.tail initEx = T.init splitWhen = T.split - intercalate = T.intercalate {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} @@ -728,7 +741,6 @@ {-# INLINE tailEx #-} {-# INLINE initEx #-} {-# INLINE splitWhen #-} - {-# INLINE intercalate #-} index t i | i >= T.length t = Nothing @@ -775,7 +787,6 @@ initEx = L.init splitWhen f s | L.null s = [L.empty] | otherwise = L.splitWith f s - intercalate = L.intercalate {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} @@ -793,7 +804,6 @@ {-# INLINE tailEx #-} {-# INLINE initEx #-} {-# INLINE splitWhen #-} - {-# INLINE intercalate #-} indexEx = L.index unsafeIndex = L.index @@ -835,7 +845,6 @@ tailEx = TL.tail initEx = TL.init splitWhen = TL.split - intercalate = TL.intercalate {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} @@ -853,7 +862,6 @@ {-# INLINE tailEx #-} {-# INLINE initEx #-} {-# INLINE splitWhen #-} - {-# INLINE intercalate #-} indexEx = TL.index unsafeIndex = TL.index @@ -927,30 +935,6 @@ {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} -instance SemiSequence (DList.DList a) where - type Index (DList.DList a) = Int - cons = DList.cons - snoc = DList.snoc - - reverse = defaultReverse - sortBy = defaultSortBy - intersperse = defaultIntersperse - find = defaultFind - {-# INLINE intersperse #-} - {-# INLINE reverse #-} - {-# INLINE find #-} - {-# INLINE sortBy #-} - {-# INLINE cons #-} - {-# INLINE snoc #-} - -instance IsSequence (DList.DList a) where - fromList = DList.fromList - replicate = DList.replicate - tailEx = DList.tail - {-# INLINE fromList #-} - {-# INLINE replicate #-} - {-# INLINE tailEx #-} - instance SemiSequence (V.Vector a) where type Index (V.Vector a) = Int reverse = V.reverse @@ -1173,268 +1157,213 @@ {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} --- | A typeclass for sequences whose elements have the 'Eq' typeclass -class (MonoFoldableEq seq, IsSequence seq, Eq (Element seq)) => EqSequence seq where - - -- | @'splitElem'@ splits a sequence into components delimited by separator - -- element. It's equivalent to 'splitWhen' with equality predicate: - -- - -- > splitElem sep === splitWhen (== sep) - -- - -- Since 0.9.3 - splitElem :: Element seq -> seq -> [seq] - splitElem x = splitWhen (== x) - - -- | @'splitSeq'@ splits a sequence into components delimited by - -- separator subsequence. 'splitSeq' is the right inverse of 'intercalate': - -- - -- > intercalate x . splitSeq x === id - -- - -- 'splitElem' can be considered a special case of 'splitSeq' - -- - -- > splitSeq (singleton sep) === splitElem sep - -- - -- @'splitSeq' mempty@ is another special case: it splits just before each - -- element, and in line with 'splitWhen' rules, it has at least one output - -- component: - -- - -- @ - -- > 'splitSeq' "" "" - -- [""] - -- > 'splitSeq' "" "a" - -- ["", "a"] - -- > 'splitSeq' "" "ab" - -- ["", "a", "b"] - -- @ - -- - -- Since 0.9.3 - splitSeq :: seq -> seq -> [seq] - splitSeq = defaultSplitOn +-- | @'splitElem'@ splits a sequence into components delimited by separator +-- element. It's equivalent to 'splitWhen' with equality predicate: +-- +-- > splitElem sep === splitWhen (== sep) +-- +-- Since 0.9.3 +splitElem :: (IsSequence seq, Eq (Element seq)) => Element seq -> seq -> [seq] +splitElem x = splitWhen (== x) - -- | 'stripPrefix' drops the given prefix from a sequence. - -- It returns 'Nothing' if the sequence did not start with the prefix - -- given, or 'Just' the sequence after the prefix, if it does. - -- - -- @ - -- > 'stripPrefix' "foo" "foobar" - -- 'Just' "foo" - -- > 'stripPrefix' "abc" "foobar" - -- 'Nothing' - -- @ - stripPrefix :: seq -> seq -> Maybe seq - stripPrefix x y = fmap fromList (otoList x `stripPrefix` otoList y) +-- | @'splitSeq'@ splits a sequence into components delimited by +-- separator subsequence. 'splitSeq' is the right inverse of 'intercalate': +-- +-- > intercalate x . splitSeq x === id +-- +-- 'splitElem' can be considered a special case of 'splitSeq' +-- +-- > splitSeq (singleton sep) === splitElem sep +-- +-- @'splitSeq' mempty@ is another special case: it splits just before each +-- element, and in line with 'splitWhen' rules, it has at least one output +-- component: +-- +-- @ +-- > 'splitSeq' "" "" +-- [""] +-- > 'splitSeq' "" "a" +-- ["", "a"] +-- > 'splitSeq' "" "ab" +-- ["", "a", "b"] +-- @ +-- +-- Since 0.9.3 +splitSeq :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> [seq] +splitSeq sep = List.map fromList . List.splitOn (otoList sep) . otoList - -- | 'stripSuffix' drops the given suffix from a sequence. - -- It returns 'Nothing' if the sequence did not end with the suffix - -- given, or 'Just' the sequence before the suffix, if it does. - -- - -- @ - -- > 'stripSuffix' "bar" "foobar" - -- 'Just' "foo" - -- > 'stripSuffix' "abc" "foobar" - -- 'Nothing' - -- @ - stripSuffix :: seq -> seq -> Maybe seq - stripSuffix x y = fmap fromList (otoList x `stripSuffix` otoList y) +-- | 'stripPrefix' drops the given prefix from a sequence. +-- It returns 'Nothing' if the sequence did not start with the prefix +-- given, or 'Just' the sequence after the prefix, if it does. +-- +-- @ +-- > 'stripPrefix' "foo" "foobar" +-- 'Just' "foo" +-- > 'stripPrefix' "abc" "foobar" +-- 'Nothing' +-- @ +stripPrefix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Maybe seq +stripPrefix x y = fmap fromList (otoList x `List.stripPrefix` otoList y) - -- | 'isPrefixOf' takes two sequences and returns 'True' if the first - -- sequence is a prefix of the second. - isPrefixOf :: seq -> seq -> Bool - isPrefixOf x y = otoList x `isPrefixOf` otoList y +-- | 'stripSuffix' drops the given suffix from a sequence. +-- It returns 'Nothing' if the sequence did not end with the suffix +-- given, or 'Just' the sequence before the suffix, if it does. +-- +-- @ +-- > 'stripSuffix' "bar" "foobar" +-- 'Just' "foo" +-- > 'stripSuffix' "abc" "foobar" +-- 'Nothing' +-- @ +stripSuffix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Maybe seq +stripSuffix x y = + fmap fromList (otoList x `stripSuffixList` otoList y) + where + stripSuffixList :: Eq a => [a] -> [a] -> Maybe [a] + stripSuffixList x' y' = fmap reverse (stripPrefix (reverse x') (reverse y')) - -- | 'isSuffixOf' takes two sequences and returns 'True' if the first - -- sequence is a suffix of the second. - isSuffixOf :: seq -> seq -> Bool - isSuffixOf x y = otoList x `isSuffixOf` otoList y +-- | 'isPrefixOf' takes two sequences and returns 'True' if the first +-- sequence is a prefix of the second. +isPrefixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool +isPrefixOf x y = otoList x `List.isPrefixOf` otoList y - -- | 'isInfixOf' takes two sequences and returns 'true' if the first - -- sequence is contained, wholly and intact, anywhere within the second. - isInfixOf :: seq -> seq -> Bool - isInfixOf x y = otoList x `isInfixOf` otoList y +-- | 'isSuffixOf' takes two sequences and returns 'True' if the first +-- sequence is a suffix of the second. +isSuffixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool +isSuffixOf x y = otoList x `List.isSuffixOf` otoList y - -- | Equivalent to @'groupBy' (==)@ - group :: seq -> [seq] - group = groupBy (==) +-- | 'isInfixOf' takes two sequences and returns 'true' if the first +-- sequence is contained, wholly and intact, anywhere within the second. +isInfixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool +isInfixOf x y = otoList x `List.isInfixOf` otoList y - -- | Similar to standard 'group', but operates on the whole collection, - -- not just the consecutive items. - -- - -- Equivalent to @'groupAllOn' id@ - groupAll :: seq -> [seq] - groupAll = groupAllOn id +-- | Equivalent to @'groupBy' (==)@ +group :: (IsSequence seq, Eq (Element seq)) => seq -> [seq] +group = groupBy (==) - -- | - -- - -- @since 0.10.2 - delete :: Element seq -> seq -> seq - delete = deleteBy (==) +-- | Similar to standard 'group', but operates on the whole collection, +-- not just the consecutive items. +-- +-- Equivalent to @'groupAllOn' id@ +groupAll :: (IsSequence seq, Eq (Element seq)) => seq -> [seq] +groupAll = groupAllOn id - -- | - -- - -- @since 0.10.2 - deleteBy :: (Element seq -> Element seq -> Bool) -> Element seq -> seq -> seq - deleteBy eq x = fromList . List.deleteBy eq x . otoList - {-# INLINE splitElem #-} - {-# INLINE splitSeq #-} - {-# INLINE isPrefixOf #-} - {-# INLINE isSuffixOf #-} - {-# INLINE isInfixOf #-} - {-# INLINE stripPrefix #-} - {-# INLINE stripSuffix #-} - {-# INLINE group #-} - {-# INLINE groupAll #-} - {-# INLINE delete #-} - {-# INLINE deleteBy #-} +-- | +-- +-- @since 0.10.2 +delete :: (IsSequence seq, Eq (Element seq)) => Element seq -> seq -> seq +delete = deleteBy (==) -{-# DEPRECATED elem "use oelem" #-} -elem :: EqSequence seq => Element seq -> seq -> Bool -elem = oelem +-- | +-- +-- @since 0.10.2 +deleteBy :: (IsSequence seq, Eq (Element seq)) => (Element seq -> Element seq -> Bool) -> Element seq -> seq -> seq +deleteBy eq x = fromList . List.deleteBy eq x . otoList +{-# INLINE [0] splitElem #-} +{-# INLINE [0] splitSeq #-} +{-# INLINE [0] isPrefixOf #-} +{-# INLINE [0] isSuffixOf #-} +{-# INLINE [0] isInfixOf #-} +{-# INLINE [0] stripPrefix #-} +{-# INLINE [0] stripSuffix #-} +{-# INLINE [0] group #-} +{-# INLINE [0] groupAll #-} +{-# INLINE [0] delete #-} +{-# INLINE [0] deleteBy #-} -{-# DEPRECATED notElem "use onotElem" #-} -notElem :: EqSequence seq => Element seq -> seq -> Bool -notElem = onotElem +{-# RULES "list splitSeq" splitSeq = List.splitOn #-} +{-# RULES "list stripPrefix" stripPrefix = List.stripPrefix #-} +{-# RULES "list isPrefixOf" isPrefixOf = List.isPrefixOf #-} +{-# RULES "list isSuffixOf" isSuffixOf = List.isSuffixOf #-} +{-# RULES "list isInfixOf" isInfixOf = List.isInfixOf #-} +{-# RULES "list delete" delete = List.delete #-} +{-# RULES "list deleteBy" deleteBy = List.deleteBy #-} --- | Use 'splitOn' from "Data.List.Split" -defaultSplitOn :: EqSequence s => s -> s -> [s] -defaultSplitOn sep = List.map fromList . List.splitOn (otoList sep) . otoList +{-# RULES "strict ByteString splitElem" splitElem = splitElemStrictBS #-} +{-# RULES "strict ByteString stripPrefix" stripPrefix = stripPrefixStrictBS #-} +{-# RULES "strict ByteString stripSuffix" stripSuffix = stripSuffixStrictBS #-} +{-# RULES "strict ByteString group" group = S.group #-} +{-# RULES "strict ByteString isPrefixOf" isPrefixOf = S.isPrefixOf #-} +{-# RULES "strict ByteString isSuffixOf" isSuffixOf = S.isSuffixOf #-} +{-# RULES "strict ByteString isInfixOf" isInfixOf = S.isInfixOf #-} -instance Eq a => EqSequence [a] where - splitSeq = List.splitOn - stripPrefix = List.stripPrefix - stripSuffix x y = fmap reverse (List.stripPrefix (reverse x) (reverse y)) - group = List.group - isPrefixOf = List.isPrefixOf - isSuffixOf x y = List.isPrefixOf (List.reverse x) (List.reverse y) - isInfixOf = List.isInfixOf - delete = List.delete - deleteBy = List.deleteBy - {-# INLINE splitSeq #-} - {-# INLINE stripPrefix #-} - {-# INLINE stripSuffix #-} - {-# INLINE group #-} - {-# INLINE isPrefixOf #-} - {-# INLINE isSuffixOf #-} - {-# INLINE isInfixOf #-} - {-# INLINE delete #-} - {-# INLINE deleteBy #-} +splitElemStrictBS :: Word8 -> S.ByteString -> [S.ByteString] +splitElemStrictBS sep s + | S.null s = [S.empty] + | otherwise = S.split sep s -instance EqSequence S.ByteString where - splitElem sep s | S.null s = [S.empty] - | otherwise = S.split sep s - stripPrefix x y - | x `S.isPrefixOf` y = Just (S.drop (S.length x) y) - | otherwise = Nothing - stripSuffix x y - | x `S.isSuffixOf` y = Just (S.take (S.length y - S.length x) y) - | otherwise = Nothing - group = S.group - isPrefixOf = S.isPrefixOf - isSuffixOf = S.isSuffixOf - isInfixOf = S.isInfixOf - {-# INLINE splitElem #-} - {-# INLINE stripPrefix #-} - {-# INLINE stripSuffix #-} - {-# INLINE group #-} - {-# INLINE isPrefixOf #-} - {-# INLINE isSuffixOf #-} - {-# INLINE isInfixOf #-} +stripPrefixStrictBS :: S.ByteString -> S.ByteString -> Maybe S.ByteString +stripPrefixStrictBS x y + | x `S.isPrefixOf` y = Just (S.drop (S.length x) y) + | otherwise = Nothing -instance EqSequence L.ByteString where - splitElem sep s | L.null s = [L.empty] - | otherwise = L.split sep s - stripPrefix x y - | x `L.isPrefixOf` y = Just (L.drop (L.length x) y) - | otherwise = Nothing - stripSuffix x y - | x `L.isSuffixOf` y = Just (L.take (L.length y - L.length x) y) - | otherwise = Nothing - group = L.group - isPrefixOf = L.isPrefixOf - isSuffixOf = L.isSuffixOf - isInfixOf x y = L.unpack x `List.isInfixOf` L.unpack y - {-# INLINE splitElem #-} - {-# INLINE stripPrefix #-} - {-# INLINE stripSuffix #-} - {-# INLINE group #-} - {-# INLINE isPrefixOf #-} - {-# INLINE isSuffixOf #-} - {-# INLINE isInfixOf #-} +stripSuffixStrictBS :: S.ByteString -> S.ByteString -> Maybe S.ByteString +stripSuffixStrictBS x y + | x `S.isSuffixOf` y = Just (S.take (S.length y - S.length x) y) + | otherwise = Nothing -instance EqSequence T.Text where - splitSeq sep | T.null sep = (:) T.empty . List.map singleton . T.unpack - | otherwise = T.splitOn sep - stripPrefix = T.stripPrefix - stripSuffix = T.stripSuffix - group = T.group - isPrefixOf = T.isPrefixOf - isSuffixOf = T.isSuffixOf - isInfixOf = T.isInfixOf - {-# INLINE splitSeq #-} - {-# INLINE stripPrefix #-} - {-# INLINE stripSuffix #-} - {-# INLINE group #-} - {-# INLINE isPrefixOf #-} - {-# INLINE isSuffixOf #-} - {-# INLINE isInfixOf #-} +{-# RULES "lazy ByteString splitElem" splitElem = splitSeqLazyBS #-} +{-# RULES "lazy ByteString stripPrefix" stripPrefix = stripPrefixLazyBS #-} +{-# RULES "lazy ByteString stripSuffix" stripSuffix = stripSuffixLazyBS #-} +{-# RULES "lazy ByteString group" group = L.group #-} +{-# RULES "lazy ByteString isPrefixOf" isPrefixOf = L.isPrefixOf #-} +{-# RULES "lazy ByteString isSuffixOf" isSuffixOf = L.isSuffixOf #-} -instance EqSequence TL.Text where - splitSeq sep | TL.null sep = (:) TL.empty . List.map singleton . TL.unpack - | otherwise = TL.splitOn sep - stripPrefix = TL.stripPrefix - stripSuffix = TL.stripSuffix - group = TL.group - isPrefixOf = TL.isPrefixOf - isSuffixOf = TL.isSuffixOf - isInfixOf = TL.isInfixOf - {-# INLINE splitSeq #-} - {-# INLINE stripPrefix #-} - {-# INLINE stripSuffix #-} - {-# INLINE group #-} - {-# INLINE isPrefixOf #-} - {-# INLINE isSuffixOf #-} - {-# INLINE isInfixOf #-} +splitSeqLazyBS :: Word8 -> L.ByteString -> [L.ByteString] +splitSeqLazyBS sep s + | L.null s = [L.empty] + | otherwise = L.split sep s -instance Eq a => EqSequence (Seq.Seq a) -instance Eq a => EqSequence (V.Vector a) -instance (Eq a, U.Unbox a) => EqSequence (U.Vector a) -instance (Eq a, VS.Storable a) => EqSequence (VS.Vector a) +stripPrefixLazyBS :: L.ByteString -> L.ByteString -> Maybe L.ByteString +stripPrefixLazyBS x y + | x `L.isPrefixOf` y = Just (L.drop (L.length x) y) + | otherwise = Nothing --- | A typeclass for sequences whose elements have the 'Ord' typeclass -class (EqSequence seq, MonoFoldableOrd seq) => OrdSequence seq where - -- | Sort a ordered sequence. - -- - -- @ - -- > 'sort' [4,3,1,2] - -- [1,2,3,4] - -- @ - sort :: seq -> seq - sort = fromList . sort . otoList - {-# INLINE sort #-} +stripSuffixLazyBS :: L.ByteString -> L.ByteString -> Maybe L.ByteString +stripSuffixLazyBS x y + | x `L.isSuffixOf` y = Just (L.take (L.length y - L.length x) y) + | otherwise = Nothing -instance Ord a => OrdSequence [a] where - sort = V.toList . sort . V.fromList - {-# INLINE sort #-} +{-# RULES "strict Text splitSeq" splitSeq = splitSeqStrictText #-} +{-# RULES "strict Text stripPrefix" stripPrefix = T.stripPrefix #-} +{-# RULES "strict Text stripSuffix" stripSuffix = T.stripSuffix #-} +{-# RULES "strict Text group" group = T.group #-} +{-# RULES "strict Text isPrefixOf" isPrefixOf = T.isPrefixOf #-} +{-# RULES "strict Text isSuffixOf" isSuffixOf = T.isSuffixOf #-} +{-# RULES "strict Text isInfixOf" isInfixOf = T.isInfixOf #-} -instance OrdSequence S.ByteString where - sort = S.sort - {-# INLINE sort #-} +splitSeqStrictText :: T.Text -> T.Text -> [T.Text] +splitSeqStrictText sep + | T.null sep = (:) T.empty . List.map singleton . T.unpack + | otherwise = T.splitOn sep -instance OrdSequence L.ByteString -instance OrdSequence T.Text -instance OrdSequence TL.Text -instance Ord a => OrdSequence (Seq.Seq a) +{-# RULES "lazy Text splitSeq" splitSeq = splitSeqLazyText #-} +{-# RULES "lazy Text stripPrefix" stripPrefix = TL.stripPrefix #-} +{-# RULES "lazy Text stripSuffix" stripSuffix = TL.stripSuffix #-} +{-# RULES "lazy Text group" group = TL.group #-} +{-# RULES "lazy Text isPrefixOf" isPrefixOf = TL.isPrefixOf #-} +{-# RULES "lazy Text isSuffixOf" isSuffixOf = TL.isSuffixOf #-} +{-# RULES "lazy Text isInfixOf" isInfixOf = TL.isInfixOf #-} -instance Ord a => OrdSequence (V.Vector a) where - sort = vectorSort - {-# INLINE sort #-} +splitSeqLazyText :: TL.Text -> TL.Text -> [TL.Text] +splitSeqLazyText sep + | TL.null sep = (:) TL.empty . List.map singleton . TL.unpack + | otherwise = TL.splitOn sep -instance (Ord a, U.Unbox a) => OrdSequence (U.Vector a) where - sort = vectorSort - {-# INLINE sort #-} +-- | Sort a ordered sequence. +-- +-- @ +-- > 'sort' [4,3,1,2] +-- [1,2,3,4] +-- @ +sort :: (IsSequence seq, Ord (Element seq)) => seq -> seq +sort = fromList . V.toList . vectorSort . V.fromList . otoList +{-# INLINE [0] sort #-} -instance (Ord a, VS.Storable a) => OrdSequence (VS.Vector a) where - sort = vectorSort - {-# INLINE sort #-} +{-# RULES "strict ByteString sort" sort = S.sort #-} +{-# RULES "boxed Vector sort" forall (v :: V.Vector a). sort v = vectorSort v #-} +{-# RULES "unboxed Vector sort" forall (v :: U.Unbox a => U.Vector a). sort v = vectorSort v #-} +{-# RULES "storable Vector sort" forall (v :: VS.Storable a => VS.Vector a). sort v = vectorSort v #-} -- | A typeclass for sequences whose elements are 'Char's. class (IsSequence t, IsString t, Element t ~ Char) => Textual t where @@ -1453,7 +1382,7 @@ -- > 'unwords' ["abc","def","ghi"] -- "abc def ghi" -- @ - unwords :: [t] -> t + unwords :: (Element seq ~ t, MonoFoldable seq) => seq -> t -- | Break up a textual sequence at newline characters. -- @@ -1470,7 +1399,7 @@ -- > 'unlines' ["abc","def","ghi"] -- "abc\\ndef\\nghi" -- @ - unlines :: [t] -> t + unlines :: (Element seq ~ t, MonoFoldable seq) => seq -> t -- | Convert a textual sequence to lower-case. -- @@ -1520,9 +1449,9 @@ instance (c ~ Char) => Textual [c] where words = List.words - unwords = List.unwords + unwords = List.unwords . otoList lines = List.lines - unlines = List.unlines + unlines = List.unlines . otoList toLower = TL.unpack . TL.toLower . TL.pack toUpper = TL.unpack . TL.toUpper . TL.pack toCaseFold = TL.unpack . TL.toCaseFold . TL.pack @@ -1536,9 +1465,9 @@ instance Textual T.Text where words = T.words - unwords = T.unwords + unwords = T.unwords . otoList lines = T.lines - unlines = T.unlines + unlines = T.unlines . otoList toLower = T.toLower toUpper = T.toUpper toCaseFold = T.toCaseFold @@ -1552,9 +1481,9 @@ instance Textual TL.Text where words = TL.words - unwords = TL.unwords + unwords = TL.unwords . otoList lines = TL.lines - unlines = TL.unlines + unlines = TL.unlines . otoList toLower = TL.toLower toUpper = TL.toUpper toCaseFold = TL.toCaseFold @@ -1581,3 +1510,69 @@ sortOn :: (Ord o, SemiSequence seq) => (Element seq -> o) -> seq -> seq sortOn = sortBy . comparing {-# INLINE sortOn #-} + +-- | Lazy sequences containing strict chunks of data. +-- +-- @since 1.0.0 +class (IsSequence lazy, IsSequence strict) => LazySequence lazy strict | lazy -> strict, strict -> lazy where + toChunks :: lazy -> [strict] + fromChunks :: [strict] -> lazy + toStrict :: lazy -> strict + fromStrict :: strict -> lazy + +instance LazySequence L.ByteString S.ByteString where + toChunks = L.toChunks + fromChunks = L.fromChunks + toStrict = S.concat . L.toChunks + fromStrict = L.fromChunks . return + +instance LazySequence TL.Text T.Text where + toChunks = TL.toChunks + fromChunks = TL.fromChunks + toStrict = TL.toStrict + fromStrict = TL.fromStrict + +-- | Synonym for 'fromList' +-- +-- @since 1.0.0 +pack :: IsSequence seq => [Element seq] -> seq +pack = fromList +{-# INLINE pack #-} + +-- | Synonym for 'otoList' +-- +-- @since 1.0.0 +unpack :: MonoFoldable mono => mono -> [Element mono] +unpack = otoList +{-# INLINE unpack #-} + +-- | Repack from one type to another, dropping to a list in the middle. +-- +-- @repack = pack . unpack@. +-- +-- @since 1.0.0 +repack :: (MonoFoldable a, IsSequence b, Element a ~ Element b) => a -> b +repack = pack . unpack + +-- | Textual data which can be encoded to and decoded from UTF8. +-- +-- @since 1.0.0 +class (Textual textual, IsSequence binary) => Utf8 textual binary | textual -> binary, binary -> textual where + -- | Encode from textual to binary using UTF-8 encoding + -- + -- @since 1.0.0 + encodeUtf8 :: textual -> binary + -- | Note that this function is required to be pure. In the case of + -- a decoding error, Unicode replacement characters must be used. + -- + -- @since 1.0.0 + decodeUtf8 :: binary -> textual +instance (c ~ Char, w ~ Word8) => Utf8 [c] [w] where + encodeUtf8 = L.unpack . TL.encodeUtf8 . TL.pack + decodeUtf8 = TL.unpack . TL.decodeUtf8With lenientDecode . L.pack +instance Utf8 T.Text S.ByteString where + encodeUtf8 = T.encodeUtf8 + decodeUtf8 = T.decodeUtf8With lenientDecode +instance Utf8 TL.Text L.ByteString where + encodeUtf8 = TL.encodeUtf8 + decodeUtf8 = TL.decodeUtf8With lenientDecode diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -10,15 +10,14 @@ import Data.Sequences import qualified Data.Sequence as Seq import qualified Data.NonNull as NN -import Data.ByteVector import Data.Monoid (mempty, mconcat) import Data.Maybe (fromMaybe) +import qualified Data.List as List import Test.Hspec import Test.Hspec.QuickCheck import Test.HUnit ((@?=)) import Test.QuickCheck hiding (NonEmptyList(..)) -import qualified Test.QuickCheck as QC import qualified Test.QuickCheck.Modifiers as QCM import Data.Text (Text) @@ -34,20 +33,21 @@ import qualified Data.Map as Map import qualified Data.IntMap as IntMap import qualified Data.HashMap.Strict as HashMap -import qualified Data.IntSet as IntSet import qualified Data.Set as Set import qualified Control.Foldl as Foldl -import Control.Arrow (first, second) +import Control.Arrow (second) import Control.Applicative import Control.Monad.Trans.Writer -import Prelude (Bool (..), ($), IO, min, abs, Eq (..), (&&), fromIntegral, Ord (..), String, mod, Int, Integer, show, - return, asTypeOf, (.), Show, id, (+), succ, Maybe (..), (*), mod, map, flip, otherwise, (-), div, seq, maybe) +import Prelude (Bool (..), ($), IO, Eq (..), fromIntegral, Ord (..), String, mod, Int, Integer, show, + return, asTypeOf, (.), Show, (+), succ, Maybe (..), (*), mod, map, flip, otherwise, (-), div, maybe) import qualified Prelude -instance Arbitrary a => Arbitrary (NE.NonEmpty a) where - arbitrary = (NE.:|) <$> arbitrary <*> arbitrary +newtype NonEmpty' a = NonEmpty' (NE.NonEmpty a) + deriving (Show, Eq) +instance Arbitrary a => Arbitrary (NonEmpty' a) where + arbitrary = NonEmpty' <$> ((NE.:|) <$> arbitrary <*> arbitrary) -- | Arbitrary newtype for key-value pairs without any duplicate keys -- and is not empty @@ -99,7 +99,7 @@ describe "osum" $ do prop "works on lists" $ \(Small x) (Small y) -> - y >= x ==> osum [x..y] @?= ((x + y) * (y - x + 1) `div` 2) + y >= x ==> osum [x..y] @?= ((x + y) * (y - x + 1) `div` (2 :: Int)) describe "oproduct" $ do prop "works on lists" $ \(Positive x) (Positive y) -> @@ -203,14 +203,14 @@ describe "NonNull" $ do describe "fromNonEmpty" $ do - prop "toMinList" $ \ne -> + prop "toMinList" $ \(NonEmpty' ne) -> (NE.toList ne :: [Int]) @?= NN.toNullable (NN.toMinList ne) let -- | Type restricted 'NN.ncons' nconsAs :: IsSequence seq => Element seq -> [Element seq] -> seq -> NN.NonNull seq nconsAs x xs _ = NN.ncons x (fromList xs) - test :: (OrdSequence typ, Arbitrary (Element typ), Show (Element typ), Show typ, Eq typ, Eq (Element typ)) + test :: (IsSequence typ, Ord (Element typ), Arbitrary (Element typ), Show (Element typ), Show typ, Eq typ, Eq (Element typ)) => String -> typ -> Spec test typ du = describe typ $ do prop "head" $ \x xs -> @@ -309,15 +309,15 @@ in updateMap f k (mapFromListAs xs dummy) @?= mapFromList (updateMap f k xs) - prop "updateWithKey" $ \(DuplPairs xs) k -> + prop "updateWithKey" $ \(DuplPairs xs) k' -> let f k i = if i < 0 then Nothing else Just $ i * k - in updateWithKey f k (mapFromListAs xs dummy) - @?= mapFromList (updateWithKey f k xs) + in updateWithKey f k' (mapFromListAs xs dummy) + @?= mapFromList (updateWithKey f k' xs) - prop "updateLookupWithKey" $ \(DuplPairs xs) k -> + prop "updateLookupWithKey" $ \(DuplPairs xs) k' -> let f k i = if i < 0 then Nothing else Just $ i * k - in updateLookupWithKey f k (mapFromListAs xs dummy) - @?= second mapFromList (updateLookupWithKey f k xs) + in updateLookupWithKey f k' (mapFromListAs xs dummy) + @?= second mapFromList (updateLookupWithKey f k' xs) prop "alter" $ \(DuplPairs xs) k -> let m = mapFromListAs xs dummy @@ -393,9 +393,9 @@ describe "Intercalate" $ do let test typ dummy = describe typ $ do prop "intercalate === defaultIntercalate" $ \list lists -> - let seq = fromListAs list dummy + let seq' = fromListAs list dummy seqs = map (`fromListAs` dummy) lists - in intercalate seq seqs @?= defaultIntercalate seq seqs + in ointercalate seq' seqs @?= fromList (List.intercalate list lists) test "List" ([] :: [Int]) test "Vector" (V.empty :: V.Vector Int) test "Storable Vector" (VS.empty :: VS.Vector Int) @@ -412,7 +412,7 @@ prop "intercalate sep . splitSeq sep === id" $ \(fromList' -> sep) -> \(mconcat . map (maybe sep fromList') -> xs) -> - intercalate sep (splitSeq sep xs) @?= xs + ointercalate sep (splitSeq sep xs) @?= xs prop "splitSeq mempty xs === mempty : map singleton (otoList xs)" $ \input -> splitSeq mempty (fromList' input) @?= mempty : map singleton input @@ -421,7 +421,7 @@ splitSeq sep mempty @?= [mempty] prop "intercalate (singleton sep) . splitElem sep === id" $ \sep -> \(fromSepList sep -> xs) -> - intercalate (singleton sep) (splitElem sep xs) @?= xs + ointercalate (singleton sep) (splitElem sep xs) @?= xs prop "length . splitElem sep === succ . length . filter (== sep)" $ \sep -> \(fromSepList sep -> xs) -> olength (splitElem sep xs) @?= olength (filter (== sep) xs) + 1 @@ -443,19 +443,12 @@ test "Strict Text" T.empty test "Lazy Text" TL.empty - describe "Data.ByteVector" $ do - prop "toByteVector" $ \ws -> - (otoList . toByteVector . fromList $ ws) @?= ws - - prop "fromByteVector" $ \ws -> - (otoList . fromByteVector . fromList $ ws) @?= ws - describe "Other Issues" $ do it "#26 headEx on a list works" $ headEx (1 : filter Prelude.odd [2,4..]) @?= (1 :: Int) it "#31 find doesn't infinitely loop on NonEmpty" $ - find (== "a") ("a" NE.:| ["d","fgf"]) @?= Just "a" + find (== "a") ("a" NE.:| ["d","fgf"]) @?= Just ("a" :: String) it "#83 head on Seq works correctly" $ do headEx (Seq.fromList [1 :: Int,2,3]) @?= (1 :: Int)