extra 1.7.3 → 1.7.4

raw patch · 8 files changed

+78/−25 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGES.txt +4/−0
• extra.cabal +1/−1
• src/Control/Concurrent/Extra.hs +1/−1
• src/Control/Monad/Extra.hs +21/−1
• src/Data/List/Extra.hs +26/−20
• src/Data/Tuple/Extra.hs +20/−0
• src/Extra.hs +2/−2
• test/TestGen.hs +3/−0

@@ -1,5 +1,9 @@ Changelog for Extra +1.7.4, released 2020-07-15+    #59, add whileJustM and untilJustM+    #61, optimise nubOrd (10% or so)+    Add first3, second3, third3 1.7.3, released 2020-05-30     #58, add disjointOrd and disjointOrdBy 1.7.2, released 2020-05-25

@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               extra-version:            1.7.3+version:            1.7.4 license:            BSD3 license-file:       LICENSE category:           Development

@@ -88,7 +88,7 @@ -- -- @ -- lock <- 'newLock'--- let output = 'withLock' . putStrLn+-- let output = 'withLock' lock . putStrLn -- forkIO $ do ...; output \"hello\" -- forkIO $ do ...; output \"world\" -- @

@@ -11,7 +11,7 @@     unit,     maybeM, fromMaybeM, eitherM,     -- * Loops-    loop, loopM, whileM,+    loop, loopM, whileM, whileJustM, untilJustM,     -- * Lists     partitionM, concatMapM, concatForM, mconcatMapM, mapMaybeM, findM, firstJustM,     fold1M, fold1M_,@@ -159,6 +159,26 @@ whileM act = do     b <- act     when b $ whileM act++-- | Keep running an operation until it becomes a 'Nothing', accumulating the+--   monoid results inside the 'Just's as the result of the overall loop.+whileJustM :: (Monad m, Monoid a) => m (Maybe a) -> m a+whileJustM act = go mempty+  where+    go accum = do+        res <- act+        case res of+            Nothing -> pure accum+            Just r -> go $! (accum <> r) -- strict apply, otherwise space leaks++-- | Keep running an operation until it becomes a 'Just', then return the value+--   inside the 'Just' as the result of the overall loop.+untilJustM :: Monad m => m (Maybe a) -> m a+untilJustM act = do+    res <- act+    case res of+        Just r  -> pure r+        Nothing -> untilJustM act  -- Booleans 

@@ -760,42 +760,48 @@ --------------------------------------------------------------------- -- OKASAKI RED BLACK TREE -- Taken from https://www.cs.kent.ac.uk/people/staff/smk/redblack/Untyped.hs+-- But with the Color = R|B fused into the tree -data Color = R | B deriving Show-data RB a = E | T Color (RB a) a (RB a) deriving Show+data RB a = E | T_R (RB a) a (RB a) | T_B (RB a) a (RB a) deriving Show  {- Insertion and membership test as by Okasaki -} insertRB :: (a -> a -> Ordering) -> a -> RB a -> RB a-insertRB cmp x s =-    T B a z b+insertRB cmp x s = case ins s of+    T_R a z b -> T_B a z b+    x -> x     where-    T _ a z b = ins s-    ins E = T R E x E-    ins s@(T B a y b) = case cmp x y of-        LT -> balance (ins a) y b-        GT -> balance a y (ins b)+    ins E = T_R E x E+    ins s@(T_B a y b) = case cmp x y of+        LT -> lbalance (ins a) y b+        GT -> rbalance a y (ins b)         EQ -> s-    ins s@(T R a y b) = case cmp x y of-        LT -> T R (ins a) y b-        GT -> T R a y (ins b)+    ins s@(T_R a y b) = case cmp x y of+        LT -> T_R (ins a) y b+        GT -> T_R a y (ins b)         EQ -> s  memberRB :: (a -> a -> Ordering) -> a -> RB a -> Bool memberRB cmp x E = False-memberRB cmp x (T _ a y b) = case cmp x y of+memberRB cmp x (T_R a y b) = case cmp x y of     LT -> memberRB cmp x a     GT -> memberRB cmp x b     EQ -> True+memberRB cmp x (T_B a y b) = case cmp x y of+    LT -> memberRB cmp x a+    GT -> memberRB cmp x b+    EQ -> True  {- balance: first equation is new,    to make it work with a weaker invariant -}-balance :: RB a -> a -> RB a -> RB a-balance (T R a x b) y (T R c z d) = T R (T B a x b) y (T B c z d)-balance (T R (T R a x b) y c) z d = T R (T B a x b) y (T B c z d)-balance (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d)-balance a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d)-balance a x (T R (T R b y c) z d) = T R (T B a x b) y (T B c z d)-balance a x b = T B a x b+lbalance, rbalance :: RB a -> a -> RB a -> RB a+lbalance (T_R a x b) y (T_R c z d) = T_R (T_B a x b) y (T_B c z d)+lbalance (T_R (T_R a x b) y c) z d = T_R (T_B a x b) y (T_B c z d)+lbalance (T_R a x (T_R b y c)) z d = T_R (T_B a x b) y (T_B c z d)+lbalance a x b = T_B a x b+rbalance (T_R a x b) y (T_R c z d) = T_R (T_B a x b) y (T_B c z d)+rbalance a x (T_R b y (T_R c z d)) = T_R (T_B a x b) y (T_B c z d)+rbalance a x (T_R (T_R b y c) z d) = T_R (T_B a x b) y (T_B c z d)+rbalance a x b = T_B a x b   -- | Like 'zipWith', but keep going to the longest value. The function

