non-empty 0.2.1 → 0.3

raw patch · 12 files changed

+252/−89 lines, 12 filesdep +deepseqdep ~containersdep ~utility-htPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

Dependency ranges changed: containers, utility-ht

API changes (from Hackage documentation)

Files

• non-empty.cabal +7/−5
• src/Data/Append.hs +9/−0
• src/Data/Empty.hs +7/−0
• src/Data/NonEmpty.hs +3/−3
• src/Data/NonEmpty/Class.hs +28/−0
• src/Data/NonEmpty/Foldable.hs +20/−0
• src/Data/NonEmpty/Map.hs +18/−2
• src/Data/NonEmpty/Mixed.hs +30/−0
• src/Data/NonEmpty/Set.hs +64/−3
• src/Data/NonEmptyPrivate.hs +46/−59
• src/Data/Optional.hs +12/−17
• src/Data/Zip.hs +8/−0

@@ -1,10 +1,10 @@ Name:             non-empty-Version:          0.2.1+Version:          0.3 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de> Maintainer:       Henning Thielemann <haskell@henning-thielemann.de>-Homepage:         http://code.haskell.org/~thielema/non-empty/+Homepage:         http://hub.darcs.net/thielema/non-empty/ Category:         Data Synopsis:         List-like structures with static restrictions on the number of elements Description:@@ -66,17 +66,18 @@ Build-Type:       Simple  Source-Repository this-  Tag:         0.2.1+  Tag:         0.3   Type:        darcs-  Location:    http://code.haskell.org/~thielema/non-empty/+  Location:    http://hub.darcs.net/thielema/non-empty/  Source-Repository head   Type:        darcs-  Location:    http://code.haskell.org/~thielema/non-empty/+  Location:    http://hub.darcs.net/thielema/non-empty/  Library   Build-Depends:     containers >=0.4 && <0.6,+    deepseq >=1.3 && <1.5,     utility-ht >=0.0.1 && <0.1,     QuickCheck >=2.1 && <3,     base >=4 && <5@@ -95,5 +96,6 @@     Data.Append     Data.Zip   Other-Modules:+    Data.NonEmpty.Foldable     Data.NonEmptyPrivate     Data.NonEmptyTest

@@ -1,6 +1,8 @@ module Data.Append where +import qualified Data.NonEmpty.Class as C import Control.Applicative (liftA2)+import Control.DeepSeq (NFData, rnf, ) import Data.Traversable (Traversable, traverse) import Data.Foldable (Foldable, foldMap) import Data.Monoid (mappend)@@ -22,3 +24,10 @@  instance (Traversable f, Traversable g) => Traversable (T f g) where    traverse f (Cons xs ys) = liftA2 Cons (traverse f xs) (traverse f ys)+++instance (C.NFData f, C.NFData g) => C.NFData (T f g) where+   rnf (Cons f g) = rnf (C.rnf f, C.rnf g)++instance (C.NFData f, C.NFData g, NFData a) => NFData (T f g a) where+   rnf = C.rnf

@@ -5,6 +5,7 @@ import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold import Control.Applicative (pure, )+import Control.DeepSeq (NFData, rnf, )  import qualified Test.QuickCheck as QC @@ -64,3 +65,9 @@ -} instance C.Iterate T where    iterate _ _ = Cons++instance C.NFData T where+   rnf Cons = ()++instance NFData (T a) where+   rnf Cons = ()

@@ -18,6 +18,7 @@    foldl1,    foldl1Map,    foldBalanced,+   foldBalancedStrict,    maximum, maximumBy, maximumKey,    minimum, minimumBy, minimumKey,    sum,@@ -29,9 +30,8 @@    Insert(insert), insertDefault,    InsertBy(insertBy),    scanl, scanr,-   Tails(tails),-   inits, initsRev,-   RemoveEach(removeEach),+   tails, inits, initsRev,+   removeEach,    ) where  import Data.NonEmptyPrivate

