utility-ht 0.0.1 → 0.0.2

raw patch · 7 files changed

+169/−28 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/Data/List/HT.hs +5/−0
• src/Data/List/HT/Private.hs +122/−19
• src/Data/List/Key.hs +1/−0
• src/Data/List/Match.hs +1/−0
• src/Data/List/Match/Private.hs +34/−7
• src/Data/Tuple/HT.hs +4/−0
• utility-ht.cabal +2/−2

@@ -1,14 +1,19 @@ module Data.List.HT (    -- * Improved standard functions    L.inits,+   L.tails,    L.groupBy,    L.group,+   L.unzip,    L.partition,    -- * Split    L.chop,    L.breakAfter,    L.segmentAfter,    L.segmentBefore,+   L.removeEach,+   L.splitEverywhere,+   --  * inspect ends of a list    L.splitLast,    L.viewL,    L.viewR,

@@ -1,16 +1,18 @@ module Data.List.HT.Private where  import Data.List  as List  (find, transpose, unfoldr, isPrefixOf,-                            tails, findIndices, foldl', )-import Data.Maybe as Maybe (fromMaybe, )+                            findIndices, foldl', )+import Data.Maybe as Maybe (fromMaybe, catMaybes, ) import Data.Maybe.HT       (toMaybe, ) import Control.Monad       (guard, )-import Data.Tuple.HT       (mapPair, mapFst, mapSnd, )+import Data.Tuple.HT       (mapPair, mapFst, mapSnd, forcePair, )  import qualified Data.List.Key.Private   as Key import qualified Data.List.Match.Private as Match +import Prelude hiding (unzip, ) + -- * Improved standard functions  {- |@@ -39,6 +41,25 @@   {- |+This function is lazier than the one suggested in the Haskell 98 report.+It is @tails undefined = ([] : undefined) : undefined@,+in contrast to @Data.List.tails undefined = undefined@.+-}+tails :: [a] -> [[a]]+tails xt =+   uncurry (:) $+   case xt of+      [] -> ([],[])+      xxs@(_:xs) -> (xxs, tails xs)++tails' :: [a] -> [[a]]+tails' = fst . breakAfter null . iterate tail++tails98            :: [a] -> [[a]]+tails98 []         = [[]]+tails98 xxs@(_:xs) = xxs : tails98 xs++{- | This function compares adjacent elements of a list. If two adjacent elements satisfy a relation then they are put into the same sublist. Example:@@ -65,6 +86,17 @@   {- |+Like standard 'unzip' but more lazy.+It is @Data.List.unzip undefined == undefined@,+but @unzip undefined == (undefined, undefined)@.+-}+unzip :: [(a,b)] -> ([a],[b])+unzip =+   forcePair .+   foldr (\ (x,y) ~(xs,ys) -> (x:xs,y:ys)) ([],[])+++{- | 'Data.List.partition' of GHC 6.2.1 fails on infinite lists. But this one does not. -}@@ -74,6 +106,7 @@ -} partition :: (a -> Bool) -> [a] -> ([a], [a]) partition p =+   forcePair .    foldr       (\x ~(y,z) ->          if p x@@ -81,6 +114,7 @@            else (y, x : z))       ([],[]) + -- * Split  {- |@@ -112,10 +146,11 @@ breakAfter p =    let recourse [] = ([],[])        recourse (x:xs) =+          mapFst (x:) $           if p x-            then ([x],xs)-            else mapFst (x:) $ recourse xs-   in  recourse+            then ([],xs)+            else recourse xs+   in  forcePair . recourse   {- |@@ -126,7 +161,13 @@ -} segmentAfter :: (a -> Bool) -> [a] -> [[a]] segmentAfter p =-   foldr (\ x ~yt@(y:ys) -> if p x then [x]:yt else (x:y):ys) [[]]+--   foldr (\ x ~yt@(y:ys) -> if p x then [x]:yt else (x:y):ys) [[]]+   uncurry (:) .+   foldr+      (\x ~(y,ys) ->+         mapFst (x:) $+         if p x then ([],y:ys) else (y,ys))+      ([],[])  propSegmentAfterConcat :: Eq a => (a -> Bool) -> [a] -> Bool propSegmentAfterConcat p xs =@@ -159,7 +200,13 @@ -} segmentBefore :: (a -> Bool) -> [a] -> [[a]] segmentBefore p =-   foldr (\ x ~(y:ys) -> (if p x then ([]:) else id) ((x:y):ys)) [[]]+--   foldr (\ x ~(y:ys) -> (if p x then ([]:) else id) ((x:y):ys)) [[]]+   uncurry (:) .+   foldr+      (\ x ~(y,ys) ->+         let xs = x:y+         in  if p x then ([],xs:ys) else (xs,ys))+      ([],[])  propSegmentBeforeConcat :: Eq a => (a -> Bool) -> [a] -> Bool propSegmentBeforeConcat p xs =@@ -235,7 +282,7 @@ -} viewR :: [a] -> Maybe ([a], a) viewR =-   foldr (\x -> Just . maybe ([],x) (mapFst (x:))) Nothing+   foldr (\x -> Just . forcePair . maybe ([],x) (mapFst (x:))) Nothing  propViewR :: Eq a => [a] -> Bool propViewR xs =@@ -327,12 +374,14 @@ -} partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a]) partitionMaybe f =+   forcePair .    foldr       (\x -> maybe (mapSnd (x:)) (\y -> mapFst (y:)) (f x))       ([],[])  unzipEithers :: [Either a b] -> ([a], [b]) unzipEithers =+   forcePair .    foldr (either (\x -> mapFst (x:)) (\y -> mapSnd (y:))) ([],[])  @@ -469,15 +518,52 @@ It is also useful for polynomial multiplication (convolution). -} shear :: [[a]] -> [[a]]-shear xs@(_:_) =+shear =+   map catMaybes .+   shearTranspose .+   transposeFill++transposeFill :: [[a]] -> [[Maybe a]]+transposeFill =+   unfoldr (\xs ->+      toMaybe (not (null xs))+         (mapSnd (dropWhileRev null) $ unzipCons xs))++unzipCons :: [[a]] -> ([Maybe a], [[a]])+unzipCons =+   unzip .+   map ((\my -> (fmap fst my, maybe [] snd my)) . viewL)++{- |+It's somehow inverse to zipCons,+but the difficult part is,+that a trailing empty list on the right side is suppressed.+-}+unzipConsSkew :: [[a]] -> ([Maybe a], [[a]])+unzipConsSkew =+   let aux [] [] = ([],[])  -- one empty list at the end will be removed+       aux xs ys = mapSnd (xs:) $ prep ys+       prep =+          forcePair .+          switchL ([],[])+             (\y ys ->+                let my = viewL y+                in  mapFst (fmap fst my :) $+                    aux (maybe [] snd my) ys)+   in  prep++++shear' :: [[a]] -> [[a]]+shear' xs@(_:_) =    let (y:ys,zs) = unzip (map (splitAt 1) xs)        zipConc (a:as) (b:bs) = (a++b) : zipConc as bs        zipConc [] bs = bs        zipConc as [] = as-   in  y : zipConc ys (shear (dropWhileRev null zs))+   in  y : zipConc ys (shear' (dropWhileRev null zs))               {- Dropping trailing empty lists is necessary,                  otherwise finite lists are filled with empty lists. -}-shear [] = []+shear' [] = []  {- | Transform@@ -493,13 +579,30 @@ -} shearTranspose :: [[a]] -> [[a]] shearTranspose =-   let -- zipCons is like zipWith (:) keep lists which are too long-       zipCons (x:xs) (y:ys) = (x:y) : zipCons xs ys-       zipCons [] ys = ys-       zipCons xs [] = map (:[]) xs-       aux (x:xs) yss = [x] : zipCons xs yss-       aux [] yss = []:yss-   in  foldr aux []+   foldr zipConsSkew []++zipConsSkew :: [a] -> [[a]] -> [[a]]+zipConsSkew xt yss =+   uncurry (:) $+   case xt of+      x:xs -> ([x], zipCons xs yss)+      [] -> ([], yss)++{- |+zipCons is like @zipWith (:)@ but it keeps lists which are too long+This version works also for @zipCons something undefined@.+-}+zipCons :: [a] -> [[a]] -> [[a]]+zipCons (x:xs) yt =+   let (y,ys) = switchL ([],[]) (,) yt+   in  (x:y) : zipCons xs ys+zipCons [] ys = ys++-- | zipCons' is like @zipWith (:)@ but it keeps lists which are too long+zipCons' :: [a] -> [[a]] -> [[a]]+zipCons' (x:xs) (y:ys) = (x:y) : zipCons' xs ys+zipCons' [] ys = ys+zipCons' xs [] = map (:[]) xs   {- |

