packages feed

utility-ht (empty) → 0.0.1

raw patch · 20 files changed

+1376/−0 lines, 20 filesdep +basesetup-changed

Dependencies added: base

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2009, Henning Thielemann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * The names of contributors may not be used to endorse or promote+      products derived from this software without specific prior+      written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ src/Control/Monad/HT.hs view
@@ -0,0 +1,42 @@+module Control.Monad.HT where++{- | repeat action until result fulfills condition -}+untilM :: (Monad m) => (a -> Bool) -> m a -> m a+untilM p m =+   do x <- m+      if p x+        then return x+        else untilM p m++-- parameter order equal to that of 'nest'+iterateLimitM :: Monad m => Int -> (a -> m a) -> a -> m [a]+iterateLimitM m f =+   let aux 0 x = return [x]+       aux n x = do y <- f x+                    z <- aux (n-1) y+                    return (x : z)+   in  aux m++{- |+Lazy monadic conjunction.+That is, when the first action returns @False@,+then @False@ is immediately returned, without running the second action.+-}+andLazy :: (Monad m) => m Bool -> m Bool -> m Bool+andLazy m0 m1 =+   m0 >>= \b ->+   if b+     then m1+     else return False++{- |+Lazy monadic disjunction.+That is, when the first action returns @True@,+then @True@ is immediately returned, without running the second action.+-}+orLazy :: (Monad m) => m Bool -> m Bool -> m Bool+orLazy m0 m1 =+   m0 >>= \b ->+   if b+     then return True+     else m1
+ src/Data/Bool/HT.hs view
@@ -0,0 +1,8 @@+module Data.Bool.HT (+   B.if',+   B.select,+   (B.?:),+   B.implies,+   ) where++import qualified Data.Bool.HT.Private as B
+ src/Data/Bool/HT/Private.hs view
@@ -0,0 +1,63 @@+module Data.Bool.HT.Private where++import Data.List  as List  (find, )+import Data.Maybe as Maybe (fromMaybe, )++{- |+@if-then-else@ as function.++Example:++> if' (even n) "even" $+> if' (isPrime n) "prime" $+> "boring"+-}+{-# INLINE if' #-}+if' :: Bool -> a -> a -> a+if' True  x _ = x+if' False _ y = y++{-|+From a list of expressions choose the one,+whose condition is true.++Example:++> select "boring" $+>   (even n, "even") :+>   (isPrime n, "prime") :+>   []+-}+{-# INLINE select #-}+select, select0, select1 :: a -> [(Bool, a)] -> a+select  def = maybe def snd . find fst+select0 def = fromMaybe def . lookup True+select1     = foldr (uncurry if')+++zipIf :: [Bool] -> [a] -> [a] -> [a]+zipIf = zipWith3 if'++infixr 1 ?:++{- |+Like the @?@ operator of the C progamming language.+Example: @bool ?: ("yes", "no")@.+-}+{-# INLINE (?:) #-}+(?:) :: Bool -> (a,a) -> a+(?:) = uncurry . if'+++-- precedence below (||) and (&&)+infixr 1 `implies`++{- |+Logical operator for implication.++Funnily because of the ordering of 'Bool' it holds @implies == (<=)@.+-}+{-# INLINE implies #-}+implies :: Bool -> Bool -> Bool+implies prerequisite conclusion =+   not prerequisite || conclusion
+ src/Data/Eq/HT.hs view
@@ -0,0 +1,7 @@+module Data.Eq.HT where++import Data.Function.HT (compose2, )++{-# INLINE equating #-}+equating :: Eq b => (a -> b) -> a -> a -> Bool+equating = compose2 (==)
+ src/Data/Function/HT.hs view
@@ -0,0 +1,12 @@+module Data.Function.HT (+   nest, powerAssociative, compose2,+   ) where++import Data.Function.HT.Private (nest, powerAssociative, )++{- |+Known as @on@ in newer versions of the @base@ package.+-}+{-# INLINE compose2 #-}+compose2 :: (b -> b -> c) -> (a -> b) -> (a -> a -> c)+compose2 g f x y = g (f x) (f y)
+ src/Data/Function/HT/Private.hs view
@@ -0,0 +1,45 @@+module Data.Function.HT.Private where++import Data.List (genericReplicate, )++{- |+Compositional power of a function,+i.e. apply the function @n@ times to a value.+It is rather the same as @iter@+in Simon Thompson: \"The Craft of Functional Programming\", page 172+-}+{-# INLINE nest #-}+nest, nest1, nest2 :: Int -> (a -> a) -> a -> a+nest 0 _ x = x+nest n f x = f (nest (n-1) f x)++nest1 n f = foldr (.) id (replicate n f)+nest2 n f x = iterate f x !! n++propNest :: (Eq a) => Int -> (a -> a) -> a -> Bool+propNest n f x =+   nest n f x == nest1 n f x+++{- |+@powerAssociative@ is an auxiliary function that,+for an associative operation @op@,+computes the same value as++  @powerAssociative op a0 a n = foldr op a0 (genericReplicate n a)@++but applies "op" O(log n) times and works for large n.+-}++{-# INLINE powerAssociative #-}+{-# INLINE powerAssociative1 #-}+powerAssociative, powerAssociative1 ::+   (a -> a -> a) -> a -> a -> Integer -> a+powerAssociative _  a0 _ 0 = a0+powerAssociative op a0 a n =+   if even n+     then powerAssociative op a0 (op a a) (div n 2)+     else powerAssociative op (op a0 a) (op a a) (div n 2)++powerAssociative1 op a0 a n =+   foldr op a0 (genericReplicate n a)
+ src/Data/List/HT.hs view
@@ -0,0 +1,51 @@+module Data.List.HT (+   -- * Improved standard functions+   L.inits,+   L.groupBy,+   L.group,+   L.partition,+   -- * Split+   L.chop,+   L.breakAfter,+   L.segmentAfter,+   L.segmentBefore,+   L.splitLast,+   L.viewL,+   L.viewR,+   L.switchL,+   L.switchR,+   -- * List processing starting at the end+   L.dropWhileRev,+   L.takeWhileRev,+   -- * List processing with Maybe and Either+   L.maybePrefixOf,+   L.partitionMaybe,+   L.unzipEithers,+   -- * Sieve and slice+   L.sieve,+   L.sliceHorizontal,+   L.sliceVertical,+   -- * Search&replace+   L.search,+   L.replace,+   L.multiReplace,+   -- * Lists of lists+   L.shear,+   L.shearTranspose,+   L.outerProduct,+   -- * Miscellaneous+   L.takeWhileMulti,+   L.rotate,+   L.mergeBy,+   L.allEqual,+   L.isAscending,+   L.isAscendingLazy,+   L.mapAdjacent,+   L.range,+   L.padLeft,+   L.padRight,+   L.iterateAssociative,+   L.iterateLeaky,+   ) where++import qualified Data.List.HT.Private as L
+ src/Data/List/HT/Private.hs view
@@ -0,0 +1,682 @@+module Data.List.HT.Private where++import Data.List  as List  (find, transpose, unfoldr, isPrefixOf,+                            tails, findIndices, foldl', )+import Data.Maybe as Maybe (fromMaybe, )+import Data.Maybe.HT       (toMaybe, )+import Control.Monad       (guard, )+import Data.Tuple.HT       (mapPair, mapFst, mapSnd, )++import qualified Data.List.Key.Private   as Key+import qualified Data.List.Match.Private as Match+++-- * Improved standard functions++{- |+This function is lazier than the one suggested in the Haskell 98 report.+It is @inits undefined = [] : undefined@,+in contrast to @Data.List.inits undefined = undefined@.+-}+inits :: [a] -> [[a]]+inits xt =+   [] :+   case xt of+      [] -> []+      x:xs -> map (x:) (inits xs)++{- |+Suggested implementation in the Haskell 98 report.+It is not as lazy as possible.+-}+inits98 :: [a] -> [[a]]+inits98 []     = [[]]+inits98 (x:xs) = [[]] ++ map (x:) (inits98 xs)++inits98' :: [a] -> [[a]]+inits98' =+   foldr (\x prefixes -> [] : map (x:) prefixes) [[]]+++{- |+This function compares adjacent elements of a list.+If two adjacent elements satisfy a relation then they are put into the same sublist.+Example:++> groupBy (<) "abcdebcdef"  ==  ["abcde","bcdef"]++In contrast to that 'Data.List.groupBy' compares+the head of each sublist with each candidate for this sublist.+This yields++> List.groupBy (<) "abcdebcdef"  ==  ["abcdebcdef"]++The second @'b'@ is compared with the leading @'a'@.+Thus it is put into the same sublist as @'a'@.++The sublists are never empty.+Thus the more precise result type would be @[(a,[a])]@.+-}+groupBy :: (a -> a -> Bool) -> [a] -> [[a]]+groupBy = Key.groupBy++group :: (Eq a) => [a] -> [[a]]+group = groupBy (==)+++{- |+'Data.List.partition' of GHC 6.2.1 fails on infinite lists.+But this one does not.+-}+{-+The lazy pattern match @(y,z)@ is necessary+since otherwise it fails on infinite lists.+-}+partition :: (a -> Bool) -> [a] -> ([a], [a])+partition p =+   foldr+      (\x ~(y,z) ->+         if p x+           then (x : y, z)+           else (y, x : z))+      ([],[])++-- * Split++{- |+Split the list at the occurrences of a separator into sub-lists.+Remove the separators.+This is a generalization of 'words'.+-}+chop :: (a -> Bool) -> [a] -> [[a]]+chop p s =+   let (l, s') = break p s+   in  l : case s' of+           [] -> []+           (_:rest) -> chop p rest+++chopAtRun :: (Eq a) => (a -> Bool) -> [a] -> [[a]]+chopAtRun p =+   let recourse [] = [[]]+       recourse y =+          let (z,zs) = break p (dropWhile p y)+          in z : recourse zs+   in  recourse+++{- |+Like 'break', but splits after the matching element.+-}+breakAfter :: (a -> Bool) -> [a] -> ([a], [a])+breakAfter p =+   let recourse [] = ([],[])+       recourse (x:xs) =+          if p x+            then ([x],xs)+            else mapFst (x:) $ recourse xs+   in  recourse+++{- |+Split the list after each occurence of a terminator.+Keep the terminator.+There is always a list for the part after the last terminator.+It may be empty.+-}+segmentAfter :: (a -> Bool) -> [a] -> [[a]]+segmentAfter p =+   foldr (\ x ~yt@(y:ys) -> if p x then [x]:yt else (x:y):ys) [[]]++propSegmentAfterConcat :: Eq a => (a -> Bool) -> [a] -> Bool+propSegmentAfterConcat p xs =+   concat (segmentAfter p xs) == xs++propSegmentAfterNumSeps :: (a -> Bool) -> [a] -> Bool+propSegmentAfterNumSeps p xs =+   length (filter p xs) == length (tail (segmentAfter p xs))++propSegmentAfterLasts :: (a -> Bool) -> [a] -> Bool+propSegmentAfterLasts p =+   all (p . last) . init . segmentAfter p++propSegmentAfterInits :: (a -> Bool) -> [a] -> Bool+propSegmentAfterInits p =+   all (all (not . p) . init) . init . segmentAfter p++{-+This test captures both infinitely many groups and infinitely big groups.+-}+propSegmentAfterInfinite :: (a -> Bool) -> a -> [a] -> Bool+propSegmentAfterInfinite p x =+   flip seq True . (!!100) . concat . segmentAfter p . cycle . (x:)++{- |+Split the list before each occurence of a leading character.+Keep these characters.+There is always a list for the part before the first leading character.+It may be empty.+-}+segmentBefore :: (a -> Bool) -> [a] -> [[a]]+segmentBefore p =+   foldr (\ x ~(y:ys) -> (if p x then ([]:) else id) ((x:y):ys)) [[]]++propSegmentBeforeConcat :: Eq a => (a -> Bool) -> [a] -> Bool+propSegmentBeforeConcat p xs =+   concat (segmentBefore p xs) == xs++propSegmentBeforeNumSeps :: (a -> Bool) -> [a] -> Bool+propSegmentBeforeNumSeps p xs =+   length (filter p xs) == length (tail (segmentBefore p xs))++propSegmentBeforeHeads :: (a -> Bool) -> [a] -> Bool+propSegmentBeforeHeads p =+   all (p . head) . tail . segmentBefore p++propSegmentBeforeTails :: (a -> Bool) -> [a] -> Bool+propSegmentBeforeTails p =+   all (all (not . p) . tail) . tail . segmentBefore p++propSegmentBeforeInfinite :: (a -> Bool) -> a -> [a] -> Bool+propSegmentBeforeInfinite p x =+   flip seq True . (!!100) . concat . segmentBefore p . cycle . (x:)+++{- |+@removeEach xs@ represents a list of sublists of @xs@,+where each element of @xs@ is removed and+the removed element is separated.+It seems to be much simpler to achieve with+@zip xs (map (flip List.delete xs) xs)@,+but the implementation of 'removeEach' does not need the 'Eq' instance+and thus can also be used for lists of functions.+-}+removeEach :: [a] -> [(a, [a])]+removeEach =+   map (\(ys, pivot, zs) -> (pivot,ys++zs)) . splitEverywhere++splitEverywhere :: [a] -> [([a], a, [a])]+splitEverywhere xs =+   map (\(y, z:zs) -> (y,z,zs))+       (init (zip (inits xs) (tails xs)))++++--  * inspect ends of a list++{-# DEPRECATED splitLast "use viewR instead" #-}+{- |+It holds @splitLast xs == (init xs, last xs)@,+but 'splitLast' is more efficient+if the last element is accessed after the initial ones,+because it avoids memoizing list.+-}+splitLast :: [a] -> ([a], a)+splitLast [] = error "splitLast: empty list"+splitLast [x] = ([], x)+splitLast (x:xs) =+   let (xs', lastx) = splitLast xs in (x:xs', lastx)++propSplitLast :: Eq a => [a] -> Bool+propSplitLast xs =+   splitLast xs  ==  (init xs, last xs)+++{- |+Should be prefered to 'head' and 'tail'.+-}+{-# INLINE viewL #-}+viewL :: [a] -> Maybe (a, [a])+viewL (x:xs) = Just (x,xs)+viewL []     = Nothing++{- |+Should be prefered to 'init' and 'last'.+-}+viewR :: [a] -> Maybe ([a], a)+viewR =+   foldr (\x -> Just . maybe ([],x) (mapFst (x:))) Nothing++propViewR :: Eq a => [a] -> Bool+propViewR xs =+   maybe True+      ((init xs, last xs) == )+      (viewR xs)++{- |+Should be prefered to 'head' and 'tail'.+-}+{-# INLINE switchL #-}+switchL :: b -> (a -> [a] -> b) -> [a] -> b+switchL n _ [] = n+switchL _ j (x:xs) = j x xs++switchL' :: b -> (a -> [a] -> b) -> [a] -> b+switchL' n j =+   maybe n (uncurry j) . viewL++{- |+Should be prefered to 'init' and 'last'.+-}+{-# INLINE switchR #-}+switchR :: b -> ([a] -> a -> b) -> [a] -> b+switchR n j =+   maybe n (uncurry j) . viewR++propSwitchR :: Eq a => [a] -> Bool+propSwitchR xs =+   switchR True (\ixs lxs -> ixs == init xs && lxs == last xs) xs++++-- * List processing starting at the end++{- |+Remove the longest suffix of elements satisfying p.+In contrast to @reverse . dropWhile p . reverse@+this works for infinite lists, too.+-}+dropWhileRev :: (a -> Bool) -> [a] -> [a]+dropWhileRev p =+   foldr (\x xs -> if p x && null xs then [] else x:xs) []++dropWhileRev' :: (a -> Bool) -> [a] -> [a]+dropWhileRev' p =+   concat . init . segmentAfter (not . p)++{- |+Alternative version of @reverse . takeWhile p . reverse@.+-}+takeWhileRev :: (a -> Bool) -> [a] -> [a]+takeWhileRev p =+   last . segmentAfter (not . p)++{- |+Doesn't seem to be superior to the naive implementation.+-}+takeWhileRev' :: (a -> Bool) -> [a] -> [a]+takeWhileRev' p =+   (\xs -> if fst (head xs)+             then map snd xs+             else []) .+   last . Key.aux groupBy (==) p++{- |+However it is more inefficient,+because of repeatedly appending single elements. :-(+-}+takeWhileRev'' :: (a -> Bool) -> [a] -> [a]+takeWhileRev'' p =+   foldl (\xs x -> if p x then xs++[x] else []) []+++-- * List processing with Maybe and Either++{- |+@maybePrefixOf xs ys@ is @Just zs@ if @xs@ is a prefix of @ys@,+where @zs@ is @ys@ without the prefix @xs@.+Otherwise it is @Nothing@.+-}+maybePrefixOf :: Eq a => [a] -> [a] -> Maybe [a]+maybePrefixOf (x:xs) (y:ys) = guard (x==y) >> maybePrefixOf xs ys+maybePrefixOf [] ys = Just ys+maybePrefixOf _  [] = Nothing++{- |+Partition a list into elements which evaluate to @Just@ or @Nothing@ by @f@.+-}+partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])+partitionMaybe f =+   foldr+      (\x -> maybe (mapSnd (x:)) (\y -> mapFst (y:)) (f x))+      ([],[])++unzipEithers :: [Either a b] -> ([a], [b])+unzipEithers =+   foldr (either (\x -> mapFst (x:)) (\y -> mapSnd (y:))) ([],[])+++-- * Sieve and slice++{-| keep every k-th value from the list -}+sieve, sieve', sieve'', sieve''' :: Int -> [a] -> [a]+sieve k =+   unfoldr (\xs -> toMaybe (not (null xs)) (head xs, drop k xs))++sieve' k = map head . sliceVertical k++sieve'' k x = map (x!!) [0,k..(length x-1)]++sieve''' k = map head . takeWhile (not . null) . iterate (drop k)++propSieve :: Eq a => Int -> [a] -> Bool+propSieve n x =+   sieve n x == sieve'  n x   &&+   sieve n x == sieve'' n x++{-+sliceHorizontal is faster than sliceHorizontal' but consumes slightly more memory+(although it needs no swapping)+-}+sliceHorizontal, sliceHorizontal', sliceHorizontal'', sliceHorizontal''' ::+   Int -> [a] -> [[a]]+sliceHorizontal n =+   map (sieve n) . take n . iterate (drop 1)++sliceHorizontal' n =+   foldr (\x ys -> let y = last ys in Match.take ys ((x:y):ys)) (replicate n [])++sliceHorizontal'' n =+   reverse . foldr (\x ~(y:ys) -> ys ++ [x:y]) (replicate n [])++sliceHorizontal''' n =+   take n . transpose . takeWhile (not . null) . iterate (drop n)++propSliceHorizontal :: Eq a => Int -> [a] -> Bool+propSliceHorizontal n x =+   sliceHorizontal n x == sliceHorizontal'   n x &&+   sliceHorizontal n x == sliceHorizontal''  n x &&+   sliceHorizontal n x == sliceHorizontal''' n x+++sliceVertical, sliceVertical' :: Int -> [a] -> [[a]]+sliceVertical n =+   map (take n) . takeWhile (not . null) . iterate (drop n)+      {- takeWhile must be performed before (map take)+         in order to handle (n==0) correctly -}++sliceVertical' n =+   unfoldr (\x -> toMaybe (not (null x)) (splitAt n x))++propSliceVertical :: Eq a => Int -> [a] -> Bool+propSliceVertical n x =+   take 100000 (sliceVertical n x) == take 100000 (sliceVertical' n x)++propSlice :: Eq a => Int -> [a] -> Bool+propSlice n x =+   -- problems: sliceHorizontal 4 [] == [[],[],[],[]]+   sliceHorizontal n x == transpose (sliceVertical  n x)  &&+   sliceVertical  n x == transpose (sliceHorizontal n x)++++-- * Search&replace++search :: (Eq a) => [a] -> [a] -> [Int]+search sub str = findIndices (isPrefixOf sub) (tails str)++markSublists :: (Eq a) => [a] -> [a] -> [Maybe [a]]+markSublists sub ys =+   let ~(hd', rest') =+          foldr (\c ~(hd, rest) ->+                   let xs = c:hd+                   in  case maybePrefixOf sub xs of+                         Just suffix -> ([], Nothing : Just suffix : rest)+                         Nothing -> (xs, rest)) ([],[]) ys+   in  Just hd' : rest'++replace :: (Eq a) => [a] -> [a] -> [a] -> [a]+replace src dst xs =+   concatMap (fromMaybe dst) (markSublists src xs)++propReplaceId :: (Eq a) => [a] -> [a] -> Bool+propReplaceId xs ys =+   replace xs xs ys == ys++propReplaceCycle :: (Eq a) => [a] -> [a] -> Bool+propReplaceCycle xs ys =+   replace xs ys (cycle xs) == cycle ys++{- | This is slightly wrong, because it re-replaces things.+     That's also the reason for inefficiency:+        The replacing can go on only when subsequent replacements are finished.+     Thus this functiob fails on infinite lists. -}+replace' :: (Eq a) => [a] -> [a] -> [a] -> [a]+replace' src dst =+    foldr (\x xs -> let y=x:xs+                    in  if isPrefixOf src y+                          then dst ++ drop (length src) y+                          else y) []++multiReplace :: Eq a => [([a], [a])] -> [a] -> [a]+multiReplace dict =+   let recourse [] = []+       recourse str@(s:ss) =+          maybe+             (s : recourse ss)+             (\(src, dst) -> dst ++ recourse (Match.drop src str))+             (find (flip isPrefixOf str . fst) dict)+   in  recourse++propMultiReplaceSingle :: Eq a => [a] -> [a] -> [a] -> Bool+propMultiReplaceSingle src dst x =+   replace src dst x == multiReplace [(src,dst)] x+++-- * Lists of lists++{- |+Transform++> [[00,01,02,...],          [[00],+>  [10,11,12,...],   -->     [10,01],+>  [20,21,22,...],           [20,11,02],+>  ...]                      ...]++With @concat . shear@ you can perform a Cantor diagonalization,+that is an enumeration of all elements of the sub-lists+where each element is reachable within a finite number of steps.+It is also useful for polynomial multiplication (convolution).+-}+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))+              {- Dropping trailing empty lists is necessary,+                 otherwise finite lists are filled with empty lists. -}+shear [] = []++{- |+Transform++> [[00,01,02,...],          [[00],+>  [10,11,12,...],   -->     [01,10],+>  [20,21,22,...],           [02,11,20],+>  ...]                      ...]++It's like 'shear' but the order of elements in the sub list is reversed.+Its implementation seems to be more efficient than that of 'shear'.+If the order does not matter, better choose 'shearTranspose'.+-}+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 []+++{- |+Operate on each combination of elements of the first and the second list.+In contrast to the list instance of 'Monad.liftM2'+in holds the results in a list of lists.+It holds+@concat (outerProduct f xs ys)  ==  liftM2 f xs ys@+-}+outerProduct :: (a -> b -> c) -> [a] -> [b] -> [[c]]+outerProduct f xs ys = map (flip map ys . f) xs++++-- * Miscellaneous++{- |+Take while first predicate holds,+then continue taking while second predicate holds,+and so on.+-}+takeWhileMulti :: [a -> Bool] -> [a] -> [a]+takeWhileMulti [] _  = []+takeWhileMulti _  [] = []+takeWhileMulti aps@(p:ps) axs@(x:xs) =+   if p x+      then x : takeWhileMulti aps xs+      else takeWhileMulti ps axs++takeWhileMulti' :: [a -> Bool] -> [a] -> [a]+takeWhileMulti' ps xs =+   concatMap fst (tail+      (scanl (flip span . snd) (undefined,xs) ps))++propTakeWhileMulti :: (Eq a) => [a -> Bool] -> [a] -> Bool+propTakeWhileMulti ps xs =+   takeWhileMulti ps xs == takeWhileMulti' ps xs++{-+Debug.QuickCheck.quickCheck (propTakeWhileMulti [(<0), (>0), odd, even, ((0::Int)==)])+-}++{- |+This is a combination of 'foldl'' and 'foldr'+in the sense of 'propFoldl'r'.+It is however more efficient+because it avoids storing the whole input list as a result of sharing.+-}+foldl'r, foldl'rStrict, foldl'rNaive ::+   (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a,c)] -> (b,d)+foldl'r f b0 g d0 =+--   (\(k,d1) -> (k b0, d1)) .+   mapFst ($b0) .+   foldr (\(a,c) ~(k,d) -> (\b -> k $! f b a, g c d)) (id,d0)++foldl'rStrict f b0 g d0 =+   mapFst ($b0) .+   foldr (\(a,c) ~(k,d) -> ((,) $! (\b -> k $! f b a)) $! g c d) (id,d0)++foldl'rNaive f b g d xs =+   mapPair (foldl' f b, foldr g d) $ unzip xs++propFoldl'r :: (Eq b, Eq d) =>+   (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a,c)] -> Bool+propFoldl'r f b g d xs =+   foldl'r f b g d xs == foldl'rNaive f b g d xs++{-+The results in GHCi surprise:++*List.HT> mapSnd last $ foldl'rNaive (+) (0::Integer) (:) "" $ replicate 1000000 (1,'a')+(1000000,'a')+(0.44 secs, 141032856 bytes)++*List.HT> mapSnd last $ foldl'r (+) (0::Integer) (:) "" $ replicate 1000000 (1,'a')+(1000000,'a')+(2.64 secs, 237424948 bytes)+-}++{-+Debug.QuickCheck.quickCheck (\b d -> propFoldl'r (+) (b::Int) (++) (d::[Int]))+-}+++{- | rotate left -}+rotate, rotate', rotate'' :: Int -> [a] -> [a]+rotate n x =+   Match.take x (drop (mod n (length x)) (cycle x))++{- | more efficient implementation of rotate' -}+rotate' n x =+   uncurry (flip (++))+           (splitAt (mod n (length x)) x)++rotate'' n x =+   Match.take x (drop n (cycle x))++propRotate :: Eq a => Int -> [a] -> Bool+propRotate n x =+   rotate n x == rotate'  n x &&+   rotate n x == rotate'' n x+{- Debug.QuickCheck.quickCheck+      (\n x -> n>=0 Debug.QuickCheck.==>+          List.HT.propRotate n ((0::Int):x)) -}++{-|+Given two lists that are ordered+(i.e. @p x y@ holds for subsequent @x@ and @y@)+'mergeBy' them into a list that is ordered, again.+-}+mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]+mergeBy = Key.mergeBy+++allEqual :: Eq a => [a] -> Bool+allEqual = and . mapAdjacent (==)++isAscending :: (Ord a) => [a] -> Bool+isAscending = and . isAscendingLazy++isAscendingLazy :: (Ord a) => [a] -> [Bool]+isAscendingLazy = mapAdjacent (<=)++mapAdjacent :: (a -> a -> b) -> [a] -> [b]+mapAdjacent f xs = zipWith f xs (tail xs)+++{- |+Enumerate without Enum context.+For Enum equivalent to enumFrom.+-}+range :: Num a => Int -> [a]+range n = take n (iterate (+1) 0)+++{-# INLINE padLeft #-}+padLeft :: a -> Int -> [a] -> [a]+padLeft  c n xs = replicate (n - length xs) c ++ xs+++{-# INLINE padRight #-}+padRight, padRight1 :: a -> Int -> [a] -> [a]+padRight  c n xs = take n $ xs ++ repeat c+padRight1 c n xs = xs ++ replicate (n - length xs) c++{- |+For an associative operation @op@ this computes+   @iterateAssociative op a = iterate (op a) a@+but it is even faster than @map (powerAssociative op a a) [0..]@+since it shares temporary results.++The idea is:+From the list @map (powerAssociative op a a) [0,(2*n)..]@+we compute the list @map (powerAssociative op a a) [0,n..]@,+and iterate that until @n==1@.+-}+iterateAssociative :: (a -> a -> a) -> a -> [a]+iterateAssociative op a =+   foldr (\pow xs -> pow : concatMap (\x -> [x, op x pow]) xs)+         undefined (iterate (\x -> op x x) a)++{- |+This is equal to 'iterateAssociative'.+The idea is the following:+The list we search is the fixpoint of the function:+"Square all elements of the list,+then spread it and fill the holes with successive numbers+of their left neighbour."+This also preserves log n applications per value.+However it has a space leak,+because for the value with index @n@+all elements starting at @div n 2@ must be kept.+-}+iterateLeaky :: (a -> a -> a) -> a -> [a]+iterateLeaky op x =+   let merge (a:as) b = a : merge b as+       merge _ _ = error "iterateLeaky: an empty list cannot occur"+       sqrs = map (\y -> op y y) z+       z = x : merge sqrs (map (op x) sqrs)+   in  z
+ src/Data/List/Key.hs view
@@ -0,0 +1,17 @@+{- |+Variant of "Data.List" functions like 'Data.List.group', 'Data.List.sort'+where the comparison is performed on a key computed from the list elements.+In principle these functions could be replaced by e.g. @sortBy (compare `on` f)@,+but @f@ will be re-computed for every comparison.+If the evaluation of @f@ is expensive,+our functions are better, since they buffer the results of @f@.+-}+module Data.List.Key (+   L.nub,+   L.sort,+   L.minimum,+   L.maximum,+   L.group,+   ) where++import qualified Data.List.Key.Private as L
+ src/Data/List/Key/Private.hs view
@@ -0,0 +1,110 @@+module Data.List.Key.Private where++import Data.Function.HT (compose2, )++import Data.List (nubBy, sortBy, minimumBy, maximumBy, )++import Prelude hiding (minimum, maximum, )+++attach :: (a -> b) -> [a] -> [(b,a)]+attach key = map (\x -> (key x, x))+++aux ::+   (((key, a) -> (key, a) -> b) -> [(key, a)] -> c) ->+      (key -> key -> b) -> (a -> key) ->+          ([a] -> c)+aux listFunc cmpFunc key =+   listFunc (compose2 cmpFunc fst) . attach key++aux' ::+   ((a -> a -> b) -> [a] -> c) ->+      (key -> key -> b) -> (a -> key) ->+          ([a] -> c)+aux' listFunc cmpFunc key =+   listFunc (compose2 cmpFunc key)+++{- |+Divides a list into sublists such that the members in a sublist+share the same key.+It uses semantics of 'Data.List.HT.groupBy',+not that of 'Data.List.groupBy'.+-}+group :: Eq b => (a -> b) -> [a] -> [[a]]+group key = map (map snd) . aux groupBy (==) key++{- |+Will be less efficient than 'group'+if @key@ is computationally expensive.+This is so because the key is re-evaluated for each list item.+Alternatively you may write @groupBy ((==) `on` key)@.+-}+group' :: Eq b => (a -> b) -> [a] -> [[a]]+group'  =  aux' groupBy (==)++propGroup :: (Eq a, Eq b) => (a -> b) -> [a] -> Bool+propGroup key xs =+   group key xs == group' key xs++{- | argmin -}+minimum :: Ord b => (a -> b) -> [a] -> a+minimum key  =  snd . aux minimumBy compare key++{- | argmax -}+maximum :: Ord b => (a -> b) -> [a] -> a+maximum key  =  snd . aux maximumBy compare key++sort :: Ord b => (a -> b) -> [a] -> [a]+sort key  =  map snd . aux sortBy compare key++merge :: Ord b => (a -> b) -> [a] -> [a] -> [a]+merge key xs ys  =+   map snd $+   mergeBy+      (compose2 (<=) fst)+      (attach key xs) (attach key ys)++nub :: Eq b => (a -> b) -> [a] -> [a]+nub key  =  map snd . aux nubBy (==) key+++-- * helper functions++groupBy :: (a -> a -> Bool) -> [a] -> [[a]]+groupBy p = map (uncurry (:)) . groupByNonEmpty p++groupByNonEmpty :: (a -> a -> Bool) -> [a] -> [(a,[a])]+groupByNonEmpty p =+   foldr+      (\x0 yt ->+         let (xr,yr) =+               case yt of+                  (x1,xs):ys ->+                     if p x0 x1+                       then (x1:xs,ys)+                       else ([],yt)+                  [] -> ([],yt)+         in  (x0,xr):yr)+      []++groupByEmpty :: (a -> a -> Bool) -> [a] -> [[a]]+groupByEmpty p =+   uncurry (:) .+   foldr+      (\x0 ~(y,ys) ->+         if (case y of x1:_ -> p x0 x1; _ -> True)+           then (x0:y,ys)+           else (x0:[],y:ys))+      ([],[])++mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]+mergeBy p =+   let recourse xl@(x:xs) yl@(y:ys) =+         if p x y+           then x : recourse xs yl+           else y : recourse xl ys+       recourse [] yl = yl+       recourse xl [] = xl+   in  recourse
+ src/Data/List/Match.hs view
@@ -0,0 +1,10 @@+module Data.List.Match (+   L.take,+   L.drop,+   L.splitAt,+   L.replicate,+   L.compareLength,+   L.shorterList,+   ) where++import qualified Data.List.Match.Private as L
+ src/Data/List/Match/Private.hs view
@@ -0,0 +1,123 @@+module Data.List.Match.Private where++import Data.Maybe    (fromJust, isNothing, )+import Data.Maybe.HT (toMaybe, )+import Data.Tuple.HT (mapFst, )+import Data.Bool.HT  (if', )++import qualified Data.List as List++import Prelude hiding (take, drop, splitAt, replicate, )+++{- | Make a list as long as another one -}+take :: [b] -> [a] -> [a]+take = flip (zipWith const)++{- | Drop as many elements as the first list is long -}+drop :: [b] -> [a] -> [a]+drop xs ys =+   -- catMaybes (+   map fromJust (dropWhile isNothing+      (zipWith (toMaybe . null) (iterate laxTail xs) ys))++drop' :: [b] -> [a] -> [a]+drop' xs ys =+   map snd (dropWhile (not . null . fst) (zip (iterate laxTail xs) ys))++drop'' :: [b] -> [a] -> [a]+drop'' xs ys =+   snd $ head $+   dropWhile (not . null . fst) $+   zip (iterate laxTail xs) (iterate laxTail ys)++{- |+Shares suffix with input, that is it is more efficient.+-}+drop''' :: [b] -> [a] -> [a]+drop''' (_:xs) (_:ys) = drop''' xs ys+drop''' _ ys = ys++{- |+@laxTail [] = []@+-}+laxTail :: [a] -> [a]+laxTail = List.drop 1++propTake :: (Eq a) => [b] -> [a] -> Bool+propTake xs ys =+   take xs ys == List.take (length xs) ys++propDrop :: (Eq a) => [b] -> [a] -> Bool+propDrop xs ys =+   drop xs ys == List.drop (length xs) ys++propDropAlt :: (Eq a) => [b] -> [a] -> Bool+propDropAlt xs ys =+   drop xs ys == drop'   xs ys &&+   drop xs ys == drop''  xs ys &&+   drop xs ys == drop''' xs ys++propTakeDrop :: (Eq a) => [b] -> [a] -> Bool+propTakeDrop xs ys =+   take xs ys ++ drop xs ys == ys+++splitAt :: [b] -> [a] -> ([a],[a])+splitAt (_:ns) (x:xs) =+   mapFst (x:) $ splitAt ns xs+splitAt _  [] = ([],[])+splitAt [] xs = ([],xs)++propSplitAt :: (Eq a) => [b] -> [a] -> Bool+propSplitAt xs ys =+   (take xs ys, drop xs ys) == splitAt xs ys+++{- |+Compare the length of two lists over different types.+It is equivalent to @(compare (length xs) (length ys))@+but more efficient.+-}+compareLength :: [a] -> [b] -> Ordering+compareLength (_:xs) (_:ys) = compareLength xs ys+compareLength []     []     = EQ+compareLength (_:_)  []     = GT+compareLength []     (_:_)  = LT++{- | efficient like compareLength, but without pattern matching -}+compareLength' :: [a] -> [b] -> Ordering+compareLength' xs ys =+   let boolList zs = replicate zs True ++ repeat False+   -- we rely in the order of Bool constructors False and True here+   in  uncurry compare (head+          (dropWhile (uncurry (&&)) (zip (boolList xs) (boolList ys))))++compareLength'' :: [a] -> [b] -> Ordering+compareLength'' xs ys =+   compare (length xs) (length ys)++propCompareLength :: [Integer] -> [Int] -> Bool+propCompareLength xs ys =+   compareLength xs ys == compareLength'  xs ys &&+   compareLength xs ys == compareLength'' xs ys+++{- |+Returns the shorter one of two lists.+It works also for infinite lists as much as possible.+E.g. @shortList (shorterList (repeat 1) (repeat 2)) [1,2,3]@+can be computed.+The trick is, that the skeleton of the resulting list+is constructed using 'zipWith' without touching the elements.+The contents is then computed (only) if requested.+-}+shorterList :: [a] -> [a] -> [a]+shorterList xs ys =+   let useX = compareLength xs ys <= EQ+   in  zipWith (if' useX) xs ys+++replicate :: [a] -> b -> [b]+replicate xs y =+   take xs (repeat y)
+ src/Data/Maybe/HT.hs view
@@ -0,0 +1,8 @@+module Data.Maybe.HT where++{- | Returns 'Just' if the precondition is fulfilled. -}+{-# INLINE toMaybe #-}+toMaybe :: Bool -> a -> Maybe a+toMaybe False _ = Nothing+toMaybe True  x = Just x+
+ src/Data/Ord/HT.hs view
@@ -0,0 +1,23 @@+module Data.Ord.HT where++import Data.Function.HT (compose2, )++{-# INLINE comparing #-}+comparing :: Ord b => (a -> b) -> a -> a -> Ordering+comparing = compose2 compare++{- |+@limit (lower,upper) x@ restricts @x@ to the range from @lower@ to @upper@.+Don't expect a sensible result for @lower>upper@.+-}+{-# INLINE limit #-}+limit :: (Ord a) => (a,a) -> a -> a+limit (l,u) = max l . min u++{- |+@limit (lower,upper) x@ checks whether @x@ is in the range from @lower@ to @upper@.+Don't expect a sensible result for @lower>upper@.+-}+{-# INLINE inRange #-}+inRange :: (Ord a) => (a,a) -> a -> Bool+inRange (l,u) x  =  l<=x && x<=u
+ src/Data/Tuple/HT.hs view
@@ -0,0 +1,46 @@+module Data.Tuple.HT where++-- * Pair++-- | '(Control.Arrow.***)'+{-# 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)+++-- * Triple++{-# INLINE fst3 #-}+fst3 :: (a,b,c) -> a+fst3 ~(x,_,_) = x++{-# INLINE snd3 #-}+snd3 :: (a,b,c) -> b+snd3 ~(_,x,_) = x++{-# INLINE thd3 #-}+thd3 :: (a,b,c) -> 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/Text/Read/HT.hs view
@@ -0,0 +1,27 @@+module Text.Read.HT where++{-| Parse a string containing an infix operator. -}+{-# INLINE readsInfixPrec #-}+readsInfixPrec :: (Read a, Read b) =>+   String -> Int -> Int -> (a -> b -> c) -> ReadS c+readsInfixPrec opStr opPrec prec cons =+   readParen+     (prec >= opPrec)+     ((\s -> [(const . cons, s)]) .>+      readsPrec opPrec .>+      (filter ((opStr==).fst) . lex) .>+      readsPrec opPrec)++{-| Compose two parsers sequentially. -}+infixl 9 .>+(.>) :: ReadS (b -> c) -> ReadS b -> ReadS c+(.>) ra rb =+   concatMap (\(f,rest) -> map (\(b, rest') -> (f b, rest')) (rb rest)) . ra+++readMany :: (Read a) => String -> [a]+readMany x =+   let contReadList []     = []+       contReadList (y:[]) = fst y : readMany (snd y)+       contReadList _      = error "readMany: ambiguous parses"+   in  contReadList (reads x)
+ src/Text/Show/HT.hs view
@@ -0,0 +1,12 @@+module Text.Show.HT where++{-| Show a value using an infix operator. -}+{-# INLINE showsInfixPrec #-}+showsInfixPrec :: (Show a, Show b) =>+                  String -> Int -> Int -> a -> b -> ShowS+showsInfixPrec opStr opPrec prec x y =+   showParen+     (prec >= opPrec)+     (showsPrec opPrec x . showString " " .+      showString opStr . showString " " .+      showsPrec opPrec y)
+ utility-ht.cabal view
@@ -0,0 +1,56 @@+Name:             utility-ht+Version:          0.0.1+License:          BSD3+License-File:     LICENSE+Author:           Henning Thielemann <haskell@henning-thielemann.de>+Maintainer:       Henning Thielemann <haskell@henning-thielemann.de>+-- Homepage:         http://www.haskell.org/haskellwiki/Utility-HT+Category:         Data, List+Synopsis:         Various small helper functions for Lists, Maybes, Tuples, Functions+Description:+  Various small helper functions for Lists, Maybes, Tuples, Functions.+  Some of these functions are improved implementations of standard functions.+  They have the same name as their standard counterparts.++  The package only contains functions+  that do not require packages other than the base package.+  Thus you do not risk a dependency avalanche by importing it.+  However, further splitting the base package might invalidate this statement.+Tested-With:       GHC==6.8.2+Cabal-Version:     >=1.6+Build-Type:        Simple++Source-Repository head+  type:     darcs+  location: http://code.haskell.org/~thielema/utility/++Source-Repository this+  type:     darcs+  location: http://code.haskell.org/~thielema/utility/+  tag:      0.0.1+++Library+  Build-Depends: base++  GHC-Options:      -Wall+  Hs-Source-Dirs:   src+  Exposed-Modules:+    Data.Bool.HT+    Data.Eq.HT+    Data.Function.HT+    Data.List.HT+    Data.List.Key+    Data.List.Match+    Data.Maybe.HT+    Data.Ord.HT+    Data.Tuple.HT+    Control.Monad.HT+    Text.Read.HT+    Text.Show.HT+  Other-Modules:+    Data.Bool.HT.Private+    Data.List.HT.Private+    Data.List.Key.Private+    Data.List.Match.Private+    Data.Function.HT.Private