@@ -1,10 +1,13 @@ module Data.NonEmpty.Class where  import qualified Data.Sequence as Seq+import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.List.HT as ListHT import qualified Data.List as List+import qualified Control.DeepSeq as DeepSeq import Data.Sequence (Seq, )+import Data.Map (Map, ) import Data.Set (Set, ) import Data.Traversable (Traversable, mapAccumL, mapAccumR) import Control.Monad (liftM2, )@@ -28,6 +31,9 @@ instance Empty Set where    empty = Set.empty +instance Empty (Map k) where+   empty = Map.empty+ instance Empty Seq where    empty = Seq.empty @@ -184,7 +190,10 @@ instance Repeat [] where    repeat = List.repeat +instance Repeat Maybe where+   repeat = Just + -- might be replaced by Mixed.iterate based on Traversable class Repeat f => Iterate f where    iterate :: (a -> a) -> a -> f a@@ -192,7 +201,10 @@ instance Iterate [] where    iterate = List.iterate +instance Iterate Maybe where+   iterate _ = Just + {- | We need to distinguish between 'Sort' and 'SortBy', since there is an @instance Sort Set@@@ -263,3 +275,19 @@ instance Arbitrary [] where    arbitrary = QC.arbitrary    shrink = QC.shrink+++class NFData f where+   rnf :: DeepSeq.NFData a => f a -> ()++instance NFData Maybe where+   rnf = DeepSeq.rnf++instance NFData [] where+   rnf = DeepSeq.rnf++instance NFData Set where+   rnf = DeepSeq.rnf++instance (DeepSeq.NFData k) => NFData (Map k) where+   rnf = DeepSeq.rnf

@@ -0,0 +1,20 @@+module Data.NonEmpty.Foldable where++import qualified Data.Foldable as Fold+import Data.Foldable (Foldable, )+++{- |+It holds:++> foldMap f . Mapped g = foldMap f . fmap g++but use of 'Mapped' avoids 'Functor' constraint.+-}+data Mapped f a b = Mapped (a -> b) (f a)+++instance (Foldable f) => Foldable (Mapped f a) where+   foldMap g (Mapped f xs) = Fold.foldMap (g . f) xs+   foldr g x (Mapped f xs) = Fold.foldr (g . f) x xs+   foldl g x (Mapped f xs) = Fold.foldl (\acc -> g acc . f) x xs

@@ -17,9 +17,12 @@    union,    unionLeft,    unionRight,+   map,+   mapWithKey,    ) where  import qualified Data.NonEmpty.Set as NonEmptySet+import qualified Data.NonEmpty.Class as C import qualified Data.NonEmpty as NonEmpty  import qualified Data.Map as Map@@ -27,6 +30,7 @@  import Control.Monad (mzero, ) import Control.Applicative (liftA2, )+import Control.DeepSeq (NFData, rnf, ) import Data.Traversable (Traversable, traverse, ) import Data.Foldable (Foldable, foldMap, ) import Data.Monoid (mappend, )@@ -34,7 +38,7 @@ import Data.Tuple.HT (forcePair, mapSnd, ) import Data.Ord.HT (comparing, ) -import Prelude hiding (lookup, )+import Prelude hiding (map, lookup, )   {-@@ -50,7 +54,7 @@          showsPrec 11 (toAscList xs)  instance (Ord k) => Functor (T k) where-   fmap f (Cons x xs) = Cons (mapSnd f x) (fmap f xs)+   fmap = map  instance (Ord k) => Foldable (T k) where    foldMap f (Cons x xs) = mappend (f (snd x)) (foldMap f xs)@@ -59,7 +63,13 @@    traverse f (Cons x xs) =       liftA2 Cons (fmap ((,) (fst x)) $ f (snd x)) (traverse f xs) +instance (NFData k, NFData a) => NFData (T k a) where+   rnf = C.rnf +instance (NFData k) => C.NFData (T k) where+   rnf (Cons x xs) = rnf (x, C.rnf xs)++ insert :: Ord k => k -> a -> Map k a -> T k a insert = curry $ insertGen fst @@ -138,3 +148,9 @@ unionRight :: (Ord k) => T k a -> Map k a -> T k a unionRight (Cons x xs) ys =    insertGen fst x $ Map.union xs ys++map :: (Ord k) => (a -> b) -> T k a -> T k b+map f (Cons x xs) = Cons (mapSnd f x) (Map.map f xs)++mapWithKey :: (Ord k) => (k -> a -> b) -> T k a -> T k b+mapWithKey f (Cons x@(k,_a) xs) = Cons (k, uncurry f x) (Map.mapWithKey f xs)

@@ -8,6 +8,7 @@ -} module Data.NonEmpty.Mixed where +import qualified Data.NonEmpty.Foldable as FoldU import qualified Data.NonEmpty.Class as C import qualified Data.NonEmpty as NonEmpty import qualified Data.Empty as Empty@@ -15,6 +16,7 @@ import Data.Traversable (Traversable, mapAccumL, sequenceA, ) import Data.Foldable (Foldable, foldr, ) import Data.Tuple.HT (mapFst, mapSnd, )+import Data.Eq.HT (equating, )  import Prelude hiding (splitAt, take, foldr, scanl, scanr, ) @@ -34,6 +36,34 @@                   [] -> ([],yt)          in  NonEmpty.Cons x0 xr : yr)       []++groupPairs :: (Foldable f, Eq a) => f (a,b) -> [(a, NonEmpty.T [] b)]+groupPairs =+   map (\xs -> (fst $ NonEmpty.head xs, fmap snd xs)) .+   groupBy (equating fst)++groupKey :: (Foldable f, Eq a) => (b -> a) -> f b -> [(a, NonEmpty.T [] b)]+groupKey f = groupPairs . FoldU.Mapped (\b -> (f b, b))++groupEithers ::+   (Foldable f) =>+   f (Either a b) -> [Either (NonEmpty.T [] a) (NonEmpty.T [] b)]+groupEithers =+   foldr+      (\x xs ->+         case x of+            Left a ->+               uncurry (:) $ mapFst (Left . NonEmpty.Cons a) $+               case xs of+                  Left as : ys -> (NonEmpty.flatten as, ys)+                  ys -> ([], ys)+            Right b ->+               uncurry (:) $ mapFst (Right . NonEmpty.Cons b) $+               case xs of+                  Right bs : ys -> (NonEmpty.flatten bs, ys)+                  ys -> ([], ys))+      []+  segmentAfter ::    (Foldable f) =>

