packages feed

non-empty 0.1.3 → 0.2

raw patch · 11 files changed

+586/−86 lines, 11 files

Files

non-empty.cabal view
@@ -1,5 +1,5 @@ Name:             non-empty-Version:          0.1.3+Version:          0.2 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -57,13 +57,13 @@ Build-Type:       Simple  Source-Repository this-  Tag:         0.1.3+  Tag:         0.2   Type:        darcs-  Location:    http://code.haskell.org/~thielema/non-empty+  Location:    http://code.haskell.org/~thielema/non-empty/  Source-Repository head   Type:        darcs-  Location:    http://code.haskell.org/~thielema/non-empty+  Location:    http://code.haskell.org/~thielema/non-empty/  Library   Build-Depends:@@ -78,8 +78,12 @@     Data.NonEmpty     Data.NonEmpty.Class     Data.NonEmpty.Mixed+    Data.NonEmpty.Set+    Data.NonEmpty.Map     Data.Empty     Data.Optional+    Data.Append     Data.Zip   Other-Modules:     Data.NonEmptyPrivate+    Data.NonEmptyTest
+ src/Data/Append.hs view
@@ -0,0 +1,24 @@+module Data.Append where++import Control.Applicative (liftA2)+import Data.Traversable (Traversable, traverse)+import Data.Foldable (Foldable, foldMap)+import Data.Monoid (mappend)++import Prelude hiding (fst, snd)+++data T f g a =+   Cons {+      fst :: f a,+      snd :: g a+   }++instance (Functor f, Functor g) => Functor (T f g) where+   fmap f (Cons xs ys) = Cons (fmap f xs) (fmap f ys)++instance (Foldable f, Foldable g) => Foldable (T f g) where+   foldMap f (Cons xs ys) = mappend (foldMap f xs) (foldMap f ys)++instance (Traversable f, Traversable g) => Traversable (T f g) where+   traverse f (Cons xs ys) = liftA2 Cons (traverse f xs) (traverse f ys)
src/Data/Empty.hs view
@@ -27,9 +27,14 @@ instance Trav.Traversable T where    sequenceA Cons = pure Cons -instance C.View T where+instance C.ViewL T where    viewL _ = Nothing +instance C.ViewR T where+   viewR _ = Nothing++instance C.View T where+ instance QC.Arbitrary (T a) where    arbitrary = return Cons    shrink _ = []@@ -43,6 +48,9 @@ instance C.Reverse T where reverse = id  instance C.Sort T where+   sort Cons = Cons++instance C.SortBy T where    sortBy _ Cons = Cons  {-
src/Data/NonEmpty.hs view
@@ -7,14 +7,16 @@    toList,    flatten,    fetch,-   cons,+   cons, snoc,    singleton,    reverse,    mapHead,    mapTail,+   viewL, viewR,    init,    last,    foldl1,+   foldBalanced,    maximum, maximumBy, maximumKey,    minimum, minimumBy, minimumKey,    sum,@@ -23,14 +25,12 @@    cycle,    zipWith,    mapAdjacent,-   sortBy, sort,-   Insert(insertBy), insert,+   Insert(insert), insertDefault,+   InsertBy(insertBy),    scanl, scanr,-   Zip.transposeClip,    Tails(tails),    RemoveEach(removeEach),    ) where -import qualified Data.Zip as Zip import Data.NonEmptyPrivate import Prelude ()
src/Data/NonEmpty/Class.hs view
@@ -6,12 +6,14 @@ import qualified Data.List as List import Data.Sequence (Seq, ) import Data.Set (Set, )+import Data.Traversable (Traversable, mapAccumL, mapAccumR) import Control.Monad (liftM2, )+import Data.Tuple.HT (swap, )  import qualified Test.QuickCheck as QC  import qualified Prelude as P-import Prelude hiding (Show, showsPrec, zipWith, reverse, )+import Prelude hiding (Show, showsPrec, zipWith, zipWith3, reverse, )   class Empty f where@@ -40,19 +42,33 @@    cons = (Seq.<|)  -class View f where+class Snoc f where+   snoc :: f a -> a -> f a++instance Snoc [] where+   snoc = snocDefault++instance Snoc Seq where+   snoc = (Seq.|>)++snocDefault :: (Cons f, Traversable f) => f a -> a -> f a+snocDefault xs x =+   uncurry cons $ mapAccumR (flip (,)) x xs+++class ViewL f where    viewL :: f a -> Maybe (a, f a) -instance View [] where+instance ViewL [] where    viewL = ListHT.viewL -instance View Maybe where+instance ViewL Maybe where    viewL = fmap (\a -> (a, Nothing)) -instance View Set where+instance ViewL Set where    viewL = Set.minView -instance View Seq where+instance ViewL Seq where    viewL x =       case Seq.viewl x of          Seq.EmptyL -> Nothing@@ -60,6 +76,40 @@    -- viewL x = do y Seq.:< ys <- Just $ Seq.viewl x; Just (y,ys)  +class ViewR f where+   viewR :: f a -> Maybe (f a, a)++instance ViewR [] where+   viewR = ListHT.viewR++instance ViewR Maybe where+   viewR = fmap (\a -> (Nothing, a))++instance ViewR Set where+   viewR = fmap swap . Set.maxView++instance ViewR Seq where+   viewR x =+      case Seq.viewr x of+         Seq.EmptyR -> Nothing+         ys Seq.:> y -> Just (ys,y)+++class (ViewL f, ViewR f) => View f where+instance View [] where+instance View Maybe where+instance View Set where+instance View Seq where+++{-+Default implementation of 'viewR' based on 'viewL' and 'Traversable'.+-}+viewRDefault :: (ViewL f, Traversable f) => f a -> Maybe (f a, a)+viewRDefault =+   fmap (swap . uncurry (mapAccumL (flip (,)))) . viewL++ class Singleton f where    singleton :: a -> f a @@ -107,10 +157,22 @@ instance Zip Seq where    zipWith = Seq.zipWith +zipWith3 :: (Zip f) => (a -> b -> c -> d) -> f a -> f b -> f c -> f d+zipWith3 f a b c = zipWith ($) (zipWith f a b) c++zipWith4 :: (Zip f) => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e+zipWith4 f a b c d = zipWith ($) (zipWith3 f a b c) d+ zip :: (Zip f) => f a -> f b -> f (a,b) zip = zipWith (,) +zip3 :: (Zip f) => f a -> f b -> f c -> f (a,b,c)+zip3 = zipWith3 (,,) +zip4 :: (Zip f) => f a -> f b -> f c -> f d -> f (a,b,c,d)+zip4 = zipWith4 (,,,)++ class Repeat f where    {- |    Create a container with as many copies as possible of a given value.@@ -123,22 +185,53 @@    repeat = List.repeat  +class Repeat f => Iterate f where+   iterate :: (a -> a) -> a -> f a++instance Iterate [] where+   iterate = List.iterate+++{- |+We need to distinguish between 'Sort' and 'SortBy',+since there is an @instance Sort Set@+but there cannot be an @instance SortBy Set@.+-} class Sort f where-   sortBy :: (a -> a -> Ordering) -> f a -> f a+   sort :: (Ord a) => f a -> f a  instance Sort [] where-   sortBy = List.sortBy+   sort = List.sort  instance Sort Maybe where-   sortBy _f = id+   sort = id  instance Sort Seq where-   sortBy = Seq.sortBy+   sort = Seq.sort -sort :: (Ord a, Sort f) => f a -> f a-sort = sortBy compare+instance Sort Set where+   sort = id +{- |+Default implementation for 'sort' based on 'sortBy'.+-}+sortDefault :: (Ord a, SortBy f) => f a -> f a+sortDefault = sortBy compare ++class Sort f => SortBy f where+   sortBy :: (a -> a -> Ordering) -> f a -> f a++instance SortBy [] where+   sortBy = List.sortBy++instance SortBy Maybe where+   sortBy _f = id++instance SortBy Seq where+   sortBy = Seq.sortBy++ class Reverse f where    reverse :: f a -> f a @@ -157,6 +250,9 @@         else showParen (p>5) $              foldr (.) (showString "[]") $              map (\x -> P.showsPrec 6 x . showString ":") xs++instance Show Set where+   showsPrec = P.showsPrec   class Arbitrary f where
+ src/Data/NonEmpty/Map.hs view
@@ -0,0 +1,104 @@+module Data.NonEmpty.Map (+   T,+   insert,+   singleton,+   member,+   lookup,+   minViewWithKey,+   maxViewWithKey,+   fromList,+   toAscList,+   flatten,+   union,+   unionLeft,+   unionRight,+   ) where++import qualified Data.NonEmpty as NonEmpty++import qualified Data.Map as Map+import Data.Map (Map, )++import Control.Monad (mzero, )+import Data.Maybe (fromMaybe, )+import Data.Tuple.HT (forcePair, )+import Data.Ord.HT (comparing, )++import Prelude hiding (lookup, )+++{-+The first field will always contain the smallest element.+-}+data T k a = Cons (k, a) (Map k a)+   deriving (Eq, Ord)++instance (Show k, Show a) => Show (T k a) where+   showsPrec p xs =+      showParen (p>10) $+         showString "NonEmptyMap.fromList " .+         showsPrec 11 (toAscList xs)+++insert :: Ord k => k -> a -> Map k a -> T k a+insert = curry $ insertGen fst++insertGen :: Ord k => (((k,a),(k,a)) -> (k,a)) -> (k,a) -> Map k a -> T k a+insertGen select y xt =+   uncurry Cons $+   fromMaybe (y, xt) $ do+      (x,xs) <- Map.minViewWithKey xt+      case comparing fst y x of+         GT -> return (x, uncurry Map.insert y xs)+         EQ -> return (select (y,x), xs)+         LT -> mzero++singleton :: k -> a -> T k a+singleton k a = Cons (k,a) Map.empty++member :: (Ord k) => k -> T k a -> Bool+member y (Cons x xs) =+   y == fst x || Map.member y xs++lookup :: (Ord k) => k -> T k a -> Maybe a+lookup y (Cons x xs) =+   if y == fst x+     then Just $ snd x+     else Map.lookup y xs++minViewWithKey :: T k a -> ((k,a), Map k a)+minViewWithKey (Cons x xs) = (x,xs)++maxViewWithKey :: (Ord k) => T k a -> ((k,a), Map k a)+maxViewWithKey (Cons x xs) =+   forcePair $+   case Map.maxViewWithKey xs of+      Nothing -> (x,xs)+      Just (y,ys) -> (y, uncurry Map.insert x ys)++fromList :: (Ord k) => NonEmpty.T [] (k,a) -> T k a+fromList (NonEmpty.Cons x xs) = uncurry insert x $ Map.fromList xs++toAscList :: T k a -> NonEmpty.T [] (k,a)+toAscList (Cons x xs) = NonEmpty.cons x $ Map.toAscList xs++flatten :: (Ord k) => T k a -> Map k a+flatten (Cons x xs) = uncurry Map.insert x xs++union :: (Ord k) => T k a -> T k a -> T k a+union (Cons x xs) (Cons y ys) =+   uncurry Cons $+   case Map.union xs ys of+      zs ->+         case comparing fst x y of+            LT -> (x, Map.union zs $ uncurry Map.singleton y)+            GT -> (y, uncurry Map.insert x zs)+            EQ -> (x, zs)++unionLeft :: (Ord k) => Map k a -> T k a -> T k a+unionLeft xs (Cons y ys) =+   insertGen snd y $ Map.union xs ys++unionRight :: (Ord k) => T k a -> Map k a -> T k a+unionRight (Cons x xs) ys =+   insertGen fst x $ Map.union xs ys
src/Data/NonEmpty/Mixed.hs view
@@ -48,17 +48,36 @@    C.zipWith f (NonEmpty.flatten xs) (NonEmpty.tail xs)  +{- |+This implementation is more efficient for Sequence than 'NonEmpty.viewR'.+-}+viewR :: (C.ViewR f, C.Empty f, C.Cons f) => NonEmpty.T f a -> (f a, a)+viewR (NonEmpty.Cons x xs) =+   case C.viewR xs of+      Nothing -> (C.empty, x)+      Just (ys, y) -> (C.cons x ys, y)++init :: (C.ViewR f, C.Empty f, C.Cons f) => NonEmpty.T f a -> f a+init = fst . viewR++last :: (C.ViewR f) => NonEmpty.T f a -> a+last (NonEmpty.Cons x xs) =+   case C.viewR xs of+      Nothing -> x+      Just (_, y) -> y++ tails ::-   (C.View f, C.Empty f) =>+   (C.ViewL f, C.Empty f) =>    f a -> NonEmpty.T [] (f a) tails xt =    NonEmpty.force $    case C.viewL xt of       Nothing -> NonEmpty.Cons C.empty []-      Just (_, xs) -> NonEmpty.cons xt $ tails xs+      Just (_, xs) -> C.cons xt $ tails xs  inits ::-   (C.View f, C.Cons f, C.Empty f) =>+   (C.ViewL f, C.Cons f, C.Empty f) =>    f a -> NonEmpty.T [] (f a) inits xt =    NonEmpty.Cons C.empty $
+ src/Data/NonEmpty/Set.hs view
@@ -0,0 +1,114 @@+module Data.NonEmpty.Set (+   T,+   insert,+   singleton,+   member,+   minView,+   maxView,+   fromList,+   toAscList,+   flatten,+   union,+   unionLeft,+   unionRight,+   ) where++import qualified Data.NonEmpty as NonEmpty++import qualified Data.Set as Set+import Data.Set (Set, )++import Control.Monad (mzero, )+import Data.Maybe (fromMaybe, )+import Data.Tuple.HT (forcePair, )+++{-+The first field will always contain the smallest element.+We do not use the NonEmpty data type here+since it is easy to break this invariant using NonEmpty.!:.+The custom type is also consistent with Map.+-}+data T a = Cons a (Set a)+   deriving (Eq, Ord)++instance (Show a) => Show (T a) where+   showsPrec p xs =+      showParen (p>10) $+         showString "NonEmptySet.fromList " .+         showsPrec 11 (toAscList xs)+++{- |+We cannot have a reasonable @instance Insert Set@,+since the @instance Insert (NonEmpty Set)@+would preserve duplicate leading elements, whereas 'Set' does not.++However, the @instance Insert NonEmpty@ is not the problem.+A general type like++> insertSet :: (Insert f, Ord a) => a -> f a -> NonEmpty f a++cannot work, since it can be instantiated to++> insertSet :: (Ord a) => a -> NonEmpty Set a -> NonEmpty (NonEmpty Set) a++and this is obviously wrong:+@insertSet x (singleton x)@ has only one element, not two.+-}+insert :: Ord a => a -> Set a -> T a+insert = insertGen fst++insertGen :: Ord a => ((a,a) -> a) -> a -> Set a -> T a+insertGen select y xt =+   uncurry Cons $+   fromMaybe (y, xt) $ do+      (x,xs) <- Set.minView xt+      case compare y x of+         GT -> return (x, Set.insert y xs)+         EQ -> return (select (y,x), xs)+         LT -> mzero++singleton :: a -> T a+singleton a = Cons a Set.empty++member :: (Ord a) => a -> T a -> Bool+member y (Cons x xs) =+   y==x || Set.member y xs++minView :: T a -> (a, Set a)+minView (Cons x xs) = (x,xs)++maxView :: (Ord a) => T a -> (a, Set a)+maxView (Cons x xs) =+   forcePair $+   case Set.maxView xs of+      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++flatten :: (Ord a) => T a -> Set a+flatten (Cons x xs) = Set.insert x xs++union :: (Ord a) => T a -> T a -> T a+union (Cons x xs) (Cons y ys) =+   uncurry Cons $+   case Set.union xs ys of+      zs ->+         case compare x y of+            LT -> (x, Set.union zs $ Set.singleton y)+            GT -> (y, Set.insert x zs)+            EQ -> (x, zs)++unionLeft :: (Ord a) => Set a -> T a -> T a+unionLeft xs (Cons y ys) =+   insertGen snd y $ Set.union xs ys++unionRight :: (Ord a) => T a -> Set a -> T a+unionRight (Cons x xs) ys =+   insertGen fst x $ Set.union xs ys
src/Data/NonEmptyPrivate.hs view
@@ -8,6 +8,7 @@  import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold+import qualified Data.List.Match as Match import qualified Data.List.HT as ListHT import qualified Data.List as List import Data.Traversable (Traversable, mapAccumL, mapAccumR)@@ -20,7 +21,7 @@ import Data.Maybe (Maybe(Just, Nothing), maybe, mapMaybe, ) import Data.Ord (Ord, Ordering(GT), (<), (>), compare, comparing, ) import Data.Eq ((==), )-import Data.Tuple.HT (mapSnd, )+import Data.Tuple.HT (mapSnd, swap, ) import Data.Tuple (fst, snd, ) import qualified Prelude as P import Prelude (Eq, Show, Num, uncurry, )@@ -59,7 +60,7 @@   by nesting Optional and NonEmpty constructors.   If list length @n@ is allowed, then place @Optional@ at depth @n@,   if it is disallowed then place @NonEmpty@.-  The maximm length is marked by @Empty@.+  The maximum length is marked by @Empty@. -} data T f a = Cons { head :: a, tail :: f a }    deriving (Eq, Ord)@@ -117,10 +118,21 @@    return = singleton    (>>=) = bind ++instance (C.Arbitrary f) => C.Arbitrary (T f) where+   arbitrary = arbitrary+   shrink = shrink+ instance (QC.Arbitrary a, C.Arbitrary f) => QC.Arbitrary (T f a) where-   arbitrary = liftA2 Cons QC.arbitrary C.arbitrary-   shrink (Cons x xs) = fmap (\(y, Aux ys) -> Cons y ys) $ QC.shrink (x, Aux xs)+   arbitrary = arbitrary+   shrink = shrink +arbitrary :: (QC.Arbitrary a, C.Arbitrary f) => QC.Gen (T f a)+arbitrary = liftA2 Cons QC.arbitrary C.arbitrary++shrink :: (QC.Arbitrary a, C.Arbitrary f) => T f a -> [T f a]+shrink (Cons x xs) = fmap (\(y, Aux ys) -> Cons y ys) $ QC.shrink (x, Aux xs)+ newtype Aux f a = Aux (f a)  instance (C.Arbitrary f, QC.Arbitrary a) => QC.Arbitrary (Aux f a) where@@ -154,22 +166,32 @@ flatten :: C.Cons f => T f a -> f a flatten (Cons x xs) = C.cons x xs -fetch :: C.View f => f a -> Maybe (T f a)+fetch :: C.ViewL f => f a -> Maybe (T f a) fetch = fmap (uncurry Cons) . C.viewL   instance C.Cons f => C.Cons (T f) where-   cons = cons+   cons x0 (Cons x1 xs) = x0 !: C.cons x1 xs -cons :: C.Cons f => a -> T f a -> T f a-cons x0 (Cons x1 xs) = x0 !: C.cons x1 xs+instance C.Snoc f => C.Snoc (T f) where+   snoc (Cons x0 xs) x1 = x0 !: C.snoc xs x1 --- snoc :: T f a -> a -> T f a-snocExtend :: Traversable f => f a -> a -> T f a-snocExtend xs y0 =-   uncurry Cons $ mapAccumR (\y x -> (x,y)) y0 xs +{- |+Synonym for 'Cons'.+For symmetry to 'snoc'.+-}+cons :: a -> f a -> T f a+cons = Cons +snoc :: Traversable f => f a -> a -> T f a+snoc xs x =+   uncurry Cons $ mapAccumR (flip (,)) x xs++snocAlt :: (C.Cons f, Traversable f) => f a -> a -> f a+snocAlt xs x = flatten $ snoc xs x++ instance C.Empty f => C.Singleton (T f) where    singleton = singleton @@ -177,17 +199,11 @@ singleton x = x !: C.empty  -{--This implementation needs quadratic time-with respect to the number of 'Cons'.-Maybe a linear time solution can be achieved using a type function-that maps a container type to the type of the reversed container.--}-reverse :: (Traversable f, C.Reverse f) => T f a -> T f a-reverse (Cons x xs) = snocExtend (C.reverse xs) x+viewL :: T f a -> (a, f a)+viewL (Cons x xs) = (x, xs) -instance (Traversable f, C.Reverse f) => C.Reverse (T f) where-   reverse = reverse+viewR :: (Traversable f) => T f a -> (f a, a)+viewR (Cons x xs) = swap $ mapAccumL (flip (,)) x xs   mapHead :: (a -> a) -> T f a -> T f a@@ -196,8 +212,8 @@ mapTail :: (f a -> g a) -> T f a -> T g a mapTail f (Cons x xs) = x !: f xs -init :: (C.Zip f, C.Cons f) => T f a -> f a-init (Cons x xs) = C.zipWith const (C.cons x xs) xs+init :: (Traversable f) => T f a -> f a+init = fst . viewR  last :: (Foldable f) => T f a -> a last = foldl1 (flip const)@@ -216,6 +232,46 @@ foldl1Map g f (Cons x xs) = Fold.foldl (\b a -> f b (g a)) (g x) xs  +-- cf. NumericPrelude: Algebra.Additive.sumNestedCommutative+{-+Estimate costs of @foldBalanced ListHT.merge@.+@a, b, c@ length of sub-lists and our measure for the cost.++xs = [a,b,c]+ys = [a,b,c,a+b,c+a+b]+costs: (a+b) + (c+a+b) = 2a+2b+c++xs = [a,b,c,d]+ys = [a,b,c,d,a+b,c+d,a+b+c+d]+costs: (a+b) + (c+d) + (a+b+c+d) = 2a+2b+2c+2d++xs = [a,b,c,d,e]+ys = [a,b,c,d,e,a+b,c+d,e+(a+b),c+d+e+(a+b)]+costs: (a+b) + (c+d) + (e+(a+b)) + (c+d+e+(a+b)) = 3a+3b+2c+2d+2e++Analysis is easiest if @length xs@ is a power of two, e.g. @2^n@.+Then the operator tree has height @n@.+That is, we get a run-time of @n * sum (map length xs)@.+This is usually better than @sort (concat xs)@+which has run-time @let m = sum (map length xs) in m * logBase 2 m@.+-}+{- |+Fold a non-empty list in a balanced way.+/Balanced/ means that each element+has approximately the same depth in the operator tree.+/Approximately the same depth/ means+that the difference between maximum and minimum depth is at most 1.+The accumulation operation must be associative and commutative+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+       reduce zs = zs+       ys = appendRight xs $ Match.take rs $ reduce $ flatten ys+   in  last ys++ -- | maximum is a total function maximum :: (Ord a, Foldable f) => T f a -> a maximum = foldl1 P.max@@ -269,22 +325,20 @@   instance (C.Cons f, C.Append f) => C.Append (T f) where-   append = append+   append xs ys = appendRight xs (flatten ys) -append :: (C.Cons f, C.Append f) => T f a -> T f a -> T f a-append xs ys = appendRight xs (flatten ys)+append :: (C.Append f, Traversable f) => T f a -> T f a -> T (T f) a+append xs ys =+   mapTail (flip appendLeft ys) xs  appendRight :: (C.Append f) => T f a -> f a -> T f a appendRight (Cons x xs) ys = Cons x (C.append xs ys)  appendLeft ::-   (C.Append f, C.View f, C.Cons f) =>+   (C.Append f, Traversable f) =>    f a -> T f a -> T f a-appendLeft xt yt =-   force $-   case C.viewL xt of-      Nothing -> yt-      Just (x,xs) -> Cons x $ C.append xs $ flatten yt+appendLeft xt (Cons y ys) =+   mapTail (flip C.append ys) $ snoc xt y   {- |@@ -293,7 +347,7 @@ -} cycle :: (C.Cons f, C.Append f) => T f a -> T f a cycle x =-   let y = append x y+   let y = C.append x y    in  y  @@ -307,38 +361,101 @@ instance (C.Repeat f) => C.Repeat (T f) where    repeat a = Cons a $ C.repeat a +instance (C.Iterate f) => C.Iterate (T f) where+   iterate f a = Cons a $ C.iterate f (f a) -instance (C.Sort f, Insert f) => C.Sort (T f) where-   sortBy = sortBy +{-+This implementation needs quadratic time+with respect to the number of 'Cons'.+Maybe a linear time solution can be achieved using a type function+that maps a container type to the type of the reversed container.+-}+reverse :: (Traversable f, C.Reverse f) => T f a -> T f a+reverse (Cons x xs) = snoc (C.reverse xs) x++instance (Traversable f, C.Reverse f) => C.Reverse (T f) where+   reverse = reverse++ {- | If you nest too many non-empty lists then the efficient merge-sort (linear-logarithmic runtime) will degenerate to an inefficient insert-sort (quadratic runtime). -}-sortBy :: (C.Sort f, Insert f) => (a -> a -> Ordering) -> T f a -> T f a-sortBy f (Cons x xs) =-   insertBy f x $ C.sortBy f xs--sort :: (Ord a, C.Sort f, Insert f) => T f a -> T f a-sort = sortBy compare+instance (C.Sort f, InsertBy f) => C.Sort (T f) where+   sort (Cons x xs) = insert x $ C.sort xs +instance (C.SortBy f, InsertBy f) => C.SortBy (T f) where+   sortBy f (Cons x xs) = insertBy f x $ C.sortBy f xs   class Insert f where-   insertBy :: (a -> a -> Ordering) -> a -> f a -> T f a+   {- |+   Insert an element into an ordered list while preserving the order.+   -}+   insert :: (Ord a) => a -> f a -> T f a  instance (Insert f) => Insert (T f) where+   insert y xt@(Cons x xs) =+      uncurry Cons $+      case compare y x of+         GT -> (x, insert y xs)+         _ -> (y, xt)++instance Insert Empty.T where+   insert = insertDefault++instance Insert [] where+   insert = insertDefault++instance Insert Maybe where+   insert = insertDefault++instance Insert Seq where+   insert = insertDefault++{-+This does not work consistently!+A Set is not a sorted list, since it collapses duplicate elements.++*Data.NonEmptyPrivate> mapTail (mapTail Set.toList) $ insert '3' $ insert '7' $ Set.fromList "346"+'3'!:'3'!:'4':'6':'7':[]++instance Insert Set where+   insert y xt =+      uncurry Cons $+      fromMaybe (y, xt) $ do+         (x,xs) <- Set.minView xt+         case compare y x of+            GT -> return (x, Set.insert y xs)+            EQ -> return (x, xs)+            LT -> mzero++We have preserved that function in NonEmpty.Mixed.+-}++{- |+Default implementation for 'insert' based on 'insertBy'.+-}+insertDefault :: (Ord a, InsertBy f, C.SortBy f) => a -> f a -> T f a+insertDefault = insertBy compare+++class Insert f => InsertBy f where+   insertBy :: (a -> a -> Ordering) -> a -> f a -> T f a++instance (InsertBy f) => InsertBy (T f) where    insertBy f y xt@(Cons x xs) =       uncurry Cons $       case f y x of          GT -> (x, insertBy f y xs)          _ -> (y, xt) -instance Insert Empty.T where+instance InsertBy Empty.T where    insertBy _ x Empty.Cons = Cons x Empty.Cons -instance Insert [] where+instance InsertBy [] where    insertBy f y xt =       uncurry Cons $       case xt of@@ -348,7 +465,7 @@                GT -> (x, List.insertBy f y xs)                _ -> (y, xt) -instance Insert Maybe where+instance InsertBy Maybe where    insertBy f y mx =       uncurry Cons $       case mx of@@ -359,7 +476,7 @@                GT -> (x, y)                _ -> (y, x) -instance Insert Seq where+instance InsertBy Seq where    {-    If we assume a sorted list    we could do binary search for the splitting point.@@ -373,16 +490,7 @@                w Seq.:< ws -> (w, ws Seq.>< y Seq.<| zs)  -{- |-Insert an element into an ordered list while preserving the order.-The first element of the resulting list is returned individually.-We need this for construction of a non-empty list.--}-insert :: (Ord a, Insert f, C.Sort f) => a -> f a -> T f a-insert = insertBy compare -- class Functor f => RemoveEach f where    removeEach :: T f a -> T f (a, f a) @@ -434,7 +542,7 @@    tails = tailsDefault  tailsDefault ::-   (C.Cons f, C.Empty f, C.View f, Tails f,+   (C.Cons f, C.Empty f, C.ViewL f, Tails f,     C.Cons g, C.Empty g) =>    f a -> T f (g a) tailsDefault xt =@@ -443,11 +551,11 @@       Nothing -> Cons C.empty C.empty       Just (x, xs) ->          case tails xs of-            xss -> cons (C.cons x $ head xss) xss+            xss -> C.cons (C.cons x $ head xss) xss   {--Not exorted by NonEmpty.+Not exported by NonEmpty. I think the transposeClip function is better. -} class TransposeOuter f where
+ src/Data/NonEmptyTest.hs view
@@ -0,0 +1,8 @@+module Data.NonEmptyTest where++import qualified Data.NonEmptyPrivate as NonEmpty+++foldBalanced :: NonEmpty.T [] Integer -> Bool+foldBalanced xs =+   NonEmpty.foldBalanced (+) xs == NonEmpty.sum xs
src/Data/Optional.hs view
@@ -8,7 +8,7 @@ import qualified Data.NonEmpty.Class as C import qualified Data.NonEmpty as NonEmpty import qualified Data.Empty as Empty-import Data.NonEmptyPrivate (Aux(Aux), snocExtend)+import Data.NonEmptyPrivate (Aux(Aux), snoc)  import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold@@ -88,14 +88,29 @@ instance (Trav.Traversable f, C.Reverse f) => C.Reverse (T f) where    reverse Nil = Nil    reverse (Cons x xs) =-      fromNonEmpty (snocExtend (C.reverse xs) x)+      fromNonEmpty (snoc (C.reverse xs) x)  instance (NonEmpty.Insert f, C.Sort f) => C.Sort (T f) where+   sort Nil = Nil+   sort (Cons x xs) =+      fromNonEmpty $ NonEmpty.insert x $ C.sort xs++instance (NonEmpty.InsertBy f, C.SortBy f) => C.SortBy (T f) where    sortBy _ Nil = Nil    sortBy f (Cons x xs) =       fromNonEmpty $ NonEmpty.insertBy f x $ C.sortBy f xs  instance (NonEmpty.Insert f) => NonEmpty.Insert (T f) where+   insert y xt =+      uncurry NonEmpty.Cons $+      case xt of+         Nil -> (y, xt)+         Cons x xs ->+            case P.compare y x of+               GT -> (x, fromNonEmpty $ NonEmpty.insert y xs)+               _ -> (y, xt)++instance (NonEmpty.InsertBy f) => NonEmpty.InsertBy (T f) where    insertBy f y xt =       uncurry NonEmpty.Cons $       case xt of