utility-ht-0.0.12/0000755000000000000000000000000012762061411012074 5ustar0000000000000000utility-ht-0.0.12/LICENSE0000644000000000000000000000272112762061411013103 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.12/utility-ht.cabal0000644000000000000000000000577712762061411015214 0ustar0000000000000000Name: utility-ht Version: 0.0.12 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. Others are equivalent to functions from the @base@ package, but if you import them from this utility package then you can write code that runs on older GHC versions or other compilers like Hugs and JHC. . All modules are plain Haskell 98. The package depends exclusively on the @base@ package and only that portions of @base@ that are simple to port. Thus you do not risk a dependency avalanche by importing it. However, further splitting the base package might invalidate this statement. . 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, GHC==7.8.2 Cabal-Version: >=1.10 Build-Type: Simple Stability: Stable -- workaround for Cabal-1.10 Extra-Source-Files: src/Test/Data/Maybe.hs src/Test/Data/ListMatch.hs src/Test/Data/Function.hs src/Test/Data/List.hs src/Test/Utility.hs src/Test.hs 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.12 Library Build-Depends: base >=2 && <5 Default-Language: Haskell98 GHC-Options: -Wall Hs-Source-Dirs: src Exposed-Modules: Data.Bits.HT Data.Bool.HT Data.Eq.HT Data.Function.HT Data.Ix.Enum Data.List.HT Data.List.Key Data.List.Match Data.List.Reverse.StrictElement Data.List.Reverse.StrictSpine Data.Maybe.HT Data.Monoid.HT Data.Ord.HT Data.Record.HT Data.String.HT Data.Tuple.HT Data.Tuple.Lazy Data.Tuple.Strict Control.Monad.HT Control.Applicative.HT Control.Functor.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 Data.Tuple.Example Test-Suite test Type: exitcode-stdio-1.0 Build-Depends: QuickCheck >=1.1 && <3, base >=3 && <5 Default-Language: Haskell98 Main-Is: Test.hs GHC-Options: -Wall Hs-source-dirs: src Other-Modules: Test.Data.List Test.Data.ListMatch Test.Data.List.Reverse.StrictElement Test.Data.List.Reverse.StrictSpine Test.Data.Maybe Test.Data.Function Test.Utility utility-ht-0.0.12/Setup.lhs0000644000000000000000000000011512762061411013701 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain utility-ht-0.0.12/src/0000755000000000000000000000000012762061411012663 5ustar0000000000000000utility-ht-0.0.12/src/Test.hs0000644000000000000000000000146212762061411014141 0ustar0000000000000000module Main where import qualified Test.Data.List.Reverse.StrictElement as RevElem import qualified Test.Data.List.Reverse.StrictSpine as RevSpine import qualified Test.Data.List as ListHT import qualified Test.Data.ListMatch as ListMatch import qualified Test.Data.Maybe as MaybeHT 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 "ReverseSpine" RevSpine.tests : prefix "ReverseElem" RevElem.tests : prefix "List" ListHT.tests : prefix "ListMatch" ListMatch.tests : prefix "Maybe" MaybeHT.tests : prefix "Function" FunctionHT.tests : [] utility-ht-0.0.12/src/Test/0000755000000000000000000000000012762061411013602 5ustar0000000000000000utility-ht-0.0.12/src/Test/Utility.hs0000644000000000000000000000070112762061411015577 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.12/src/Test/Data/0000755000000000000000000000000012762061411014453 5ustar0000000000000000utility-ht-0.0.12/src/Test/Data/Maybe.hs0000644000000000000000000000055212762061411016046 0ustar0000000000000000module Test.Data.Maybe where import Control.Monad (guard, ) import Data.Maybe.HT (toMaybe, ) import Test.QuickCheck (quickCheck, ) toMaybeGuard :: Eq a => Bool -> Maybe a -> Bool toMaybeGuard b x = (guard b >> x) == (toMaybe b =<< x) tests :: [(String, IO ())] tests = ("toMaybeGuard", quickCheck (\b x -> toMaybeGuard b (x::Maybe Int))) : [] utility-ht-0.0.12/src/Test/Data/ListMatch.hs0000644000000000000000000000367012762061411016705 0ustar0000000000000000module Test.Data.ListMatch where import qualified Data.List.Match.Private as Match import qualified Data.List as List import Test.Utility (equalLists, ) import Test.QuickCheck (Testable, quickCheck, ) import Prelude hiding (iterate, take, drop, splitAt, ) laxTail :: (Eq a) => [a] -> Bool laxTail xs = Match.laxTail xs == Match.laxTail0 xs take :: (Eq a) => [b] -> [a] -> Bool take xs ys = Match.take xs ys == List.take (length xs) ys drop :: (Eq a) => [b] -> [a] -> Bool drop xs ys = Match.drop xs ys == List.drop (length xs) ys dropAlt :: (Eq a) => [b] -> [a] -> Bool dropAlt xs ys = equalLists $ Match.drop xs ys : Match.drop0 xs ys : Match.drop1 xs ys : Match.drop2 xs ys : Match.dropRec xs ys : [] takeDrop :: (Eq a) => [b] -> [a] -> Bool takeDrop xs ys = Match.take xs ys ++ Match.drop xs ys == ys splitAt :: (Eq a) => [b] -> [a] -> Bool splitAt xs ys = (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 && Match.compareLength xs ys == Match.compareLength1 xs ys test1 :: Testable test => ([Int] -> test) -> IO () test1 = quickCheck test2 :: Testable test => ([Int] -> [Integer] -> test) -> IO () test2 = quickCheck tests :: [(String, IO ())] tests = ("laxTail", test1 laxTail) : ("take", test2 take) : ("drop", test2 drop) : ("dropAlt", test2 dropAlt) : ("takeDrop", test2 takeDrop) : ("splitAt", test2 splitAt) : ("takeRev", test2 takeRev) : ("dropRev", test2 dropRev) : ("compareLength", test2 compareLength) : [] utility-ht-0.0.12/src/Test/Data/Function.hs0000644000000000000000000000075012762061411016576 0ustar0000000000000000module Test.Data.Function where import qualified Data.Function.HT.Private as FuncHT import Test.QuickCheck (Property, quickCheck, (==>), ) powerAssociative :: Eq a => (a -> a -> a) -> a -> a -> Integer -> Property powerAssociative op a0 a n = n>0 ==> FuncHT.powerAssociative op a0 a n == FuncHT.powerAssociative1 op a0 a n tests :: [(String, IO ())] tests = ("powerAssociative", quickCheck (powerAssociative (+) :: Integer -> Integer -> Integer -> Property)) : [] utility-ht-0.0.12/src/Test/Data/List.hs0000644000000000000000000001163212762061411015725 0ustar0000000000000000module Test.Data.List where import qualified Data.List.Reverse.StrictElement as Rev 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 (Testable, Property, quickCheck, (==>), ) import Prelude hiding (iterate, ) takeWhileRev0 :: (Eq a) => (a -> Bool) -> [a] -> Bool takeWhileRev0 p xs = ListHT.takeWhileRev0 p xs == Rev.takeWhile p xs takeWhileRev1 :: (Eq a) => (a -> Bool) -> [a] -> Bool takeWhileRev1 p xs = ListHT.takeWhileRev1 p xs == Rev.takeWhile p xs takeWhileRev2 :: (Eq a) => (a -> Bool) -> [a] -> Bool takeWhileRev2 p xs = ListHT.takeWhileRev2 p xs == Rev.takeWhile p xs dropWhileRev :: (Eq a) => (a -> Bool) -> [a] -> Bool dropWhileRev p xs = ListHT.dropWhileRev p xs == Rev.dropWhile p 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)) splitAtRev :: (Eq a) => Int -> [a] -> Bool splitAtRev n xs = xs == uncurry (++) (ListHT.splitAtRev n xs) breakAfterAppend :: (Eq a) => (a -> Bool) -> [a] -> Bool breakAfterAppend p xs = uncurry (++) (ListHT.breakAfter p xs) == xs breakAfter0 :: (Eq a) => (a -> Bool) -> [a] -> Bool breakAfter0 p xs = ListHT.breakAfterRec p xs == ListHT.breakAfterFoldr p xs breakAfter1 :: (Eq a) => (a -> Bool) -> [a] -> Bool breakAfter1 p xs = ListHT.breakAfterRec p xs == ListHT.breakAfterBreak p xs breakAfter2 :: (Eq a) => (a -> Bool) -> [a] -> Bool breakAfter2 p xs = ListHT.breakAfterRec p xs == ListHT.breakAfterTakeUntil p xs breakAfterUntil :: (Eq a) => (a -> Bool) -> [a] -> Bool breakAfterUntil p xs = ListHT.takeUntil p xs == fst (ListHT.breakAfter p xs) 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] -> Bool sliceHorizontal n0 x = let n = 1 + mod n0 1000 in 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] -> a -> Bool slice n0 as a = let x = a:as n = 1 + mod n0 (length x) in -- 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] mapAdjacent :: (Num a, Eq a) => a -> [a] -> Bool mapAdjacent x xs = ListHT.mapAdjacent subtract (scanl (+) x xs) == xs mapAdjacentPointfree :: (Num a, Eq a) => [a] -> Bool mapAdjacentPointfree xs = ListHT.mapAdjacent (+) xs == ListHT.mapAdjacentPointfree (+) xs simple :: (Testable test) => (Int -> [Integer] -> test) -> IO () simple = quickCheck elemCheck :: (Testable test) => (Float -> [Float] -> test) -> IO () elemCheck = quickCheck tests :: [(String, IO ())] tests = ("takeWhileRev0", elemCheck (\a -> takeWhileRev0 (a>=))) : ("takeWhileRev1", elemCheck (\a -> takeWhileRev1 (a>=))) : ("takeWhileRev2", elemCheck (\a -> takeWhileRev2 (a>=))) : ("dropWhileRev", elemCheck (\a -> dropWhileRev (a>=))) : ("takeRev", simple takeRev) : ("dropRev", simple dropRev) : ("splitAtRev", simple splitAtRev) : ("breakAfterAppend", elemCheck (\a -> breakAfterAppend (a>=))) : ("breakAfter0", elemCheck (\a -> breakAfter0 (a>=))) : ("breakAfter1", elemCheck (\a -> breakAfter1 (a>=))) : ("breakAfter2", elemCheck (\a -> breakAfter2 (a>=))) : ("breakAfterUntil", elemCheck (\a -> breakAfterUntil (a>=))) : ("sieve", simple sieve) : ("sliceHorizontal", simple sliceHorizontal) : ("sliceVertical", simple sliceVertical) : ("slice", simple slice) : ("shear", quickCheck (shear :: [[Integer]] -> Bool)) : ("outerProduct", quickCheck (outerProduct :: [Integer] -> [Int] -> Bool)) : ("iterate", quickCheck (iterate (+) :: Integer -> Bool)) : ("mapAdjacent", quickCheck (mapAdjacent :: Integer -> [Integer] -> Bool)) : ("mapAdjacentPointfree", quickCheck (mapAdjacentPointfree :: [Integer] -> Bool)) : [] utility-ht-0.0.12/src/Test/Data/List/0000755000000000000000000000000012762061411015366 5ustar0000000000000000utility-ht-0.0.12/src/Test/Data/List/Reverse/0000755000000000000000000000000012762061411017001 5ustar0000000000000000utility-ht-0.0.12/src/Test/Data/List/Reverse/StrictSpine.hs0000644000000000000000000000356512762061411021615 0ustar0000000000000000module Test.Data.List.Reverse.StrictSpine where import qualified Data.List.Reverse.StrictSpine as Rev import qualified Data.List.Match as Match import qualified Data.List as List import Data.Tuple.HT (mapFst, mapPair, swap, ) import Test.QuickCheck (Testable, quickCheck, ) import Prelude hiding (takeWhile, dropWhile, span, ) takeWhile :: (Ord a) => (a -> Bool) -> [a] -> Bool takeWhile p xs = Rev.takeWhile p xs == reverse (List.takeWhile p (reverse xs)) dropWhile :: (Ord a) => (a -> Bool) -> [a] -> Bool dropWhile p xs = Rev.dropWhile p xs == reverse (List.dropWhile p (reverse xs)) span :: (Ord a) => (a -> Bool) -> [a] -> Bool span p xs = Rev.span p xs == swap (mapPair (reverse, reverse) (List.span p (reverse xs))) spanTakeDrop :: (Ord a) => (a -> Bool) -> [a] -> Bool spanTakeDrop p xs = Rev.span p xs == (Rev.dropWhile p xs, Rev.takeWhile p xs) takeWhileBottom :: (Ord a) => a -> [a] -> [a] -> Bool takeWhileBottom x xs pad = let ys = Rev.takeWhile (x/=) $ Match.replicate pad undefined ++ x:xs in ys==ys dropWhileBottom :: (Ord a) => a -> [a] -> [a] -> Bool dropWhileBottom x xs pad = let n = length $ Rev.dropWhile (x/=) $ Match.replicate pad undefined ++ x:xs in n==n spanBottom :: (Ord a) => a -> [a] -> [a] -> Bool spanBottom x xs pad = let (n,ys) = mapFst length $ Rev.span (x/=) $ Match.replicate pad undefined ++ x:xs in n==n && ys==ys simple :: (Testable test) => (Float -> [Float] -> test) -> IO () simple = quickCheck tests :: [(String, IO ())] tests = ("takeWhile", simple (\a -> takeWhile (a>=))) : ("dropWhile", simple (\a -> dropWhile (a>=))) : ("span", simple (\a -> span (a>=))) : ("spanTakeDrop", simple (\a -> spanTakeDrop (a>=))) : ("takeWhileBottom", simple takeWhileBottom) : ("dropWhileBottom", simple dropWhileBottom) : ("spanBottom", simple spanBottom) : [] utility-ht-0.0.12/src/Test/Data/List/Reverse/StrictElement.hs0000644000000000000000000000300712762061411022117 0ustar0000000000000000module Test.Data.List.Reverse.StrictElement where import qualified Data.List.Reverse.StrictElement as Rev import qualified Data.List as List import Data.Tuple.HT (mapPair, swap, ) import Test.QuickCheck (Testable, quickCheck, ) import Prelude hiding (takeWhile, dropWhile, span, ) takeWhile :: (Ord a) => (a -> Bool) -> [a] -> Bool takeWhile p xs = Rev.takeWhile p xs == reverse (List.takeWhile p (reverse xs)) dropWhile :: (Ord a) => (a -> Bool) -> [a] -> Bool dropWhile p xs = Rev.dropWhile p xs == reverse (List.dropWhile p (reverse xs)) span :: (Ord a) => (a -> Bool) -> [a] -> Bool span p xs = Rev.span p xs == swap (mapPair (reverse, reverse) (List.span p (reverse xs))) spanTakeDrop :: (Ord a) => (a -> Bool) -> [a] -> Bool spanTakeDrop p xs = Rev.span p xs == (Rev.dropWhile p xs, Rev.takeWhile p xs) dropWhileInf :: (Ord a) => a -> [a] -> Bool dropWhileInf x xs = let ys = List.take 1000 $ Rev.dropWhile (x/=) $ cycle $ x:xs in ys==ys spanInf :: (Ord a) => a -> [a] -> Bool spanInf x xs = let ys = List.take 1000 $ fst $ Rev.span (x/=) $ cycle $ x:xs in ys==ys simple :: (Testable test) => (Float -> [Float] -> test) -> IO () simple = quickCheck tests :: [(String, IO ())] tests = ("takeWhile", simple (\a -> takeWhile (a>=))) : ("dropWhile", simple (\a -> dropWhile (a>=))) : ("span", simple (\a -> span (a>=))) : ("spanTakeDrop", simple (\a -> spanTakeDrop (a>=))) : ("dropWhileInf", simple dropWhileInf) : ("spanInf", simple spanInf) : [] utility-ht-0.0.12/src/Text/0000755000000000000000000000000012762061411013607 5ustar0000000000000000utility-ht-0.0.12/src/Text/Read/0000755000000000000000000000000012762061411014462 5ustar0000000000000000utility-ht-0.0.12/src/Text/Read/HT.hs0000644000000000000000000000166212762061411015336 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.12/src/Text/Show/0000755000000000000000000000000012762061411014527 5ustar0000000000000000utility-ht-0.0.12/src/Text/Show/HT.hs0000644000000000000000000000073412762061411015402 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) concatS :: [ShowS] -> ShowS concatS = flip (foldr ($)) {- precedences appPrec :: Int appPrec = 10 -} utility-ht-0.0.12/src/Control/0000755000000000000000000000000012762061411014303 5ustar0000000000000000utility-ht-0.0.12/src/Control/Functor/0000755000000000000000000000000012762061411015723 5ustar0000000000000000utility-ht-0.0.12/src/Control/Functor/HT.hs0000644000000000000000000000254612762061411016601 0ustar0000000000000000module Control.Functor.HT where import Data.Tuple.HT (fst3, snd3, thd3, ) void :: Functor f => f a -> f () void = fmap (const ()) map :: Functor f => (a -> b) -> f a -> f b map = fmap 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) mapFst :: Functor f => (a -> f c) -> (a, b) -> f (c, b) mapFst f ~(a,b) = fmap (flip (,) b) $ f a mapSnd :: Functor f => (b -> f c) -> (a, b) -> f (a, c) mapSnd f ~(a,b) = fmap ((,) a) $ f b mapFst3 :: Functor f => (a -> f d) -> (a,b,c) -> f (d,b,c) mapFst3 f ~(a,b,c) = fmap (\x -> (x,b,c)) $ f a mapSnd3 :: Functor f => (b -> f d) -> (a,b,c) -> f (a,d,c) mapSnd3 f ~(a,b,c) = fmap (\x -> (a,x,c)) $ f b mapThd3 :: Functor f => (c -> f d) -> (a,b,c) -> f (a,b,d) mapThd3 f ~(a,b,c) = fmap ((,,) a b) $ f c {- | 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 utility-ht-0.0.12/src/Control/Applicative/0000755000000000000000000000000012762061411016544 5ustar0000000000000000utility-ht-0.0.12/src/Control/Applicative/HT.hs0000644000000000000000000000171712762061411017421 0ustar0000000000000000module Control.Applicative.HT where import qualified Data.Tuple.HT as Tuple import Control.Applicative (Applicative, liftA2, liftA3, (<$>), (<*>), ) mapPair :: (Applicative f) => (a -> f c, b -> f d) -> (a,b) -> f (c,d) mapPair fg = uncurry (liftA2 (,)) . Tuple.mapPair fg mapTriple :: (Applicative m) => (a -> m d, b -> m e, c -> m f) -> (a,b,c) -> m (d,e,f) mapTriple fgh = Tuple.uncurry3 (liftA3 (,,)) . Tuple.mapTriple fgh {-# INLINE liftA4 #-} liftA4 :: Applicative f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e liftA4 f a b c d = f <$> a <*> b <*> c <*> d {-# INLINE liftA5 #-} liftA5 :: Applicative f => (a -> b -> c -> d -> e -> g) -> f a -> f b -> f c -> f d -> f e -> f g liftA5 f a b c d e = f <$> a <*> b <*> c <*> d <*> e {-# INLINE liftA6 #-} liftA6 :: Applicative f => (a -> b -> c -> d -> e -> g -> h) -> f a -> f b -> f c -> f d -> f e -> f g -> f h liftA6 f a b c d e g = f <$> a <*> b <*> c <*> d <*> e <*> g utility-ht-0.0.12/src/Control/Monad/0000755000000000000000000000000012762061411015341 5ustar0000000000000000utility-ht-0.0.12/src/Control/Monad/HT.hs0000644000000000000000000000712312762061411016213 0ustar0000000000000000module Control.Monad.HT where import qualified Control.Monad as M 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 = lift2 (:) 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 = lift (x:) $ if n==0 then return [] else aux (n-1) =<< f x in aux m {- | I think this makes only sense in a lazy monad like @Trans.State.Lazy@ or @IO.Lazy@. -} iterate :: Monad m => (a -> m a) -> a -> m [a] iterate f = let go x = lift (x:) $ go =<< f x in go {- | 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 void :: (Monad m) => m a -> m () void = lift (const ()) for :: Monad m => [a] -> (a -> m b) -> m [b] for = M.forM map :: Monad m => (a -> m b) -> [a] -> m [b] map = M.mapM 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 -- there is also mfilter, but this should be part of Control.Monad.Plus filter :: Monad m => (a -> m Bool) -> [a] -> m [a] filter = M.filterM replicate :: Monad m => Int -> m a -> m [a] replicate = M.replicateM lift :: Monad m => (a -> r) -> m a -> m r lift = M.liftM lift2 :: Monad m => (a -> b -> r) -> m a -> m b -> m r lift2 = M.liftM2 lift3 :: Monad m => (a -> b -> c -> r) -> m a -> m b -> m c -> m r lift3 = M.liftM3 lift4 :: Monad m => (a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r lift4 = M.liftM4 lift5 :: Monad m => (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? Shall their element types be monoids? Should we add these functions to a Foldable.HT module in order to save the underscore? (>>) mapM_ zipWithM_ sequence_ ... -} utility-ht-0.0.12/src/Data/0000755000000000000000000000000012762061411013534 5ustar0000000000000000utility-ht-0.0.12/src/Data/Monoid/0000755000000000000000000000000012762061411014761 5ustar0000000000000000utility-ht-0.0.12/src/Data/Monoid/HT.hs0000644000000000000000000000066712762061411015641 0ustar0000000000000000module Data.Monoid.HT (cycle, (<>), when, ) where import Data.Monoid (Monoid, mappend, mempty, ) import Data.Function (fix, ) import Prelude (Bool) {- | Generalization of 'Data.List.cycle' to any monoid. -} cycle :: Monoid m => m -> m cycle x = fix (mappend x) infixr 6 <> {- | Infix synonym for 'mappend'. -} (<>) :: Monoid m => m -> m -> m (<>) = mappend when :: Monoid m => Bool -> m -> m when b m = if b then m else mempty utility-ht-0.0.12/src/Data/Eq/0000755000000000000000000000000012762061411014101 5ustar0000000000000000utility-ht-0.0.12/src/Data/Eq/HT.hs0000644000000000000000000000023712762061411014752 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.12/src/Data/String/0000755000000000000000000000000012762061411015002 5ustar0000000000000000utility-ht-0.0.12/src/Data/String/HT.hs0000644000000000000000000000070112762061411015647 0ustar0000000000000000module Data.String.HT where import qualified Data.List.Reverse.StrictSpine as Rev import Data.Char (isSpace, ) {- | Remove leading and trailing spaces. We use spine strict 'Rev.dropWhile' instead of the element strict version. This is more efficient for finite 'String's because 'isSpace' is expensive. The downside is that 'trim' does not work for infinite 'String's. -} trim :: String -> String trim = Rev.dropWhile isSpace . dropWhile isSpace utility-ht-0.0.12/src/Data/Bool/0000755000000000000000000000000012762061411014427 5ustar0000000000000000utility-ht-0.0.12/src/Data/Bool/HT.hs0000644000000000000000000000021612762061411015275 0ustar0000000000000000module Data.Bool.HT ( B.if', B.ifThenElse, B.select, (B.?:), B.implies, ) where import qualified Data.Bool.HT.Private as B utility-ht-0.0.12/src/Data/Bool/HT/0000755000000000000000000000000012762061411014742 5ustar0000000000000000utility-ht-0.0.12/src/Data/Bool/HT/Private.hs0000644000000000000000000000254712762061411016720 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 {-| The same as 'if'', but the name is chosen such that it can be used for GHC-7.0's rebindable if-then-else syntax. -} {-# INLINE ifThenElse #-} ifThenElse :: Bool -> a -> a -> a ifThenElse = if' {-| 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.12/src/Data/Function/0000755000000000000000000000000012762061411015321 5ustar0000000000000000utility-ht-0.0.12/src/Data/Function/HT.hs0000644000000000000000000000046612762061411016176 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.12/src/Data/Function/HT/0000755000000000000000000000000012762061411015634 5ustar0000000000000000utility-ht-0.0.12/src/Data/Function/HT/Private.hs0000644000000000000000000000261212762061411017603 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 = powerAssociative op (if even n then a0 else (op a0 a)) (op a a) (div n 2) powerAssociative1 op a0 a n = foldr op a0 (genericReplicate n a) infixl 0 $% {- | Flipped version of '($)'. It was discussed as (&) in http://www.haskell.org/pipermail/libraries/2012-November/018832.html I am not sure, that we need it. It is not exported for now. -} ($%) :: a -> (a -> b) -> b ($%) = flip ($) utility-ht-0.0.12/src/Data/Ord/0000755000000000000000000000000012762061411014260 5ustar0000000000000000utility-ht-0.0.12/src/Data/Ord/HT.hs0000644000000000000000000000116712762061411015134 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.12/src/Data/Strictness/0000755000000000000000000000000012762061411015675 5ustar0000000000000000utility-ht-0.0.12/src/Data/Strictness/HT.hs0000644000000000000000000000120212762061411016537 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.12/src/Data/Tuple/0000755000000000000000000000000012762061411014625 5ustar0000000000000000utility-ht-0.0.12/src/Data/Tuple/Lazy.hs0000644000000000000000000000400012762061411016072 0ustar0000000000000000module 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{(a,b)} we may use \function{fst} and \function{snd}. -} {-# INLINE mapPair #-} mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d) mapPair ~(f,g) ~(a,b) = (f a, g b) -- | '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 zipWithPair #-} zipWithPair :: (a -> c -> e, b -> d -> f) -> (a,b) -> (c,d) -> (e,f) zipWithPair ~(e,f) ~(a,b) ~(c,d) = (e a c, f b d) {-# INLINE swap #-} swap :: (a,b) -> (b,a) swap ~(a,b) = (b,a) {-# INLINE forcePair #-} forcePair :: (a,b) -> (a,b) forcePair ~(a,b) = (a,b) -- * Triple {-# INLINE mapTriple #-} mapTriple :: (a -> d, b -> e, c -> f) -> (a,b,c) -> (d,e,f) mapTriple ~(f,g,h) ~(a,b,c) = (f a, g b, h c) {-# 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 zipWithTriple #-} zipWithTriple :: (a -> d -> g, b -> e -> h, c -> f -> i) -> (a,b,c) -> (d,e,f) -> (g,h,i) zipWithTriple ~(g,h,i) ~(a,b,c) ~(d,e,f) = (g a d, h b e, i c f) {-# INLINE uncurry3 #-} uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) uncurry3 f ~(a,b,c) = f a b c utility-ht-0.0.12/src/Data/Tuple/HT.hs0000644000000000000000000000124712762061411015500 0ustar0000000000000000module Data.Tuple.HT ( -- * Pair mapPair, mapFst, mapSnd, swap, sortPair, forcePair, -- * Triple fst3, snd3, thd3, mapTriple, mapFst3, mapSnd3, mapThd3, curry3, uncurry3, ) where import Data.Tuple.Lazy {-# 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) sortPair, _sortPairMinMax :: (Ord a) => (a,a) -> (a,a) sortPair (x,y) = if x<=y then (x,y) else (y,x) _sortPairMinMax (x,y) = (min x y, max x y) utility-ht-0.0.12/src/Data/Tuple/Example.hs0000644000000000000000000000173212762061411016557 0ustar0000000000000000module 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) utility-ht-0.0.12/src/Data/Tuple/Strict.hs0000644000000000000000000000234512762061411016435 0ustar0000000000000000module Data.Tuple.Strict where -- * Pair {-# INLINE mapPair #-} mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d) mapPair (f,g) (a,b) = (f a, g b) {-# 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 zipWithPair #-} zipWithPair :: (a -> c -> e, b -> d -> f) -> (a,b) -> (c,d) -> (e,f) zipWithPair (e,f) (a,b) (c,d) = (e a c, f b d) {-# INLINE swap #-} swap :: (a,b) -> (b,a) swap (a,b) = (b,a) -- * Triple {-# INLINE mapTriple #-} mapTriple :: (a -> d, b -> e, c -> f) -> (a,b,c) -> (d,e,f) mapTriple (f,g,h) (a,b,c) = (f a, g b, h c) {-# 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 zipWithTriple #-} zipWithTriple :: (a -> d -> g, b -> e -> h, c -> f -> i) -> (a,b,c) -> (d,e,f) -> (g,h,i) zipWithTriple (g,h,i) (a,b,c) (d,e,f) = (g a d, h b e, i c f) {-# INLINE uncurry3 #-} uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) uncurry3 f (a,b,c) = f a b c utility-ht-0.0.12/src/Data/Bits/0000755000000000000000000000000012762061411014435 5ustar0000000000000000utility-ht-0.0.12/src/Data/Bits/HT.hs0000644000000000000000000000061312762061411015304 0ustar0000000000000000module Data.Bits.HT where import Data.Bits (Bits, shiftL, shiftR) infixl 7 .<<., .>>. {- | Infix variant of 'shiftL'. Precedence is chosen like multiplication since @a .<<. k == a * 2^k@. -} (.<<.) :: Bits a => a -> Int -> a (.<<.) = shiftL {- | Infix variant of 'shiftR'. Precedence is chosen like division since @a .>>. k == a / 2^k@. -} (.>>.) :: Bits a => a -> Int -> a (.>>.) = shiftR utility-ht-0.0.12/src/Data/Ix/0000755000000000000000000000000012762061411014114 5ustar0000000000000000utility-ht-0.0.12/src/Data/Ix/Enum.hs0000644000000000000000000000236612762061411015363 0ustar0000000000000000{- | Implementations of 'Ix' methods in terms of 'Enum' methods. For a type @T@ of class 'Enum' you can easily define an 'Ix' instance by copying the following code into your module: >import qualified Data.Ix.Enum as IxEnum > >instance Ix T where > range = IxEnum.range > index = IxEnum.index > inRange = IxEnum.inRange > rangeSize = IxEnum.rangeSize > unsafeIndex = IxEnum.unsafeIndex > unsafeRangeSize = IxEnum.unsafeRangeSize -} module Data.Ix.Enum where {-# INLINE range #-} {-# INLINE index #-} {-# INLINE unsafeIndex #-} {-# INLINE inRange #-} {-# INLINE rangeSize #-} {-# INLINE unsafeRangeSize #-} range :: Enum a => (a, a) -> [a] index :: Enum a => (a, a) -> a -> Int unsafeIndex :: Enum a => (a, a) -> a -> Int inRange :: Enum a => (a, a) -> a -> Bool rangeSize :: Enum a => (a, a) -> Int unsafeRangeSize :: Enum a => (a, a) -> Int range (l,r) = map toEnum $ range (fromEnum l, fromEnum r) index (l,r) i = index (fromEnum l, fromEnum r) (fromEnum i) unsafeIndex (l,r) i = unsafeIndex (fromEnum l, fromEnum r) (fromEnum i) inRange (l,r) i = inRange (fromEnum l, fromEnum r) (fromEnum i) rangeSize (l,r) = rangeSize (fromEnum l, fromEnum r) unsafeRangeSize (l,r) = unsafeRangeSize (fromEnum l, fromEnum r) utility-ht-0.0.12/src/Data/Record/0000755000000000000000000000000012762061411014752 5ustar0000000000000000utility-ht-0.0.12/src/Data/Record/HT.hs0000644000000000000000000000015312762061411015620 0ustar0000000000000000module Data.Record.HT ( R.compare, R.equal, ) where import qualified Data.Record.HT.Private as R utility-ht-0.0.12/src/Data/Record/HT/0000755000000000000000000000000012762061411015265 5ustar0000000000000000utility-ht-0.0.12/src/Data/Record/HT/Private.hs0000644000000000000000000000157212762061411017240 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.12/src/Data/Maybe/0000755000000000000000000000000012762061411014571 5ustar0000000000000000utility-ht-0.0.12/src/Data/Maybe/HT.hs0000644000000000000000000000177412762061411015451 0ustar0000000000000000module Data.Maybe.HT where import Data.Maybe (fromMaybe, ) import Control.Monad (msum, ) {- It was proposed as addition to Data.Maybe and rejected at that time. -} {- | 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.12/src/Data/List/0000755000000000000000000000000012762061411014447 5ustar0000000000000000utility-ht-0.0.12/src/Data/List/Match.hs0000644000000000000000000000036312762061411016041 0ustar0000000000000000module Data.List.Match ( L.take, L.drop, L.splitAt, L.takeRev, L.dropRev, L.replicate, L.equalLength, L.compareLength, L.lessOrEqualLength, L.shorterList, ) where import qualified Data.List.Match.Private as L utility-ht-0.0.12/src/Data/List/Key.hs0000644000000000000000000000104112762061411015527 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.12/src/Data/List/HT.hs0000644000000000000000000000325512762061411015323 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.takeUntil, L.segmentAfter, L.segmentBefore, L.segmentAfterMaybe, L.segmentBeforeMaybe, 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.dropRev, L.takeRev, L.splitAtRev, dropWhileRev, takeWhileRev, -- * List processing with Maybe and Either L.maybePrefixOf, L.maybeSuffixOf, 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.mapAdjacent1, L.range, L.padLeft, L.padRight, L.iterateAssociative, L.iterateLeaky, L.lengthAtLeast, ) where import qualified Data.List.HT.Private as L import qualified Data.List.Reverse.StrictElement as Rev {-# DEPRECATED dropWhileRev "Use dropWhile from Data.List.Reverse.StrictElement or Data.List.Reverse.StrictSpine instead" #-} dropWhileRev :: (a -> Bool) -> [a] -> [a] dropWhileRev = Rev.dropWhile {-# DEPRECATED takeWhileRev "Use takeWhile from Data.List.Reverse.StrictElement or Data.List.Reverse.StrictSpine instead" #-} takeWhileRev :: (a -> Bool) -> [a] -> [a] takeWhileRev = Rev.takeWhile utility-ht-0.0.12/src/Data/List/Key/0000755000000000000000000000000012762061411015177 5ustar0000000000000000utility-ht-0.0.12/src/Data/List/Key/Private.hs0000644000000000000000000000534612762061411017155 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.12/src/Data/List/Match/0000755000000000000000000000000012762061411015503 5ustar0000000000000000utility-ht-0.0.12/src/Data/List/Match/Private.hs0000644000000000000000000000747712762061411017470 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 Control.Functor.HT (void, ) 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 ys0 = foldl (\ys _ -> laxTail ys) ys0 xs {- Shares suffix with input, that is it is more efficient than the implementations below. -} dropRec :: [b] -> [a] -> [a] dropRec (_:xs) (_:ys) = dropRec xs ys dropRec _ ys = ys drop0 :: [b] -> [a] -> [a] drop0 xs ys = -- catMaybes ( map fromJust (dropWhile isNothing (zipWith (toMaybe . null) (iterate laxTail xs) ys)) drop1 :: [b] -> [a] -> [a] drop1 xs ys = map snd (dropWhile (not . null . fst) (zip (iterate laxTail xs) ys)) drop2 :: [b] -> [a] -> [a] drop2 xs ys = snd $ head $ dropWhile (not . null . fst) $ zip (iterate laxTail xs) (iterate laxTail ys) {- | @laxTail [] = []@ -} laxTail :: [a] -> [a] laxTail xt = case xt of [] -> []; _:xs -> xs laxTail0 :: [a] -> [a] laxTail0 = List.drop 1 splitAt :: [b] -> [a] -> ([a],[a]) splitAt nt xt = forcePair $ case (nt,xt) of (_:ns, x:xs) -> mapFst (x:) $ splitAt ns xs (_, 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. -} equalLength :: [a] -> [b] -> Bool equalLength xs ys = void xs == void ys {- | Compare the length of two lists over different types. It is equivalent to @(compare (length xs) (length ys))@ but more efficient. -} compareLength :: [a] -> [b] -> Ordering compareLength xs ys = compare (void xs) (void ys) {- | this one uses explicit recursion -} compareLength0 :: [a] -> [b] -> Ordering compareLength0 = let recourse (_:xs) (_:ys) = recourse xs ys recourse [] [] = EQ recourse (_:_) [] = GT recourse [] (_:_) = LT in recourse {- | strict comparison -} compareLength1 :: [a] -> [b] -> Ordering compareLength1 xs ys = compare (length xs) (length 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. @shorterList (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 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 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 {- | Specialisation of 'Data.Functor.$>'. -} replicate :: [a] -> b -> [b] replicate xs y = take xs (repeat y) utility-ht-0.0.12/src/Data/List/HT/0000755000000000000000000000000012762061411014762 5ustar0000000000000000utility-ht-0.0.12/src/Data/List/HT/Private.hs0000644000000000000000000006755112762061411016746 0ustar0000000000000000module Data.List.HT.Private where import Data.List as List (find, transpose, unfoldr, isPrefixOf, findIndices, foldl', mapAccumL, ) import Data.Maybe as Maybe (fromMaybe, catMaybes, ) import Data.Maybe.HT (toMaybe, ) import Control.Monad (guard, msum, ) import Control.Applicative ((<*>), ) import Data.Tuple.HT (mapPair, mapFst, mapSnd, forcePair, swap, ) import qualified Data.List.Key.Private as Key import qualified Data.List.Match.Private as Match import qualified Data.List.Reverse.StrictElement as Rev 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@. -} {- suggested in -} inits :: [a] -> [[a]] 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:) (initsLazy 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 [] -> ([],[]) _:xs -> (xt, 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 somehow a generalization of 'lines' and 'words'. But note the differences: > Prelude Data.List.HT> words "a a" > ["a","a"] > Prelude Data.List.HT> chop (' '==) "a a" > ["a","","a"] > Prelude Data.List.HT> lines "a\n\na" > ["a","","a"] > Prelude Data.List.HT> chop ('\n'==) "a\n\na" > ["a","","a"] > Prelude Data.List.HT> lines "a\n" > ["a"] > Prelude Data.List.HT> chop ('\n'==) "a\n" > ["a",""] -} 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 :: (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 = breakAfterRec breakAfterRec :: (a -> Bool) -> [a] -> ([a], [a]) breakAfterRec p = let recourse [] = ([],[]) recourse (x:xs) = mapFst (x:) $ if p x then ([],xs) else recourse xs in forcePair . recourse {- The use of 'foldr' might allow for fusion, but unfortunately this simple implementation would copy the tail of the list. -} breakAfterFoldr :: (a -> Bool) -> [a] -> ([a], [a]) breakAfterFoldr p = forcePair . foldr (\x yzs -> mapFst (x:) $ if p x then ([], uncurry (++) yzs) else yzs) ([],[]) breakAfterBreak :: (a -> Bool) -> [a] -> ([a], [a]) breakAfterBreak p xs = case break p xs of (ys, []) -> (ys, []) (ys, z:zs) -> (ys++[z], zs) breakAfterTakeUntil :: (a -> Bool) -> [a] -> ([a], [a]) breakAfterTakeUntil p xs = forcePair $ (\ys -> (map fst ys, maybe [] (snd . snd) $ viewR ys)) $ takeUntil (p . fst) $ zip xs $ tail $ tails xs {- | Take all elements until one matches. The matching element is returned, too. This is the key difference to @takeWhile (not . p)@. It holds @takeUntil p xs == fst (breakAfter p xs)@. -} takeUntil :: (a -> Bool) -> [a] -> [a] takeUntil p = foldr (\x ys -> x : if p x then [] else ys) [] {- | 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. See package @non-empty@ for more precise result type. -} segmentAfter :: (a -> Bool) -> [a] -> [[a]] segmentAfter p = uncurry (:) . foldr (\x ~(y,ys) -> mapFst (x:) $ if p x then ([],y:ys) else (y,ys)) ([],[]) 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. See package @non-empty@ for more precise result type. -} 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)) ([],[]) segmentBefore' :: (a -> Bool) -> [a] -> [[a]] segmentBefore' p = uncurry (:) . (\xst -> fromMaybe ([],xst) $ do ((x:xs):xss) <- Just xst guard $ not $ p x return (x:xs, xss)) . groupBy (\_ x -> not $ p x) segmentBefore'' :: (a -> Bool) -> [a] -> [[a]] segmentBefore'' p = (\xst -> case xst of ~(xs:xss) -> tail xs : xss) . groupBy (\_ x -> not $ p x) . (error "segmentBefore: dummy element" :) 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:) propSegmentBeforeGroupBy0 :: Eq a => (a -> Bool) -> [a] -> Bool propSegmentBeforeGroupBy0 p xs = segmentBefore p xs == segmentBefore' p xs propSegmentBeforeGroupBy1 :: Eq a => (a -> Bool) -> [a] -> Bool propSegmentBeforeGroupBy1 p xs = segmentBefore p xs == segmentBefore'' p xs {- | > Data.List.HT Data.Char> segmentBeforeMaybe (\c -> toMaybe (isLetter c) (toUpper c)) "123a5345b---" > ("123",[('A',"5345"),('B',"---")]) -} segmentBeforeMaybe :: (a -> Maybe b) -> [a] -> ([a], [(b, [a])]) segmentBeforeMaybe f = forcePair . foldr (\ x ~(y,ys) -> case f x of Just b -> ([],(b,y):ys) Nothing -> (x:y,ys)) ([],[]) {- | > Data.List.HT Data.Char> segmentAfterMaybe (\c -> toMaybe (isLetter c) (toUpper c)) "123a5345b---" > ([("123",'A'),("5345",'B')],"---") -} segmentAfterMaybe :: (a -> Maybe b) -> [a] -> ([([a], b)], [a]) segmentAfterMaybe f = swap . uncurry (mapAccumL (\as0 (b,as1) -> (as1, (as0,b)))) . segmentBeforeMaybe f -- 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. See also the proposal -} removeEach :: [a] -> [(a, [a])] removeEach = map (\(ys, pivot, zs) -> (pivot,ys++zs)) . splitEverywhere splitEverywhere :: [a] -> [([a], a, [a])] splitEverywhere xs = map (\(y, zs0) -> case zs0 of z:zs -> (y,z,zs) [] -> error "splitEverywhere: empty list") (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 {- | @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 {- | @splitAtRev n xs == (dropRev n xs, takeRev n xs)@. It holds @xs == uncurry (++) (splitAtRev n xs)@ -} splitAtRev :: Int -> [a] -> ([a], [a]) splitAtRev n xs = Match.splitAt (drop n xs) xs dropWhileRev :: (a -> Bool) -> [a] -> [a] dropWhileRev p = concat . init . segmentAfter (not . p) takeWhileRev0 :: (a -> Bool) -> [a] -> [a] takeWhileRev0 p = last . segmentAfter (not . p) {- | Doesn't seem to be superior to the naive implementation. -} takeWhileRev1 :: (a -> Bool) -> [a] -> [a] takeWhileRev1 p = (\mx -> case mx of Just (_, xs@((True,_):_)) -> map snd xs _ -> []) . viewR . Key.aux groupBy (==) p {- | However it is more inefficient, because of repeatedly appending single elements. :-( -} takeWhileRev2 :: (a -> Bool) -> [a] -> [a] takeWhileRev2 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@. It is the same as 'Data.List.stripPrefix'. -} maybePrefixOf :: Eq a => [a] -> [a] -> Maybe [a] maybePrefixOf (x:xs) (y:ys) = guard (x==y) >> maybePrefixOf xs ys maybePrefixOf [] ys = Just ys maybePrefixOf _ [] = Nothing maybeSuffixOf :: Eq a => [a] -> [a] -> Maybe [a] maybeSuffixOf xs ys = fmap reverse $ maybePrefixOf (reverse xs) (reverse ys) {- | 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) replace :: Eq a => [a] -> [a] -> [a] -> [a] replace src dst = let recourse [] = [] recourse str@(s:ss) = fromMaybe (s : recourse ss) (fmap ((dst++) . recourse) $ maybePrefixOf src str) in recourse 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) = fromMaybe (s : recourse ss) (msum $ map (\(src,dst) -> fmap ((dst++) . recourse) $ maybePrefixOf src str) dict) in recourse 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 (Rev.dropWhile 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' (Rev.dropWhile 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])) -} lengthAtLeast :: Int -> [a] -> Bool lengthAtLeast n = if n<=0 then const False else not . null . drop (n-1) {- Iterate until elements start to cycle. This implementation is inspired by Elements of Programming but I am still not satisfied where the iteration actually stops. -} iterateUntilCycle :: (Eq a) => (a -> a) -> a -> [a] iterateUntilCycle f a = let as = iterate f a in (a:) $ map fst $ takeWhile (uncurry (/=)) $ zip (tail as) (concatMap (\ai->[ai,ai]) as) {- iterateUntilCycleQ :: (Eq a) => (a -> a) -> a -> [a] iterateUntilCycleQ f a = let as = tail $ iterate f a in (a:) $ map fst $ takeWhile (uncurry (/=)) $ zip as (downsample2 (tail as)) -} iterateUntilCycleP :: (Eq a) => (a -> a) -> a -> [a] iterateUntilCycleP f a = let as = iterate f a in map fst $ takeWhile (\(a1,(a20,a21)) -> a1/=a20 && a1/=a21) $ zip as (pairs (tail as)) pairs :: [t] -> [(t, t)] pairs [] = [] pairs (_:[]) = error "pairs: odd number of elements" pairs (x0:x1:xs) = (x0,x1) : pairs xs {- | 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) {- | -} mapAdjacentPointfree :: (a -> a -> b) -> [a] -> [b] mapAdjacentPointfree f = zipWith f <*> tail {- | > 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 {- | 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.12/src/Data/List/Reverse/0000755000000000000000000000000012762061411016062 5ustar0000000000000000utility-ht-0.0.12/src/Data/List/Reverse/StrictSpine.hs0000644000000000000000000000201312762061411020661 0ustar0000000000000000{- | The functions in this module process the list from the end. They do not access elements at the beginning if not necessary. You can apply the function only to infinite lists. Use these functions if the list is short and the test is expensive. -} module Data.List.Reverse.StrictSpine where import Data.Tuple.HT (mapFst, mapSnd, forcePair, ) import Prelude hiding (dropWhile, takeWhile, span, ) {- | Like @reverse . List.dropWhile p . reverse@. -} dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile p = foldr (\x xs -> if null xs && p x then [] else x:xs) [] {- | Like @reverse . List.takeWhile p . reverse@. -} takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile p = snd . foldr (\x xys -> (if fst xys && p x then mapSnd (x:) else mapFst (const False)) xys) (True, []) {- | @span p xs == (dropWhile p xs, takeWhile p xs)@ -} span :: (a -> Bool) -> [a] -> ([a], [a]) span p = forcePair . foldr (\x xys -> (if null (fst xys) && p x then mapSnd else mapFst) (x:) xys) ([], []) utility-ht-0.0.12/src/Data/List/Reverse/StrictElement.hs0000644000000000000000000000230012762061411021173 0ustar0000000000000000{- | The functions in this module process the list formally from the end. Actually they traverse the list from the start and check every element. This way they are strict in the elements and lazy in the list spline. Thus you can apply them to infinite lists. Use these functions if the list is long or the test is cheap. -} module Data.List.Reverse.StrictElement where import Data.Tuple.HT (mapFst, mapSnd, forcePair, ) import Prelude hiding (dropWhile, takeWhile, span, ) {- | Remove the longest suffix of elements satisfying p. In contrast to @reverse . dropWhile p . reverse@ this works for infinite lists, too. -} dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile p = foldr (\x xs -> if p x && null xs then [] else x:xs) [] {- | Alternative version of @reverse . takeWhile p . reverse@. -} takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile p = snd . foldr (\x xys -> (if p x && fst xys then mapSnd (x:) else mapFst (const False)) xys) (True, []) {- | @span p xs == (dropWhile p xs, takeWhile p xs)@ -} span :: (a -> Bool) -> [a] -> ([a], [a]) span p = forcePair . foldr (\x xys -> (if p x && null (fst xys) then mapSnd else mapFst) (x:) xys) ([], [])