@@ -4,24 +4,34 @@    singleton,    member,    size,-   minView,-   maxView,    fromList,    toAscList,+   fetch,    flatten,    union,    unionLeft,    unionRight,++   findMin,+   findMax,+   deleteMin,+   deleteMax,+   deleteFindMin,+   deleteFindMax,+   minView,+   maxView,    ) where +import qualified Data.NonEmpty.Class as C import qualified Data.NonEmpty as NonEmpty  import qualified Data.Set as Set import Data.Set (Set, )  import Control.Monad (mzero, )+import Control.DeepSeq (NFData, rnf, ) import Data.Maybe (fromMaybe, )-import Data.Tuple.HT (forcePair, )+import Data.Tuple.HT (forcePair, mapSnd, )   {-@@ -40,6 +50,13 @@          showsPrec 11 (toAscList xs)  +instance (NFData a) => NFData (T a) where+   rnf = C.rnf++instance C.NFData T where+   rnf (Cons x xs) = rnf (x, C.rnf xs)++ {- | We cannot have a reasonable @instance Insert Set@, since the @instance Insert (NonEmpty Set)@@@ -80,6 +97,33 @@ size :: T a -> Int size (Cons _ xs) = 1 + Set.size xs ++findMin :: T a -> a+findMin (Cons x _) = x++findMax :: T a -> a+findMax (Cons x xs) =+   if Set.null xs then x else Set.findMax xs+++deleteMin :: T a -> Set a+deleteMin (Cons _ xs) = xs++deleteMax :: (Ord a) => T a -> Set a+deleteMax (Cons x xs) =+   if Set.null xs then Set.empty else Set.insert x $ Set.deleteMax xs+++deleteFindMin :: T a -> (a, Set a)+deleteFindMin (Cons x xs) = (x, xs)++deleteFindMax :: (Ord a) => T a -> (a, Set a)+deleteFindMax (Cons x xs) =+   if Set.null xs+     then (x, Set.empty)+     else mapSnd (Set.insert x) $ Set.deleteFindMax xs++ minView :: T a -> (a, Set a) minView (Cons x xs) = (x,xs) @@ -90,12 +134,16 @@       Nothing -> (x,xs)       Just (y,ys) -> (y, Set.insert x ys) + fromList :: (Ord a) => NonEmpty.T [] a -> T a fromList (NonEmpty.Cons x xs) = insert x $ Set.fromList xs  toAscList :: T a -> NonEmpty.T [] a toAscList (Cons x xs) = NonEmpty.Cons x $ Set.toAscList xs +fetch :: (Ord a) => Set a -> Maybe (T a)+fetch  =  fmap (uncurry Cons) . Set.minView+ flatten :: (Ord a) => T a -> Set a flatten (Cons x xs) = Set.insert x xs @@ -116,3 +164,16 @@ unionRight :: (Ord a) => T a -> Set a -> T a unionRight (Cons x xs) ys =    insertGen fst x $ Set.union xs ys+++{-+According Set functions are only available since containers-0.5.2, i.e. GHC-7.8.++elemAt :: Int -> T a -> a+elemAt k (Cons x xs) =+   if k==0 then x else Set.elemAt (pred k) xs++deleteAt :: Int -> T a -> Set a+deleteAt k (Cons _ xs) =+   if k==0 then xs else Set.deleteAt (pred k) xs+-}

@@ -1,5 +1,6 @@ module Data.NonEmptyPrivate where +import qualified Data.NonEmpty.Foldable as FoldU import qualified Data.NonEmpty.Class as C import qualified Data.Empty as Empty @@ -15,18 +16,19 @@ import Data.Foldable (Foldable, ) 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.Maybe (Maybe(Just, Nothing), maybe, mapMaybe, ) import Data.Bool.HT (if', ) import Data.Bool (Bool(True), (&&), )-import Data.Ord (Ord, Ordering(GT), (<), (>), compare, comparing, )+import Data.Ord (Ord, Ordering(GT), (<=), (>), compare, comparing, ) import Data.Eq ((==), ) import Data.Tuple.HT (mapFst, mapSnd, swap, ) import Data.Tuple (fst, snd, ) import qualified Prelude as P-import Prelude (Eq, Show, Num, uncurry, )+import Prelude (Eq, Show, Num, Int, uncurry, ($!), )  import qualified Test.QuickCheck as QC @@ -67,6 +69,14 @@ data T f a = Cons { head :: a, tail :: f a }    deriving (Eq, Ord) ++instance (C.NFData f, NFData a) => NFData (T f a) where+   rnf = C.rnf++instance (C.NFData f) => C.NFData (T f) where+   rnf (Cons x xs) = rnf (x, C.rnf xs)++ instance (C.Show f, Show a) => Show (T f a) where    showsPrec = C.showsPrec @@ -277,8 +287,14 @@ in order to get the same result as 'foldl1' or 'foldr1'. -} foldBalanced :: (a -> a -> a) -> T [] a -> a-foldBalanced f xs@(Cons _ rs) =-   let reduce (z0:z1:zs) = f z0 z1 : reduce zs+foldBalanced = foldBalancedGen (:)++foldBalancedStrict :: (a -> a -> a) -> T [] a -> a+foldBalancedStrict = foldBalancedGen (\x -> ((:) $! x))++foldBalancedGen :: (a -> [a] -> [a]) -> (a -> a -> a) -> T [] a -> a+foldBalancedGen listCons f xs@(Cons _ rs) =+   let reduce (z0:z1:zs) = listCons (f z0 z1) (reduce zs)        reduce zs = zs        ys = appendRight xs $ Match.take rs $ reduce $ flatten ys    in  last ys@@ -303,18 +319,12 @@ -- | maximumKey is a total function maximumKey :: (Ord b, Foldable f) => (a -> b) -> T f a -> a maximumKey f =-   snd .-   foldl1Map-      (\ky0 ky1 -> if fst ky0 < fst ky1 then ky1 else ky0)-      (attachKey f)+   snd . Fold.maximumBy (comparing fst) . FoldU.Mapped (attachKey f)  -- | minimumKey is a total function minimumKey :: (Ord b, Foldable f) => (a -> b) -> T f a -> a minimumKey f =-   snd .-   foldl1Map-      (\ky0 ky1 -> if fst ky0 > fst ky1 then ky1 else ky0)-      (attachKey f)+   snd . Fold.minimumBy (comparing fst) . FoldU.Mapped (attachKey f)  -- | maximumKey is a total function _maximumKey :: (Ord b, Foldable f, Functor f) => (a -> b) -> T f a -> a@@ -520,59 +530,31 @@   -class Functor f => RemoveEach f where-   removeEach :: T f a -> T f (a, f a)+mapWithIndex :: (Traversable f) => (Int -> a -> b) -> Int -> f a -> f b+mapWithIndex f n = snd . mapAccumL (\k x -> (P.succ k, f k x)) n -instance RemoveEach [] where-   removeEach (Cons x xs) =-      Cons (x, xs) (fmap (mapSnd (x:)) $ ListHT.removeEach xs)+removeAt :: (Traversable f) => Int -> T f a -> (a, f a)+removeAt n (Cons x0 xs) =+   mapAccumL (\x (k,y) -> if k<=n then (y,x) else (x,y)) x0 $+   mapWithIndex (,) 1 xs -instance RemoveEach Empty.T where-   removeEach (Cons x Empty.Cons) = Cons (x, Empty.Cons) Empty.Cons+removeEach :: (Traversable f) => T f a -> T f (a, f a)+removeEach xs  =  mapWithIndex (\n _ -> removeAt n xs) 0 xs -instance RemoveEach f => RemoveEach (T f) where-   removeEach (Cons x xs) =-      Cons (x, xs) (fmap (mapSnd (x !:)) $ removeEach xs) -instance RemoveEach Maybe where-   removeEach (Cons x0 xs) =-      (\ ~(a,b) -> Cons (x0, a) b) $-      case xs of-         Nothing -> (Nothing, Nothing)-         Just x1 -> (Just x1, Just (x1, Just x0)) - {- It is somehow better than the variant in NonEmpty.Mixed, since it can be applied to nested NonEmptys.--}-class Tails f where-   tails :: (C.Cons g, C.Empty g) => f a -> T f (g a) -instance Tails [] where-   tails = tailsTraversable--instance Tails Empty.T where-   tails Empty.Cons = Cons C.empty Empty.Cons--instance Tails f => Tails (T f) where-   tails (Cons x xs) =-      case tails xs of-         xss -> Cons (C.cons x $ head xss) xss--instance Tails Maybe where-   tails xs =-      force $-      case xs of-         Nothing -> Cons C.empty Nothing-         Just x -> Cons (C.cons x C.empty) (Just C.empty)--instance Tails Seq where-   tails = tailsTraversable--tailsTraversable :: (Traversable f, C.Cons g, C.Empty g) => f a -> T f (g a)-tailsTraversable =-   uncurry cons . mapAccumR (\xs x -> (C.cons x xs, xs)) C.empty+Type @g@ could be fixed to List,+since context (C.Cons g, C.Empty g) means+that @g@ is a supertype of something isomorphic to list.+However, repeatedly prepending an element might be more efficient+than repeated conversion from list to a structure like Sequence.+-}+tails :: (Traversable f, C.Cons g, C.Empty g) => f a -> T f (g a)+tails = scanr C.cons C.empty   {- |@@ -580,9 +562,7 @@ like 'Sequence'. Alternatively you may consider 'initsRev'. -}-inits ::-   (Traversable f, C.Snoc g, C.Empty g) =>-   f a -> T f (g a)+inits :: (Traversable f, C.Snoc g, C.Empty g) => f a -> T f (g a) inits = scanl C.snoc C.empty  {-@@ -686,3 +666,10 @@    (Traversable f) => (a -> a -> b) -> T f a -> f b mapAdjacent f (Cons x xs) =    snd $ mapAccumL (\a0 a1 -> (a1, f a0 a1)) x xs++{-+A nice function but not particularly related to NonEmpty.+Maybe move it to Class module?+-}+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))

@@ -13,6 +13,7 @@ import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold import Control.Applicative (pure, liftA2, )+import Control.DeepSeq (NFData, rnf, )  import qualified Test.QuickCheck as QC @@ -20,7 +21,6 @@ import Data.Functor (fmap, ) import Data.Function (($), (.), ) import Data.Ord (Ord, Ordering(GT), (>), )-import Data.Tuple.HT (mapSnd, ) import qualified Prelude as P import Prelude (Eq, uncurry, ) @@ -35,6 +35,14 @@ fromNonEmpty (NonEmpty.Cons x xs) = Cons x xs  +instance (C.NFData f, NFData a) => NFData (T f a) where+   rnf = C.rnf++instance (C.NFData f) => C.NFData (T f) where+   rnf Nil = ()+   rnf (Cons x xs) = rnf (x, C.rnf xs)++ instance (C.Show f, P.Show a) => P.Show (T f a) where    showsPrec = C.showsPrec @@ -81,6 +89,9 @@ instance (C.Repeat f) => C.Repeat (T f) where    repeat x = Cons x $ C.repeat x +instance (C.Iterate f) => C.Iterate (T f) where+   iterate f x = Cons x $ C.iterate f (f x)+ instance C.Zip f => C.Zip (T f) where    zipWith f (Cons x xs) (Cons y ys) = Cons (f x y) (C.zipWith f xs ys)    zipWith _ _ _ = Nil@@ -119,19 +130,3 @@             case f y x of                GT -> (x, fromNonEmpty $ NonEmpty.insertBy f y xs)                _ -> (y, xt)--instance NonEmpty.RemoveEach f => NonEmpty.RemoveEach (T f) where-   removeEach (NonEmpty.Cons x Nil) = NonEmpty.Cons (x, Nil) Nil-   removeEach (NonEmpty.Cons x0 xs0@(Cons x1 xs1)) =-      NonEmpty.Cons (x0, xs0) $-      fmap (mapSnd (x0 ?:)) $-      fromNonEmpty $ NonEmpty.removeEach $ NonEmpty.Cons x1 xs1--instance NonEmpty.Tails f => NonEmpty.Tails (T f) where-   tails xt =-      NonEmpty.force $-      case xt of-         Nil -> NonEmpty.Cons C.empty Nil-         Cons x xs ->-            case NonEmpty.tails xs of-               xss -> NonEmpty.Cons (C.cons x $ NonEmpty.head xss) (fromNonEmpty xss)

@@ -5,6 +5,7 @@ import qualified Data.Traversable as Trav import Data.Traversable (Traversable, ) import Control.Applicative (Applicative, pure, (<*>), )+import Control.DeepSeq (NFData, rnf, )   {- |@@ -18,6 +19,13 @@ instance (C.Zip f, C.Repeat f) => Applicative (T f) where    pure a = Cons $ C.repeat a    Cons f <*> Cons x = Cons $ C.zipWith ($) f x+++instance (C.NFData f, NFData a) => NFData (T f a) where+   rnf = C.rnf++instance (C.NFData f) => C.NFData (T f) where+   rnf = C.rnf . decons   {- |