packages feed

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 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) :-   []