@@ -12,6 +12,7 @@    L.minimum,    L.maximum,    L.group,+   L.merge,    ) where  import qualified Data.List.Key.Private as L

@@ -4,6 +4,7 @@    L.splitAt,    L.replicate,    L.compareLength,+   L.lessOrEqualLength,    L.shorterList,    ) where 

@@ -2,7 +2,7 @@  import Data.Maybe    (fromJust, isNothing, ) import Data.Maybe.HT (toMaybe, )-import Data.Tuple.HT (mapFst, )+import Data.Tuple.HT (mapFst, forcePair, ) import Data.Bool.HT  (if', )  import qualified Data.List as List@@ -11,8 +11,13 @@   {- | 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 :: [b] -> [a] -> [a]-take = flip (zipWith const)+take = zipWith (flip const)  {- | Drop as many elements as the first list is long -} drop :: [b] -> [a] -> [a]@@ -64,10 +69,11 @@   splitAt :: [b] -> [a] -> ([a],[a])-splitAt (_:ns) (x:xs) =-   mapFst (x:) $ splitAt ns xs-splitAt _  [] = ([],[])-splitAt [] xs = ([],xs)+splitAt nt xt =+   forcePair $+   case (nt,xt) of+      (_:ns, x:xs) -> mapFst (x:) $ splitAt ns xs+      (_, xs) -> ([],xs)  propSplitAt :: (Eq a) => [b] -> [a] -> Bool propSplitAt xs ys =@@ -102,6 +108,15 @@    compareLength xs ys == compareLength'  xs ys &&    compareLength xs ys == compareLength'' xs ys +{- |+@lessOrEqualLength x y@ is almost the same as @compareLength x y <= EQ@,+but @lessOrEqualLength [] undefined  =  True@,+whereas @compareLength [] undefined <= EQ  =  undefined@.+-}+lessOrEqualLength :: [a] -> [b] -> Bool+lessOrEqualLength [] _ = True+lessOrEqualLength _ [] = False+lessOrEqualLength (_:xs) (_:ys) = lessOrEqualLength xs ys  {- | Returns the shorter one of two lists.@@ -114,8 +129,20 @@ -} shorterList :: [a] -> [a] -> [a] shorterList xs ys =-   let useX = compareLength xs ys <= EQ+   let useX = lessOrEqualLength xs ys    in  zipWith (if' useX) xs ys++{- |+This lazier than 'shorterList' in a different aspect:+It returns a common prefix+even if it is undefined, which list is the shorter one.+However, it requires a proper 'Eq' instance+and if elements are undefined, it may fail even earlier.+-}+shorterListEq :: (Eq a) => [a] -> [a] -> [a]+shorterListEq xs ys =+   let useX = lessOrEqualLength xs ys+   in  zipWith (\x y -> if' (x==y || useX) x y) xs ys   replicate :: [a] -> b -> [b]

@@ -22,6 +22,10 @@ swap :: (a,b) -> (b,a) swap ~(x,y) = (y,x) +{-# INLINE forcePair #-}+forcePair :: (a,b) -> (a,b)+forcePair ~(x,y) = (x,y)+  -- * Triple 

@@ -1,5 +1,5 @@ Name:             utility-ht-Version:          0.0.1+Version:          0.0.2 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -27,7 +27,7 @@ Source-Repository this   type:     darcs   location: http://code.haskell.org/~thielema/utility/-  tag:      0.0.1+  tag:      0.0.2   Library