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.9.0.1 +version: 0.9.0.2 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 @@ -51,6 +51,7 @@ , bytestring , text , hspec + , HUnit , transformers , vector , QuickCheck diff --git a/src/Data/MinLen.hs b/src/Data/MinLen.hs --- a/src/Data/MinLen.hs +++ b/src/Data/MinLen.hs @@ -52,20 +52,46 @@ import Control.Monad (liftM) -- $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. +-- 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. +-- | '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 @@ -73,12 +99,30 @@ toValueNat (Succ nat) = 1 + toValueNat nat typeNat = Succ typeNat --- | Adds two type-level naturals. See the 'mlappend' type signature for an example. +-- | 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. +-- | 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 @@ -89,26 +133,35 @@ -- -- 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 atleast one element, then, are typed with @Succ nat@, +-- 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 +-- @ +-- '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: +-- 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]}) +-- @ +-- > '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 = 1 `mlcons` toMinLenZero [] --- > > :i xs --- > xs :: Num t => MinLen (Succ Zero) [t] -newtype MinLen nat mono = MinLen { unMinLen :: mono } - deriving (Eq, Ord, Read, Show, Data, Typeable, Functor) +-- @ +-- > 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, Functor) + type instance Element (MinLen nat mono) = Element mono deriving instance MonoFunctor mono => MonoFunctor (MinLen nat mono) deriving instance MonoFoldable mono => MonoFoldable (MinLen nat mono) @@ -141,6 +194,7 @@ opoint = MinLen . opoint {-# INLINE opoint #-} +-- | Get the 'typeNat' of a 'MinLen' container. natProxy :: TypeNat nat => MinLen nat mono -> nat natProxy _ = typeNat @@ -149,24 +203,30 @@ -- -- ==== __Examples__ -- --- > > 1 `mlcons` toMinLenZero [] --- > MinLen {unMinLen = [1]} +-- @ +-- > 1 \`mlcons` 'toMinLenZero' [] +-- 'MinLen' {unMinLen = [1]} +-- @ toMinLenZero :: (MonoFoldable mono) => mono -> MinLen Zero mono toMinLenZero = MinLen --- | Attempts to add a 'MinLen' constraint to a 'MonoFoldable'. +-- | 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]) +-- @ +-- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) +-- > xs +-- 'Just' ('MinLen' {unMinLen = [1,2,3]}) -- --- > > toMinLen [] :: Maybe (MinLen (Succ Zero) [Int]) --- > Nothing +-- > :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 @@ -176,17 +236,21 @@ nat = natProxy res' res' = MinLen mono --- | Although this function itself cannot cause a segfault, it breaks the --- safety guarantees of @MinLen@ and can lead to a segfault when using +-- | __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] --- > > length xs --- > 0 --- > > head xs --- > *** Exception: Data.MonoTraversable.headEx: empty +-- @ +-- > let xs = 'unsafeToMinLen' [] :: 'MinLen' ('Succ' 'Zero') ['Int'] +-- > 'olength' xs +-- 0 +-- > 'head' xs +-- *** Exception: Data.MonoTraversable.headEx: empty +-- @ unsafeToMinLen :: mono -> MinLen nat mono unsafeToMinLen = MinLen @@ -196,51 +260,69 @@ -- -- ==== __Examples__ -- --- > > let xs = unsafeToMinLen [1,2,3] :: MinLen (Succ Zero) [Int] --- > > 0 `mlcons` xs --- > MinLen {unMinLen = [0,1,2,3]} +-- @ +-- > 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 #-} --- | Concatenates two sequences, adding their minimum lengths together. +-- | 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]} +-- @ +-- > 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 #-} --- | Returns the first element. +-- | 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 #-} --- | Returns the last element. +-- | 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]}) +-- @ +-- > 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]}) +-- @ +-- > 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 @@ -248,50 +330,67 @@ -- -- ==== __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] +-- @ +-- > 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) --- | Maps a function that returns a 'Semigroup' over the container, then joins those semigroups together. +-- | 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" +-- @ +-- > 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 #-} --- | Joins a list of 'Semigroups' together. +-- | 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" +-- @ +-- > 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 #-} --- | A right fold that has no base case, and thus may only be applied to non-empty structures. +-- | Right-associative fold of a monomorphic container with no base element. -- --- @'foldr1' f = 'Prelude.foldr1' f . 'otoList'@ +-- 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" +-- @ +-- > 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 @@ -299,16 +398,21 @@ ofoldr1 f = ofoldr1Ex f . unMinLen {-# INLINE ofoldr1 #-} --- | A variant of 'ofoldl'' that has no base case, --- and thus may only be applied to non-empty structures. +-- | Strict left-associative fold of a monomorphic container with no base +-- element. -- --- @'foldl1' f = 'Prelude.foldl1' f . 'otoList'@ +-- 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" +-- @ +-- > 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 @@ -316,33 +420,47 @@ ofoldl1' f = ofoldl1Ex' f . unMinLen {-# INLINE ofoldl1' #-} --- | Like Data.List.'Data.List.maximum', but not partial on a MonoFoldable. +-- | 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 +-- @ +-- > 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 #-} --- | Like Data.List.'Data.List.minimum', but not partial on a MonoFoldable. +-- | 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 +-- @ +-- > 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 #-} --- | Like Data.List.'Data.List.maximumBy', but not partial on a MonoFoldable. +-- | 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 @@ -350,7 +468,11 @@ maximumBy cmp = maximumByEx cmp . unMinLen {-# INLINE maximumBy #-} --- | Like Data.List.'Data.List.minimumBy', but not partial on a MonoFoldable. +-- | 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 diff --git a/src/Data/MonoTraversable.hs b/src/Data/MonoTraversable.hs --- a/src/Data/MonoTraversable.hs +++ b/src/Data/MonoTraversable.hs @@ -301,7 +301,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See "Data.NonNull" for a total version of this function./ + -- /See 'Data.MinLen.ofoldMap1' from "Data.MinLen" 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) @@ -311,7 +311,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See "Data.NonNull" for a total version of this function./ + -- /See 'Data.MinLen.ofoldr1Ex' from "Data.MinLen" 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 @@ -324,7 +324,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See "Data.NonNull" for a total version of this function./ + -- /See 'Data.MinLen.ofoldl1Ex'' from "Data.MinLen" 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 @@ -336,7 +336,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See "Data.NonNull" for a total version of this function./ + -- /See 'Data.MinLen.head' from "Data.MinLen" for a total version of this function./ headEx :: mono -> Element mono headEx = ofoldr const (Prelude.error "Data.MonoTraversable.headEx: empty") {-# INLINE headEx #-} @@ -346,7 +346,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See "Data.NonNull" for a total version of this function./ + -- /See 'Data.MinLen.last from "Data.MinLen" for a total version of this function./ lastEx :: mono -> Element mono lastEx = ofoldl1Ex' (flip const) {-# INLINE lastEx #-} @@ -361,13 +361,13 @@ unsafeLast = lastEx {-# INLINE unsafeLast #-} - -- | Get the minimum element of a monomorphic container, + -- | Get the maximum element of a monomorphic container, -- using a supplied element ordering function. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See "Data.NonNull" for a total version of this function./ + -- /See 'Data.MinLen.maximiumBy' from "Data.MinLen" for a total version of this function./ maximumByEx :: (Element mono -> Element mono -> Ordering) -> mono -> Element mono maximumByEx f = ofoldl1Ex' go @@ -378,13 +378,13 @@ _ -> x {-# INLINE maximumByEx #-} - -- | Get the maximum element of a monomorphic container, + -- | Get the minimum element of a monomorphic container, -- using a supplied element ordering function. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See "Data.NonNull" for a total version of this function./ + -- /See 'Data.MinLen.minimumBy' from "Data.MinLen" for a total version of this function./ minimumByEx :: (Element mono -> Element mono -> Ordering) -> mono -> Element mono minimumByEx f = ofoldl1Ex' go @@ -834,7 +834,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See "Data.NonNull" for a total version of this function./ + -- /See 'Data.MinLen.maximum' from "Data.MinLen" for a total version of this function./ maximumEx :: mono -> Element mono maximumEx = maximumByEx compare {-# INLINE maximumEx #-} @@ -844,7 +844,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- - -- /See "Data.NonNull" for a total version of this function./ + -- /See 'Data.MinLen.minimum' from "Data.MinLen" for a total version of this function./ minimumEx :: mono -> Element mono minimumEx = minimumByEx compare {-# INLINE minimumEx #-} diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,14 +1,21 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE ScopedTypeVariables #-} module Spec where +import Data.MonoTraversable +import Data.Containers +import Data.Sequences +import qualified Data.Sequence as Seq +import qualified Data.NonNull as NN +import Data.ByteVector + import Test.Hspec import Test.Hspec.QuickCheck -import Test.QuickCheck (Arbitrary(..)) -import Data.MonoTraversable +import Test.HUnit ((@?=)) +import Test.QuickCheck hiding (NonEmptyList(..)) +import qualified Test.QuickCheck.Modifiers as QCM + import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL @@ -17,120 +24,160 @@ import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Storable as VS -import Data.Sequences -import Prelude (Bool (..), ($), IO, min, abs, Eq (..), (&&), fromIntegral, Ord (..), String, mod, Int, show, - return, asTypeOf, (.), Show, id, (+), succ, Maybe (..), (*), mod, map, flip, otherwise, (-), div, seq) -import qualified Prelude -import Control.Monad.Trans.Writer -import qualified Data.NonNull as NN import qualified Data.List.NonEmpty as NE import qualified Data.Semigroup as SG import qualified Data.Map as Map import qualified Data.IntMap as IntMap import qualified Data.HashMap.Strict as HashMap -import Data.Containers import qualified Data.IntSet as IntSet -import Control.Arrow (first, second) +import qualified Data.Set as Set import qualified Control.Foldl as Foldl -import Data.Int (Int64) -import Data.ByteVector -import Control.Monad (liftM2) -import qualified Data.Sequence as Seq +import Control.Arrow (first, 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) +import qualified Prelude + instance Arbitrary a => Arbitrary (NE.NonEmpty a) where - arbitrary = liftM2 (NE.:|) arbitrary arbitrary + arbitrary = (NE.:|) <$> arbitrary <*> arbitrary +-- | Arbitrary newtype for key-value pairs without any duplicate keys +-- and is not empty +newtype DuplPairs k v = DuplPairs { unDupl :: [(k,v)] } + deriving (Eq, Show) + +removeDuplicateKeys :: Ord k => [(k,v)] -> [(k,v)] +removeDuplicateKeys m = go Set.empty m + where go _ [] = [] + go used ((k,v):xs) + | k `member` used = go used xs + | otherwise = (k,v) : go (insertSet k used) xs + +instance (Arbitrary k, Arbitrary v, Ord k, Eq v) => Arbitrary (DuplPairs k v) where + arbitrary = DuplPairs . removeDuplicateKeys <$> arbitrary `suchThat` (/= []) + shrink (DuplPairs xs) = + map (DuplPairs . removeDuplicateKeys) $ filter (/= []) $ shrink xs + +-- | Arbitrary newtype for small lists whose length is <= 10 +-- +-- Used for testing 'unionsWith' +newtype SmallList a = SmallList { getSmallList :: [a] } + deriving (Eq, Show, Ord) + +instance (Arbitrary a) => Arbitrary (SmallList a) where + arbitrary = SmallList <$> arbitrary `suchThat` ((<= 10) . olength) + shrink (SmallList xs) = + map SmallList $ filter ((<= 10) . olength) $ shrink xs + +-- | Choose a random key from a key-value pair list +indexIn :: (Show k, Testable prop) => [(k,v)] -> (k -> prop) -> Property +indexIn = forAll . elements . map Prelude.fst + +-- | Type restricted 'fromList' +fromListAs :: IsSequence a => [Element a] -> a -> a +fromListAs xs _ = fromList xs + +-- | Type restricted 'mapFromListAs' +mapFromListAs :: IsMap a => [(ContainerKey a, MapValue a)] -> a -> a +mapFromListAs xs _ = mapFromList xs + main :: IO () main = hspec $ do - describe "cnull" $ do - it "empty list" $ onull [] `shouldBe` True - it "non-empty list" $ onull [()] `shouldBe` False - it "empty text" $ onull ("" :: Text) `shouldBe` True - it "non-empty text" $ onull ("foo" :: Text) `shouldBe` False + describe "onull" $ do + it "works on empty lists" $ onull [] @?= True + it "works on non-empty lists" $ onull [()] @?= False + it "works on empty texts" $ onull ("" :: Text) @?= True + it "works on non-empty texts" $ onull ("foo" :: Text) @?= False + describe "osum" $ do - it "list" $ do - let x = 1 - -- explicitly using Int64 to avoid overflow issues, see: - -- https://github.com/snoyberg/mono-traversable/issues/29 - y = 10000000 :: Int64 - list = [x..y] - osum list `shouldBe` ((x + y) * (y - x + 1) `div` 2) + prop "works on lists" $ \(Small x) (Small y) -> + y >= x ==> osum [x..y] @?= ((x + y) * (y - x + 1) `div` 2) + describe "oproduct" $ do - it "list" $ do - let x = 1 - y = 10000000 :: Int64 - list = [x..y] - fact n = - go 1 1 - where - go i j - | i `seq` j `seq` j >= n = i - | otherwise = go (i * j) (j + 1) - oproduct list `shouldBe` fact y `div` (fact (x - 1)) - describe "clength" $ do - prop "list" $ \i' -> - let x = replicate i () :: [()] - i = min 500 $ abs i' - in olength x == i - prop "text" $ \i' -> - let x = replicate i 'a' :: Text - i = min 500 $ abs i' - in olength x == i - prop "lazy bytestring" $ \i' -> - let x = replicate i 6 :: L.ByteString - i = min 500 $ abs i' - in olength64 x == i - describe "ccompareLength" $ do - prop "list" $ \i' j -> - let i = min 500 $ abs i' - x = replicate i () :: [()] - in ocompareLength x j == compare i j + prop "works on lists" $ \(Positive x) (Positive y) -> + let fact n = oproduct [1..n] + in (y :: Integer) > (x :: Integer) ==> + oproduct [x..y] @?= fact y `div` fact (x - 1) + + describe "olength" $ do + prop "works on lists" $ \(NonNegative i) -> + olength (replicate i () :: [()]) @?= i + prop "works on texts" $ \(NonNegative i) -> + olength (replicate i 'a' :: Text) @?= i + prop "works on lazy bytestrings" $ \(NonNegative (Small i)) -> + olength64 (replicate i 6 :: L.ByteString) @?= i + + describe "omap" $ do + prop "works on lists" $ \xs -> + omap (+1) xs @?= map (+1) (xs :: [Int]) + prop "works on lazy bytestrings" $ \xs -> + omap (+1) (fromList xs :: L.ByteString) @?= fromList (map (+1) xs) + prop "works on texts" $ \xs -> + omap succ (fromList xs :: Text) @?= fromList (map succ xs) + + describe "oconcatMap" $ do + prop "works on lists" $ \xs -> + oconcatMap (: []) xs @?= (xs :: [Int]) + + describe "ocompareLength" $ do + prop "works on lists" $ \(Positive i) j -> + ocompareLength (replicate i () :: [()]) j @?= compare i j + describe "groupAll" $ do - it "list" $ groupAll ("abcabcabc" :: String) == ["aaa", "bbb", "ccc"] - it "Text" $ groupAll ("abcabcabc" :: Text) == ["aaa", "bbb", "ccc"] + it "works on lists" $ groupAll ("abcabcabc" :: String) @?= ["aaa", "bbb", "ccc"] + it "works on texts" $ groupAll ("abcabcabc" :: Text) @?= ["aaa", "bbb", "ccc"] + describe "unsnoc" $ do - let test name dummy = prop name $ \xs -> - let seq' = fromList xs `asTypeOf` dummy - in case (unsnoc seq', onull seq', onull xs) of - (Nothing, True, True) -> return () - (Just (y, z), False, False) -> do - (y SG.<> singleton z) `shouldBe` seq' - snoc y z `shouldBe` seq' - otoList (snoc y z) `shouldBe` xs - x -> Prelude.error $ show x - test "list" ([] :: [Int]) - test "Text" ("" :: Text) - test "lazy ByteString" L.empty + let test name dummy = prop name $ \(QCM.NonEmpty xs) -> + let seq' = fromListAs xs dummy + in case unsnoc seq' of + Just (y, z) -> do + y SG.<> singleton z @?= seq' + snoc y z @?= seq' + otoList (snoc y z) @?= xs + Nothing -> expectationFailure "unsnoc returned Nothing" + test "works on lists" ([] :: [Int]) + test "works on texts" ("" :: Text) + test "works on lazy bytestrings" L.empty + describe "index" $ do - let test name dummy = prop name $ \(abs -> i) xs -> - let seq' = fromList xs `asTypeOf` dummy - mx = index xs (fromIntegral i) - in mx == index seq' i && - (case mx of - Nothing -> True - Just x -> indexEx seq' i == x && - unsafeIndex seq' i == x) - test "list" ([] :: [Int]) - test "Text" ("" :: Text) - test "lazy Text" ("" :: TL.Text) - test "ByteString" S.empty - test "lazy ByteString" L.empty - test "Vector" (V.singleton (1 :: Int)) - test "SVector" (VS.singleton (1 :: Int)) - test "UVector" (U.singleton (1 :: Int)) - test "Seq" (Seq.fromList [1 :: Int]) + let test name dummy = prop name $ + \(NonNegative i) (QCM.NonEmpty xs) -> + let seq' = fromListAs xs dummy + mx = index xs (fromIntegral i) + in do + mx @?= index seq' i + case mx of + Nothing -> return () + Just x -> indexEx seq' i @?= x + test "works on lists" ([] :: [Int]) + test "works on strict texts" ("" :: Text) + test "works on lazy texts" ("" :: TL.Text) + test "works on strict bytestrings" S.empty + test "works on lazy bytestrings" L.empty + test "works on Vector" (V.singleton (1 :: Int)) + test "works on SVector" (VS.singleton (1 :: Int)) + test "works on UVector" (U.singleton (1 :: Int)) + test "works on Seq" (Seq.fromList [1 :: Int]) + describe "groupAllOn" $ do - it "list" $ groupAllOn (`mod` 3) ([1..9] :: [Int]) == [[1, 4, 7], [2, 5, 8], [3, 6, 9]] + it "works on lists" $ + groupAllOn (`mod` 3) ([1..9] :: [Int]) @?= [[1, 4, 7], [2, 5, 8], [3, 6, 9]] + describe "breakWord" $ do - let test x y z = it (show (x, y, z)) $ breakWord (x :: Text) `shouldBe` (y, z) + let test x y z = it (show (x, y, z)) $ breakWord (x :: Text) @?= (y, z) test "hello world" "hello" "world" test "hello world" "hello" "world" test "hello\r\nworld" "hello" "world" test "hello there world" "hello" "there world" test "" "" "" test "hello \n\r\t" "hello" "" + describe "breakLine" $ do - let test x y z = it (show (x, y, z)) $ breakLine (x :: Text) `shouldBe` (y, z) + let test x y z = it (show (x, y, z)) $ breakLine (x :: Text) @?= (y, z) test "hello world" "hello world" "" test "hello\r\n world" "hello" " world" test "hello\n world" "hello" " world" @@ -139,214 +186,214 @@ test "hello\r\nthere\nworld" "hello" "there\nworld" test "hello\n\r\nworld" "hello" "\r\nworld" test "" "" "" + describe "omapM_" $ do let test typ dummy = prop typ $ \input -> - let res = execWriter $ omapM_ (tell . return) (fromList input `asTypeOf` dummy) - in res == input - test "strict ByteString" S.empty - test "lazy ByteString" L.empty - test "strict Text" T.empty - test "lazy Text" TL.empty + input @?= execWriter (omapM_ (tell . return) (fromListAs input dummy)) + test "works on strict bytestrings" S.empty + test "works on lazy bytestrings" L.empty + test "works on strict texts" T.empty + test "works on lazy texts" TL.empty + describe "NonNull" $ do describe "fromNonEmpty" $ do - prop "toMinList" $ \(ne :: NE.NonEmpty Int) -> - let m = NN.toMinList ne - in NE.toList ne `shouldBe` NN.toNullable m + prop "toMinList" $ \ne -> + (NE.toList ne :: [Int]) @?= NN.toNullable (NN.toMinList ne) - let test' forceTyp typ dummy = describe typ $ do + 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)) + => String -> typ -> Spec + test typ du = describe typ $ do prop "head" $ \x xs -> - let nn = forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy) - in NN.head nn `shouldBe` x + NN.head (nconsAs x xs du) @?= x prop "tail" $ \x xs -> - let nn = forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy) - in NN.tail nn `shouldBe` fromList xs + NN.tail (nconsAs x xs du) @?= fromList xs prop "last" $ \x xs -> - let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy) - in NN.last nn `shouldBe` x + NN.last (reverse $ nconsAs x xs du) @?= x prop "init" $ \x xs -> - let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy) - in NN.init nn `shouldBe` reverse (fromList xs) + NN.init (reverse $ nconsAs x xs du) @?= reverse (fromList xs) prop "maximum" $ \x xs -> - let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy) - in NN.maximum nn `shouldBe` Prelude.maximum (x:xs) + NN.maximum (nconsAs x xs du) @?= Prelude.maximum (x:xs) prop "maximumBy" $ \x xs -> - let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy) - in NN.maximumBy compare nn `shouldBe` Prelude.maximum (x:xs) + NN.maximumBy compare (nconsAs x xs du) @?= Prelude.maximum (x:xs) prop "minimum" $ \x xs -> - let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy) - in NN.minimum nn `shouldBe` Prelude.minimum (x:xs) + NN.minimum (nconsAs x xs du) @?= Prelude.minimum (x:xs) prop "minimumBy" $ \x xs -> - let nn = reverse $ forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy) - in NN.minimumBy compare nn `shouldBe` Prelude.minimum (x:xs) + NN.minimumBy compare (nconsAs x xs du) @?= Prelude.minimum (x:xs) prop "ofoldMap1" $ \x xs -> - let nn = forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy) - in SG.getMax (NN.ofoldMap1 SG.Max nn) `shouldBe` Prelude.maximum (x:xs) + SG.getMax (NN.ofoldMap1 SG.Max $ nconsAs x xs du) @?= Prelude.maximum (x:xs) prop "ofoldr1" $ \x xs -> - let nn = forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy) - in NN.ofoldr1 (Prelude.min) nn `shouldBe` Prelude.minimum (x:xs) + NN.ofoldr1 Prelude.min (nconsAs x xs du) @?= Prelude.minimum (x:xs) prop "ofoldl1'" $ \x xs -> - let nn = forceTyp $ NN.ncons x (fromList xs `asTypeOf` dummy) - in NN.ofoldl1' (Prelude.min) nn `shouldBe` Prelude.minimum (x:xs) + NN.ofoldl1' Prelude.min (nconsAs x xs du) @?= Prelude.minimum (x:xs) - test :: (OrdSequence typ, Arbitrary (Element typ), Show (Element typ), Show typ, Eq typ, Eq (Element typ)) - => String -> typ -> Spec - test = test' id - test "strict ByteString" S.empty - test "lazy ByteString" L.empty - test "strict Text" T.empty - test "lazy Text" TL.empty + test "Strict ByteString" S.empty + test "Lazy ByteString" L.empty + test "Strict Text" T.empty + test "Lazy Text" TL.empty test "Vector" (V.empty :: V.Vector Int) - test "unboxed Vector" (U.empty :: U.Vector Int) - test "storable Vector" (VS.empty :: VS.Vector Int) - test "list" ([5 :: Int]) - -- test' (id :: NE.NonEmpty Int -> NE.NonEmpty Int) "NonEmpty" ([] :: [Int]) + test "Unboxed Vector" (U.empty :: U.Vector Int) + test "Storable Vector" (VS.empty :: VS.Vector Int) + test "List" ([5 :: Int]) describe "Containers" $ do let test typ dummy xlookup xinsert xdelete = describe typ $ do - prop "difference" $ \(filterDups -> xs) (filterDups -> ys) -> do + prop "difference" $ \(DuplPairs xs) (DuplPairs ys) -> let m1 = mapFromList xs `difference` mapFromList ys - m2 = mapFromList (xs `difference` ys) `asTypeOf` dummy - m1 `shouldBe` m2 - prop "lookup" $ \(fixK -> k) (filterDups -> xs) -> do - let m = mapFromList xs + m2 = mapFromListAs (xs `difference` ys) dummy + in m1 @?= m2 + + prop "lookup" $ \(DuplPairs xs) -> indexIn xs $ \k -> + let m = mapFromListAs xs dummy v1 = lookup k m - v2 = lookup k (xs :: [(Int, Int)]) - v3 = xlookup k m - v1 `shouldBe` v2 - v1 `shouldBe` v3 - prop "insert" $ \(fixK -> k) v (filterDups -> xs) -> do - let m = mapFromList (xs :: [(Int, Int)]) + in do + v1 @?= lookup k xs + v1 @?= xlookup k m + + prop "insert" $ \(DuplPairs xs) v -> indexIn xs $ \k -> + let m = mapFromListAs xs dummy m1 = insertMap k v m - m2 = mapFromList (insertMap k v xs) - m3 = xinsert k v m - m1 `shouldBe` m2 - m1 `shouldBe` m3 - prop "delete" $ \(fixK -> k) (filterDups -> xs) -> do - let m = mapFromList (xs :: [(Int, Int)]) `asTypeOf` dummy + in do + m1 @?= mapFromList (insertMap k v xs) + m1 @?= xinsert k v m + + prop "delete" $ \(DuplPairs xs) -> indexIn xs $ \k -> + let m = mapFromListAs xs dummy m1 = deleteMap k m - m2 = mapFromList (deleteMap k xs) - m3 = xdelete k m - m1 `shouldBe` m2 - m1 `shouldBe` m3 - prop "singletonMap" $ \(fixK -> k) v -> do - singletonMap k v `shouldBe` (mapFromList [(k, v)] `asTypeOf` dummy) - prop "findWithDefault" $ \(fixK -> k) v (filterDups -> xs) -> do - let m = mapFromList xs `asTypeOf` dummy - findWithDefault v k m `shouldBe` findWithDefault v k xs - prop "insertWith" $ \(fixK -> k) v (filterDups -> xs) -> do - let m = mapFromList xs `asTypeOf` dummy - f = (+) - insertWith f k v m `shouldBe` mapFromList (insertWith f k v xs) - prop "insertWithKey" $ \(fixK -> k) v (filterDups -> xs) -> do - let m = mapFromList xs `asTypeOf` dummy + in do + m1 @?= mapFromList (deleteMap k xs) + m1 @?= xdelete k m + + prop "singletonMap" $ \k v -> + singletonMap k v @?= (mapFromListAs [(k, v)] dummy) + + prop "findWithDefault" $ \(DuplPairs xs) k v -> + findWithDefault v k (mapFromListAs xs dummy) + @?= findWithDefault v k xs + + prop "insertWith" $ \(DuplPairs xs) k v -> + insertWith (+) k v (mapFromListAs xs dummy) + @?= mapFromList (insertWith (+) k v xs) + + prop "insertWithKey" $ \(DuplPairs xs) k v -> + let m = mapFromListAs xs dummy f x y z = x + y + z - insertWithKey f k v m `shouldBe` mapFromList (insertWithKey f k v xs) - prop "insertLookupWithKey" $ \(fixK -> k) v (filterDups -> xs) -> do - let m = mapFromList xs `asTypeOf` dummy + in insertWithKey f k v m + @?= mapFromList (insertWithKey f k v xs) + + prop "insertLookupWithKey" $ \(DuplPairs xs) k v -> + let m = mapFromListAs xs dummy f x y z = x + y + z - insertLookupWithKey f k v m `shouldBe` - second mapFromList (insertLookupWithKey f k v xs) - prop "adjustMap" $ \(fixK -> k) (filterDups -> xs) -> do - let m = mapFromList xs `asTypeOf` dummy - adjustMap succ k m `shouldBe` mapFromList (adjustMap succ k xs) - prop "adjustWithKey" $ \(fixK -> k) (filterDups -> xs) -> do - let m = mapFromList xs `asTypeOf` dummy - adjustWithKey (+) k m `shouldBe` mapFromList (adjustWithKey (+) k xs) - prop "updateMap" $ \(fixK -> k) (filterDups -> xs) -> do - let m = mapFromList xs `asTypeOf` dummy - f i = if i < 0 then Nothing else Just $ i * 2 - updateMap f k m `shouldBe` mapFromList (updateMap f k xs) - prop "updateWithKey" $ \(fixK -> k) (filterDups -> xs) -> do - let m = mapFromList xs `asTypeOf` dummy - f k i = if i < 0 then Nothing else Just $ i * k - updateWithKey f k m `shouldBe` mapFromList (updateWithKey f k xs) - prop "updateLookupWithKey" $ \(fixK -> k) (filterDups -> xs) -> do - let m = mapFromList xs `asTypeOf` dummy - f k i = if i < 0 then Nothing else Just $ i * k - updateLookupWithKey f k m `shouldBe` second mapFromList (updateLookupWithKey f k xs) - prop "alter" $ \(fixK -> k) (filterDups -> xs) -> do - let m = mapFromList xs `asTypeOf` dummy + in insertLookupWithKey f k v m @?= + second mapFromList (insertLookupWithKey f k v xs) + + prop "adjustMap" $ \(DuplPairs xs) k -> + adjustMap succ k (mapFromListAs xs dummy) + @?= mapFromList (adjustMap succ k xs) + + prop "adjustWithKey" $ \(DuplPairs xs) k -> + adjustWithKey (+) k (mapFromListAs xs dummy) + @?= mapFromList (adjustWithKey (+) k xs) + + prop "updateMap" $ \(DuplPairs xs) k -> + let f i = if i < 0 then Nothing else Just $ i * 2 + in updateMap f k (mapFromListAs xs dummy) + @?= mapFromList (updateMap f k xs) + + 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) + + 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) + + prop "alter" $ \(DuplPairs xs) k -> + let m = mapFromListAs xs dummy f Nothing = Just (-1) f (Just i) = if i < 0 then Nothing else Just (i * 2) - lookup k (alterMap f k m) `shouldBe` f (lookup k m) - prop "unionWith" $ \(filterDups -> xs) (filterDups -> ys) -> do + in lookup k (alterMap f k m) @?= f (lookup k m) + + prop "unionWith" $ \(DuplPairs xs) (DuplPairs ys) -> let m1 = unionWith (+) - (mapFromList xs `asTypeOf` dummy) - (mapFromList ys `asTypeOf` dummy) + (mapFromListAs xs dummy) + (mapFromListAs ys dummy) m2 = mapFromList (unionWith (+) xs ys) - m1 `shouldBe` m2 - prop "unionWithKey" $ \(filterDups -> xs) (filterDups -> ys) -> do + in m1 @?= m2 + + prop "unionWithKey" $ \(DuplPairs xs) (DuplPairs ys) -> let f k x y = k + x + y m1 = unionWithKey f - (mapFromList xs `asTypeOf` dummy) - (mapFromList ys `asTypeOf` dummy) + (mapFromListAs xs dummy) + (mapFromListAs ys dummy) m2 = mapFromList (unionWithKey f xs ys) - m1 `shouldBe` m2 - prop "unionsWith" $ \(map filterDups -> xss) -> do - let ms = map mapFromList xss `asTypeOf` [dummy] - unionsWith (+) ms `shouldBe` mapFromList (unionsWith (+) xss) - prop "mapWithKey" $ \(filterDups -> xs) -> do + in m1 @?= m2 + + prop "unionsWith" $ \(SmallList xss) -> + let duplXss = map unDupl xss + ms = map mapFromList duplXss `asTypeOf` [dummy] + in unionsWith (+) ms + @?= mapFromList (unionsWith (+) duplXss) + + prop "mapWithKey" $ \(DuplPairs xs) -> let m1 = mapWithKey (+) (mapFromList xs) `asTypeOf` dummy m2 = mapFromList $ mapWithKey (+) xs - m1 `shouldBe` m2 - prop "omapKeysWith" $ \(filterDups -> xs) -> do - let m1 = omapKeysWith (+) f (mapFromList xs) `asTypeOf` dummy - m2 = mapFromList $ omapKeysWith (+) f xs - f = flip mod 5 - m1 `shouldBe` m2 - filterDups :: [(Int, v)] -> [(Int, v)] - filterDups = - loop IntSet.empty . map (first (`mod` 20)) - where - loop _ [] = [] - loop used ((k, v):rest) - | k `member` used = loop used rest - | Prelude.otherwise = (k, v) : loop (insertSet k used) rest + in m1 @?= m2 - fixK :: Int -> Int - fixK = flip mod 20 + prop "omapKeysWith" $ \(DuplPairs xs) -> + let f = flip mod 5 + m1 = omapKeysWith (+) f (mapFromList xs) `asTypeOf` dummy + m2 = mapFromList $ omapKeysWith (+) f xs + in m1 @?= m2 - test "Data.Map" Map.empty Map.lookup Map.insert Map.delete - test "Data.IntMap" IntMap.empty IntMap.lookup IntMap.insert IntMap.delete - test "Data.HashMap" HashMap.empty HashMap.lookup HashMap.insert HashMap.delete + test "Data.Map" (Map.empty :: Map.Map Int Int) + Map.lookup Map.insert Map.delete + test "Data.IntMap" (IntMap.empty :: IntMap.IntMap Int) + IntMap.lookup IntMap.insert IntMap.delete + test "Data.HashMap" (HashMap.empty :: HashMap.HashMap Int Int) + HashMap.lookup HashMap.insert HashMap.delete - describe "foldl integration" $ do + describe "Foldl Integration" $ do prop "vector" $ \xs -> do x1 <- Foldl.foldM Foldl.vector (xs :: [Int]) x2 <- Foldl.impurely ofoldMUnwrap Foldl.vector xs - x2 `shouldBe` (x1 :: V.Vector Int) + x2 @?= (x1 :: V.Vector Int) prop "length" $ \xs -> do let x1 = Foldl.fold Foldl.length (xs :: [Int]) x2 = Foldl.purely ofoldlUnwrap Foldl.length xs - x2 `shouldBe` x1 + x2 @?= x1 - describe "sorting" $ do + describe "Sorting" $ do let test typ dummy = describe typ $ do prop "sortBy" $ \input -> do - let orig = fromList input `asTypeOf` dummy - f x y = compare y x - fromList (sortBy f input) `shouldBe` sortBy f orig - fromList input `shouldBe` orig - prop "sort" $ \input -> do - let orig = fromList input `asTypeOf` dummy - fromList (sort input) `shouldBe` sort orig - fromList input `shouldBe` orig - test "list" ([] :: [Int]) - test "vector" (V.empty :: V.Vector Int) - test "storable vector" (VS.empty :: VS.Vector Int) - test "unboxed vector" (U.empty :: U.Vector Int) - test "strict ByteString" S.empty - test "lazy ByteString" L.empty - test "strict Text" T.empty - test "lazy Text" TL.empty - it "headEx on a list works #26" $ - headEx (1 : filter Prelude.odd [2,4..]) `shouldBe` (1 :: Int) + let f x y = compare y x + fromList (sortBy f input) @?= sortBy f (fromListAs input dummy) + prop "sort" $ \input -> + fromList (sort input) @?= sort (fromListAs input dummy) + test "List" ([] :: [Int]) + test "Vector" (V.empty :: V.Vector Int) + test "Storable Vector" (VS.empty :: VS.Vector Int) + test "Unboxed Vector" (U.empty :: U.Vector Int) + test "Strict ByteString" S.empty + test "Lazy ByteString" L.empty + test "Strict Text" T.empty + test "Lazy Text" TL.empty - it "find doesn't infinitely loop on NonEmpty #31" $ - find (== "a") ("a" NE.:| ["d","fgf"]) `shouldBe` Just "a" + describe "Data.ByteVector" $ do + prop "toByteVector" $ \ws -> + (otoList . toByteVector . fromList $ ws) @?= ws - prop "toByteVector works" $ \ws -> - (otoList . toByteVector . fromList $ ws) `shouldBe` ws + prop "fromByteVector" $ \ws -> + (otoList . fromByteVector . fromList $ ws) @?= ws - prop "fromByteVector works" $ \ws -> - (otoList . fromByteVector . fromList $ ws) `shouldBe` 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"