packages feed

utility-ht 0.0.5.1 → 0.0.6

raw patch · 14 files changed

+303/−87 lines, 14 filesdep ~QuickCheckdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, base

API changes (from Hackage documentation)

+ Data.Bool.HT: ifThenElse :: Bool -> a -> a -> a
+ Data.Monoid.HT: cycle :: Monoid m => m -> m
+ Text.Show.HT: concatS :: [ShowS] -> ShowS

Files

src/Data/Bool/HT.hs view
@@ -1,5 +1,6 @@ module Data.Bool.HT (    B.if',+   B.ifThenElse,    B.select,    (B.?:),    B.implies,
src/Data/Bool/HT/Private.hs view
@@ -18,6 +18,15 @@ 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.
src/Data/Function/HT/Private.hs view
@@ -37,9 +37,9 @@    (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)+   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)
src/Data/List/HT/Private.hs view
@@ -4,7 +4,7 @@                             findIndices, foldl', ) import Data.Maybe as Maybe (fromMaybe, catMaybes, ) import Data.Maybe.HT       (toMaybe, )-import Control.Monad       (guard, )+import Control.Monad       (guard, msum, ) import Data.Tuple.HT       (mapPair, mapFst, mapSnd, forcePair, )  import qualified Data.List.Key.Private   as Key@@ -137,7 +137,24 @@ {- | Split the list at the occurrences of a separator into sub-lists. Remove the separators.-This is a generalization of 'words'.+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 =@@ -268,8 +285,12 @@  splitEverywhere :: [a] -> [([a], a, [a])] splitEverywhere xs =-   map (\(y, z:zs) -> (y,z,zs))-       (init (zip (inits xs) (tails xs)))+   map+      (\(y, zs0) ->+         case zs0 of+            z:zs -> (y,z,zs)+            [] -> error "splitEverywhere: empty list")+      (init (zip (inits xs) (tails xs)))   @@ -493,6 +514,16 @@ 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') =@@ -503,8 +534,8 @@                          Nothing -> (xs, rest)) ([],[]) ys    in  Just hd' : rest' -replace :: (Eq a) => [a] -> [a] -> [a] -> [a]-replace src dst xs =+replace' :: (Eq a) => [a] -> [a] -> [a] -> [a]+replace' src dst xs =    concatMap (fromMaybe dst) (markSublists src xs)  propReplaceId :: (Eq a) => [a] -> [a] -> Bool@@ -519,8 +550,8 @@      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 =+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@@ -530,6 +561,18 @@ 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))@@ -724,6 +767,41 @@ {- Debug.QuickCheck.quickCheck (\b d -> propFoldl'r (+) (b::Int) (++) (d::[Int])) -}+++{-+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 -}
src/Data/List/Match/Private.hs view
@@ -21,52 +21,42 @@  {- | Drop as many elements as the first list is long -} drop :: [b] -> [a] -> [a]-drop xs ys =+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)) -drop' :: [b] -> [a] -> [a]-drop' xs ys =+drop1 :: [b] -> [a] -> [a]+drop1 xs ys =    map snd (dropWhile (not . null . fst) (zip (iterate laxTail xs) ys)) -drop'' :: [b] -> [a] -> [a]-drop'' xs ys =+drop2 :: [b] -> [a] -> [a]+drop2 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+laxTail xt = case xt of [] -> []; _:xs -> xs +laxTail0 :: [a] -> [a]+laxTail0 = List.drop 1  splitAt :: [b] -> [a] -> ([a],[a]) splitAt nt xt =@@ -75,11 +65,7 @@       (_: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))@@@ -92,21 +78,16 @@ compareLength []     (_:_)  = LT  {- | efficient like compareLength, but without pattern matching -}-compareLength' :: [a] -> [b] -> Ordering-compareLength' xs ys =+compareLength0 :: [a] -> [b] -> Ordering+compareLength0 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 =+compareLength1 :: [a] -> [b] -> Ordering+compareLength1 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@,
src/Data/Maybe/HT.hs view
@@ -3,7 +3,10 @@ import Data.Maybe (fromMaybe, ) import Control.Monad (msum, ) -+{-+It was proposed as addition to Data.Maybe and rejected at that time.+<http://www.haskell.org/pipermail/libraries/2004-July/002381.html>+-} {- | Returns 'Just' if the precondition is fulfilled. -} {-# INLINE toMaybe #-} toMaybe :: Bool -> a -> Maybe a
+ src/Data/Monoid/HT.hs view
@@ -0,0 +1,14 @@+module Data.Monoid.HT (cycle, ) where++import Data.Monoid (Monoid, mappend, )+import Data.Function (fix, )++import Prelude ()+++{- |+Generalization of 'Data.List.cycle' to any monoid.+-}+cycle :: Monoid m => m -> m+cycle x =+   fix (mappend x)
src/Test.hs view
@@ -1,7 +1,9 @@ module Main where -import qualified Test.Data.List     as ListHT-import qualified Test.Data.Function as FunctionHT+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 ())]@@ -12,6 +14,8 @@ main =    mapM_ (\(msg,io) -> putStr (msg++": ") >> io) $    concat $-      prefix "List"     ListHT.tests :-      prefix "Function" FunctionHT.tests :+      prefix "List"      ListHT.tests :+      prefix "ListMatch" ListMatch.tests :+      prefix "Maybe"     MaybeHT.tests :+      prefix "Function"  FunctionHT.tests :       []
+ src/Test/Data/Function.hs view
@@ -0,0 +1,18 @@+module 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)) :+   []
src/Test/Data/List.hs view
@@ -5,7 +5,7 @@ import Control.Monad (liftM2, )  import Test.Utility (equalLists, equalInfLists, )-import Test.QuickCheck (Property, test, (==>), )+import Test.QuickCheck (Testable, Property, quickCheck, (==>), )  import Prelude hiding (iterate, ) @@ -20,10 +20,10 @@                   ListHT.sieve''' n x]  -sliceHorizontal :: Eq a => Int -> [a] -> Property-sliceHorizontal n x =-   n>0 ==>-      ListHT.sliceHorizontal n x == ListHT.sliceHorizontal' 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@@ -31,12 +31,13 @@    n>0 ==>       ListHT.sliceVertical n x == ListHT.sliceVertical' n x -slice :: Eq a => Int -> [a] -> Property-slice n x =-   0<n && n <= length x  ==>-      -- problems: ListHT.sliceHorizontal 4 [] == [[],[],[],[]]-      ListHT.sliceHorizontal n x == List.transpose (ListHT.sliceVertical  n x)  &&-      ListHT.sliceVertical  n x == List.transpose (ListHT.sliceHorizontal 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)   @@ -62,14 +63,19 @@   +simple ::+   (Testable test) =>+   (Int -> [Integer] -> test) -> IO ()+simple = quickCheck + 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)) :+   ("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)) :    []
+ src/Test/Data/ListMatch.hs view
@@ -0,0 +1,66 @@+module 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+++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) :+   ("compareLength",    test2 compareLength) :+   []
+ src/Test/Data/Maybe.hs view
@@ -0,0 +1,17 @@+module 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))) :+   []
src/Text/Show/HT.hs view
@@ -2,11 +2,22 @@  {-| Show a value using an infix operator. -} {-# INLINE showsInfixPrec #-}-showsInfixPrec :: (Show a, Show b) =>-                  String -> Int -> Int -> a -> b -> ShowS+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.cabal view
@@ -1,5 +1,5 @@ Name:             utility-ht-Version:          0.0.5.1+Version:          0.0.6 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -11,12 +11,15 @@   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.+  .+  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.-Tested-With:       GHC==6.8.2+  .+  Alternative packages: @Useful@, @MissingH@+Tested-With:       GHC==6.8.2, GHC==6.10.4, GHC==6.12.3, GHC==7.0.2 Cabal-Version:     >=1.6 Build-Type:        Simple @@ -27,14 +30,15 @@ Source-Repository this   type:     darcs   location: http://code.haskell.org/~thielema/utility/-  tag:      0.0.5.1+  tag:      0.0.6  Flag buildTests   description: Build test executables   default:     False  Library-  Build-Depends: base+  Build-Depends:+    base >=3 && <5    GHC-Options:      -Wall   Hs-Source-Dirs:   src@@ -46,6 +50,7 @@     Data.List.Key     Data.List.Match     Data.Maybe.HT+    Data.Monoid.HT     Data.Ord.HT     Data.Record.HT     Data.String.HT@@ -65,12 +70,15 @@  Executable test   If flag(buildTests)-    Build-Depends:  QuickCheck >=1.1 && <2+    Build-Depends:  QuickCheck >=1.1 && <3   Else     Buildable:      False   GHC-Options:      -Wall   Hs-source-dirs:   src   Other-Modules:     Test.Data.List+    Test.Data.ListMatch+    Test.Data.Maybe+    Test.Data.Function     Test.Utility   Main-Is:          Test.hs