utility-ht-0.0.5.1/0000755000000000000000000000000011202542123012145 5ustar0000000000000000utility-ht-0.0.5.1/Setup.lhs0000755000000000000000000000011511202542123013755 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain utility-ht-0.0.5.1/utility-ht.cabal0000644000000000000000000000401111202542123015241 0ustar0000000000000000Name: utility-ht Version: 0.0.5.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann Maintainer: Henning Thielemann -- 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.5.1 Flag buildTests description: Build test executables default: False 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.Record.HT Data.String.HT Data.Tuple.HT Control.Monad.HT Data.Strictness.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 Data.Record.HT.Private Executable test If flag(buildTests) Build-Depends: QuickCheck >=1.1 && <2 Else Buildable: False GHC-Options: -Wall Hs-source-dirs: src Other-Modules: Test.Data.List Test.Utility Main-Is: Test.hs utility-ht-0.0.5.1/LICENSE0000644000000000000000000000272111202542123013154 0ustar0000000000000000Copyright (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. utility-ht-0.0.5.1/src/0000755000000000000000000000000011202542123012734 5ustar0000000000000000utility-ht-0.0.5.1/src/Test.hs0000644000000000000000000000063711202542123014215 0ustar0000000000000000module Main where import qualified Test.Data.List as ListHT import qualified Test.Data.Function as FunctionHT prefix :: String -> [(String, IO ())] -> [(String, IO ())] prefix msg = map (\(str,test) -> (msg ++ "." ++ str, test)) main :: IO () main = mapM_ (\(msg,io) -> putStr (msg++": ") >> io) $ concat $ prefix "List" ListHT.tests : prefix "Function" FunctionHT.tests : [] utility-ht-0.0.5.1/src/Data/0000755000000000000000000000000011202542123013605 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Ord/0000755000000000000000000000000011202542123014331 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Ord/HT.hs0000644000000000000000000000116711202542123015205 0ustar0000000000000000module 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 utility-ht-0.0.5.1/src/Data/Maybe/0000755000000000000000000000000011202542123014642 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Maybe/HT.hs0000644000000000000000000000155711202542123015521 0ustar0000000000000000module Data.Maybe.HT where import Data.Maybe (fromMaybe, ) import Control.Monad (msum, ) {- | Returns 'Just' if the precondition is fulfilled. -} {-# INLINE toMaybe #-} toMaybe :: Bool -> a -> Maybe a toMaybe False _ = Nothing toMaybe True x = Just x infixl 6 ?-> {- | This is an infix version of 'fmap' for writing 'Data.Bool.HT.select' style expressions using test functions, that produce 'Maybe's. The precedence is chosen to be higher than '(:)', in order to allow: > alternatives default $ > checkForA ?-> (\a -> f a) : > checkForB ?-> (\b -> g b) : > [] The operation is left associative in order to allow to write > checkForA ?-> f ?-> g which is equivalent to > checkForA ?-> g . f due to the functor law. -} (?->) :: Maybe a -> (a -> b) -> Maybe b (?->) = flip fmap alternatives :: a -> [Maybe a] -> a alternatives deflt = fromMaybe deflt . msum utility-ht-0.0.5.1/src/Data/List/0000755000000000000000000000000011202542123014520 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/List/HT.hs0000644000000000000000000000210411202542123015364 0ustar0000000000000000module Data.List.HT ( -- * Improved standard functions L.inits, L.tails, L.groupBy, L.group, L.unzip, L.partition, L.span, L.break, -- * Split L.chop, L.breakAfter, L.segmentAfter, L.segmentBefore, L.removeEach, L.splitEverywhere, -- * inspect ends of a list 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.takeWhileJust, 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 utility-ht-0.0.5.1/src/Data/List/Key.hs0000644000000000000000000000104111202542123015600 0ustar0000000000000000{- | 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, L.merge, ) where import qualified Data.List.Key.Private as L utility-ht-0.0.5.1/src/Data/List/Match.hs0000644000000000000000000000030511202542123016106 0ustar0000000000000000module Data.List.Match ( L.take, L.drop, L.splitAt, L.replicate, L.compareLength, L.lessOrEqualLength, L.shorterList, ) where import qualified Data.List.Match.Private as L utility-ht-0.0.5.1/src/Data/List/Key/0000755000000000000000000000000011202542123015250 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/List/Key/Private.hs0000644000000000000000000000534611202542123017226 0ustar0000000000000000module 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 [] yl = yl recourse xl [] = xl recourse xl@(x:xs) yl@(y:ys) = uncurry (:) $ if p x y then (x, recourse xs yl) else (y, recourse xl ys) in recourse utility-ht-0.0.5.1/src/Data/List/Match/0000755000000000000000000000000011202542123015554 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/List/Match/Private.hs0000644000000000000000000001014211202542123017520 0ustar0000000000000000module Data.List.Match.Private where import Data.Maybe (fromJust, isNothing, ) import Data.Maybe.HT (toMaybe, ) import Data.Tuple.HT (mapFst, forcePair, ) 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 -} {- @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 = zipWith (flip 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 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 = (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 {- | @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. 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 = 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] replicate xs y = take xs (repeat y) utility-ht-0.0.5.1/src/Data/List/HT/0000755000000000000000000000000011202542123015033 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/List/HT/Private.hs0000644000000000000000000005362111202542123017010 0ustar0000000000000000module Data.List.HT.Private where import Data.List as List (find, transpose, unfoldr, isPrefixOf, 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, forcePair, ) import qualified Data.List.Key.Private as Key import qualified Data.List.Match.Private as Match import Prelude hiding (unzip, break, span, ) -- * 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 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: > 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 (==) {- | 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. -} {- The lazy pattern match @(y,z)@ is necessary since otherwise it fails on infinite lists. -} partition :: (a -> Bool) -> [a] -> ([a], [a]) partition p = forcePair . foldr (\x ~(y,z) -> if p x then (x : y, z) else (y, x : z)) ([],[]) {- | It is @Data.List.span f undefined = undefined@, whereas @span f undefined = (undefined, undefined)@. -} span, break :: (a -> Bool) -> [a] -> ([a],[a]) span p = let recourse xt = forcePair $ fromMaybe ([],xt) $ do (x,xs) <- viewL xt guard $ p x return $ mapFst (x:) $ recourse xs in recourse break p = span (not . p) -- * 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 = uncurry (:) . foldr (\ x ~(y,ys) -> if p x then ([],y:ys) else ((x:y),ys) ) ([],[]) chop' :: (a -> Bool) -> [a] -> [[a]] chop' p = let recourse = uncurry (:) . mapSnd (switchL [] (const recourse)) . break p in recourse 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) = mapFst (x:) $ if p x then ([],xs) else recourse xs in forcePair . 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) [[]] 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 = 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)) [[]] 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 = 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:) -- cf. Matroid.hs {- | @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 . forcePair . 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@. It holds @mapMaybe f == fst . partitionMaybe f@ and @partition p == partitionMaybe (\ x -> toMaybe (p x) x)@. -} partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a]) partitionMaybe f = forcePair . foldr (\x -> maybe (mapSnd (x:)) (\y -> mapFst (y:)) (f x)) ([],[]) {- | This is the cousin of 'takeWhile' analogously to 'catMaybes' being the cousin of 'filter'. Example: Keep the heads of sublists until an empty list occurs. > takeWhileJust $ map (fmap fst . viewL) xs -} takeWhileJust :: [Maybe a] -> [a] takeWhileJust = foldr (\x acc -> maybe [] (:acc) x) [] unzipEithers :: [Either a b] -> ([a], [b]) unzipEithers = forcePair . 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 = 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)) {- 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 = 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 {- | 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 (<=) {- | This function combines every pair of neighbour elements in a list with a certain function. -} 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 utility-ht-0.0.5.1/src/Data/Bool/0000755000000000000000000000000011202542123014500 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Bool/HT.hs0000644000000000000000000000017511202542123015352 0ustar0000000000000000module Data.Bool.HT ( B.if', B.select, (B.?:), B.implies, ) where import qualified Data.Bool.HT.Private as B utility-ht-0.0.5.1/src/Data/Bool/HT/0000755000000000000000000000000011202542123015013 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Bool/HT/Private.hs0000644000000000000000000000224011202542123016757 0ustar0000000000000000module 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 utility-ht-0.0.5.1/src/Data/String/0000755000000000000000000000000011202542123015053 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/String/HT.hs0000644000000000000000000000032111202542123015716 0ustar0000000000000000module Data.String.HT where import Data.Char (isSpace, ) import Data.List.HT (dropWhileRev, ) -- | remove leading and trailing spaces trim :: String -> String trim = dropWhileRev isSpace . dropWhile isSpace utility-ht-0.0.5.1/src/Data/Function/0000755000000000000000000000000011202542123015372 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Function/HT.hs0000644000000000000000000000046611202542123016247 0ustar0000000000000000module 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) utility-ht-0.0.5.1/src/Data/Function/HT/0000755000000000000000000000000011202542123015705 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Function/HT/Private.hs0000644000000000000000000000226311202542123017656 0ustar0000000000000000module 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) utility-ht-0.0.5.1/src/Data/Strictness/0000755000000000000000000000000011202542123015746 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Strictness/HT.hs0000644000000000000000000000120211202542123016610 0ustar0000000000000000module Data.Strictness.HT where {-# INLINE arguments1 #-} arguments1 :: (a -> x) -> a -> x arguments1 f a = f $! a {-# INLINE arguments2 #-} arguments2 :: (a -> b -> x) -> a -> b -> x arguments2 f a b = (f $! a) $! b {-# INLINE arguments3 #-} arguments3 :: (a -> b -> c -> x) -> a -> b -> c -> x arguments3 f a b c = ((f $! a) $! b) $! c {-# INLINE arguments4 #-} arguments4 :: (a -> b -> c -> d -> x) -> a -> b -> c -> d -> x arguments4 f a b c d = (((f $! a) $! b) $! c) $! d {-# INLINE arguments5 #-} arguments5 :: (a -> b -> c -> d -> e -> x) -> a -> b -> c -> d -> e -> x arguments5 f a b c d e = ((((f $! a) $! b) $! c) $! d) $! e utility-ht-0.0.5.1/src/Data/Eq/0000755000000000000000000000000011202542123014152 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Eq/HT.hs0000644000000000000000000000023711202542123015023 0ustar0000000000000000module Data.Eq.HT where import Data.Function.HT (compose2, ) {-# INLINE equating #-} equating :: Eq b => (a -> b) -> a -> a -> Bool equating = compose2 (==) utility-ht-0.0.5.1/src/Data/Record/0000755000000000000000000000000011202542123015023 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Record/HT.hs0000644000000000000000000000015311202542123015671 0ustar0000000000000000module Data.Record.HT ( R.compare, R.equal, ) where import qualified Data.Record.HT.Private as R utility-ht-0.0.5.1/src/Data/Record/HT/0000755000000000000000000000000011202542123015336 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Record/HT/Private.hs0000644000000000000000000000157211202542123017311 0ustar0000000000000000module Data.Record.HT.Private where import Data.Monoid (mconcat, ) import Data.List.HT (switchL, ) {- | Lexicographically compare a list of attributes of two records. Example: > compare [comparing fst, comparing snd] -} {-# INLINE compare #-} compare :: [a -> a -> Ordering] -> a -> a -> Ordering compare cs x y = mconcat $ map (\c -> c x y) cs {-# INLINE compare1 #-} compare1 :: [a -> a -> Ordering] -> a -> a -> Ordering compare1 cs x y = switchL EQ const $ dropWhile (EQ==) $ map (\c -> c x y) cs {-# INLINE compare2 #-} compare2 :: [a -> a -> Ordering] -> a -> a -> Ordering compare2 cs x y = head $ dropWhile (EQ==) (map (\c -> c x y) cs) ++ [EQ] {- | Check whether a selected set of fields of two records is equal. Example: > equal [equating fst, equating snd] -} {-# INLINE equal #-} equal :: [a -> a -> Bool] -> a -> a -> Bool equal cs x y = all (\c -> c x y) cs utility-ht-0.0.5.1/src/Data/Tuple/0000755000000000000000000000000011202542123014676 5ustar0000000000000000utility-ht-0.0.5.1/src/Data/Tuple/HT.hs0000644000000000000000000000230111202542123015541 0ustar0000000000000000module 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) {-# 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 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 utility-ht-0.0.5.1/src/Text/0000755000000000000000000000000011202542123013660 5ustar0000000000000000utility-ht-0.0.5.1/src/Text/Show/0000755000000000000000000000000011202542123014600 5ustar0000000000000000utility-ht-0.0.5.1/src/Text/Show/HT.hs0000644000000000000000000000060011202542123015443 0ustar0000000000000000module 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-0.0.5.1/src/Text/Read/0000755000000000000000000000000011202542123014533 5ustar0000000000000000utility-ht-0.0.5.1/src/Text/Read/HT.hs0000644000000000000000000000166211202542123015407 0ustar0000000000000000module 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) maybeRead :: Read a => String -> Maybe a maybeRead str = case reads str of [(x,"")] -> Just x _ -> Nothing utility-ht-0.0.5.1/src/Test/0000755000000000000000000000000011202542123013653 5ustar0000000000000000utility-ht-0.0.5.1/src/Test/Utility.hs0000644000000000000000000000070111202542123015650 0ustar0000000000000000-- cf. Test.NumericPrelude.Utility module Test.Utility where import Data.List.HT (mapAdjacent, ) import qualified Data.List as List -- compare the lists simultaneously equalLists :: Eq a => [[a]] -> Bool equalLists xs = let equalElems ys = and (mapAdjacent (==) ys) && length xs == length ys in all equalElems (List.transpose xs) equalInfLists :: Eq a => Int -> [[a]] -> Bool equalInfLists n xs = equalLists (map (take n) xs) utility-ht-0.0.5.1/src/Test/Data/0000755000000000000000000000000011202542123014524 5ustar0000000000000000utility-ht-0.0.5.1/src/Test/Data/List.hs0000644000000000000000000000415711202542123016002 0ustar0000000000000000module Test.Data.List where import qualified Data.List.HT.Private as ListHT import qualified Data.List as List import Control.Monad (liftM2, ) import Test.Utility (equalLists, equalInfLists, ) import Test.QuickCheck (Property, test, (==>), ) import Prelude hiding (iterate, ) sieve :: Eq a => Int -> [a] -> Property sieve n x = n>0 ==> equalLists [ListHT.sieve n x, ListHT.sieve' n x, ListHT.sieve'' n x, ListHT.sieve''' n x] sliceHorizontal :: Eq a => Int -> [a] -> Property sliceHorizontal n x = n>0 ==> ListHT.sliceHorizontal n x == ListHT.sliceHorizontal' n x sliceVertical :: Eq a => Int -> [a] -> Property sliceVertical n x = n>0 ==> ListHT.sliceVertical n x == ListHT.sliceVertical' n x slice :: Eq a => Int -> [a] -> Property slice n x = 0 -- problems: ListHT.sliceHorizontal 4 [] == [[],[],[],[]] ListHT.sliceHorizontal n x == List.transpose (ListHT.sliceVertical n x) && ListHT.sliceVertical n x == List.transpose (ListHT.sliceHorizontal n x) shear :: Eq a => [[a]] -> Bool shear xs = ListHT.shearTranspose xs == map reverse (ListHT.shear xs) outerProduct :: (Eq a, Eq b) => [a] -> [b] -> Bool outerProduct xs ys = concat (ListHT.outerProduct (,) xs ys) == liftM2 (,) xs ys iterate :: Eq a => (a -> a -> a) -> a -> Bool iterate op a = let xs = List.iterate (op a) a ys = ListHT.iterateAssociative op a zs = ListHT.iterateLeaky op a in equalInfLists 1000 [xs, ys, zs] tests :: [(String, IO ())] tests = ("sieve", test (sieve :: Int -> [Integer] -> Property)) : ("sliceHorizontal", test (sliceHorizontal :: Int -> [Integer] -> Property)) : ("sliceVertical", test (sliceVertical :: Int -> [Integer] -> Property)) : ("slice", test (slice :: Int -> [Integer] -> Property)) : ("shear", test (shear :: [[Integer]] -> Bool)) : ("outerProduct", test (outerProduct :: [Integer] -> [Int] -> Bool)) : ("iterate", test (iterate (+) :: Integer -> Bool)) : [] utility-ht-0.0.5.1/src/Control/0000755000000000000000000000000011202542123014354 5ustar0000000000000000utility-ht-0.0.5.1/src/Control/Monad/0000755000000000000000000000000011202542123015412 5ustar0000000000000000utility-ht-0.0.5.1/src/Control/Monad/HT.hs0000644000000000000000000000307011202542123016261 0ustar0000000000000000module Control.Monad.HT where import Control.Monad (liftM, liftM2, ) import Prelude hiding (repeat, until, ) infixr 1 <=< {- | Also present in newer versions of the 'base' package. -} (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c) (<=<) f g = (f =<<) . g {- | Monadic 'List.repeat'. -} repeat :: (Monad m) => m a -> m [a] repeat x = let go = liftM2 (:) x go in go {-# DEPRECATED untilM "use M.until" #-} {- | repeat action until result fulfills condition -} until, untilM :: (Monad m) => (a -> Bool) -> m a -> m a untilM = until until p m = let go = do x <- m if p x then return x else go in go {-# DEPRECATED iterateLimitM "use M.iterateLimit" #-} {- | parameter order equal to that of 'nest' -} iterateLimit, iterateLimitM :: Monad m => Int -> (a -> m a) -> a -> m [a] iterateLimitM = iterateLimit iterateLimit m f = let aux n x = liftM (x:) $ if n==0 then return [] else aux (n-1) =<< f x 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