packages feed

utility-ht 0.0.10 → 0.0.11

raw patch · 13 files changed

+318/−65 lines, 13 files

Files

src/Control/Functor/HT.hs view
@@ -12,8 +12,26 @@ for :: Functor f => f a -> (a -> b) -> f b for = flip fmap ++{- |+Caution:+Every pair member has a reference to the argument of 'unzip'.+Depending on the consumption pattern this may cause a memory leak.+For lists, I think, you should generally prefer 'List.unzip'.+-} unzip :: Functor f => f (a, b) -> (f a, f b) unzip x = (fmap fst x, fmap snd x) +{- |+Caution: See 'unzip'.+-} unzip3 :: Functor f => f (a, b, c) -> (f a, f b, f c) unzip3 x = (fmap fst3 x, fmap snd3 x, fmap thd3 x)++{- |+Generalization of 'Data.List.HT.outerProduct'.+-}+outerProduct ::+   (Functor f, Functor g) =>+   (a -> b -> c) -> f a -> g b -> f (g c)+outerProduct f xs ys = fmap (flip fmap ys . f) xs
src/Control/Monad/HT.hs view
@@ -81,6 +81,9 @@ zipWith :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c] zipWith = M.zipWithM +chain :: (Monad m) => [a -> m a] -> (a -> m a)+chain = foldr (flip (<=<)) return+ filter :: Monad m => (a -> m Bool) -> [a] -> m [a] filter = M.filterM @@ -108,6 +111,37 @@    (a -> b -> c -> d -> e -> r) ->    m a -> m b -> m c -> m d -> m e -> m r lift5 = M.liftM5+++{-+that's just (=<<)++liftJoin :: (Monad m) => (a -> m b) -> m a -> m b+liftJoin f ma =+   join (lift f ma)+-}++liftJoin2 :: (Monad m) => (a -> b -> m c) -> m a -> m b -> m c+liftJoin2 f ma mb =+   M.join (lift2 f ma mb)++liftJoin3 :: (Monad m) => (a -> b -> c -> m d) -> m a -> m b -> m c -> m d+liftJoin3 f ma mb mc =+   M.join (lift3 f ma mb mc)++liftJoin4 ::+   (Monad m) =>+   (a -> b -> c -> d -> m e) ->+   m a -> m b -> m c -> m d -> m e+liftJoin4 f ma mb mc md =+   M.join (lift4 f ma mb mc md)++liftJoin5 ::+   (Monad m) =>+   (a -> b -> c -> d -> e -> m f) ->+   m a -> m b -> m c -> m d -> m e -> m f+liftJoin5 f ma mb mc md me =+   M.join (lift5 f ma mb mc md me)  {- Add functions with restricted types?
src/Data/List/HT.hs view
@@ -24,6 +24,8 @@    L.switchL,    L.switchR,    -- * List processing starting at the end+   L.dropRev,+   L.takeRev,    L.dropWhileRev,    L.takeWhileRev,    -- * List processing with Maybe and Either@@ -51,6 +53,7 @@    L.isAscending,    L.isAscendingLazy,    L.mapAdjacent,+   L.mapAdjacent1,    L.range,    L.padLeft,    L.padRight,
src/Data/List/HT/Private.hs view
@@ -20,12 +20,22 @@ It is @inits undefined = [] : undefined@, in contrast to @Data.List.inits undefined = undefined@. -}+{-+suggested in+<http://www.haskell.org/pipermail/libraries/2014-July/023291.html>+-} inits :: [a] -> [[a]]-inits xt =+inits = map reverse . scanl (flip (:)) []++{- |+As lazy as 'inits' but less efficient because of repeated 'map'.+-}+initsLazy :: [a] -> [[a]]+initsLazy xt =    [] :    case xt of       [] -> []-      x:xs -> map (x:) (inits xs)+      x:xs -> map (x:) (initsLazy xs)  {- | Suggested implementation in the Haskell 98 report.@@ -429,6 +439,21 @@ -- * List processing starting at the end  {- |+@takeRev n@ is like @reverse . take n . reverse@+but it is lazy enough to work for infinite lists, too.+-}+takeRev :: Int -> [a] -> [a]+takeRev n xs = Match.drop (drop n xs) xs++{- |+@dropRev n@ is like @reverse . drop n . reverse@+but it is lazy enough to work for infinite lists, too.+-}+dropRev :: Int -> [a] -> [a]+dropRev n xs = Match.take (drop n xs) xs+++{- | Remove the longest suffix of elements satisfying p. In contrast to @reverse . dropWhile p . reverse@ this works for infinite lists, too.@@ -920,6 +945,15 @@ -} mapAdjacent :: (a -> a -> b) -> [a] -> [b] mapAdjacent f xs = zipWith f xs (tail xs)++{- |+> mapAdjacent f a0 [(a1,b1), (a2,b2), (a3,b3)]+> ==+> [f a0 a1 b1, f a1 a2 b2, f a2 a3 b3]+-}+mapAdjacent1 :: (a -> a -> b -> c) -> a -> [(a,b)] -> [c]+mapAdjacent1 f a xs =+   zipWith (\a0 (a1,b) -> f a0 a1 b) (a : map fst xs) xs   {- |
src/Data/List/Match.hs view
@@ -2,6 +2,8 @@    L.take,    L.drop,    L.splitAt,+   L.takeRev,+   L.dropRev,    L.replicate,    L.equalLength,    L.compareLength,
src/Data/List/Match/Private.hs view
@@ -68,6 +68,12 @@       (_, xs) -> ([],xs)  +takeRev :: [b] -> [a] -> [a]+takeRev ys xs = drop (drop ys xs) xs++dropRev :: [b] -> [a] -> [a]+dropRev ys xs = take (drop ys xs) xs+ {- | Check whether two lists with different element types have equal length. It is equivalent to @length xs == length ys@ but more efficient.@@ -124,7 +130,7 @@    in  zipWith (if' useX) xs ys  {- |-This lazier than 'shorterList' in a different aspect:+This is 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@@ -136,6 +142,9 @@    in  zipWith (\x y -> if' (x==y || useX) x y) xs ys  +{- |+Specialisation of 'Data.Functor.$>'.+-} replicate :: [a] -> b -> [b] replicate xs y =    take xs (repeat y)
+ src/Data/Tuple/Example.hs view
@@ -0,0 +1,41 @@+module Data.Tuple.Example where++import qualified Data.Tuple.Lazy as Lazy+import qualified Data.Tuple.Strict as Strict++import Data.List.HT (sieve, )+++partitionLazy :: (a -> Bool) -> [a] -> ([a], [a])+partitionLazy p =+   foldr+      (\x -> (if p x then Lazy.mapFst else Lazy.mapSnd) (x:))+      ([], [])++partitionStrict :: (a -> Bool) -> [a] -> ([a], [a])+partitionStrict p =+   foldr+      (\x -> (if p x then Strict.mapFst else Strict.mapSnd) (x:))+      ([], [])+++mainPartitionRuns :: IO ()+mainPartitionRuns =+   print $ partitionLazy (>=0) $ repeat (0::Int)++mainPartitionBlocks :: IO ()+mainPartitionBlocks =+   print $ partitionStrict (>=0) $ repeat (0::Int)++++printSomeChars :: (Show a) => a -> IO ()+printSomeChars = putStrLn . sieve 100000 . show++mainMemoryOk :: IO ()+mainMemoryOk =+   printSomeChars $ Strict.mapSnd (1+) $ (iterate (1+) (0::Int), 0::Int)++mainMemoryLeak :: IO ()+mainMemoryLeak =+   printSomeChars $ Lazy.mapSnd (1+) $ (iterate (1+) (0::Int), 0::Int)
src/Data/Tuple/HT.hs view
@@ -1,75 +1,38 @@-module Data.Tuple.HT where---- * Pair--{- | Cf. '(Control.Arrow.***)'.--Apply two functions on corresponding values in a pair,-where the pattern match on the pair constructor is lazy.-This is crucial in recursions such as the of 'partition'.--}-{--Instead of pattern matching with \code{(x,y)}-we may use \function{fst} and \function{snd}.--}-{-# INLINE mapPair #-}-mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d)-mapPair ~(f,g) ~(x,y) = (f x, g y)---- | 'Control.Arrow.first'-{-# INLINE mapFst #-}-mapFst :: (a -> c) -> (a,b) -> (c,b)-mapFst f ~(a,b) = (f a, b)---- | 'Control.Arrow.second'-{-# INLINE mapSnd #-}-mapSnd :: (b -> c) -> (a,b) -> (a,c)-mapSnd f ~(a,b) = (a, f b)-+module Data.Tuple.HT (+   -- * Pair+   mapPair,+   mapFst,+   mapSnd,+   swap,+   forcePair, -{-# INLINE swap #-}-swap :: (a,b) -> (b,a)-swap ~(x,y) = (y,x)+   -- * Triple+   fst3,+   snd3,+   thd3,+   mapTriple,+   mapFst3,+   mapSnd3,+   mapThd3,+   curry3,+   uncurry3,+   ) where -{-# INLINE forcePair #-}-forcePair :: (a,b) -> (a,b)-forcePair ~(x,y) = (x,y)+import Data.Tuple.Lazy  --- * Triple- {-# INLINE fst3 #-} fst3 :: (a,b,c) -> a-fst3 ~(x,_,_) = x+fst3 (x,_,_) = x  {-# INLINE snd3 #-} snd3 :: (a,b,c) -> b-snd3 ~(_,x,_) = x+snd3 (_,x,_) = x  {-# INLINE thd3 #-} thd3 :: (a,b,c) -> c-thd3 ~(_,_,x) = x--{-# INLINE mapTriple #-}-mapTriple :: (a -> d, b -> e, c -> f) -> (a,b,c) -> (d,e,f)-mapTriple ~(f,g,h) ~(x,y,z) = (f x, g y, h z)--{-# INLINE mapFst3 #-}-mapFst3 :: (a -> d) -> (a,b,c) -> (d,b,c)-mapFst3 f ~(a,b,c) = (f a, b, c)--{-# INLINE mapSnd3 #-}-mapSnd3 :: (b -> d) -> (a,b,c) -> (a,d,c)-mapSnd3 f ~(a,b,c) = (a, f b, c)--{-# INLINE mapThd3 #-}-mapThd3 :: (c -> d) -> (a,b,c) -> (a,b,d)-mapThd3 f ~(a,b,c) = (a, b, f c)+thd3 (_,_,x) = x  {-# INLINE curry3 #-} curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d curry3 f a b c = f (a,b,c)--{-# INLINE uncurry3 #-}-uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)-uncurry3 f ~(a,b,c) = f a b c
+ src/Data/Tuple/Lazy.hs view
@@ -0,0 +1,65 @@+module Data.Tuple.Lazy where++-- * Pair++{- | Cf. '(Control.Arrow.***)'.++Apply two functions on corresponding values in a pair,+where the pattern match on the pair constructor is lazy.+This is crucial in recursions such as the one of 'partition'.+One the other hand there are applications+where strict application is crucial,+e.g. @mapSnd f ab@ where the left pair member is a large lazy list.+With the lazy @mapSnd@ we make the application of @f@ depend on the whole pair @ab@.+See "Data.Tuple.Example" for two examples+where one variant is definitely better than the other one.+-}+{-+Instead of lazy pattern matching with \code{(x,y)}+we may use \function{fst} and \function{snd}.+-}+{-# INLINE mapPair #-}+mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d)+mapPair ~(f,g) ~(x,y) = (f x, g y)++-- | 'Control.Arrow.first'+{-# INLINE mapFst #-}+mapFst :: (a -> c) -> (a,b) -> (c,b)+mapFst f ~(a,b) = (f a, b)++-- | 'Control.Arrow.second'+{-# INLINE mapSnd #-}+mapSnd :: (b -> c) -> (a,b) -> (a,c)+mapSnd f ~(a,b) = (a, f b)+++{-# INLINE swap #-}+swap :: (a,b) -> (b,a)+swap ~(x,y) = (y,x)++{-# INLINE forcePair #-}+forcePair :: (a,b) -> (a,b)+forcePair ~(x,y) = (x,y)+++-- * Triple++{-# INLINE mapTriple #-}+mapTriple :: (a -> d, b -> e, c -> f) -> (a,b,c) -> (d,e,f)+mapTriple ~(f,g,h) ~(x,y,z) = (f x, g y, h z)++{-# INLINE mapFst3 #-}+mapFst3 :: (a -> d) -> (a,b,c) -> (d,b,c)+mapFst3 f ~(a,b,c) = (f a, b, c)++{-# INLINE mapSnd3 #-}+mapSnd3 :: (b -> d) -> (a,b,c) -> (a,d,c)+mapSnd3 f ~(a,b,c) = (a, f b, c)++{-# INLINE mapThd3 #-}+mapThd3 :: (c -> d) -> (a,b,c) -> (a,b,d)+mapThd3 f ~(a,b,c) = (a, b, f c)++{-# INLINE uncurry3 #-}+uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)+uncurry3 f ~(a,b,c) = f a b c
+ src/Data/Tuple/Strict.hs view
@@ -0,0 +1,43 @@+module Data.Tuple.Strict where++-- * Pair++{-# INLINE mapPair #-}+mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d)+mapPair (f,g) (x,y) = (f x, g y)++{-# INLINE mapFst #-}+mapFst :: (a -> c) -> (a,b) -> (c,b)+mapFst f (a,b) = (f a, b)++{-# INLINE mapSnd #-}+mapSnd :: (b -> c) -> (a,b) -> (a,c)+mapSnd f (a,b) = (a, f b)+++{-# INLINE swap #-}+swap :: (a,b) -> (b,a)+swap (x,y) = (y,x)+++-- * Triple++{-# INLINE mapTriple #-}+mapTriple :: (a -> d, b -> e, c -> f) -> (a,b,c) -> (d,e,f)+mapTriple (f,g,h) (x,y,z) = (f x, g y, h z)++{-# INLINE mapFst3 #-}+mapFst3 :: (a -> d) -> (a,b,c) -> (d,b,c)+mapFst3 f (a,b,c) = (f a, b, c)++{-# INLINE mapSnd3 #-}+mapSnd3 :: (b -> d) -> (a,b,c) -> (a,d,c)+mapSnd3 f (a,b,c) = (a, f b, c)++{-# INLINE mapThd3 #-}+mapThd3 :: (c -> d) -> (a,b,c) -> (a,b,d)+mapThd3 f (a,b,c) = (a, b, f c)++{-# INLINE uncurry3 #-}+uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)+uncurry3 f (a,b,c) = f a b c
src/Test/Data/List.hs view
@@ -11,6 +11,24 @@   +takeWhileRev :: (Ord a) => (a -> Bool) -> [a] -> Bool+takeWhileRev p xs =+   ListHT.takeWhileRev p xs == reverse (takeWhile p (reverse xs))++dropWhileRev :: (Ord a) => (a -> Bool) -> [a] -> Bool+dropWhileRev p xs =+   ListHT.dropWhileRev p xs == reverse (dropWhile p (reverse xs))+++takeRev :: (Eq a) => Int -> [a] -> Bool+takeRev n xs =+   ListHT.takeRev n xs == reverse (take n (reverse xs))++dropRev :: (Eq a) => Int -> [a] -> Bool+dropRev n xs =+   ListHT.dropRev n xs == reverse (drop n (reverse xs))++ sieve :: Eq a => Int -> [a] -> Property sieve n x =    n>0 ==>@@ -62,7 +80,11 @@    in  equalInfLists 1000 [xs, ys, zs]  +mapAdjacent :: (Num a, Eq a) => a -> [a] -> Bool+mapAdjacent x xs =+   ListHT.mapAdjacent subtract (scanl (+) x xs) == xs + simple ::    (Testable test) =>    (Int -> [Integer] -> test) -> IO ()@@ -71,6 +93,10 @@  tests :: [(String, IO ())] tests =+   ("takeWhileRev",     quickCheck (\a -> takeWhileRev ((a::Integer)>=))) :+   ("dropWhileRev",     quickCheck (\a -> dropWhileRev ((a::Integer)>=))) :+   ("takeRev",          simple takeRev) :+   ("dropRev",          simple dropRev) :    ("sieve",            simple sieve) :    ("sliceHorizontal",  simple sliceHorizontal) :    ("sliceVertical",    simple sliceVertical) :@@ -78,4 +104,5 @@    ("shear",            quickCheck (shear           :: [[Integer]] -> Bool)) :    ("outerProduct",     quickCheck (outerProduct    :: [Integer] -> [Int] -> Bool)) :    ("iterate",          quickCheck (iterate (+)     :: Integer -> Bool)) :+   ("mapAdjacent",      quickCheck (mapAdjacent     :: Integer -> [Integer] -> Bool)) :    []
src/Test/Data/ListMatch.hs view
@@ -41,6 +41,15 @@    (Match.take xs ys, Match.drop xs ys) == Match.splitAt xs ys  +takeRev :: (Eq a) => [b] -> [a] -> Bool+takeRev xs ys =+   Match.takeRev xs ys == reverse (Match.take xs (reverse ys))++dropRev :: (Eq a) => [b] -> [a] -> Bool+dropRev xs ys =+   Match.dropRev xs ys == reverse (Match.drop xs (reverse ys))++ compareLength :: [a] -> [b] -> Bool compareLength xs ys =    Match.compareLength xs ys == Match.compareLength0 xs ys &&@@ -62,5 +71,7 @@    ("dropAlt",          test2 dropAlt) :    ("takeDrop",         test2 takeDrop) :    ("splitAt",          test2 splitAt) :+   ("takeRev",          test2 takeRev) :+   ("dropRev",          test2 dropRev) :    ("compareLength",    test2 compareLength) :    []
utility-ht.cabal view
@@ -1,5 +1,5 @@ Name:             utility-ht-Version:          0.0.10+Version:          0.0.11 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -24,7 +24,7 @@   .   Alternative packages: @Useful@, @MissingH@ Tested-With:       GHC==6.8.2, GHC==6.10.4, GHC==6.12.3-Tested-With:       GHC==7.0.2, GHC==7.2.2, GHC==7.4.1+Tested-With:       GHC==7.0.2, GHC==7.2.2, GHC==7.4.1, GHC==7.8.2 Cabal-Version:     >=1.10 Build-Type:        Simple @@ -44,7 +44,7 @@ Source-Repository this   type:     darcs   location: http://code.haskell.org/~thielema/utility/-  tag:      0.0.10+  tag:      0.0.11  Library   Build-Depends:@@ -67,6 +67,8 @@     Data.Record.HT     Data.String.HT     Data.Tuple.HT+    Data.Tuple.Lazy+    Data.Tuple.Strict     Control.Monad.HT     Control.Functor.HT     Data.Strictness.HT@@ -79,6 +81,7 @@     Data.List.Match.Private     Data.Function.HT.Private     Data.Record.HT.Private+    Data.Tuple.Example   Test-Suite test