packages feed

utility-ht 0.0.12 → 0.0.13

raw patch · 8 files changed

+167/−34 lines, 8 files

Files

src/Control/Monad/HT.hs view
@@ -1,6 +1,7 @@ module Control.Monad.HT where  import qualified Control.Monad as M+import qualified Data.List as List import Prelude hiding (repeat, until, )  @@ -19,6 +20,9 @@ repeat :: (Monad m) => m a -> m [a] repeat x =    let go = lift2 (:) x go in go++nest :: (Monad m) => Int -> (a -> m a) -> a -> m a+nest n f x0 = M.foldM (\x () -> f x) x0 (List.replicate n ())  {-# DEPRECATED untilM "use M.until" #-} {- | repeat action until result fulfills condition -}
+ src/Data/Either/HT.hs view
@@ -0,0 +1,15 @@+module Data.Either.HT (+   mapLeft,+   mapRight,+   mapBoth,+   ) where+++mapLeft :: (a -> b) -> Either a c -> Either b c+mapLeft f = either (Left . f) Right++mapRight :: (b -> c) -> Either a b -> Either a c+mapRight f = either Left (Right . f)++mapBoth :: (a -> c) -> (b -> d) -> Either a b -> Either c d+mapBoth f g = either (Left . f) (Right . g)
src/Data/Function/HT.hs view
@@ -1,8 +1,16 @@ module Data.Function.HT (-   nest, powerAssociative, compose2,+   Id, nest, powerAssociative, compose2,    ) where  import Data.Function.HT.Private (nest, powerAssociative, )+++{- |+Useful for adding type annotations like in++> f . (id :: Id Char) . g+-}+type Id a = a -> a  {- | Known as @on@ in newer versions of the @base@ package.
src/Data/List/HT.hs view
@@ -63,6 +63,7 @@    L.iterateAssociative,    L.iterateLeaky,    L.lengthAtLeast,+   L.lengthAtMost,    ) where  import qualified Data.List.HT.Private as L
src/Data/List/HT/Private.hs view
@@ -2,12 +2,15 @@  import Data.List  as List  (find, transpose, unfoldr, isPrefixOf,                             findIndices, foldl', mapAccumL, )-import Data.Maybe as Maybe (fromMaybe, catMaybes, )+import Data.Maybe as Maybe (fromMaybe, catMaybes, isJust, mapMaybe, ) import Data.Maybe.HT       (toMaybe, )-import Control.Monad       (guard, msum, )-import Control.Applicative ((<*>), )+import Control.Monad.HT    ((<=<), )+import Control.Monad       (guard, msum, mplus, )+import Control.Applicative ((<$>), (<*>), ) import Data.Tuple.HT       (mapPair, mapFst, mapSnd, forcePair, swap, ) +import qualified Control.Functor.HT as Func+ import qualified Data.List.Key.Private   as Key import qualified Data.List.Match.Private as Match import qualified Data.List.Reverse.StrictElement as Rev@@ -568,6 +571,41 @@ takeWhileJust =    foldr (\x acc -> maybe [] (:acc) x) [] +dropWhileNothing :: (a -> Maybe b) -> [a] -> Maybe (b, [a])+dropWhileNothing f =+   msum . map (Func.mapFst f <=< viewL) . tails++dropWhileNothingRec :: (a -> Maybe b) -> [a] -> Maybe (b, [a])+dropWhileNothingRec f =+   let go [] = Nothing+       go (a:xs) = (flip (,) xs <$> f a) `mplus` go xs+   in  go++breakJust :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))+breakJust f =+   let go [] = ([], Nothing)+       go (a:xs) =+         case f a of+            Nothing -> mapFst (a:) $ go xs+            Just b -> ([], Just (b, xs))+   in  go++-- memory leak, because xs is hold all the time+breakJustRemoveEach :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))+breakJustRemoveEach f xs =+   switchL (xs, Nothing) const $+   mapMaybe (\(ys,a,zs) -> (\b -> (ys, Just (b,zs))) <$> f a) $+   splitEverywhere xs++-- needs to apply 'f' twice at the end and uses partial functions+breakJustPartial :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))+breakJustPartial f xs =+   let (ys,zs) = break (isJust . f) xs+   in  (ys,+        mapFst (maybe (error "breakJust: unexpected Nothing") id . f) <$>+            viewL zs)++ unzipEithers :: [Either a b] -> ([a], [b]) unzipEithers =    forcePair .@@ -901,8 +939,17 @@ lengthAtLeast :: Int -> [a] -> Bool lengthAtLeast n =    if n<=0-     then const False+     then const True      else not . null . drop (n-1)++lengthAtMost :: Int -> [a] -> Bool+lengthAtMost n =+   if n<0+     then const False+     else null . drop n++lengthAtMost0 :: Int -> [a] -> Bool+lengthAtMost0 n = (n>=) . length . take (n+1)  {- Iterate until elements start to cycle.
src/Data/Tuple/HT.hs view
@@ -6,6 +6,7 @@    swap,    sortPair,    forcePair,+   double,     -- * Triple    fst3,@@ -17,10 +18,19 @@    mapThd3,    curry3,    uncurry3,+   triple,    ) where  import Data.Tuple.Lazy ++{-# INLINE double #-}+double :: a -> (a,a)+double a = (a,a)++{-# INLINE triple #-}+triple :: a -> (a,a,a)+triple a = (a,a,a)  {-# INLINE fst3 #-} fst3 :: (a,b,c) -> a
src/Test/Data/List.hs view
@@ -3,10 +3,13 @@ import qualified Data.List.Reverse.StrictElement as Rev import qualified Data.List.HT.Private as ListHT import qualified Data.List as List+import Data.Maybe.HT (toMaybe, ) import Control.Monad (liftM2, ) +import qualified Test.QuickCheck.Modifiers as Mod+import qualified Test.QuickCheck as QC import Test.Utility (equalLists, equalInfLists, )-import Test.QuickCheck (Testable, Property, quickCheck, (==>), )+import Test.QuickCheck (Arbitrary, Testable, Property, quickCheck, )  import Prelude hiding (iterate, ) @@ -63,37 +66,60 @@    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]+geMaybe :: Float -> Float -> Maybe Integer+geMaybe x y = toMaybe (x < y) (round y) +dropWhileNothing :: Float -> [Float] -> Bool+dropWhileNothing x xs =+   ListHT.dropWhileNothing (geMaybe x) xs+   ==+   ListHT.dropWhileNothingRec (geMaybe x) xs -sliceHorizontal :: Eq a => Int -> [a] -> Bool-sliceHorizontal n0 x =-   let n = 1 + mod n0 1000-   in  ListHT.sliceHorizontal n x == ListHT.sliceHorizontal' n x+dropWhileNothingBreakJust :: Float -> [Float] -> Bool+dropWhileNothingBreakJust x xs =+   snd (ListHT.breakJust (geMaybe x) xs)+   ==+   ListHT.dropWhileNothing (geMaybe x) xs +breakJustRemoveEach :: Float -> [Float] -> Bool+breakJustRemoveEach x xs =+   ListHT.breakJust (geMaybe x) xs == ListHT.breakJustRemoveEach (geMaybe x) xs -sliceVertical :: Eq a => Int -> [a] -> Property-sliceVertical n x =-   n>0 ==>-      ListHT.sliceVertical n x == ListHT.sliceVertical' n x+breakJustPartial :: Float -> [Float] -> Bool+breakJustPartial x xs =+   ListHT.breakJust (geMaybe x) xs == ListHT.breakJustPartial (geMaybe x) xs -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) +sieve :: Eq a => Mod.Positive Int -> [a] -> Bool+sieve (Mod.Positive n) x =+   equalLists $+      (ListHT.sieve    n x) :+      (ListHT.sieve'   n x) :+      (ListHT.sieve''  n x) :+      (ListHT.sieve''' n x) :+      []  +sliceHorizontal :: Eq a => [a] -> Property+sliceHorizontal x =+   QC.forAll (QC.choose (1,1000)) $ \n ->+      ListHT.sliceHorizontal n x == ListHT.sliceHorizontal' n x ++sliceVertical :: Eq a => Mod.Positive Int -> [a] -> Bool+sliceVertical (Mod.Positive n) x =+   ListHT.sliceVertical n x == ListHT.sliceVertical' n x++slice :: Eq a => Mod.NonEmptyList a -> Property+slice (Mod.NonEmpty x) =+   QC.forAll (QC.choose (1, length x)) $ \n ->+      -- 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)@@ -105,7 +131,19 @@    concat (ListHT.outerProduct (,) xs ys)  ==  liftM2 (,) xs ys  +lengthAtLeast :: Int -> [a] -> Bool+lengthAtLeast n xs =+   ListHT.lengthAtLeast n xs  ==  (length xs >= n) +lengthAtMost :: Int -> [a] -> Bool+lengthAtMost n xs =+   ListHT.lengthAtMost n xs  ==  (length xs <= n)++lengthAtMost0 :: Int -> [a] -> Bool+lengthAtMost0 n xs =+   ListHT.lengthAtMost0 n xs  ==  (length xs <= n)++ iterate :: Eq a => (a -> a -> a) -> a -> Bool iterate op a =    let xs = List.iterate (op a) a@@ -124,8 +162,8 @@   simple ::-   (Testable test) =>-   (Int -> [Integer] -> test) -> IO ()+   (Show int, Arbitrary int, Testable test) =>+   (int -> [Integer] -> test) -> IO () simple = quickCheck  elemCheck ::@@ -148,12 +186,21 @@    ("breakAfter1",      elemCheck (\a -> breakAfter1 (a>=))) :    ("breakAfter2",      elemCheck (\a -> breakAfter2 (a>=))) :    ("breakAfterUntil",  elemCheck (\a -> breakAfterUntil (a>=))) :+   ("dropWhileNothing", elemCheck dropWhileNothing) :+   ("dropWhileNothingBreakJust",+                        elemCheck dropWhileNothingBreakJust) :+   ("breakJustRemoveEach",+                        elemCheck breakJustRemoveEach) :+   ("breakJustPartial", elemCheck breakJustPartial) :    ("sieve",            simple sieve) :-   ("sliceHorizontal",  simple sliceHorizontal) :+   ("sliceHorizontal",  quickCheck (sliceHorizontal :: String -> Property)) :    ("sliceVertical",    simple sliceVertical) :-   ("slice",            simple slice) :+   ("slice",            quickCheck (slice :: Mod.NonEmptyList Char -> Property)) :    ("shear",            quickCheck (shear           :: [[Integer]] -> Bool)) :    ("outerProduct",     quickCheck (outerProduct    :: [Integer] -> [Int] -> Bool)) :+   ("lengthAtLeast",    simple lengthAtLeast) :+   ("lengthAtMost",     simple lengthAtMost) :+   ("lengthAtMost0",    simple lengthAtMost0) :    ("iterate",          quickCheck (iterate (+)     :: Integer -> Bool)) :    ("mapAdjacent",      quickCheck (mapAdjacent     :: Integer -> [Integer] -> Bool)) :    ("mapAdjacentPointfree",
utility-ht.cabal view
@@ -1,5 +1,5 @@ Name:             utility-ht-Version:          0.0.12+Version:          0.0.13 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -45,7 +45,7 @@ Source-Repository this   type:     darcs   location: http://code.haskell.org/~thielema/utility/-  tag:      0.0.12+  tag:      0.0.13  Library   Build-Depends:@@ -66,6 +66,7 @@     Data.List.Reverse.StrictElement     Data.List.Reverse.StrictSpine     Data.Maybe.HT+    Data.Either.HT     Data.Monoid.HT     Data.Ord.HT     Data.Record.HT