non-empty 0.3.2 → 0.3.3
raw patch · 11 files changed
+304/−150 lines, 11 filesdep +doctest-exitcode-stdiodep ~utility-ht
Dependencies added: doctest-exitcode-stdio
Dependency ranges changed: utility-ht
Files
- Makefile +8/−0
- non-empty.cabal +15/−9
- src/Data/NonEmpty.hs +3/−0
- src/Data/NonEmpty/Class.hs +39/−0
- src/Data/NonEmpty/Map.hs +41/−2
- src/Data/NonEmpty/Set.hs +9/−1
- src/Data/NonEmptyPrivate.hs +61/−0
- test/Main.hs +7/−13
- test/Test/Data/NonEmpty/Map.hs +86/−0
- test/Test/Data/NonEmptyPrivate.hs +35/−0
- test/Test/Map.hs +0/−125
+ Makefile view
@@ -0,0 +1,8 @@+run-test: update-test+ runhaskell Setup configure --user --enable-tests+ runhaskell Setup build+ runhaskell Setup haddock+ runhaskell Setup test non-empty-test --show-details=streaming++update-test:+ doctest-extract -i src/ -o test/ --executable-main=Main.hs Data.NonEmptyPrivate Data.NonEmpty.Map
non-empty.cabal view
@@ -1,10 +1,11 @@+Cabal-Version: 2.2 Name: non-empty-Version: 0.3.2-License: BSD3+Version: 0.3.3+License: BSD-3-Clause License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de> Maintainer: Henning Thielemann <haskell@henning-thielemann.de>-Homepage: http://hub.darcs.net/thielema/non-empty/+Homepage: https://hub.darcs.net/thielema/non-empty/ Category: Data Synopsis: List-like structures with static restrictions on the number of elements Description:@@ -62,17 +63,18 @@ Requires multi-parameter type classes with functional dependencies. Tested-With: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.1-Cabal-Version: >=1.8 Build-Type: Simple+Extra-Source-Files:+ Makefile Source-Repository this- Tag: 0.3.2+ Tag: 0.3.3 Type: darcs- Location: http://hub.darcs.net/thielema/non-empty/+ Location: https://hub.darcs.net/thielema/non-empty/ Source-Repository head Type: darcs- Location: http://hub.darcs.net/thielema/non-empty/+ Location: https://hub.darcs.net/thielema/non-empty/ Library Build-Depends:@@ -82,6 +84,7 @@ QuickCheck >=2.1 && <3, base >=4 && <5 + Default-Language: Haskell98 GHC-Options: -Wall Hs-Source-Dirs: src Exposed-Modules:@@ -104,13 +107,16 @@ Test-Suite non-empty-test Type: exitcode-stdio-1.0 Main-Is: Main.hs+ Default-Language: Haskell98 GHC-Options: -Wall Hs-source-dirs: test Build-Depends: non-empty, containers,- utility-ht,+ utility-ht >=0.0.16,+ doctest-exitcode-stdio >=0.0 && <0.1, QuickCheck, base Other-Modules:- Test.Map+ Test.Data.NonEmpty.Map+ Test.Data.NonEmptyPrivate
src/Data/NonEmpty.hs view
@@ -23,6 +23,7 @@ minimum, minimumBy, minimumKey, sum, product,+ chop, append, appendLeft, appendRight, cycle, zipWith,@@ -32,6 +33,8 @@ scanl, scanr, tails, inits, initsRev, removeEach,+ partitionEithersLeft,+ partitionEithersRight, ) where import Data.NonEmptyPrivate
src/Data/NonEmpty/Class.hs view
@@ -3,6 +3,7 @@ import qualified Data.Sequence as Seq import qualified Data.Map as Map import qualified Data.Set as Set+import qualified Data.List.Key as Key import qualified Data.List.HT as ListHT import qualified Data.List as List import qualified Control.DeepSeq as DeepSeq@@ -12,6 +13,7 @@ import Data.Traversable (Traversable, mapAccumL, mapAccumR) import Control.Monad (liftM2, ) import Data.Tuple.HT (swap, )+import Data.Ord.HT (comparing, ) import qualified Test.QuickCheck as QC @@ -245,6 +247,22 @@ sortBy = Seq.sortBy +class Sort f => SortKey f where+ sortKey :: (Ord b) => (a -> b) -> f a -> f a++instance SortKey [] where+ sortKey = Key.sort++instance SortKey Maybe where+ sortKey _f = id++instance SortKey Seq where+ sortKey = sortKeyGen++sortKeyGen :: (SortBy f, Functor f, Ord b) => (a -> b) -> f a -> f a+sortKeyGen f = fmap snd . sortBy (comparing fst) . fmap (\x -> (f x, x))++ class Reverse f where reverse :: f a -> f a @@ -264,6 +282,12 @@ foldr (.) (showString "[]") $ map (\x -> P.showsPrec 6 x . showString ":") xs +instance Show Maybe where+ showsPrec = P.showsPrec++instance Show Seq where+ showsPrec = P.showsPrec+ instance Show Set where showsPrec = P.showsPrec @@ -276,21 +300,36 @@ arbitrary = QC.arbitrary shrink = QC.shrink +instance Arbitrary Seq where+ arbitrary = QC.arbitrary+ shrink = QC.shrink+ instance Arbitrary Maybe where arbitrary = QC.arbitrary shrink = QC.shrink +instance (QC.Arbitrary k, Ord k) => Arbitrary (Map k) where+ arbitrary = QC.arbitrary+ shrink = QC.shrink + class (Arbitrary f) => Gen f where genOf :: QC.Gen a -> QC.Gen (f a) instance Gen [] where genOf = QC.listOf +instance Gen Seq where+ genOf = fmap Seq.fromList . QC.listOf+ instance Gen Maybe where genOf gen = do b <- QC.arbitrary if b then fmap Just gen else return Nothing++instance (QC.Arbitrary k, Ord k) => Gen (Map k) where+ genOf gen =+ fmap Map.fromList $ mapM (\k -> fmap ((,) k) gen) =<< QC.arbitrary class NFData f where
src/Data/NonEmpty/Map.hs view
@@ -36,18 +36,33 @@ import Data.Map (Map, ) import Control.Monad (mzero, )-import Control.Applicative (liftA2, )+import Control.Applicative (liftA2, liftA3) import Control.DeepSeq (NFData, rnf, ) import Data.Traversable (Traversable, traverse, ) import Data.Foldable (Foldable, foldMap, ) import Data.Monoid (mappend, )-import Data.Maybe (fromMaybe, )+import Data.Maybe (fromMaybe, mapMaybe) import Data.Tuple.HT (forcePair, mapSnd, ) import Data.Ord.HT (comparing, ) +import qualified Test.QuickCheck as QC+ import Prelude hiding (map, lookup, ) +{- $setup+>>> import qualified Data.NonEmpty.Map as NonEmptyMap+>>> import qualified Data.NonEmpty as NonEmpty+>>> import qualified Data.Map as Map+>>> import qualified Test.QuickCheck as QC+>>>+>>> forAllMap :: (QC.Testable test) => (Map.Map Int String -> test) -> QC.Property+>>> forAllMap = QC.forAll (fmap Map.fromList QC.arbitrary)+>>>+>>> forAllNonEmptyMap :: (QC.Testable test) => (NonEmptyMap.T Int String -> test) -> QC.Property+>>> forAllNonEmptyMap = QC.forAll (fmap NonEmptyMap.fromList QC.arbitrary)+-}+ {- The first field will always contain the smallest element. -}@@ -76,10 +91,23 @@ instance (NFData k) => C.NFData (T k) where rnf (Cons x xs) = rnf (x, C.rnf xs) +instance (QC.Arbitrary k, Ord k, QC.Arbitrary a) => QC.Arbitrary (T k a) where+ arbitrary = C.arbitrary+ shrink = C.shrink +instance (QC.Arbitrary k, Ord k) => C.Arbitrary (T k) where+ arbitrary = liftA3 insert QC.arbitrary QC.arbitrary QC.arbitrary+ shrink = mapMaybe fetch . QC.shrink . flatten++instance (QC.Arbitrary k, Ord k) => C.Gen (T k) where+ genOf gen = liftA3 insert QC.arbitrary gen $ C.genOf gen+++-- | prop> \k a -> forAllMap $ \m -> Map.insert k a m == NonEmptyMap.flatten (NonEmptyMap.insert k a m) insert :: Ord k => k -> a -> Map k a -> T k a insert = curry $ insertGen Map.insert fst +-- | prop> \k a -> forAllMap $ \m -> Map.insertWith (++) k a m == NonEmptyMap.flatten (NonEmptyMap.insertWith (++) k a m) insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> T k a insertWith f = curry $ insertGen (Map.insertWith f) (applyFst f) @@ -133,6 +161,7 @@ then Just $ snd x else Map.lookup y xs +-- | prop> \k -> forAllNonEmptyMap $ \m -> Map.delete k (NonEmptyMap.flatten m) == NonEmptyMap.delete k m delete :: (Ord k) => k -> T k a -> Map k a delete y (Cons x xs) = if y == fst x then xs else uncurry Map.insert x $ Map.delete y xs@@ -147,16 +176,20 @@ Nothing -> (x,xs) Just (y,ys) -> (y, uncurry Map.insert x ys) +-- | prop> \xs -> Map.fromList (NonEmpty.flatten xs) == NonEmptyMap.flatten (NonEmptyMap.fromList (xs::NonEmpty.T [] (Int,Char))) fromList :: (Ord k) => NonEmpty.T [] (k,a) -> T k a fromList (NonEmpty.Cons x xs) = insertRight x $ Map.fromList xs +-- | prop> \xs -> Map.fromListWith (++) (NonEmpty.flatten xs) == NonEmptyMap.flatten (NonEmptyMap.fromListWith (++) (xs::NonEmpty.T [] (Int,String))) fromListWith :: (Ord k) => (a -> a -> a) -> NonEmpty.T [] (k,a) -> T k a fromListWith f (NonEmpty.Cons x xs) = insertRightWith f x $ Map.fromListWith f xs +-- | prop> forAllNonEmptyMap $ \m -> NonEmptyMap.fromAscList (NonEmptyMap.toAscList m) == m fromAscList :: (Ord k) => NonEmpty.T [] (k,a) -> T k a fromAscList (NonEmpty.Cons x xs) = Cons x $ Map.fromAscList xs +-- | prop> forAllNonEmptyMap $ \m -> NonEmpty.flatten (NonEmptyMap.toAscList m) == Map.toAscList (NonEmptyMap.flatten m) toAscList :: T k a -> NonEmpty.T [] (k,a) toAscList (Cons x xs) = NonEmpty.cons x $ Map.toAscList xs @@ -171,6 +204,7 @@ Could be implemented in terms of unionRight but that would require inspection of the plain Map using Map.minViewWithKey. -}+-- | prop> forAllNonEmptyMap $ \xs -> forAllNonEmptyMap $ \ys -> Map.union (NonEmptyMap.flatten xs) (NonEmptyMap.flatten ys) == NonEmptyMap.flatten (NonEmptyMap.union xs ys) union :: (Ord k) => T k a -> T k a -> T k a union (Cons x xs) (Cons y ys) = uncurry Cons $@@ -181,13 +215,16 @@ GT -> (y, uncurry Map.insert x zs) EQ -> (x, zs) +-- | prop> forAllMap $ \xm -> forAllNonEmptyMap $ \ym -> Map.union xm (NonEmptyMap.flatten ym) == NonEmptyMap.flatten (NonEmptyMap.unionLeft xm ym) unionLeft :: (Ord k) => Map k a -> T k a -> T k a unionLeft xs (Cons y ys) = insertRight y $ Map.union xs ys +-- | prop> forAllNonEmptyMap $ \xm -> forAllMap $ \ym -> Map.union (NonEmptyMap.flatten xm) ym == NonEmptyMap.flatten (NonEmptyMap.unionRight xm ym) unionRight :: (Ord k) => T k a -> Map k a -> T k a unionRight (Cons x xs) ys = uncurry insert x $ Map.union xs ys +-- | prop> forAllNonEmptyMap $ \xs -> forAllNonEmptyMap $ \ys -> Map.unionWith (++) (NonEmptyMap.flatten xs) (NonEmptyMap.flatten ys) == NonEmptyMap.flatten (NonEmptyMap.unionWith (++) xs ys) unionWith :: (Ord k) => (a -> a -> a) -> T k a -> T k a -> T k a unionWith f (Cons x xs) (Cons y ys) = uncurry Cons $@@ -198,10 +235,12 @@ GT -> (y, uncurry (Map.insertWith f) x zs) EQ -> (applyFst f (x,y), zs) +-- | prop> forAllMap $ \xm -> forAllNonEmptyMap $ \ym -> Map.unionWith (++) xm (NonEmptyMap.flatten ym) == NonEmptyMap.flatten (NonEmptyMap.unionLeftWith (++) xm ym) unionLeftWith :: (Ord k) => (a -> a -> a) -> Map k a -> T k a -> T k a unionLeftWith f xs (Cons y ys) = insertRightWith f y $ Map.unionWith f xs ys +-- | prop> forAllNonEmptyMap $ \xm -> forAllMap $ \ym -> Map.unionWith (++) (NonEmptyMap.flatten xm) ym == NonEmptyMap.flatten (NonEmptyMap.unionRightWith (++) xm ym) unionRightWith :: (Ord k) => (a -> a -> a) -> T k a -> Map k a -> T k a unionRightWith f (Cons x xs) ys = uncurry (insertWith f) x $ Map.unionWith f xs ys
src/Data/NonEmpty/Set.hs view
@@ -31,11 +31,14 @@ import Data.Set (Set, ) import Control.Monad (mzero, )+import Control.Applicative (liftA2) import Control.DeepSeq (NFData, rnf, )-import Data.Maybe (fromMaybe, )+import Data.Maybe (fromMaybe, mapMaybe) import Data.Tuple.HT (forcePair, mapSnd, ) +import qualified Test.QuickCheck as QC + {- The first field will always contain the smallest element. We do not use the NonEmpty data type here@@ -57,6 +60,11 @@ instance C.NFData T where rnf (Cons x xs) = rnf (x, C.rnf xs)+++instance (QC.Arbitrary a, Ord a) => QC.Arbitrary (T a) where+ arbitrary = liftA2 insert QC.arbitrary QC.arbitrary+ shrink = mapMaybe fetch . QC.shrink . flatten {- |
src/Data/NonEmptyPrivate.hs view
@@ -14,12 +14,14 @@ import qualified Data.List as List import Data.Traversable (Traversable, mapAccumL, mapAccumR) import Data.Foldable (Foldable, )+import Control.Monad.HT (void, ) import Control.Monad (Monad, return, (=<<), ) import Control.Applicative (Applicative, liftA2, pure, (<*>), ) import Control.DeepSeq (NFData, rnf, ) import Data.Functor (Functor, fmap, ) import Data.Function (flip, const, ($), (.), )+import Data.Either (Either(Left, Right), ) import Data.Maybe (Maybe(Just, Nothing), maybe, mapMaybe, ) import Data.Bool.HT (if', ) import Data.Bool (Bool(True), (&&), )@@ -33,6 +35,13 @@ import qualified Test.QuickCheck as QC +{- $setup+>>> import qualified Data.NonEmpty as NonEmpty+>>> import qualified Data.Either.HT as EitherHT+>>> import Data.Tuple.HT (swap)+>>> import Data.Maybe (mapMaybe)+-}+ {- We could also have (:!) as constructor, but in order to import it unqualified we have to import 'T' unqualified, too,@@ -215,6 +224,22 @@ snoc xs x = uncurry Cons $ mapAccumR (flip (,)) x xs +-- name of the class could also be ShiftL+class Snoc f where snocFast :: f a -> a -> T f a+instance Snoc [] where snocFast = snocGeneric+instance Snoc Seq where snocFast = snocGeneric+instance Snoc Empty.T where snocFast ~Empty.Cons x = Cons x Empty.Cons+instance Snoc Maybe where+ snocFast mx y = uncurry Cons $ maybe (y, Nothing) (\x -> (x, Just y)) mx++-- | For 'Seq' faster than 'snoc'.+snocGeneric :: (C.ViewL f, C.Empty f, C.Snoc f) => f a -> a -> T f a+snocGeneric xs x =+ uncurry Cons $+ case C.viewL xs of+ Nothing -> (x, C.empty)+ Just (y,ys) -> (y, C.snoc ys x)+ snocAlt :: (C.Cons f, Traversable f) => f a -> a -> f a snocAlt xs x = flatten $ snoc xs x @@ -353,6 +378,12 @@ product = foldl1 (P.*) +chop :: (a -> Bool) -> [a] -> T [] [a]+chop p =+ uncurry cons .+ P.foldr (\ x ~(y,ys) -> if p x then ([],y:ys) else ((x:y),ys) ) ([],[])++ instance (C.Cons f, C.Append f) => C.Append (T f) where append xs ys = appendRight xs (flatten ys) @@ -546,8 +577,16 @@ removeEach :: (Traversable f) => T f a -> T f (a, f a) removeEach xs = mapWithIndex (\n _ -> removeAt n xs) 0 xs +takeUntil :: (a -> Bool) -> T [] a -> T [] a+takeUntil p (Cons x xs) =+ x !: if p x then [] else ListHT.takeUntil p xs +takeUntilAlt :: (a -> Bool) -> T [] a -> T [] a+takeUntilAlt p xs =+ zipWith const xs $ Cons () $ void $ List.takeWhile (P.not . p) $ flatten xs ++ {- It is somehow better than the variant in NonEmpty.Mixed, since it can be applied to nested NonEmptys.@@ -678,3 +717,25 @@ -} mapAdjacent1 :: (Traversable f) => (a -> a -> b -> c) -> a -> f (a,b) -> f c mapAdjacent1 f = (snd.) . mapAccumL (\a0 (a1,b) -> (a1, f a0 a1 b))++{- |+prop> \xs -> mapMaybe EitherHT.maybeLeft (NonEmpty.flatten xs) == either NonEmpty.flatten fst (NonEmpty.partitionEithersLeft (xs::NonEmpty.T[](Either Char Int)))+prop> \xs -> mapMaybe EitherHT.maybeRight (NonEmpty.flatten xs) == either (const []) (NonEmpty.flatten . snd) (NonEmpty.partitionEithersLeft (xs::NonEmpty.T[](Either Char Int)))+prop> \xs -> NonEmpty.partitionEithersRight (fmap EitherHT.swap xs) == EitherHT.mapLeft swap (EitherHT.swap (NonEmpty.partitionEithersLeft (xs::NonEmpty.T[](Either Char Int))))+-}+partitionEithersLeft :: T [] (Either a b) -> Either (T [] a) ([a], T [] b)+partitionEithersLeft (Cons x xs) =+ case (x, ListHT.unzipEithers xs) of+ (Right r, (ls,rs)) -> Right (ls, Cons r rs)+ (Left l, (ls,rs)) ->+ maybe (Left $ Cons l ls) (Right . (,) (l:ls)) $ fetch rs++{- |+prop> \xs -> NonEmpty.partitionEithersLeft (fmap EitherHT.swap xs) == EitherHT.mapRight swap (EitherHT.swap (NonEmpty.partitionEithersRight (xs::NonEmpty.T[](Either Char Int))))+-}+partitionEithersRight :: T [] (Either a b) -> Either (T [] a, [b]) (T [] b)+partitionEithersRight (Cons x xs) =+ case (x, ListHT.unzipEithers xs) of+ (Left l, (ls,rs)) -> Left (Cons l ls, rs)+ (Right r, (ls,rs)) ->+ maybe (Right $ Cons r rs) (Left . flip (,) (r:rs)) $ fetch ls
test/Main.hs view
@@ -1,18 +1,12 @@+-- Do not edit! Automatically created with doctest-extract. module Main where -import qualified Test.Map as Map--import qualified Test.QuickCheck as QC--import Data.Tuple.HT (mapFst)-+import qualified Test.Data.NonEmptyPrivate+import qualified Test.Data.NonEmpty.Map -prefix :: String -> [(String, test)] -> [(String, test)]-prefix msg = map (mapFst (\str -> msg ++ "." ++ str))+import qualified Test.DocTest.Driver as DocTest main :: IO ()-main =- mapM_ (\(msg,prop) -> putStr (msg++": ") >> QC.quickCheck prop) $- concat $- prefix "Map" Map.tests :- []+main = DocTest.run $ do+ Test.Data.NonEmptyPrivate.test+ Test.Data.NonEmpty.Map.test
+ test/Test/Data/NonEmpty/Map.hs view
@@ -0,0 +1,86 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/NonEmpty/Map.hs+{-# LINE 53 "src/Data/NonEmpty/Map.hs" #-}++module Test.Data.NonEmpty.Map where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 54 "src/Data/NonEmpty/Map.hs" #-}+import qualified Data.NonEmpty.Map as NonEmptyMap+import qualified Data.NonEmpty as NonEmpty+import qualified Data.Map as Map+import qualified Test.QuickCheck as QC++forAllMap :: (QC.Testable test) => (Map.Map Int String -> test) -> QC.Property+forAllMap = QC.forAll (fmap Map.fromList QC.arbitrary)++forAllNonEmptyMap :: (QC.Testable test) => (NonEmptyMap.T Int String -> test) -> QC.Property+forAllNonEmptyMap = QC.forAll (fmap NonEmptyMap.fromList QC.arbitrary)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.NonEmpty.Map:106: "+{-# LINE 106 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 106 "src/Data/NonEmpty/Map.hs" #-}+ (\k a -> forAllMap $ \m -> Map.insert k a m == NonEmptyMap.flatten (NonEmptyMap.insert k a m))+ DocTest.printPrefix "Data.NonEmpty.Map:110: "+{-# LINE 110 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 110 "src/Data/NonEmpty/Map.hs" #-}+ (\k a -> forAllMap $ \m -> Map.insertWith (++) k a m == NonEmptyMap.flatten (NonEmptyMap.insertWith (++) k a m))+ DocTest.printPrefix "Data.NonEmpty.Map:164: "+{-# LINE 164 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 164 "src/Data/NonEmpty/Map.hs" #-}+ (\k -> forAllNonEmptyMap $ \m -> Map.delete k (NonEmptyMap.flatten m) == NonEmptyMap.delete k m)+ DocTest.printPrefix "Data.NonEmpty.Map:179: "+{-# LINE 179 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 179 "src/Data/NonEmpty/Map.hs" #-}+ (\xs -> Map.fromList (NonEmpty.flatten xs) == NonEmptyMap.flatten (NonEmptyMap.fromList (xs::NonEmpty.T [] (Int,Char))))+ DocTest.printPrefix "Data.NonEmpty.Map:183: "+{-# LINE 183 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 183 "src/Data/NonEmpty/Map.hs" #-}+ (\xs -> Map.fromListWith (++) (NonEmpty.flatten xs) == NonEmptyMap.flatten (NonEmptyMap.fromListWith (++) (xs::NonEmpty.T [] (Int,String))))+ DocTest.printPrefix "Data.NonEmpty.Map:188: "+{-# LINE 188 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 188 "src/Data/NonEmpty/Map.hs" #-}+ (forAllNonEmptyMap $ \m -> NonEmptyMap.fromAscList (NonEmptyMap.toAscList m) == m)+ DocTest.printPrefix "Data.NonEmpty.Map:192: "+{-# LINE 192 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 192 "src/Data/NonEmpty/Map.hs" #-}+ (forAllNonEmptyMap $ \m -> NonEmpty.flatten (NonEmptyMap.toAscList m) == Map.toAscList (NonEmptyMap.flatten m))+ DocTest.printPrefix "Data.NonEmpty.Map:207: "+{-# LINE 207 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 207 "src/Data/NonEmpty/Map.hs" #-}+ (forAllNonEmptyMap $ \xs -> forAllNonEmptyMap $ \ys -> Map.union (NonEmptyMap.flatten xs) (NonEmptyMap.flatten ys) == NonEmptyMap.flatten (NonEmptyMap.union xs ys))+ DocTest.printPrefix "Data.NonEmpty.Map:218: "+{-# LINE 218 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 218 "src/Data/NonEmpty/Map.hs" #-}+ (forAllMap $ \xm -> forAllNonEmptyMap $ \ym -> Map.union xm (NonEmptyMap.flatten ym) == NonEmptyMap.flatten (NonEmptyMap.unionLeft xm ym))+ DocTest.printPrefix "Data.NonEmpty.Map:222: "+{-# LINE 222 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 222 "src/Data/NonEmpty/Map.hs" #-}+ (forAllNonEmptyMap $ \xm -> forAllMap $ \ym -> Map.union (NonEmptyMap.flatten xm) ym == NonEmptyMap.flatten (NonEmptyMap.unionRight xm ym))+ DocTest.printPrefix "Data.NonEmpty.Map:227: "+{-# LINE 227 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 227 "src/Data/NonEmpty/Map.hs" #-}+ (forAllNonEmptyMap $ \xs -> forAllNonEmptyMap $ \ys -> Map.unionWith (++) (NonEmptyMap.flatten xs) (NonEmptyMap.flatten ys) == NonEmptyMap.flatten (NonEmptyMap.unionWith (++) xs ys))+ DocTest.printPrefix "Data.NonEmpty.Map:238: "+{-# LINE 238 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 238 "src/Data/NonEmpty/Map.hs" #-}+ (forAllMap $ \xm -> forAllNonEmptyMap $ \ym -> Map.unionWith (++) xm (NonEmptyMap.flatten ym) == NonEmptyMap.flatten (NonEmptyMap.unionLeftWith (++) xm ym))+ DocTest.printPrefix "Data.NonEmpty.Map:243: "+{-# LINE 243 "src/Data/NonEmpty/Map.hs" #-}+ DocTest.property+{-# LINE 243 "src/Data/NonEmpty/Map.hs" #-}+ (forAllNonEmptyMap $ \xm -> forAllMap $ \ym -> Map.unionWith (++) (NonEmptyMap.flatten xm) ym == NonEmptyMap.flatten (NonEmptyMap.unionRightWith (++) xm ym))
+ test/Test/Data/NonEmptyPrivate.hs view
@@ -0,0 +1,35 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/NonEmptyPrivate.hs+{-# LINE 38 "src/Data/NonEmptyPrivate.hs" #-}++module Test.Data.NonEmptyPrivate where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 39 "src/Data/NonEmptyPrivate.hs" #-}+import qualified Data.NonEmpty as NonEmpty+import qualified Data.Either.HT as EitherHT+import Data.Tuple.HT (swap)+import Data.Maybe (mapMaybe)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.NonEmptyPrivate:722: "+{-# LINE 722 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property+{-# LINE 722 "src/Data/NonEmptyPrivate.hs" #-}+ (\xs -> mapMaybe EitherHT.maybeLeft (NonEmpty.flatten xs) == either NonEmpty.flatten fst (NonEmpty.partitionEithersLeft (xs::NonEmpty.T[](Either Char Int))))+ DocTest.printPrefix "Data.NonEmptyPrivate:723: "+{-# LINE 723 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property+{-# LINE 723 "src/Data/NonEmptyPrivate.hs" #-}+ (\xs -> mapMaybe EitherHT.maybeRight (NonEmpty.flatten xs) == either (const []) (NonEmpty.flatten . snd) (NonEmpty.partitionEithersLeft (xs::NonEmpty.T[](Either Char Int))))+ DocTest.printPrefix "Data.NonEmptyPrivate:724: "+{-# LINE 724 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property+{-# LINE 724 "src/Data/NonEmptyPrivate.hs" #-}+ (\xs -> NonEmpty.partitionEithersRight (fmap EitherHT.swap xs) == EitherHT.mapLeft swap (EitherHT.swap (NonEmpty.partitionEithersLeft (xs::NonEmpty.T[](Either Char Int)))))+ DocTest.printPrefix "Data.NonEmptyPrivate:734: "+{-# LINE 734 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property+{-# LINE 734 "src/Data/NonEmptyPrivate.hs" #-}+ (\xs -> NonEmpty.partitionEithersLeft (fmap EitherHT.swap xs) == EitherHT.mapRight swap (EitherHT.swap (NonEmpty.partitionEithersRight (xs::NonEmpty.T[](Either Char Int)))))
− test/Test/Map.hs
@@ -1,125 +0,0 @@-module Test.Map where--import qualified Data.NonEmpty.Map as NonEmptyMap-import qualified Data.NonEmpty as NonEmpty-import qualified Data.Map as Map--import qualified Test.QuickCheck as QC---insert :: (Int,Char) -> [(Int,Char)] -> Bool-insert (k,a) xs =- let m = Map.fromList xs- in Map.insert k a m- ==- NonEmptyMap.flatten (NonEmptyMap.insert k a m)--insertWith :: (Int,String) -> [(Int,String)] -> Bool-insertWith (k,a) xs =- let m = Map.fromList xs- in Map.insertWith (++) k a m- ==- NonEmptyMap.flatten (NonEmptyMap.insertWith (++) k a m)--delete :: Int -> NonEmpty.T [] (Int,Char) -> Bool-delete k xs =- let m = NonEmptyMap.fromList xs- in Map.delete k (NonEmptyMap.flatten m)- ==- NonEmptyMap.delete k m---fromList :: NonEmpty.T [] (Int,Char) -> Bool-fromList xs =- Map.fromList (NonEmpty.flatten xs)- ==- NonEmptyMap.flatten (NonEmptyMap.fromList xs)--fromListWith :: NonEmpty.T [] (Int,String) -> Bool-fromListWith xs =- Map.fromListWith (++) (NonEmpty.flatten xs)- ==- NonEmptyMap.flatten (NonEmptyMap.fromListWith (++) xs)--fromAscList :: NonEmpty.T [] (Int,Char) -> Bool-fromAscList xs =- let m = NonEmptyMap.fromList xs- in NonEmptyMap.fromAscList (NonEmptyMap.toAscList m) == m--toAscList :: NonEmpty.T [] (Int,Char) -> Bool-toAscList xs =- let m = NonEmptyMap.fromList xs- in NonEmpty.flatten (NonEmptyMap.toAscList m)- ==- Map.toAscList (NonEmptyMap.flatten m)---union :: NonEmpty.T [] (Int,Char) -> NonEmpty.T [] (Int,Char) -> Bool-union xs ys =- Map.union- (Map.fromList (NonEmpty.flatten xs))- (Map.fromList (NonEmpty.flatten ys))- ==- NonEmptyMap.flatten- (NonEmptyMap.union- (NonEmptyMap.fromList xs)- (NonEmptyMap.fromList ys))--unionWith :: NonEmpty.T [] (Int,String) -> NonEmpty.T [] (Int,String) -> Bool-unionWith xs ys =- Map.unionWith (++)- (Map.fromList (NonEmpty.flatten xs))- (Map.fromList (NonEmpty.flatten ys))- ==- NonEmptyMap.flatten- (NonEmptyMap.unionWith (++)- (NonEmptyMap.fromList xs)- (NonEmptyMap.fromList ys))--unionLeft :: [] (Int,Char) -> NonEmpty.T [] (Int,Char) -> Bool-unionLeft xs ys =- let xm = Map.fromList xs- in Map.union xm (Map.fromList (NonEmpty.flatten ys))- ==- NonEmptyMap.flatten (NonEmptyMap.unionLeft xm (NonEmptyMap.fromList ys))--unionLeftWith :: [] (Int,String) -> NonEmpty.T [] (Int,String) -> Bool-unionLeftWith xs ys =- let xm = Map.fromList xs- in Map.unionWith (++) xm (Map.fromList (NonEmpty.flatten ys))- ==- NonEmptyMap.flatten- (NonEmptyMap.unionLeftWith (++) xm (NonEmptyMap.fromList ys))--unionRight :: NonEmpty.T [] (Int,Char) -> [] (Int,Char) -> Bool-unionRight xs ys =- let ym = Map.fromList ys- in Map.union (Map.fromList (NonEmpty.flatten xs)) ym- ==- NonEmptyMap.flatten (NonEmptyMap.unionRight (NonEmptyMap.fromList xs) ym)--unionRightWith :: NonEmpty.T [] (Int,String) -> [] (Int,String) -> Bool-unionRightWith xs ys =- let ym = Map.fromList ys- in Map.unionWith (++) (Map.fromList (NonEmpty.flatten xs)) ym- ==- NonEmptyMap.flatten- (NonEmptyMap.unionRightWith (++) (NonEmptyMap.fromList xs) ym)---tests :: [(String, QC.Property)]-tests =- ("insert", QC.property insert) :- ("insertWith", QC.property insertWith) :- ("delete", QC.property delete) :- ("fromList", QC.property fromList) :- ("fromListWith", QC.property fromListWith) :- ("fromAscList", QC.property fromAscList) :- ("toAscList", QC.property toAscList) :- ("union", QC.property union) :- ("unionWith", QC.property unionWith) :- ("unionLeft", QC.property unionLeft) :- ("unionLeftWith", QC.property unionLeftWith) :- ("unionRight", QC.property unionRight) :- ("unionRightWith", QC.property unionRightWith) :- []