@@ -13,6 +13,7 @@     firstM, secondM,     -- * Operations on triple     fst3, snd3, thd3,+    first3, second3, third3,     curry3, uncurry3     ) where @@ -90,3 +91,22 @@ -- | Converts a curried function to a function on a triple. uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) uncurry3 f ~(a,b,c) = f a b c+++-- | Update the first component of a triple.+--+-- > first3 succ (1,1,1) == (2,1,1)+first3 :: (a -> a') -> (a, b, c) -> (a', b, c)+first3 f (a,b,c) = (f a,b,c)++-- | Update the second component of a triple.+--+-- > second3 succ (1,1,1) == (1,2,1)+second3 :: (b -> b') -> (a, b, c) -> (a, b', c)+second3 f (a,b,c) = (a,f b,c)++-- | Update the third component of a triple.+--+-- > third3 succ (1,1,1) == (1,1,2)+third3 :: (c -> c') -> (a, b, c) -> (a, b, c')+third3 f (a,b,c) = (a,b,f c)

@@ -14,7 +14,7 @@     Partial, retry, retryBool, errorWithoutStackTrace, showException, stringException, errorIO, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool,     -- * Control.Monad.Extra     -- | Extra functions available in @"Control.Monad.Extra"@.-    whenJust, whenJustM, whenMaybe, whenMaybeM, unit, maybeM, fromMaybeM, eitherM, loop, loopM, whileM, partitionM, concatMapM, concatForM, mconcatMapM, mapMaybeM, findM, firstJustM, fold1M, fold1M_, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM,+    whenJust, whenJustM, whenMaybe, whenMaybeM, unit, maybeM, fromMaybeM, eitherM, loop, loopM, whileM, whileJustM, untilJustM, partitionM, concatMapM, concatForM, mconcatMapM, mapMaybeM, findM, firstJustM, fold1M, fold1M_, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM,     -- * Data.Either.Extra     -- | Extra functions available in @"Data.Either.Extra"@.     fromLeft, fromRight, fromEither, fromLeft', fromRight', eitherToMaybe, maybeToEither, mapLeft, mapRight,@@ -29,7 +29,7 @@     (|:), (|>), appendl, appendr, maximum1, minimum1, maximumBy1, minimumBy1, maximumOn1, minimumOn1,     -- * Data.Tuple.Extra     -- | Extra functions available in @"Data.Tuple.Extra"@.-    first, second, (***), (&&&), dupe, both, firstM, secondM, fst3, snd3, thd3, curry3, uncurry3,+    first, second, (***), (&&&), dupe, both, firstM, secondM, fst3, snd3, thd3, first3, second3, third3, curry3, uncurry3,     -- * Data.Version.Extra     -- | Extra functions available in @"Data.Version.Extra"@.     readVersion,

@@ -265,6 +265,9 @@     testGen "(succ &&& pred) 1 == (2,0)" $ (succ &&& pred) 1 == (2,0)     testGen "dupe 12 == (12, 12)" $ dupe 12 == (12, 12)     testGen "both succ (1,2) == (2,3)" $ both succ (1,2) == (2,3)+    testGen "first3 succ (1,1,1) == (2,1,1)" $ first3 succ (1,1,1) == (2,1,1)+    testGen "second3 succ (1,1,1) == (1,2,1)" $ second3 succ (1,1,1) == (1,2,1)+    testGen "third3 succ (1,1,1) == (1,1,2)" $ third3 succ (1,1,1) == (1,1,2)     testGen "\\x -> readVersion (showVersion x) == x" $ \x -> readVersion (showVersion x) == x     testGen "readVersion \"hello\" == undefined" $ erroneous $ readVersion "hello"     testGen "showDP 4 pi == \"3.1416\"" $ showDP 4 pi == "3.1416"