non-empty 0.3.5 → 0.3.6
raw patch · 13 files changed
+382/−67 lines, 13 filesdep +doctest-libdep +semigroups
Dependencies added: doctest-lib, semigroups
Files
- Makefile +1/−1
- non-empty.cabal +7/−4
- src/Data/Empty.hs +25/−0
- src/Data/NonEmpty.hs +1/−0
- src/Data/NonEmpty/Class.hs +20/−0
- src/Data/NonEmpty/Map.hs +4/−4
- src/Data/NonEmpty/Mixed.hs +33/−0
- src/Data/NonEmpty/Set.hs +7/−0
- src/Data/NonEmptyPrivate.hs +104/−0
- test/Main.hs +2/−0
- test/Test/Data/NonEmpty/Map.hs +39/−26
- test/Test/Data/NonEmpty/Mixed.hs +50/−0
- test/Test/Data/NonEmptyPrivate.hs +89/−32
Makefile view
@@ -5,4 +5,4 @@ runhaskell Setup test non-empty-test --show-details=streaming update-test:- doctest-extract-0.1 -i src/ -o test/ --executable-main=Main.hs Data.NonEmptyPrivate Data.NonEmpty.Map+ doctest-extract-0.1 -i src/ -o test/ --executable-main=Main.hs Data.NonEmptyPrivate Data.NonEmpty.Mixed Data.NonEmpty.Map
non-empty.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: non-empty-Version: 0.3.5+Version: 0.3.6 License: BSD-3-Clause License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -68,7 +68,7 @@ Makefile Source-Repository this- Tag: 0.3.5+ Tag: 0.3.6 Type: darcs Location: https://hub.darcs.net/thielema/non-empty/ @@ -78,8 +78,9 @@ Library Build-Depends:- containers >=0.4 && <0.7,- deepseq >=1.3 && <1.6,+ containers >=0.4 && <0.9,+ semigroups >=0.1 && <1,+ deepseq >=1.3 && <1.7, utility-ht >=0.0.8 && <0.1, QuickCheck >=2.1 && <3, base >=4 && <5@@ -116,8 +117,10 @@ containers, utility-ht >=0.0.16, doctest-exitcode-stdio >=0.0 && <0.1,+ doctest-lib >=0.1.1 && <0.1.2, QuickCheck, base Other-Modules: Test.Data.NonEmpty.Map+ Test.Data.NonEmpty.Mixed Test.Data.NonEmptyPrivate
src/Data/Empty.hs view
@@ -5,9 +5,13 @@ import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold import qualified Data.Ix as Ix+import Data.Semigroup (Semigroup((<>)))+import Data.Monoid (Monoid(mempty,mappend)) import Control.Applicative (pure, ) import Control.DeepSeq (NFData, rnf, ) +import qualified Foreign+ import qualified Test.QuickCheck as QC @@ -20,6 +24,13 @@ instance C.Show T where showsPrec _p Cons = showString "Empty.Cons" +instance Semigroup (T a) where+ Cons <> Cons = Cons++instance Monoid (T a) where+ mempty = Cons+ mappend Cons Cons = Cons+ instance Functor T where fmap _ Cons = Cons @@ -94,6 +105,20 @@ index = C.index inRange = C.inRange rangeSize = C.rangeSize++instance C.Storable T where+ sizeOf _ = 0+ peek _ptr = return Cons+ poke _ptr Cons = return ()++instance Foreign.Storable a => Foreign.Storable (T a) where+ sizeOf = C.sizeOf+ alignment =+ let alignmentOfElem :: Foreign.Storable a => T a -> a -> Int+ alignmentOfElem _ = Foreign.alignment+ in \xs -> alignmentOfElem xs $ error "undefined Storable Empty element"+ peek = C.peek . Foreign.castPtr+ poke = C.poke . Foreign.castPtr switch :: b -> T a -> b
src/Data/NonEmpty.hs view
@@ -30,6 +30,7 @@ mapAdjacent, Insert(insert), insertDefault, InsertBy(insertBy),+ mergeBy, mergeLeftBy, mergeRightBy, scanl, scanr, tails, inits, initsRev, removeEach,
src/Data/NonEmpty/Class.hs view
@@ -16,6 +16,8 @@ import Data.Tuple.HT (swap, ) import Data.Ord.HT (comparing, ) +import qualified Foreign+ import qualified Test.QuickCheck as QC import qualified Prelude as P@@ -264,6 +266,14 @@ sortKeyGen f = fmap snd . sortBy (comparing fst) . fmap (\x -> (f x, x)) +class MergeBy f where+ mergeBy :: (a -> a -> Bool) -> f a -> f a -> f a++instance MergeBy [] where+ mergeBy = ListHT.mergeBy+++ class Reverse f where reverse :: f a -> f a @@ -376,3 +386,13 @@ indexHorner b = let size = rangeSize b in \offset i -> offset * size + index b i+++{- |+Assumes that all elements in the list have the same size and alignment.+Works only for fixed length lists.+-}+class Storable f where+ sizeOf :: (Foreign.Storable a) => f a -> Int+ peek :: (Foreign.Storable a) => Foreign.Ptr a -> IO (f a)+ poke :: (Foreign.Storable a) => Foreign.Ptr a -> f a -> IO ()
src/Data/NonEmpty/Map.hs view
@@ -176,7 +176,7 @@ Nothing -> (x,xs) Just (y,ys) -> (y, uncurry Map.insert x ys) -{-# WARNING fromList "Dangerous because it silently drops colliding key/value pairs. Better use fromListWith." #-}+{-# WARNING fromList "Dangerous because it silently drops colliding key/value pairs. Better use fromListWith with 'error' or 'const'." #-} -- | 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@@ -201,7 +201,7 @@ flatten (Cons x xs) = uncurry Map.insert x xs -{-# WARNING union "Dangerous because it silently drops colliding key/value pairs. Better use unionWith." #-}+{-# WARNING union "Dangerous because it silently drops colliding key/value pairs. Better use unionWith with 'error' or 'const'." #-} {- Could be implemented in terms of unionRight but that would require inspection of the plain Map using Map.minViewWithKey.@@ -217,12 +217,12 @@ GT -> (y, uncurry Map.insert x zs) EQ -> (x, zs) -{-# WARNING unionLeft "Dangerous because it silently drops colliding key/value pairs. Better use unionLeftWith." #-}+{-# WARNING unionLeft "Dangerous because it silently drops colliding key/value pairs. Better use unionLeftWith with 'error' or 'const'." #-} -- | 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 -{-# WARNING unionRight "Dangerous because it silently drops colliding key/value pairs. Better use unionRightWith." #-}+{-# WARNING unionRight "Dangerous because it silently drops colliding key/value pairs. Better use unionRightWith with 'error' or 'const'." #-} -- | 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
src/Data/NonEmpty/Mixed.hs view
@@ -21,6 +21,15 @@ import Prelude hiding (splitAt, take, foldr, scanl, scanr, ) +{- $setup+>>> import qualified Data.NonEmpty as NonEmpty+>>> import qualified Data.List.Match as Match+>>> import Data.NonEmpty.Mixed (chopNothing)+>>> import Data.NonEmpty.Class (append)+>>> import Data.Eq.HT (equating)+-}++ groupBy :: (Foldable f) => (a -> a -> Bool) -> f a -> [NonEmpty.T [] a]@@ -63,6 +72,30 @@ Right bs : ys -> (NonEmpty.flatten bs, ys) ys -> ([], ys)) []++{- |+>>> chopNothing ([] :: [Maybe String])+[]!:[]++>>> chopNothing [Nothing :: Maybe String]+[]!:[]:[]++>>> chopNothing [Just "a", Just "b", Nothing, Just "c", Nothing, Just "d", Just "e"]+["a","b"]!:["c"]:["d","e"]:[]++prop> \xs ys -> chopNothing (xs ++ Nothing : ys) == append (chopNothing xs) (chopNothing (ys :: [Maybe Int]))++prop> \ns xs -> equating (Match.take (ns::[()]) . NonEmpty.flatten) (NonEmpty.cycle (chopNothing xs)) (chopNothing (cycle (xs ++ [Nothing :: Maybe Int])))+-}+chopNothing :: (Foldable f) => f (Maybe a) -> NonEmpty.T [] [a]+chopNothing =+ NonEmpty.force .+ foldr+ (\mx ~(NonEmpty.Cons ys yss) ->+ case mx of+ Nothing -> NonEmpty.Cons [] (ys:yss)+ Just x -> NonEmpty.Cons (x:ys) yss)+ (NonEmpty.singleton []) segmentAfter ::
src/Data/NonEmpty/Set.hs view
@@ -12,6 +12,7 @@ union, unionLeft, unionRight,+ map, findMin, findMax,@@ -38,7 +39,9 @@ import qualified Test.QuickCheck as QC +import Prelude hiding (map) + {- The first field will always contain the smallest element. We do not use the NonEmpty data type here@@ -181,6 +184,10 @@ unionRight :: (Ord a) => T a -> Set a -> T a unionRight (Cons x xs) ys = insertGen fst x $ Set.union xs ys+++map :: (Ord a, Ord b) => (a -> b) -> T a -> T b+map f (Cons x xs) = insert (f x) (Set.map f xs) {-
src/Data/NonEmptyPrivate.hs view
@@ -16,6 +16,7 @@ import qualified Data.Ix as Ix import Data.Traversable (Traversable, mapAccumL, mapAccumR) import Data.Foldable (Foldable, )+import Data.Semigroup (Semigroup((<>))) import Control.Monad.HT (void, ) import Control.Monad (Monad, return, (=<<), ) import Control.Applicative (Applicative, liftA2, pure, (<*>), )@@ -34,12 +35,16 @@ import qualified Prelude as P import Prelude (Eq, Show, Num, Int, uncurry, ($!), (*), (+), ) +import qualified Foreign+ import qualified Test.QuickCheck as QC {- $setup+>>> import qualified Data.NonEmpty.Class as NonEmptyC >>> import qualified Data.NonEmpty as NonEmpty >>> import qualified Data.Empty as Empty+>>> import qualified Data.List.HT as ListHT >>> import qualified Data.Either.HT as EitherHT >>> import qualified Control.Functor.HT as FuncHT >>> import qualified Data.Ix as Ix@@ -410,6 +415,9 @@ instance (C.Cons f, C.Append f) => C.Append (T f) where append xs ys = appendRight xs (flatten ys) +instance (C.Cons f, C.Append f) => Semigroup (T f a) where+ (<>) = C.append+ append :: (C.Append f, Traversable f) => T f a -> T f a -> T (T f) a append xs ys = mapTail (flip appendLeft ys) xs@@ -472,7 +480,79 @@ instance (C.SortBy f, InsertBy f) => C.SortBy (T f) where sortBy f (Cons x xs) = insertBy f x $ C.sortBy f xs +{- |+prop> :{+ \xs ys ->+ NonEmpty.flatten (NonEmptyC.mergeBy (<=) xs (ys :: NonEmpty.T [] Int))+ ==+ ListHT.mergeBy (<=) (NonEmpty.flatten xs) (NonEmpty.flatten ys)+:}+-}+instance (C.MergeBy f, C.Cons f) => C.MergeBy (T f) where+ mergeBy le (Cons x xs) (Cons y ys) =+ if le x y+ then Cons x $ C.mergeBy le xs (C.cons y ys)+ else Cons y $ C.mergeBy le (C.cons x xs) ys +{- |+prop> :{+ \xs ys ->+ NonEmpty.flatten (NonEmpty.mergeLeftBy (<=) xs (ys :: [Int]))+ ==+ ListHT.mergeBy (<=) (NonEmpty.flatten xs) ys+:}+-}+mergeLeftBy ::+ (C.MergeBy f, C.ViewL f, C.Cons f) =>+ (a -> a -> Bool) -> T f a -> f a -> T f a+mergeLeftBy le xt@(Cons x xs) yt =+ case C.viewL yt of+ Nothing -> xt+ Just (y,ys) ->+ if le x y+ then Cons x $ C.mergeBy le xs (C.cons y ys)+ else Cons y $ C.mergeBy le (C.cons x xs) ys++{- |+prop> :{+ \xs ys ->+ NonEmpty.flatten (NonEmpty.mergeRightBy (<=) (xs :: [Int]) ys)+ ==+ ListHT.mergeBy (<=) xs (NonEmpty.flatten ys)+:}+-}+mergeRightBy ::+ (C.MergeBy f, C.ViewL f, C.Cons f) =>+ (a -> a -> Bool) -> f a -> T f a -> T f a+mergeRightBy le xt yt@(Cons y ys) =+ case C.viewL xt of+ Nothing -> yt+ Just (x,xs) ->+ if le x y+ then Cons x $ C.mergeBy le xs (C.cons y ys)+ else Cons y $ C.mergeBy le (C.cons x xs) ys++{- |+>>> NonEmpty.mergeBy (<=) ('c'!:'d':'f':[]) ('a'!:'e':'h':[])+'a'!:'c'!:'d':'e':'f':'h':[]++prop> :{+ \xs ys ->+ NonEmpty.flatten+ (NonEmpty.flatten (NonEmpty.mergeBy (<=) xs (ys :: NonEmpty.T [] Int)))+ ==+ ListHT.mergeBy (<=) (NonEmpty.flatten xs) (NonEmpty.flatten ys)+:}+-}+mergeBy ::+ (C.MergeBy f, C.ViewL f, C.Cons f) =>+ (a -> a -> Bool) -> T f a -> T f a -> T (T f) a+mergeBy le xt@(Cons x xs) yt@(Cons y ys) =+ if le x y+ then Cons x $ mergeRightBy le xs yt+ else Cons y $ mergeLeftBy le xt ys++ class Insert f where {- | Insert an element into an ordered list while preserving the order.@@ -795,3 +875,27 @@ index = C.index inRange = C.inRange rangeSize = C.rangeSize+++elemFromPtr :: Foreign.Ptr a -> a+elemFromPtr _ptr = P.error "undefined Storable NonEmpty element"++sizeOfElem :: Foreign.Storable a => a -> Int+sizeOfElem x = P.lcm (Foreign.sizeOf x) (Foreign.alignment x)++instance C.Storable f => C.Storable (T f) where+ sizeOf ~(Cons x xs) = sizeOfElem x + C.sizeOf xs+-- alignment ~(Cons x xs) = P.lcm (Foreign.alignment x) (C.alignment xs)+ peek ptr =+ liftA2 Cons+ (Foreign.peek ptr)+ (C.peek $ Foreign.plusPtr ptr $ sizeOfElem $ elemFromPtr ptr)+ poke ptr (Cons x xs) = do+ Foreign.poke ptr x+ C.poke (Foreign.plusPtr ptr $ sizeOfElem x) xs++instance (C.Storable f, Foreign.Storable a) => Foreign.Storable (T f a) where+ sizeOf = C.sizeOf+ alignment ~(Cons x _xs) = Foreign.alignment x+ peek = C.peek . Foreign.castPtr+ poke = C.poke . Foreign.castPtr
test/Main.hs view
@@ -2,6 +2,7 @@ module Main where import qualified Test.Data.NonEmptyPrivate+import qualified Test.Data.NonEmpty.Mixed import qualified Test.Data.NonEmpty.Map import qualified Test.DocTest.Driver as DocTest@@ -9,4 +10,5 @@ main :: IO () main = DocTest.run $ do Test.Data.NonEmptyPrivate.test+ Test.Data.NonEmpty.Mixed.test Test.Data.NonEmpty.Map.test
test/Test/Data/NonEmpty/Map.hs view
@@ -21,66 +21,79 @@ test = do DocTest.printPrefix "Data.NonEmpty.Map:106: " {-# LINE 106 "src/Data/NonEmpty/Map.hs" #-}- DocTest.property+ 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))+ \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+ 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))+ \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+ DocTest.property( {-# LINE 164 "src/Data/NonEmpty/Map.hs" #-}- (\k -> forAllNonEmptyMap $ \m -> Map.delete k (NonEmptyMap.flatten m) == NonEmptyMap.delete k m)+ \k -> forAllNonEmptyMap $ \m -> Map.delete k (NonEmptyMap.flatten m) == NonEmptyMap.delete k m+ ) DocTest.printPrefix "Data.NonEmpty.Map:180: " {-# LINE 180 "src/Data/NonEmpty/Map.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 180 "src/Data/NonEmpty/Map.hs" #-}- (\xs -> Map.fromList (NonEmpty.flatten xs) == NonEmptyMap.flatten (NonEmptyMap.fromList (xs::NonEmpty.T [] (Int,Char))))+ \xs -> Map.fromList (NonEmpty.flatten xs) == NonEmptyMap.flatten (NonEmptyMap.fromList (xs::NonEmpty.T [] (Int,Char)))+ ) DocTest.printPrefix "Data.NonEmpty.Map:184: " {-# LINE 184 "src/Data/NonEmpty/Map.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 184 "src/Data/NonEmpty/Map.hs" #-}- (\xs -> Map.fromListWith (++) (NonEmpty.flatten xs) == NonEmptyMap.flatten (NonEmptyMap.fromListWith (++) (xs::NonEmpty.T [] (Int,String))))+ \xs -> Map.fromListWith (++) (NonEmpty.flatten xs) == NonEmptyMap.flatten (NonEmptyMap.fromListWith (++) (xs::NonEmpty.T [] (Int,String)))+ ) DocTest.printPrefix "Data.NonEmpty.Map:189: " {-# LINE 189 "src/Data/NonEmpty/Map.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 189 "src/Data/NonEmpty/Map.hs" #-}- (forAllNonEmptyMap $ \m -> NonEmptyMap.fromAscList (NonEmptyMap.toAscList m) == m)+ forAllNonEmptyMap $ \m -> NonEmptyMap.fromAscList (NonEmptyMap.toAscList m) == m+ ) DocTest.printPrefix "Data.NonEmpty.Map:193: " {-# LINE 193 "src/Data/NonEmpty/Map.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 193 "src/Data/NonEmpty/Map.hs" #-}- (forAllNonEmptyMap $ \m -> NonEmpty.flatten (NonEmptyMap.toAscList m) == Map.toAscList (NonEmptyMap.flatten m))+ forAllNonEmptyMap $ \m -> NonEmpty.flatten (NonEmptyMap.toAscList m) == Map.toAscList (NonEmptyMap.flatten m)+ ) DocTest.printPrefix "Data.NonEmpty.Map:209: " {-# LINE 209 "src/Data/NonEmpty/Map.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 209 "src/Data/NonEmpty/Map.hs" #-}- (forAllNonEmptyMap $ \xs -> forAllNonEmptyMap $ \ys -> Map.union (NonEmptyMap.flatten xs) (NonEmptyMap.flatten ys) == NonEmptyMap.flatten (NonEmptyMap.union xs ys))+ forAllNonEmptyMap $ \xs -> forAllNonEmptyMap $ \ys -> Map.union (NonEmptyMap.flatten xs) (NonEmptyMap.flatten ys) == NonEmptyMap.flatten (NonEmptyMap.union xs ys)+ ) DocTest.printPrefix "Data.NonEmpty.Map:221: " {-# LINE 221 "src/Data/NonEmpty/Map.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 221 "src/Data/NonEmpty/Map.hs" #-}- (forAllMap $ \xm -> forAllNonEmptyMap $ \ym -> Map.union xm (NonEmptyMap.flatten ym) == NonEmptyMap.flatten (NonEmptyMap.unionLeft xm ym))+ forAllMap $ \xm -> forAllNonEmptyMap $ \ym -> Map.union xm (NonEmptyMap.flatten ym) == NonEmptyMap.flatten (NonEmptyMap.unionLeft xm ym)+ ) DocTest.printPrefix "Data.NonEmpty.Map:226: " {-# LINE 226 "src/Data/NonEmpty/Map.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 226 "src/Data/NonEmpty/Map.hs" #-}- (forAllNonEmptyMap $ \xm -> forAllMap $ \ym -> Map.union (NonEmptyMap.flatten xm) ym == NonEmptyMap.flatten (NonEmptyMap.unionRight xm ym))+ forAllNonEmptyMap $ \xm -> forAllMap $ \ym -> Map.union (NonEmptyMap.flatten xm) ym == NonEmptyMap.flatten (NonEmptyMap.unionRight xm ym)+ ) DocTest.printPrefix "Data.NonEmpty.Map:231: " {-# LINE 231 "src/Data/NonEmpty/Map.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 231 "src/Data/NonEmpty/Map.hs" #-}- (forAllNonEmptyMap $ \xs -> forAllNonEmptyMap $ \ys -> Map.unionWith (++) (NonEmptyMap.flatten xs) (NonEmptyMap.flatten ys) == NonEmptyMap.flatten (NonEmptyMap.unionWith (++) xs ys))+ forAllNonEmptyMap $ \xs -> forAllNonEmptyMap $ \ys -> Map.unionWith (++) (NonEmptyMap.flatten xs) (NonEmptyMap.flatten ys) == NonEmptyMap.flatten (NonEmptyMap.unionWith (++) xs ys)+ ) DocTest.printPrefix "Data.NonEmpty.Map:242: " {-# LINE 242 "src/Data/NonEmpty/Map.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 242 "src/Data/NonEmpty/Map.hs" #-}- (forAllMap $ \xm -> forAllNonEmptyMap $ \ym -> Map.unionWith (++) xm (NonEmptyMap.flatten ym) == NonEmptyMap.flatten (NonEmptyMap.unionLeftWith (++) xm ym))+ forAllMap $ \xm -> forAllNonEmptyMap $ \ym -> Map.unionWith (++) xm (NonEmptyMap.flatten ym) == NonEmptyMap.flatten (NonEmptyMap.unionLeftWith (++) xm ym)+ ) DocTest.printPrefix "Data.NonEmpty.Map:247: " {-# LINE 247 "src/Data/NonEmpty/Map.hs" #-}- DocTest.property+ DocTest.property( {-# LINE 247 "src/Data/NonEmpty/Map.hs" #-}- (forAllNonEmptyMap $ \xm -> forAllMap $ \ym -> Map.unionWith (++) (NonEmptyMap.flatten xm) ym == NonEmptyMap.flatten (NonEmptyMap.unionRightWith (++) xm ym))+ forAllNonEmptyMap $ \xm -> forAllMap $ \ym -> Map.unionWith (++) (NonEmptyMap.flatten xm) ym == NonEmptyMap.flatten (NonEmptyMap.unionRightWith (++) xm ym)+ )
+ test/Test/Data/NonEmpty/Mixed.hs view
@@ -0,0 +1,50 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/NonEmpty/Mixed.hs+{-# LINE 24 "src/Data/NonEmpty/Mixed.hs" #-}++module Test.Data.NonEmpty.Mixed where++import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 25 "src/Data/NonEmpty/Mixed.hs" #-}+import qualified Data.NonEmpty as NonEmpty+import qualified Data.List.Match as Match+import Data.NonEmpty.Mixed (chopNothing)+import Data.NonEmpty.Class (append)+import Data.Eq.HT (equating)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.NonEmpty.Mixed:77: "+{-# LINE 77 "src/Data/NonEmpty/Mixed.hs" #-}+ DocTest.example(+{-# LINE 77 "src/Data/NonEmpty/Mixed.hs" #-}+ chopNothing ([] :: [Maybe String])+ )+ [ExpectedLine [LineChunk "[]!:[]"]]+ DocTest.printPrefix "Data.NonEmpty.Mixed:80: "+{-# LINE 80 "src/Data/NonEmpty/Mixed.hs" #-}+ DocTest.example(+{-# LINE 80 "src/Data/NonEmpty/Mixed.hs" #-}+ chopNothing [Nothing :: Maybe String]+ )+ [ExpectedLine [LineChunk "[]!:[]:[]"]]+ DocTest.printPrefix "Data.NonEmpty.Mixed:83: "+{-# LINE 83 "src/Data/NonEmpty/Mixed.hs" #-}+ DocTest.example(+{-# LINE 83 "src/Data/NonEmpty/Mixed.hs" #-}+ chopNothing [Just "a", Just "b", Nothing, Just "c", Nothing, Just "d", Just "e"]+ )+ [ExpectedLine [LineChunk "[\"a\",\"b\"]!:[\"c\"]:[\"d\",\"e\"]:[]"]]+ DocTest.printPrefix "Data.NonEmpty.Mixed:86: "+{-# LINE 86 "src/Data/NonEmpty/Mixed.hs" #-}+ DocTest.property(+{-# LINE 86 "src/Data/NonEmpty/Mixed.hs" #-}+ \xs ys -> chopNothing (xs ++ Nothing : ys) == append (chopNothing xs) (chopNothing (ys :: [Maybe Int]))+ )+ DocTest.printPrefix "Data.NonEmpty.Mixed:88: "+{-# LINE 88 "src/Data/NonEmpty/Mixed.hs" #-}+ DocTest.property(+{-# LINE 88 "src/Data/NonEmpty/Mixed.hs" #-}+ \ns xs -> equating (Match.take (ns::[()]) . NonEmpty.flatten) (NonEmpty.cycle (chopNothing xs)) (chopNothing (cycle (xs ++ [Nothing :: Maybe Int])))+ )
test/Test/Data/NonEmptyPrivate.hs view
@@ -1,13 +1,16 @@ -- Do not edit! Automatically created with doctest-extract from src/Data/NonEmptyPrivate.hs-{-# LINE 40 "src/Data/NonEmptyPrivate.hs" #-}+{-# LINE 43 "src/Data/NonEmptyPrivate.hs" #-} module Test.Data.NonEmptyPrivate where +import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest -{-# LINE 41 "src/Data/NonEmptyPrivate.hs" #-}+{-# LINE 44 "src/Data/NonEmptyPrivate.hs" #-}+import qualified Data.NonEmpty.Class as NonEmptyC import qualified Data.NonEmpty as NonEmpty import qualified Data.Empty as Empty+import qualified Data.List.HT as ListHT import qualified Data.Either.HT as EitherHT import qualified Control.Functor.HT as FuncHT import qualified Data.Ix as Ix@@ -24,33 +27,87 @@ test :: DocTest.T () test = do- DocTest.printPrefix "Data.NonEmptyPrivate:604: "-{-# LINE 604 "src/Data/NonEmptyPrivate.hs" #-}- DocTest.property-{-# LINE 604 "src/Data/NonEmptyPrivate.hs" #-}- (let takeUntil p xs = NonEmpty.zipWith const xs $ () !: void (takeWhile (not . p) $ NonEmpty.flatten xs) in \k xs -> takeUntil (>=k) xs == NonEmpty.takeUntil (>=(k::Int)) xs)- DocTest.printPrefix "Data.NonEmptyPrivate:748: "-{-# LINE 748 "src/Data/NonEmptyPrivate.hs" #-}- DocTest.property-{-# LINE 748 "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:749: "-{-# LINE 749 "src/Data/NonEmptyPrivate.hs" #-}- DocTest.property-{-# LINE 749 "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:750: "-{-# LINE 750 "src/Data/NonEmptyPrivate.hs" #-}- DocTest.property-{-# LINE 750 "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:760: "-{-# LINE 760 "src/Data/NonEmptyPrivate.hs" #-}- DocTest.property-{-# LINE 760 "src/Data/NonEmptyPrivate.hs" #-}- (\xs -> NonEmpty.partitionEithersLeft (fmap EitherHT.swap xs) == EitherHT.mapRight swap (EitherHT.swap (NonEmpty.partitionEithersRight (xs::NonEmpty.T[](Either Char Int)))))- DocTest.printPrefix "Data.NonEmptyPrivate:771: "-{-# LINE 771 "src/Data/NonEmptyPrivate.hs" #-}- DocTest.property-{-# LINE 771 "src/Data/NonEmptyPrivate.hs" #-}- (forRange $ \b0 -> forRange $ \b1 -> forRange $ \b2 -> let b = FuncHT.unzip $ b0!:b1!:b2!:Empty.Cons in map (Ix.index b) (Ix.range b) == take (Ix.rangeSize b) [0..])+ DocTest.printPrefix "Data.NonEmptyPrivate:484: "+{-# LINE 484 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property(+{-# LINE 484 "src/Data/NonEmptyPrivate.hs" #-}+ + \xs ys ->+ NonEmpty.flatten (NonEmptyC.mergeBy (<=) xs (ys :: NonEmpty.T [] Int))+ ==+ ListHT.mergeBy (<=) (NonEmpty.flatten xs) (NonEmpty.flatten ys)+ )+ DocTest.printPrefix "Data.NonEmptyPrivate:498: "+{-# LINE 498 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property(+{-# LINE 498 "src/Data/NonEmptyPrivate.hs" #-}+ + \xs ys ->+ NonEmpty.flatten (NonEmpty.mergeLeftBy (<=) xs (ys :: [Int]))+ ==+ ListHT.mergeBy (<=) (NonEmpty.flatten xs) ys+ )+ DocTest.printPrefix "Data.NonEmptyPrivate:517: "+{-# LINE 517 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property(+{-# LINE 517 "src/Data/NonEmptyPrivate.hs" #-}+ + \xs ys ->+ NonEmpty.flatten (NonEmpty.mergeRightBy (<=) (xs :: [Int]) ys)+ ==+ ListHT.mergeBy (<=) xs (NonEmpty.flatten ys)+ )+ DocTest.printPrefix "Data.NonEmptyPrivate:536: "+{-# LINE 536 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.example(+{-# LINE 536 "src/Data/NonEmptyPrivate.hs" #-}+ NonEmpty.mergeBy (<=) ('c'!:'d':'f':[]) ('a'!:'e':'h':[])+ )+ [ExpectedLine [LineChunk "'a'!:'c'!:'d':'e':'f':'h':[]"]]+ DocTest.printPrefix "Data.NonEmptyPrivate:539: "+{-# LINE 539 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property(+{-# LINE 539 "src/Data/NonEmptyPrivate.hs" #-}+ + \xs ys ->+ NonEmpty.flatten+ (NonEmpty.flatten (NonEmpty.mergeBy (<=) xs (ys :: NonEmpty.T [] Int)))+ ==+ ListHT.mergeBy (<=) (NonEmpty.flatten xs) (NonEmpty.flatten ys)+ )+ DocTest.printPrefix "Data.NonEmptyPrivate:684: "+{-# LINE 684 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property(+{-# LINE 684 "src/Data/NonEmptyPrivate.hs" #-}+ let takeUntil p xs = NonEmpty.zipWith const xs $ () !: void (takeWhile (not . p) $ NonEmpty.flatten xs) in \k xs -> takeUntil (>=k) xs == NonEmpty.takeUntil (>=(k::Int)) xs+ )+ DocTest.printPrefix "Data.NonEmptyPrivate:828: "+{-# LINE 828 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property(+{-# LINE 828 "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:829: "+{-# LINE 829 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property(+{-# LINE 829 "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:830: "+{-# LINE 830 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property(+{-# LINE 830 "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:840: "+{-# LINE 840 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property(+{-# LINE 840 "src/Data/NonEmptyPrivate.hs" #-}+ \xs -> NonEmpty.partitionEithersLeft (fmap EitherHT.swap xs) == EitherHT.mapRight swap (EitherHT.swap (NonEmpty.partitionEithersRight (xs::NonEmpty.T[](Either Char Int))))+ )+ DocTest.printPrefix "Data.NonEmptyPrivate:851: "+{-# LINE 851 "src/Data/NonEmptyPrivate.hs" #-}+ DocTest.property(+{-# LINE 851 "src/Data/NonEmptyPrivate.hs" #-}+ forRange $ \b0 -> forRange $ \b1 -> forRange $ \b2 -> let b = FuncHT.unzip $ b0!:b1!:b2!:Empty.Cons in map (Ix.index b) (Ix.range b) == take (Ix.rangeSize b) [0..]+ )