packages feed

non-empty 0.2 → 0.2.1

raw patch · 11 files changed

+292/−26 lines, 11 files

Files

non-empty.cabal view
@@ -1,5 +1,5 @@ Name:             non-empty-Version:          0.2+Version:          0.2.1 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -40,6 +40,10 @@   .   * @Cardinality@:@NeverEmptyList@   .+  * @mono-traversable@:@Data.MinLen@:+    allows to specify a minimum number of elements using type families+    and works also for monomorphic data structures like 'ByteString'+  .   * <http://www.haskell.org/haskellwiki/Non-empty_list>   .   Related packages:@@ -47,17 +51,22 @@   * @Stream@:     Lists that contain always infinitely many elements.   .+  * @fixed-length@:+    Uses the data structure of this package+    and defines a closed-world class for fixed-length lists+    and an according index type.+  .   * @fixed-list@:     Uses the same data structure as this package     but is intended for fixing the number of elements in a list.     Requires multi-parameter type classes with functional dependencies. -Tested-With:      GHC==7.4.1+Tested-With:      GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.1 Cabal-Version:    >=1.6 Build-Type:       Simple  Source-Repository this-  Tag:         0.2+  Tag:         0.2.1   Type:        darcs   Location:    http://code.haskell.org/~thielema/non-empty/ @@ -78,6 +87,7 @@     Data.NonEmpty     Data.NonEmpty.Class     Data.NonEmpty.Mixed+    Data.NonEmpty.Match     Data.NonEmpty.Set     Data.NonEmpty.Map     Data.Empty
src/Data/Empty.hs view
@@ -58,3 +58,9 @@ -} instance C.Repeat T where    repeat _ = Cons++{-+This instance allows us to iterate on fixed length lists.+-}+instance C.Iterate T where+   iterate _ _ = Cons
src/Data/NonEmpty.hs view
@@ -16,6 +16,7 @@    init,    last,    foldl1,+   foldl1Map,    foldBalanced,    maximum, maximumBy, maximumKey,    minimum, minimumBy, minimumKey,@@ -29,6 +30,7 @@    InsertBy(insertBy),    scanl, scanr,    Tails(tails),+   inits, initsRev,    RemoveEach(removeEach),    ) where
src/Data/NonEmpty/Class.hs view
@@ -185,6 +185,7 @@    repeat = List.repeat  +-- might be replaced by Mixed.iterate based on Traversable class Repeat f => Iterate f where    iterate :: (a -> a) -> a -> f a
src/Data/NonEmpty/Map.hs view
@@ -3,25 +3,35 @@    insert,    singleton,    member,+   size,+   elems,+   keys,+   keysSet,    lookup,    minViewWithKey,    maxViewWithKey,    fromList,    toAscList,+   fetch,    flatten,    union,    unionLeft,    unionRight,    ) where +import qualified Data.NonEmpty.Set as NonEmptySet import qualified Data.NonEmpty as NonEmpty  import qualified Data.Map as Map import Data.Map (Map, )  import Control.Monad (mzero, )+import Control.Applicative (liftA2, )+import Data.Traversable (Traversable, traverse, )+import Data.Foldable (Foldable, foldMap, )+import Data.Monoid (mappend, ) import Data.Maybe (fromMaybe, )-import Data.Tuple.HT (forcePair, )+import Data.Tuple.HT (forcePair, mapSnd, ) import Data.Ord.HT (comparing, )  import Prelude hiding (lookup, )@@ -39,7 +49,17 @@          showString "NonEmptyMap.fromList " .          showsPrec 11 (toAscList xs) +instance (Ord k) => Functor (T k) where+   fmap f (Cons x xs) = Cons (mapSnd f x) (fmap f xs) +instance (Ord k) => Foldable (T k) where+   foldMap f (Cons x xs) = mappend (f (snd x)) (foldMap f xs)++instance (Ord k) => Traversable (T k) where+   traverse f (Cons x xs) =+      liftA2 Cons (fmap ((,) (fst x)) $ f (snd x)) (traverse f xs)++ insert :: Ord k => k -> a -> Map k a -> T k a insert = curry $ insertGen fst @@ -60,6 +80,19 @@ member y (Cons x xs) =    y == fst x || Map.member y xs +size :: T k a -> Int+size (Cons _ xs) = 1 + Map.size xs++elems :: T k a -> NonEmpty.T [] a+elems (Cons x xs) = NonEmpty.cons (snd x) (Map.elems xs)++keys :: T k a -> NonEmpty.T [] k+keys (Cons x xs) = NonEmpty.cons (fst x) (Map.keys xs)++-- 'insert' could be optimized to 'Cons'+keysSet :: (Ord k) => T k a -> NonEmptySet.T k+keysSet (Cons x xs) = NonEmptySet.insert (fst x) (Map.keysSet xs)+ lookup :: (Ord k) => k -> T k a -> Maybe a lookup y (Cons x xs) =    if y == fst x@@ -81,6 +114,9 @@  toAscList :: T k a -> NonEmpty.T [] (k,a) toAscList (Cons x xs) = NonEmpty.cons x $ Map.toAscList xs++fetch :: (Ord k) => Map k a -> Maybe (T k a)+fetch  =  fmap (uncurry Cons) . Map.minViewWithKey  flatten :: (Ord k) => T k a -> Map k a flatten (Cons x xs) = uncurry Map.insert x xs
+ src/Data/NonEmpty/Match.hs view
@@ -0,0 +1,51 @@+{- |+Generalized version of utility-ht:"Data.List.Match".+-}+module Data.NonEmpty.Match (take, replicate) where++import qualified Data.NonEmpty.Class as C++import Control.Functor.HT (void, )++import Prelude hiding (take, replicate, )+++{- | Make a list as long as another one -}+{-+@flip (zipWith const)@ is not as lazy,+e.g. would be @take [] undefined = undefined@,+but it should be @take [] undefined = []@.+-}+take :: (C.Zip f) => f b -> f a -> f a+take = C.zipWith (flip const)+++{- |+Check whether two lists with different element types have equal length.+It is equivalent to @length xs == length ys@ but more efficient.+-}+{-+I'd prefer a type constructor class Eq+-}+_equalLength :: (Functor f, Eq (f ())) => f a -> f b -> Bool+_equalLength xs ys =+   void xs == void ys++{- |+Compare the length of two lists over different types.+It is equivalent to @(compare (length xs) (length ys))@+but more efficient.+-}+{-+I'd prefer a type constructor class Ord+-}+_compareLength :: (Functor f, Ord (f ())) => f a -> f b -> Ordering+_compareLength xs ys =+   compare (void xs) (void ys)+++{- |+the same as @($>)@+-}+replicate :: (Functor f) => f a -> b -> f b+replicate xs y = fmap (const y) xs
src/Data/NonEmpty/Mixed.hs view
@@ -3,16 +3,20 @@  If there are two versions of a function, where one works on fixed-length lists,-the place the fixed-length list variant to NonEmpty+then place the fixed-length list variant in NonEmpty and the other one here. -} module Data.NonEmpty.Mixed where  import qualified Data.NonEmpty.Class as C import qualified Data.NonEmpty as NonEmpty+import qualified Data.Empty as Empty+import qualified Data.List.HT as ListHT+import Data.Traversable (Traversable, mapAccumL, sequenceA, ) import Data.Foldable (Foldable, foldr, )+import Data.Tuple.HT (mapFst, mapSnd, ) -import Prelude hiding (foldr, scanl, scanr, )+import Prelude hiding (splitAt, take, foldr, scanl, scanr, )   groupBy ::@@ -31,6 +35,20 @@          in  NonEmpty.Cons x0 xr : yr)       [] +segmentAfter ::+   (Foldable f) =>+   (a -> Bool) -> f a -> ([NonEmpty.T [] a], [a])+segmentAfter p =+   foldr+      (\x ~(ys,zs) ->+         if p x+           then (NonEmpty.singleton x : ys, zs)+           else+              case ys of+                 [] -> (ys, x:zs)+                 w:ws -> (C.cons x w : ws, zs))+      ([],[])+ segmentBefore ::    (Foldable f) =>    (a -> Bool) -> f a -> ([a], [NonEmpty.T [] a])@@ -42,12 +60,55 @@            else (x : fst ys, snd ys))       ([],[]) +filterToInfixes ::+   (Foldable f) =>+   (a -> Bool) -> f a -> [NonEmpty.T [] a]+filterToInfixes p =+   let cons = uncurry $ maybe id (:) . NonEmpty.fetch+   in  cons .+       foldr+          (\x yzs ->+             if p x+               then mapFst (x:) yzs+               else ([], cons yzs))+          ([], [])+ mapAdjacent ::    (C.Cons f, C.Zip f) => (a -> a -> b) -> NonEmpty.T f a -> f b mapAdjacent f xs =    C.zipWith f (NonEmpty.flatten xs) (NonEmpty.tail xs)  +take ::+   (C.View g, C.Repeat f, Traversable f) =>+   g a -> Maybe (f a)+take = fst . splitAt++splitAt ::+   (C.View g, C.Repeat f, Traversable f) =>+   g a -> (Maybe (f a), g a)+splitAt xs0 =+   (\(xs1, mys) -> (mys, maybe xs0 (const xs1) mys)) $+   mapSnd sequenceA $+   mapAccumL+      (\xt () ->+         case C.viewL xt of+            Nothing -> (xt, Nothing)+            Just (x,xs) -> (xs, Just x))+      xs0 (C.repeat ())++sliceVertical ::+   (C.View g, C.Repeat f, Traversable f) =>+   g a -> ([f a], g a)+sliceVertical x0 =+   case splitAt x0 of+      (my,x1) ->+         case my of+            Nothing -> ([], x1)+            Just y -> mapFst (y:) $ sliceVertical x1+++ {- | This implementation is more efficient for Sequence than 'NonEmpty.viewR'. -}@@ -88,3 +149,30 @@  appendLeft :: (C.Cons f) => [a] -> f a -> f a appendLeft = flip $ foldr C.cons+++iterate :: (C.Repeat f, Traversable f) => (a -> a) -> a -> f a+iterate f x0 =+   snd $ mapAccumL (\xi fi -> (fi xi, xi)) x0 $ C.repeat f+++class Choose f where+   {- |+   Select tuples of list elements:+   @choose "abc" == ['a'!:'b'!:empty,'a'!:'c'!:empty,'b'!:'c'!:empty]@+   -}+   choose :: [a] -> [f a]++instance Choose Empty.T where+   choose _ = [Empty.Cons]++instance (Choose f) => Choose (NonEmpty.T f) where+   choose xs = do+      (y:ys) <- ListHT.tails xs+      map (NonEmpty.cons y) $ choose ys++instance Choose [] where+   choose [] = [[]]+   choose (x:xs) =+      let ys = choose xs+      in  map (x:) ys ++ ys
src/Data/NonEmpty/Set.hs view
@@ -3,6 +3,7 @@    insert,    singleton,    member,+   size,    minView,    maxView,    fromList,@@ -75,6 +76,9 @@ member :: (Ord a) => a -> T a -> Bool member y (Cons x xs) =    y==x || Set.member y xs++size :: T a -> Int+size (Cons _ xs) = 1 + Set.size xs  minView :: T a -> (a, Set a) minView (Cons x xs) = (x,xs)
src/Data/NonEmptyPrivate.hs view
@@ -19,9 +19,11 @@ 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.Eq ((==), )-import Data.Tuple.HT (mapSnd, swap, )+import Data.Tuple.HT (mapFst, mapSnd, swap, ) import Data.Tuple (fst, snd, ) import qualified Prelude as P import Prelude (Eq, Show, Num, uncurry, )@@ -170,6 +172,16 @@ fetch = fmap (uncurry Cons) . C.viewL  +{- |+Caution:+@viewL (NonEmpty.Cons x []) = Nothing@+because the tail is empty, and thus cannot be NonEmpty!++This instance mainly exist to allow cascaded applications of 'fetch'.+-}+instance C.ViewL f => C.ViewL (T f) where+   viewL (Cons x xs) = fmap ((,) x) $ fetch xs+ instance C.Cons f => C.Cons (T f) where    cons x0 (Cons x1 xs) = x0 !: C.cons x1 xs @@ -224,12 +236,12 @@ {- | It holds: -> foldl1Map g f = foldl1 f . fmap g+> foldl1Map f g = foldl1 f . fmap g  but 'foldl1Map' does not need a 'Functor' instance. -}-foldl1Map :: (Foldable f) => (a -> b) -> (b -> b -> b) -> T f a -> b-foldl1Map g f (Cons x xs) = Fold.foldl (\b a -> f b (g a)) (g x) xs+foldl1Map :: (Foldable f) => (b -> b -> b) -> (a -> b) -> T f a -> b+foldl1Map f g (Cons x xs) = Fold.foldl (\b a -> f b (g a)) (g x) xs   -- cf. NumericPrelude: Algebra.Additive.sumNestedCommutative@@ -292,15 +304,17 @@ maximumKey :: (Ord b, Foldable f) => (a -> b) -> T f a -> a maximumKey f =    snd .-   foldl1Map (attachKey f)+   foldl1Map       (\ky0 ky1 -> if fst ky0 < fst ky1 then ky1 else ky0)+      (attachKey f)  -- | minimumKey is a total function minimumKey :: (Ord b, Foldable f) => (a -> b) -> T f a -> a minimumKey f =    snd .-   foldl1Map (attachKey f)+   foldl1Map       (\ky0 ky1 -> if fst ky0 > fst ky1 then ky1 else ky0)+      (attachKey f)  -- | maximumKey is a total function _maximumKey :: (Ord b, Foldable f, Functor f) => (a -> b) -> T f a -> a@@ -489,8 +503,23 @@                Seq.EmptyL -> (y, xt)                w Seq.:< ws -> (w, ws Seq.>< y Seq.<| zs) +{-+Certainly not as efficient as insertBy as class method+since all elements of the list are touched.+-}+insertByTraversable ::+   (Traversable f) =>+   (a -> a -> Ordering) -> a -> f a -> T f a+insertByTraversable cmp y0 =+   uncurry (flip snoc . snd) .+   mapAccumL+      (\(searching,y) x ->+         let stillSearching = searching && cmp y x == GT+         in  mapFst ((,) stillSearching) $ if' stillSearching (y,x) (x,y))+      (True, y0)  + class Functor f => RemoveEach f where    removeEach :: T f a -> T f (a, f a) @@ -521,7 +550,7 @@    tails :: (C.Cons g, C.Empty g) => f a -> T f (g a)  instance Tails [] where-   tails = tailsDefault+   tails = tailsTraversable  instance Tails Empty.T where    tails Empty.Cons = Cons C.empty Empty.Cons@@ -539,20 +568,31 @@          Just x -> Cons (C.cons x C.empty) (Just C.empty)  instance Tails Seq where-   tails = tailsDefault+   tails = tailsTraversable -tailsDefault ::-   (C.Cons f, C.Empty f, C.ViewL f, Tails f,-    C.Cons g, C.Empty g) =>+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+++{- |+Only advised for structures with efficient appending of single elements+like 'Sequence'.+Alternatively you may consider 'initsRev'.+-}+inits ::+   (Traversable f, C.Snoc g, C.Empty g) =>    f a -> T f (g a)-tailsDefault xt =-   force $-   case C.viewL xt of-      Nothing -> Cons C.empty C.empty-      Just (x, xs) ->-         case tails xs of-            xss -> C.cons (C.cons x $ head xss) xss+inits = scanl C.snoc C.empty +{-+suggested in+<http://www.haskell.org/pipermail/libraries/2014-July/023291.html>+-}+initsRev ::+   (Traversable f, C.Cons g, C.Empty g, C.Reverse g) =>+   f a -> T f (g a)+initsRev = fmap C.reverse . scanl (flip C.cons) C.empty  {- Not exported by NonEmpty.
src/Data/NonEmptyTest.hs view
@@ -1,8 +1,36 @@ module Data.NonEmptyTest where +import qualified Data.NonEmpty.Mixed as NonEmptyMixed import qualified Data.NonEmptyPrivate as NonEmpty +import Control.Monad (guard, ) +import qualified Data.List.HT as ListHT+import Data.Tuple.HT (mapFst, )++ foldBalanced :: NonEmpty.T [] Integer -> Bool foldBalanced xs =    NonEmpty.foldBalanced (+) xs == NonEmpty.sum xs++++filterToInfixesAlt :: (a -> Bool) -> [a] -> [NonEmpty.T [] a]+filterToInfixesAlt p =+   snd .+   foldr+      (\x ~(b1, yt) ->+         let b0 = p x+         in  (b0,+              if b0+                then uncurry (:) $+                     mapFst (NonEmpty.cons x) $+                     case guard b1 >> ListHT.viewL yt of+                        Just (y,ys) -> (NonEmpty.flatten y, ys)+                        Nothing -> ([], yt)+                else yt))+      (True, [])++filterToInfixes :: [Int] -> Bool+filterToInfixes xs =+   NonEmptyMixed.filterToInfixes (>0) xs == filterToInfixesAlt (>0) xs
src/Data/Optional.hs view
@@ -17,12 +17,12 @@ import qualified Test.QuickCheck as QC  import Control.Monad (return, )-import Data.Functor (Functor, fmap, )+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, Show, Num, uncurry, )+import Prelude (Eq, uncurry, )   data T f a = Nil | Cons a (f a)