Hello community,
here is the log from the commit of package ghc-extra for openSUSE:Leap:15.2
checked in at 2020-05-21 12:58:22
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Leap:15.2/ghc-extra (Old)
and /work/SRC/openSUSE:Leap:15.2/.ghc-extra.new.2738 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-extra"
Thu May 21 12:58:22 2020 rev:13 rq:805464 version:1.7.1
Changes:
--------
--- /work/SRC/openSUSE:Leap:15.2/ghc-extra/ghc-extra.changes 2020-03-13
10:56:51.676412695 +0100
+++ /work/SRC/openSUSE:Leap:15.2/.ghc-extra.new.2738/ghc-extra.changes
2020-05-21 12:58:23.250670677 +0200
@@ -1,0 +2,13 @@
+Wed May 6 06:54:11 UTC 2020 - psim...@suse.com
+
+- Update extra to version 1.7.1.
+ 1.7.1, released 2020-03-10
+ Add NOINLINE to errorIO to work around a GHC 8.4 bug
+ 1.7, released 2020-03-05
+ * #40, delete deprecated function for
+ * zipFrom now truncates lists, rather than error, just like zip
+ 1.6.21, released 2020-03-02
+ #54, deprecate nubOn since its O(n^2). Use nubOrdOn
+ #53, add some nub functions to NonEmpty
+
+-------------------------------------------------------------------
Old:
----
extra-1.6.20.tar.gz
New:
----
extra-1.7.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-extra.spec ++++++
--- /var/tmp/diff_new_pack.DOaOlV/_old 2020-05-21 12:58:23.586671409 +0200
+++ /var/tmp/diff_new_pack.DOaOlV/_new 2020-05-21 12:58:23.590671417 +0200
@@ -19,7 +19,7 @@
%global pkg_name extra
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 1.6.20
+Version: 1.7.1
Release: 0
Summary: Extra functions I use
License: BSD-3-Clause
@@ -36,6 +36,7 @@
BuildRequires: ghc-unix-devel
%if %{with tests}
BuildRequires: ghc-QuickCheck-devel
+BuildRequires: ghc-quickcheck-instances-devel
%endif
%description
++++++ extra-1.6.20.tar.gz -> extra-1.7.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/CHANGES.txt new/extra-1.7.1/CHANGES.txt
--- old/extra-1.6.20/CHANGES.txt 2020-02-16 14:17:13.000000000 +0100
+++ new/extra-1.7.1/CHANGES.txt 2020-03-10 23:59:31.000000000 +0100
@@ -1,5 +1,13 @@
Changelog for Extra
+1.7.1, released 2020-03-10
+ Add NOINLINE to errorIO to work around a GHC 8.4 bug
+1.7, released 2020-03-05
+* #40, delete deprecated function for
+* zipFrom now truncates lists, rather than error, just like zip
+1.6.21, released 2020-03-02
+ #54, deprecate nubOn since its O(n^2). Use nubOrdOn
+ #53, add some nub functions to NonEmpty
1.6.20, released 2020-02-16
Add firstM, secondM
1.6.19, released 2020-02-11
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/Generate.hs new/extra-1.7.1/Generate.hs
--- old/extra-1.6.20/Generate.hs 2019-04-22 20:25:59.000000000 +0200
+++ new/extra-1.7.1/Generate.hs 2020-03-02 10:33:57.000000000 +0100
@@ -25,7 +25,7 @@
words $ replace "," " " $ drop1 $ dropWhile (/= '(') $
unlines $ filter (\x -> not $ any (`isPrefixOf` trim x)
["--","#"]) $ lines src
let tests = mapMaybe (stripPrefix "-- > ") $ lines src
- return (mod, funcs, tests)
+ pure (mod, funcs, tests)
writeFileBinaryChanged "src/Extra.hs" $ unlines $
["-- GENERATED CODE - DO NOT MODIFY"
,"-- See Generate.hs for details of how to generate"
@@ -49,6 +49,9 @@
,"{-# LANGUAGE ExtendedDefaultRules, ScopedTypeVariables, ViewPatterns
#-}"
,"module TestGen(tests) where"
,"import TestUtil"
+ ,"import qualified Data.List"
+ ,"import qualified Data.List.NonEmpty.Extra"
+ ,"import Test.QuickCheck.Instances.Semigroup ()"
,"default(Maybe Bool,Int,Double,Maybe (Maybe Bool),Maybe (Maybe Char))"
,"tests :: IO ()"
,"tests = do"] ++
@@ -62,12 +65,14 @@
writeFileBinaryChanged :: FilePath -> String -> IO ()
writeFileBinaryChanged file x = do
evaluate $ length x -- ensure we don't write out files with _|_ in them
- old <- ifM (doesFileExist file) (Just <$> readFileBinary' file) (return
Nothing)
+ old <- ifM (doesFileExist file) (Just <$> readFileBinary' file) (pure
Nothing)
when (Just x /= old) $
writeFileBinary file x
hidden :: String -> [String]
-hidden "Data.List.NonEmpty.Extra" = ["cons", "snoc", "sortOn", "union",
"unionBy"]
+hidden "Data.List.NonEmpty.Extra" = [ "cons", "snoc", "sortOn", "union",
"unionBy"
+ , "nubOrd", "nubOrdBy", "nubOrdOn"
+ ]
hidden _ = []
notHidden :: String -> String -> Bool
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/extra.cabal new/extra-1.7.1/extra.cabal
--- old/extra-1.6.20/extra.cabal 2020-02-16 14:17:19.000000000 +0100
+++ new/extra-1.7.1/extra.cabal 2020-03-10 23:59:36.000000000 +0100
@@ -1,7 +1,7 @@
cabal-version: >= 1.18
build-type: Simple
name: extra
-version: 1.6.20
+version: 1.7.1
license: BSD3
license-file: LICENSE
category: Development
@@ -73,7 +73,8 @@
directory,
filepath,
extra,
- QuickCheck >= 2.10
+ QuickCheck >= 2.10,
+ quickcheck-instances >= 0.3.17
if !os(windows)
build-depends: unix
hs-source-dirs: test
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/src/Control/Concurrent/Extra.hs
new/extra-1.7.1/src/Control/Concurrent/Extra.hs
--- old/extra-1.6.20/src/Control/Concurrent/Extra.hs 2020-02-16
13:45:13.000000000 +0100
+++ new/extra-1.7.1/src/Control/Concurrent/Extra.hs 2020-02-28
10:29:17.000000000 +0100
@@ -46,23 +46,23 @@
-- If the function raises an exception, the same exception will be reraised
each time.
--
-- > let x ||| y = do t1 <- onceFork x; t2 <- onceFork y; t1; t2
--- > \(x :: IO Int) -> void (once x) == return ()
+-- > \(x :: IO Int) -> void (once x) == pure ()
-- > \(x :: IO Int) -> join (once x) == x
-- > \(x :: IO Int) -> (do y <- once x; y; y) == x
-- > \(x :: IO Int) -> (do y <- once x; y ||| y) == x
once :: IO a -> IO (IO a)
once act = do
var <- newVar OncePending
- let run = either throwIO return
- return $ mask $ \unmask -> join $ modifyVar var $ \v -> case v of
- OnceDone x -> return (v, unmask $ run x)
- OnceRunning x -> return (v, unmask $ run =<< waitBarrier x)
+ let run = either throwIO pure
+ pure $ mask $ \unmask -> join $ modifyVar var $ \v -> case v of
+ OnceDone x -> pure (v, unmask $ run x)
+ OnceRunning x -> pure (v, unmask $ run =<< waitBarrier x)
OncePending -> do
b <- newBarrier
- return $ (OnceRunning b,) $ do
+ pure $ (OnceRunning b,) $ do
res <- try_ $ unmask act
signalBarrier b res
- modifyVar_ var $ \_ -> return $ OnceDone res
+ modifyVar_ var $ \_ -> pure $ OnceDone res
run res
data Once a = OncePending | OnceRunning (Barrier a) | OnceDone a
@@ -76,7 +76,7 @@
onceFork act = do
bar <- newBarrier
forkFinally act $ signalBarrier bar
- return $ eitherM throwIO return $ waitBarrier bar
+ pure $ eitherM throwIO pure $ waitBarrier bar
---------------------------------------------------------------------
@@ -115,7 +115,7 @@
withLockTry (Lock m) act = bracket
(tryTakeMVar m)
(\v -> when (isJust v) $ putMVar m ())
- (\v -> if isJust v then fmap Just act else return Nothing)
+ (\v -> if isJust v then fmap Just act else pure Nothing)
---------------------------------------------------------------------
@@ -150,7 +150,7 @@
-- | Write a value to become the new value of 'Var'.
writeVar :: Var a -> a -> IO ()
-writeVar v x = modifyVar_ v $ const $ return x
+writeVar v x = modifyVar_ v $ const $ pure x
-- | Modify a 'Var' producing a new value and a return result.
modifyVar :: Var a -> (a -> IO (a, b)) -> IO b
@@ -195,7 +195,7 @@
signalBarrier :: Partial => Barrier a -> a -> IO ()
signalBarrier (Barrier var) v = mask_ $ -- use mask so never in an
inconsistent state
join $ modifyVar var $ \x -> case x of
- Left bar -> return (Right v, putMVar bar ())
+ Left bar -> pure (Right v, putMVar bar ())
Right res -> error "Control.Concurrent.Extra.signalBarrier, attempt to
signal a barrier that has already been signaled"
@@ -204,12 +204,12 @@
waitBarrier (Barrier var) = do
x <- readVar var
case x of
- Right res -> return res
+ Right res -> pure res
Left bar -> do
readMVar bar
x <- readVar var
case x of
- Right res -> return res
+ Right res -> pure res
Left bar -> error "Control.Concurrent.Extra, internal
invariant violated in Barrier"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/src/Control/Exception/Extra.hs
new/extra-1.7.1/src/Control/Exception/Extra.hs
--- old/extra-1.6.20/src/Control/Exception/Extra.hs 2019-08-23
14:45:24.000000000 +0200
+++ new/extra-1.7.1/src/Control/Exception/Extra.hs 2020-03-09
22:13:41.000000000 +0100
@@ -35,16 +35,16 @@
-- | Fully evaluate an input String. If the String contains embedded
exceptions it will produce @\<Exception\>@.
--
--- > stringException "test" == return "test"
--- > stringException ("test" ++ undefined) == return
"test<Exception>"
--- > stringException ("test" ++ undefined ++ "hello") == return
"test<Exception>"
--- > stringException ['t','e','s','t',undefined] == return
"test<Exception>"
+-- > stringException "test" == pure "test"
+-- > stringException ("test" ++ undefined) == pure "test<Exception>"
+-- > stringException ("test" ++ undefined ++ "hello") == pure "test<Exception>"
+-- > stringException ['t','e','s','t',undefined] == pure "test<Exception>"
stringException :: String -> IO String
stringException x = do
r <- try_ $ evaluate $ list [] (\x xs -> x `seq` x:xs) x
case r of
- Left e -> return "<Exception>"
- Right [] -> return []
+ Left e -> pure "<Exception>"
+ Right [] -> pure []
Right (x:xs) -> (x:) <$> stringException xs
@@ -66,7 +66,7 @@
-- | Ignore any exceptions thrown by the action.
--
-- > ignore (print 1) == print 1
--- > ignore (fail "die") == return ()
+-- > ignore (fail "die") == pure ()
ignore :: IO () -> IO ()
ignore = void . try_
@@ -74,8 +74,9 @@
-- | An 'IO' action that when evaluated calls 'error', in the 'IO' monad.
-- Note that while 'fail' in 'IO' raises an 'IOException', this function
raises an 'ErrorCall' exception with a call stack.
--
--- > catch (errorIO "Hello") (\(ErrorCall x) -> return x) == return "Hello"
+-- > catch (errorIO "Hello") (\(ErrorCall x) -> pure x) == pure "Hello"
-- > seq (errorIO "foo") (print 1) == print 1
+{-# NOINLINE errorIO #-} -- otherwise GHC 8.4.1 seems to get upset
errorIO :: Partial => String -> IO a
errorIO x = withFrozenCallStack $ evaluate $ error x
@@ -103,7 +104,7 @@
res <- tryBool p x
case res of
Left _ -> retryBool p (i-1) x
- Right v -> return v
+ Right v -> pure v
-- | A version of 'catch' without the 'Exception' context, restricted to
'SomeException',
@@ -135,7 +136,7 @@
-- As an example:
--
-- @
--- readFileExists x == catchBool isDoesNotExistError (readFile \"myfile\")
(const $ return \"\")
+-- readFileExists x == catchBool isDoesNotExistError (readFile \"myfile\")
(const $ pure \"\")
-- @
catchBool :: Exception e => (e -> Bool) -> IO a -> (e -> IO a) -> IO a
catchBool f a b = catchJust (bool f) a b
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/src/Control/Monad/Extra.hs
new/extra-1.7.1/src/Control/Monad/Extra.hs
--- old/extra-1.6.20/src/Control/Monad/Extra.hs 2020-02-16 13:46:02.000000000
+0100
+++ new/extra-1.7.1/src/Control/Monad/Extra.hs 2020-02-28 10:30:04.000000000
+0100
@@ -30,7 +30,7 @@
-- | Perform some operation on 'Just', given the field inside the 'Just'.
--
--- > whenJust Nothing print == return ()
+-- > whenJust Nothing print == pure ()
-- > whenJust (Just 1) print == print 1
whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
whenJust mg f = maybe (pure ()) f mg
@@ -38,14 +38,14 @@
-- | Like 'whenJust', but where the test can be monadic.
whenJustM :: Monad m => m (Maybe a) -> (a -> m ()) -> m ()
-- Can't reuse whenMaybe on GHC 7.8 or lower because Monad does not imply
Applicative
-whenJustM mg f = maybeM (return ()) f mg
+whenJustM mg f = maybeM (pure ()) f mg
-- | Like 'when', but return either 'Nothing' if the predicate was 'False',
-- of 'Just' with the result of the computation.
--
-- > whenMaybe True (print 1) == fmap Just (print 1)
--- > whenMaybe False (print 1) == return Nothing
+-- > whenMaybe False (print 1) == pure Nothing
whenMaybe :: Applicative m => Bool -> m a -> m (Maybe a)
whenMaybe b x = if b then Just <$> x else pure Nothing
@@ -54,7 +54,7 @@
-- Can't reuse whenMaybe on GHC 7.8 or lower because Monad does not imply
Applicative
whenMaybeM mb x = do
b <- mb
- if b then liftM Just x else return Nothing
+ if b then liftM Just x else pure Nothing
-- | The identity function which requires the inner argument to be @()@.
Useful for functions
@@ -89,7 +89,7 @@
-- | Like 'fold1M' but discards the result.
fold1M_ :: (Partial, Monad m) => (a -> a -> m a) -> [a] -> m ()
-fold1M_ f xs = fold1M f xs >> return ()
+fold1M_ f xs = fold1M f xs >> pure ()
-- Data.List for Monad
@@ -99,18 +99,18 @@
-- > partitionM (Just . even) [1,2,3] == Just ([2], [1,3])
-- > partitionM (const Nothing) [1,2,3] == Nothing
partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
-partitionM f [] = return ([], [])
+partitionM f [] = pure ([], [])
partitionM f (x:xs) = do
res <- f x
(as,bs) <- partitionM f xs
- return ([x | res]++as, [x | not res]++bs)
+ pure ([x | res]++as, [x | not res]++bs)
-- | A version of 'concatMap' that works with a monadic predicate.
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
{-# INLINE concatMapM #-}
-concatMapM op = foldr f (return [])
- where f x xs = do x <- op x; if null x then xs else do xs <- xs; return $
x++xs
+concatMapM op = foldr f (pure [])
+ where f x xs = do x <- op x; if null x then xs else do xs <- xs; pure $
x++xs
-- | Like 'concatMapM', but has its arguments flipped, so can be used
-- instead of the common @fmap concat $ forM@ pattern.
@@ -124,8 +124,8 @@
-- | A version of 'mapMaybe' that works with a monadic predicate.
mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
{-# INLINE mapMaybeM #-}
-mapMaybeM op = foldr f (return [])
- where f x xs = do x <- op x; case x of Nothing -> xs; Just x -> do xs <-
xs; return $ x:xs
+mapMaybeM op = foldr f (pure [])
+ where f x xs = do x <- op x; case x of Nothing -> xs; Just x -> do xs <-
xs; pure $ x:xs
-- Looping
@@ -145,7 +145,7 @@
res <- act x
case res of
Left x -> loopM act x
- Right v -> return v
+ Right v -> pure v
-- | Keep running an operation until it becomes 'False'. As an example:
--
@@ -164,11 +164,11 @@
-- | Like 'when', but where the test can be monadic.
whenM :: Monad m => m Bool -> m () -> m ()
-whenM b t = ifM b t (return ())
+whenM b t = ifM b t (pure ())
-- | Like 'unless', but where the test can be monadic.
unlessM :: Monad m => m Bool -> m () -> m ()
-unlessM b f = ifM b (return ()) f
+unlessM b f = ifM b (pure ()) f
-- | Like @if@, but where the test can be monadic.
ifM :: Monad m => m Bool -> m a -> m a -> m a
@@ -186,7 +186,7 @@
-- > Just False ||^ Just True == Just True
-- > Just False ||^ Just False == Just False
(||^) :: Monad m => m Bool -> m Bool -> m Bool
-(||^) a b = ifM a (return True) b
+(||^) a b = ifM a (pure True) b
-- | The lazy '&&' operator lifted to a monad. If the first
-- argument evaluates to 'False' the second argument will not
@@ -196,7 +196,7 @@
-- > Just True &&^ Just True == Just True
-- > Just True &&^ Just False == Just False
(&&^) :: Monad m => m Bool -> m Bool -> m Bool
-(&&^) a b = ifM a b (return False)
+(&&^) a b = ifM a b (pure False)
-- | A version of 'any' lifted to a monad. Retains the short-circuiting
behaviour.
--
@@ -204,7 +204,7 @@
-- > anyM Just [False,False,undefined] == undefined
-- > \(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs)
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
-anyM p = foldr ((||^) . p) (return False)
+anyM p = foldr ((||^) . p) (pure False)
-- | A version of 'all' lifted to a monad. Retains the short-circuiting
behaviour.
--
@@ -212,7 +212,7 @@
-- > allM Just [True,True ,undefined] == undefined
-- > \(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs)
allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
-allM p = foldr ((&&^) . p) (return True)
+allM p = foldr ((&&^) . p) (pure True)
-- | A version of 'or' lifted to a monad. Retains the short-circuiting
behaviour.
--
@@ -238,9 +238,9 @@
-- > findM (Just . isUpper) "test" == Just Nothing
-- > findM (Just . const True) ["x",undefined] == Just (Just "x")
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
-findM p = foldr (\x -> ifM (p x) (return $ Just x)) (return Nothing)
+findM p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
-- | Like 'findM', but also allows you to compute some additional information
in the predicate.
firstJustM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
-firstJustM p [] = return Nothing
-firstJustM p (x:xs) = maybeM (firstJustM p xs) (return . Just) (p x)
+firstJustM p [] = pure Nothing
+firstJustM p (x:xs) = maybeM (firstJustM p xs) (pure . Just) (p x)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/src/Data/List/Extra.hs
new/extra-1.7.1/src/Data/List/Extra.hs
--- old/extra-1.6.20/src/Data/List/Extra.hs 2020-02-16 13:43:54.000000000
+0100
+++ new/extra-1.7.1/src/Data/List/Extra.hs 2020-03-05 10:10:35.000000000
+0100
@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections, BangPatterns, ConstraintKinds #-}
+{-# LANGUAGE TupleSections, ConstraintKinds #-}
-- | This module extends "Data.List" with extra functions of a similar nature.
-- The package also exports the existing "Data.List" functions.
@@ -29,7 +29,7 @@
nubSort, nubSortBy, nubSortOn,
maximumOn, minimumOn,
disjoint, allSame, anySame,
- repeatedly, for, firstJust,
+ repeatedly, firstJust,
concatUnzip, concatUnzip3,
zipFrom, zipWithFrom,
replace, merge, mergeBy,
@@ -59,13 +59,6 @@
where (b, as') = f as
--- | /DEPRECATED/ Use @flip map@ directly, since this function clashes with
@Data.Traversable.for@.
---
--- Flipped version of 'map'.
-{-# DEPRECATED for "Use flip map directly, since this function clashes with
Data.Traversable.for" #-}
-for :: [a] -> (a -> b) -> [b]
-for = flip map
-
-- | Are two lists disjoint, with no elements in common.
--
-- > disjoint [1,2,3] [4,5] == True
@@ -211,20 +204,18 @@
-- Never truncates the output - raises an error if the enumeration runs out.
--
-- > \i xs -> zip [i..] xs == zipFrom i xs
--- > zipFrom False [1..3] == undefined
-zipFrom :: (Partial, Enum a) => a -> [b] -> [(a, b)]
+-- > zipFrom False [1..3] == [(False,1),(True, 2)]
+zipFrom :: Enum a => a -> [b] -> [(a, b)]
zipFrom = zipWithFrom (,)
-- | 'zipFrom' generalised to any combining operation.
-- Never truncates the output - raises an error if the enumeration runs out.
--
-- > \i xs -> zipWithFrom (,) i xs == zipFrom i xs
-zipWithFrom :: (Partial, Enum a) => (a -> b -> c) -> a -> [b] -> [c]
-zipWithFrom f a xs = go a xs
- where
- -- if we aren't strict in the accumulator, it's highly like to be a
space leak
- go !a [] = []
- go !a (x:xs) = f a x : go (succ a) xs
+zipWithFrom :: Enum a => (a -> b -> c) -> a -> [b] -> [c]
+-- would love to deforest the intermediate [a..] list
+-- but would require Bounded and Eq as well, so better go for simplicit
+zipWithFrom f a = zipWith f [a..]
-- | A merging of 'unzip' and 'concat'.
@@ -377,10 +368,13 @@
where (.*.) `on2` f = \x -> let fx = f x in \y -> fx .*. f y
--- | A version of 'nub' where the equality is done on some extracted value.
+-- | /DEPRECATED/ Use 'nubOrdOn', since this function is _O(n^2)_.
+--
+-- A version of 'nub' where the equality is done on some extracted value.
-- @nubOn f@ is equivalent to @nubBy ((==) `on` f)@, but has the
-- performance advantage of only evaluating @f@ once for each element in the
-- input list.
+{-# DEPRECATED nubOn "Use nubOrdOn, since this function is O(n^2)" #-}
nubOn :: Eq b => (a -> b) -> [a] -> [a]
nubOn f = map snd . nubBy ((==) `on` fst) . map (\x -> let y = f x in y `seq`
(y, x))
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/src/Data/List/NonEmpty/Extra.hs
new/extra-1.7.1/src/Data/List/NonEmpty/Extra.hs
--- old/extra-1.6.20/src/Data/List/NonEmpty/Extra.hs 2019-04-22
20:25:59.000000000 +0200
+++ new/extra-1.7.1/src/Data/List/NonEmpty/Extra.hs 2020-03-02
10:33:57.000000000 +0100
@@ -7,11 +7,12 @@
(|:), (|>), snoc,
appendl, appendr,
sortOn, union, unionBy,
+ nubOrd, nubOrdBy, nubOrdOn,
maximum1, minimum1, maximumBy1, minimumBy1, maximumOn1, minimumOn1
) where
import Data.Function
-import qualified Data.List as List
+import qualified Data.List.Extra as List
import Data.List.NonEmpty
#if __GLASGOW_HASKELL__ <= 802
@@ -62,6 +63,25 @@
union :: Eq a => NonEmpty a -> NonEmpty a -> NonEmpty a
union = unionBy (==)
+-- | @nubOrd@ for 'NonEmpty'. Behaves the same as 'Data.List.Extra.nubOrd'.
+--
+-- > Data.List.NonEmpty.Extra.nubOrd (1 :| [2, 3, 3, 4, 1, 2]) == 1 :| [2, 3,
4]
+-- > \xs -> Data.List.NonEmpty.Extra.nubOrd xs == Data.List.NonEmpty.Extra.nub
xs
+nubOrd :: Ord a => NonEmpty a -> NonEmpty a
+nubOrd = nubOrdBy compare
+
+-- | @nubOrdBy@ for 'NonEmpty'. Behaves the same as 'Data.List.Extra.nubOrdBy'.
+--
+-- > Data.List.NonEmpty.Extra.nubOrdBy (compare `on` Data.List.length) ("a" :|
["test","of","this"]) == "a" :| ["test","of"]
+nubOrdBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
+nubOrdBy cmp = fromList . List.nubOrdBy cmp . toList
+
+-- | @nubOrdOn@ for 'NonEmpty'. Behaves the same as 'Data.List.Extra.nubOrdOn'.
+--
+-- > Data.List.NonEmpty.Extra.nubOrdOn Data.List.length ("a" :|
["test","of","this"]) == "a" :| ["test","of"]
+nubOrdOn :: Ord b => (a -> b) -> NonEmpty a -> NonEmpty a
+nubOrdOn f = fromList . List.nubOrdOn f . toList
+
-- | The non-overloaded version of 'union'.
unionBy :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a -> NonEmpty a
unionBy eq xs ys = fromList $ List.unionBy eq (toList xs) (toList ys)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/src/Extra.hs
new/extra-1.7.1/src/Extra.hs
--- old/extra-1.6.20/src/Extra.hs 2020-02-16 12:34:30.000000000 +0100
+++ new/extra-1.7.1/src/Extra.hs 2020-03-05 10:10:08.000000000 +0100
@@ -23,7 +23,7 @@
writeIORef', atomicWriteIORef', atomicModifyIORef_, atomicModifyIORef'_,
-- * Data.List.Extra
-- | Extra functions available in @"Data.List.Extra"@.
- lower, upper, trim, trimStart, trimEnd, word1, line1, escapeHTML,
escapeJSON, unescapeHTML, unescapeJSON, dropEnd, takeEnd, splitAtEnd, breakEnd,
spanEnd, dropWhileEnd', takeWhileEnd, stripSuffix, stripInfix, stripInfixEnd,
dropPrefix, dropSuffix, wordsBy, linesBy, breakOn, breakOnEnd, splitOn, split,
chunksOf, headDef, lastDef, notNull, list, unsnoc, cons, snoc, drop1, dropEnd1,
mconcatMap, enumerate, groupSort, groupSortOn, groupSortBy, nubOrd, nubOrdBy,
nubOrdOn, nubOn, groupOn, nubSort, nubSortBy, nubSortOn, maximumOn, minimumOn,
disjoint, allSame, anySame, repeatedly, for, firstJust, concatUnzip,
concatUnzip3, zipFrom, zipWithFrom, replace, merge, mergeBy,
+ lower, upper, trim, trimStart, trimEnd, word1, line1, escapeHTML,
escapeJSON, unescapeHTML, unescapeJSON, dropEnd, takeEnd, splitAtEnd, breakEnd,
spanEnd, dropWhileEnd', takeWhileEnd, stripSuffix, stripInfix, stripInfixEnd,
dropPrefix, dropSuffix, wordsBy, linesBy, breakOn, breakOnEnd, splitOn, split,
chunksOf, headDef, lastDef, notNull, list, unsnoc, cons, snoc, drop1, dropEnd1,
mconcatMap, enumerate, groupSort, groupSortOn, groupSortBy, nubOrd, nubOrdBy,
nubOrdOn, nubOn, groupOn, nubSort, nubSortBy, nubSortOn, maximumOn, minimumOn,
disjoint, allSame, anySame, repeatedly, firstJust, concatUnzip, concatUnzip3,
zipFrom, zipWithFrom, replace, merge, mergeBy,
-- * Data.List.NonEmpty.Extra
-- | Extra functions available in @"Data.List.NonEmpty.Extra"@.
(|:), (|>), appendl, appendr, maximum1, minimum1, maximumBy1, minimumBy1,
maximumOn1, minimumOn1,
@@ -59,7 +59,7 @@
import Data.Either.Extra
import Data.IORef.Extra
import Data.List.Extra
-import Data.List.NonEmpty.Extra hiding (cons, snoc, sortOn, union, unionBy)
+import Data.List.NonEmpty.Extra hiding (cons, snoc, sortOn, union, unionBy,
nubOrd, nubOrdBy, nubOrdOn)
import Data.Tuple.Extra
import Data.Version.Extra
import Numeric.Extra
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/src/System/Directory/Extra.hs
new/extra-1.7.1/src/System/Directory/Extra.hs
--- old/extra-1.6.20/src/System/Directory/Extra.hs 2018-05-24
16:54:16.000000000 +0200
+++ new/extra-1.7.1/src/System/Directory/Extra.hs 2020-02-28
10:28:02.000000000 +0100
@@ -52,12 +52,12 @@
--
-- > withTempDir $ \dir -> do writeFile (dir </> "test.txt") ""; (== [dir </>
"test.txt"]) <$> listContents dir
-- > let touch = mapM_ $ \x -> createDirectoryIfMissing True (takeDirectory x)
>> writeFile x ""
--- > let listTest op as bs = withTempDir $ \dir -> do touch $ map (dir </>)
as; res <- op dir; return $ map (drop (length dir + 1)) res == bs
+-- > let listTest op as bs = withTempDir $ \dir -> do touch $ map (dir </>)
as; res <- op dir; pure $ map (drop (length dir + 1)) res == bs
-- > listTest listContents ["bar.txt","foo/baz.txt","zoo"]
["bar.txt","foo","zoo"]
listContents :: FilePath -> IO [FilePath]
listContents dir = do
xs <- getDirectoryContents dir
- return $ sort [dir </> x | x <- xs, not $ all (== '.') x]
+ pure $ sort [dir </> x | x <- xs, not $ all (== '.') x]
-- | Like 'listContents', but only returns the directories in a directory, not
the files.
@@ -81,21 +81,21 @@
--
-- > listTest listFilesRecursive ["bar.txt","zoo","foo" </> "baz.txt"]
["bar.txt","zoo","foo" </> "baz.txt"]
listFilesRecursive :: FilePath -> IO [FilePath]
-listFilesRecursive = listFilesInside (const $ return True)
+listFilesRecursive = listFilesInside (const $ pure True)
-- | Like 'listFilesRecursive', but with a predicate to decide where to
recurse into.
-- Typically directories starting with @.@ would be ignored. The initial
argument directory
-- will have the test applied to it.
--
--- > listTest (listFilesInside $ return . not . isPrefixOf "." . takeFileName)
+-- > listTest (listFilesInside $ pure . not . isPrefixOf "." . takeFileName)
-- > ["bar.txt","foo" </> "baz.txt",".foo" </> "baz2.txt", "zoo"]
["bar.txt","zoo","foo" </> "baz.txt"]
--- > listTest (listFilesInside $ const $ return False) ["bar.txt"] []
+-- > listTest (listFilesInside $ const $ pure False) ["bar.txt"] []
listFilesInside :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
-listFilesInside test dir = ifM (notM $ test $ dropTrailingPathSeparator dir)
(return []) $ do
+listFilesInside test dir = ifM (notM $ test $ dropTrailingPathSeparator dir)
(pure []) $ do
(dirs,files) <- partitionM doesDirectoryExist =<< listContents dir
rest <- concatMapM (listFilesInside test) dirs
- return $ files ++ rest
+ pure $ files ++ rest
-- | Create a directory with permissions so that only the current user can
view it.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/src/System/IO/Extra.hs
new/extra-1.7.1/src/System/IO/Extra.hs
--- old/extra-1.6.20/src/System/IO/Extra.hs 2018-12-07 12:00:59.000000000
+0100
+++ new/extra-1.7.1/src/System/IO/Extra.hs 2020-02-28 10:28:02.000000000
+0100
@@ -66,7 +66,7 @@
hGetContents' h = do
s <- hGetContents h
void $ evaluate $ length s
- return s
+ pure s
-- | A strict version of 'readFile'. When the string is produced, the entire
-- file will have been read into memory and the file handle will have been
closed.
@@ -112,7 +112,7 @@
-- | Capture the 'stdout' and 'stderr' of a computation.
--
--- > captureOutput (print 1) == return ("1\n",())
+-- > captureOutput (print 1) == pure ("1\n",())
captureOutput :: IO a -> IO (String, a)
captureOutput act = withTempFile $ \file ->
withFile file ReadWriteMode $ \h -> do
@@ -120,7 +120,7 @@
hClose h
act
out <- readFile' file
- return (out, res)
+ pure (out, res)
where
clone out h act = do
buf <- hGetBuffering out
@@ -166,13 +166,13 @@
newTempFileWithin tmpdir = do
file <- create
del <- once $ ignore $ removeFile file
- return (file, del)
+ pure (file, del)
where
create = do
val <- tempUnique
(file, h) <- retryBool (\(_ :: IOError) -> True) 5 $ openTempFile
tmpdir $ "extra-file-" ++ show val ++ "-"
hClose h
- return file
+ pure file
-- | Create a temporary file in the temporary directory. The file will be
deleted
@@ -180,9 +180,9 @@
-- The 'FilePath' will not have any file extension, will exist, and will be
zero bytes long.
-- If you require a file with a specific name, use 'withTempDir'.
--
--- > withTempFile doesFileExist == return True
--- > (doesFileExist =<< withTempFile return) == return False
--- > withTempFile readFile' == return ""
+-- > withTempFile doesFileExist == pure True
+-- > (doesFileExist =<< withTempFile pure) == pure False
+-- > withTempFile readFile' == pure ""
withTempFile :: (FilePath -> IO a) -> IO a
withTempFile act = do
(file, del) <- newTempFile
@@ -200,22 +200,22 @@
newTempDirWithin tmpdir = do
dir <- retryBool (\(_ :: IOError) -> True) 5 $ create tmpdir
del <- once $ ignore $ removeDirectoryRecursive dir
- return (dir, del)
+ pure (dir, del)
where
create tmpdir = do
v <- tempUnique
let dir = tmpdir </> "extra-dir-" ++ show v
catchBool isAlreadyExistsError
- (createDirectoryPrivate dir >> return dir) $
+ (createDirectoryPrivate dir >> pure dir) $
\_ -> create tmpdir
-- | Create a temporary directory inside the system temporary directory.
-- The directory will be deleted after the action completes.
--
--- > withTempDir doesDirectoryExist == return True
--- > (doesDirectoryExist =<< withTempDir return) == return False
--- > withTempDir listFiles == return []
+-- > withTempDir doesDirectoryExist == pure True
+-- > (doesDirectoryExist =<< withTempDir pure) == pure False
+-- > withTempDir listFiles == pure []
withTempDir :: (FilePath -> IO a) -> IO a
withTempDir act = do
(dir,del) <- newTempDir
@@ -235,8 +235,8 @@
r1 <- hGetBuf h1 b1 bufsz
r2 <- hGetBuf h2 b2 bufsz
if r1 == 0
- then return $ r2 == 0
- else return (r1 == r2) &&^ bufeq b1 b2 r1 &&^ eq b1 b2
+ then pure $ r2 == 0
+ else pure (r1 == r2) &&^ bufeq b1 b2 r1 &&^ eq b1 b2
bufeq b1 b2 s = (==0) <$> memcmp b1 b2 (fromIntegral s)
withb = allocaBytesAligned bufsz 4096
bufsz = 64*1024
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/src/System/Process/Extra.hs
new/extra-1.7.1/src/System/Process/Extra.hs
--- old/extra-1.6.20/src/System/Process/Extra.hs 2018-05-23
08:09:48.000000000 +0200
+++ new/extra-1.7.1/src/System/Process/Extra.hs 2020-02-28 10:28:02.000000000
+0100
@@ -40,4 +40,4 @@
(res,out) <- systemOutput x
when (res /= ExitSuccess) $
error $ "Failed when running system command: " ++ x
- return out
+ pure out
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/src/System/Time/Extra.hs
new/extra-1.7.1/src/System/Time/Extra.hs
--- old/extra-1.6.20/src/System/Time/Extra.hs 2018-09-04 22:17:51.000000000
+0200
+++ new/extra-1.7.1/src/System/Time/Extra.hs 2020-02-28 10:28:02.000000000
+0100
@@ -26,18 +26,18 @@
-- | Sleep for a number of seconds.
--
--- > fmap (round . fst) (duration $ sleep 1) == return 1
+-- > fmap (round . fst) (duration $ sleep 1) == pure 1
sleep :: Seconds -> IO ()
sleep = loopM $ \s ->
-- important to handle both overflow and underflow vs Int
if s < 0 then
- return $ Right ()
+ pure $ Right ()
else if s > 2000 then do
threadDelay 2000000000 -- 2000 * 1e6
- return $ Left $ s - 2000
+ pure $ Left $ s - 2000
else do
threadDelay $ ceiling $ s * 1000000
- return $ Right ()
+ pure $ Right ()
-- An internal type that is thrown as a dynamic exception to
@@ -52,19 +52,19 @@
-- overflows the bounds of an 'Int'. In addition, the bug that negative
-- timeouts run for ever has been fixed.
--
--- > timeout (-3) (print 1) == return Nothing
+-- > timeout (-3) (print 1) == pure Nothing
-- > timeout 0.1 (print 1) == fmap Just (print 1)
--- > do (t, _) <- duration $ timeout 0.1 $ sleep 1000; print t; return $ t < 1
--- > timeout 0.1 (sleep 2 >> print 1) == return Nothing
+-- > do (t, _) <- duration $ timeout 0.1 $ sleep 1000; print t; pure $ t < 1
+-- > timeout 0.1 (sleep 2 >> print 1) == pure Nothing
timeout :: Seconds -> IO a -> IO (Maybe a)
-- Copied from GHC with a few tweaks.
timeout n f
- | n <= 0 = return Nothing
+ | n <= 0 = pure Nothing
| otherwise = do
pid <- myThreadId
ex <- fmap Timeout newUnique
handleBool (== ex)
- (const $ return Nothing)
+ (const $ pure Nothing)
(bracket (forkIOWithUnmask $ \unmask -> unmask $ sleep n >>
throwTo pid ex)
killThread
(\_ -> fmap Just f))
@@ -90,13 +90,13 @@
-- | Call once to start, then call repeatedly to get the elapsed time since
the first call.
-- The time is guaranteed to be monotonic. This function is robust to system
time changes.
--
--- > do f <- offsetTime; xs <- replicateM 10 f; return $ xs == sort xs
+-- > do f <- offsetTime; xs <- replicateM 10 f; pure $ xs == sort xs
offsetTime :: IO (IO Seconds)
offsetTime = do
start <- time
- return $ do
+ pure $ do
end <- time
- return $ 1e-9 * fromIntegral (toNanoSecs $ end - start)
+ pure $ 1e-9 * fromIntegral (toNanoSecs $ end - start)
where time = getTime Monotonic
{-# DEPRECATED offsetTimeIncrease "Use 'offsetTime' instead, which is
guaranteed to always increase." #-}
@@ -107,10 +107,10 @@
-- | Record how long a computation takes in 'Seconds'.
--
--- > do (a,_) <- duration $ sleep 1; return $ a >= 1 && a <= 1.5
+-- > do (a,_) <- duration $ sleep 1; pure $ a >= 1 && a <= 1.5
duration :: IO a -> IO (Seconds, a)
duration act = do
time <- offsetTime
res <- act
time <- time
- return (time, res)
+ pure (time, res)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/test/TestCustom.hs
new/extra-1.7.1/test/TestCustom.hs
--- old/extra-1.6.20/test/TestCustom.hs 2017-11-24 11:40:53.000000000 +0100
+++ new/extra-1.7.1/test/TestCustom.hs 2020-02-28 10:28:02.000000000 +0100
@@ -16,14 +16,14 @@
testRaw "withTempFile" $ do
xs <- replicateM 4 $ onceFork $ do
- replicateM_ 100 $ withTempFile (const $ return ())
+ replicateM_ 100 $ withTempFile (const $ pure ())
putChar '.'
sequence_ xs
putStrLn "done"
testRaw "withTempDir" $ do
xs <- replicateM 4 $ onceFork $ do
- replicateM_ 100 $ withTempDir (const $ return ())
+ replicateM_ 100 $ withTempDir (const $ pure ())
putChar '.'
sequence_ xs
putStrLn "done"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/test/TestGen.hs
new/extra-1.7.1/test/TestGen.hs
--- old/extra-1.6.20/test/TestGen.hs 2020-02-16 12:34:30.000000000 +0100
+++ new/extra-1.7.1/test/TestGen.hs 2020-03-05 09:43:16.000000000 +0100
@@ -4,30 +4,33 @@
{-# LANGUAGE ExtendedDefaultRules, ScopedTypeVariables, ViewPatterns #-}
module TestGen(tests) where
import TestUtil
+import qualified Data.List
+import qualified Data.List.NonEmpty.Extra
+import Test.QuickCheck.Instances.Semigroup ()
default(Maybe Bool,Int,Double,Maybe (Maybe Bool),Maybe (Maybe Char))
tests :: IO ()
tests = do
let x ||| y = do t1 <- onceFork x; t2 <- onceFork y; t1; t2
- testGen "\\(x :: IO Int) -> void (once x) == return ()" $ \(x :: IO Int)
-> void (once x) == return ()
+ testGen "\\(x :: IO Int) -> void (once x) == pure ()" $ \(x :: IO Int) ->
void (once x) == pure ()
testGen "\\(x :: IO Int) -> join (once x) == x" $ \(x :: IO Int) -> join
(once x) == x
testGen "\\(x :: IO Int) -> (do y <- once x; y; y) == x" $ \(x :: IO Int)
-> (do y <- once x; y; y) == x
testGen "\\(x :: IO Int) -> (do y <- once x; y ||| y) == x" $ \(x :: IO
Int) -> (do y <- once x; y ||| y) == x
testGen "\\(x :: IO Int) -> join (onceFork x) == x" $ \(x :: IO Int) ->
join (onceFork x) == x
testGen "\\(x :: IO Int) -> (do a <- onceFork x; a; a) == x" $ \(x :: IO
Int) -> (do a <- onceFork x; a; a) == x
- testGen "stringException \"test\" == return
\"test\"" $ stringException "test" == return "test"
- testGen "stringException (\"test\" ++ undefined) == return
\"test<Exception>\"" $ stringException ("test" ++ undefined) ==
return "test<Exception>"
- testGen "stringException (\"test\" ++ undefined ++ \"hello\") == return
\"test<Exception>\"" $ stringException ("test" ++ undefined ++ "hello") ==
return "test<Exception>"
- testGen "stringException ['t','e','s','t',undefined] == return
\"test<Exception>\"" $ stringException ['t','e','s','t',undefined] ==
return "test<Exception>"
+ testGen "stringException \"test\" == pure
\"test\"" $ stringException "test" == pure "test"
+ testGen "stringException (\"test\" ++ undefined) == pure
\"test<Exception>\"" $ stringException ("test" ++ undefined) == pure
"test<Exception>"
+ testGen "stringException (\"test\" ++ undefined ++ \"hello\") == pure
\"test<Exception>\"" $ stringException ("test" ++ undefined ++ "hello") == pure
"test<Exception>"
+ testGen "stringException ['t','e','s','t',undefined] == pure
\"test<Exception>\"" $ stringException ['t','e','s','t',undefined] == pure
"test<Exception>"
testGen "ignore (print 1) == print 1" $ ignore (print 1) == print 1
- testGen "ignore (fail \"die\") == return ()" $ ignore (fail "die") ==
return ()
- testGen "catch (errorIO \"Hello\") (\\(ErrorCall x) -> return x) == return
\"Hello\"" $ catch (errorIO "Hello") (\(ErrorCall x) -> return x) == return
"Hello"
+ testGen "ignore (fail \"die\") == pure ()" $ ignore (fail "die") == pure ()
+ testGen "catch (errorIO \"Hello\") (\\(ErrorCall x) -> pure x) == pure
\"Hello\"" $ catch (errorIO "Hello") (\(ErrorCall x) -> pure x) == pure "Hello"
testGen "seq (errorIO \"foo\") (print 1) == print 1" $ seq (errorIO "foo")
(print 1) == print 1
testGen "retry 1 (print \"x\") == print \"x\"" $ retry 1 (print "x") ==
print "x"
testGen "retry 3 (fail \"die\") == fail \"die\"" $ retry 3 (fail "die") ==
fail "die"
- testGen "whenJust Nothing print == return ()" $ whenJust Nothing print
== return ()
+ testGen "whenJust Nothing print == pure ()" $ whenJust Nothing print ==
pure ()
testGen "whenJust (Just 1) print == print 1" $ whenJust (Just 1) print ==
print 1
testGen "whenMaybe True (print 1) == fmap Just (print 1)" $ whenMaybe
True (print 1) == fmap Just (print 1)
- testGen "whenMaybe False (print 1) == return Nothing" $ whenMaybe False
(print 1) == return Nothing
+ testGen "whenMaybe False (print 1) == pure Nothing" $ whenMaybe False
(print 1) == pure Nothing
testGen "\\(x :: Maybe ()) -> unit x == x" $ \(x :: Maybe ()) -> unit x ==
x
testGen "fold1M (\\x y -> Just x) [] == undefined" $ erroneous $ fold1M
(\x y -> Just x) []
testGen "fold1M (\\x y -> Just $ x + y) [1, 2, 3] == Just 6" $ fold1M (\x
y -> Just $ x + y) [1, 2, 3] == Just 6
@@ -125,7 +128,7 @@
testGen "\\i xs -> uncurry (++) (splitAt i xs) == xs" $ \i xs -> uncurry
(++) (splitAt i xs) == xs
testGen "\\i xs -> splitAtEnd i xs == (dropEnd i xs, takeEnd i xs)" $ \i
xs -> splitAtEnd i xs == (dropEnd i xs, takeEnd i xs)
testGen "\\i xs -> zip [i..] xs == zipFrom i xs" $ \i xs -> zip [i..] xs
== zipFrom i xs
- testGen "zipFrom False [1..3] == undefined" $ erroneous $ zipFrom False
[1..3]
+ testGen "zipFrom False [1..3] == [(False,1),(True, 2)]" $ zipFrom False
[1..3] == [(False,1),(True, 2)]
testGen "\\i xs -> zipWithFrom (,) i xs == zipFrom i xs" $ \i xs ->
zipWithFrom (,) i xs == zipFrom i xs
testGen "concatUnzip [(\"a\",\"AB\"),(\"bc\",\"C\")] == (\"abc\",\"ABC\")"
$ concatUnzip [("a","AB"),("bc","C")] == ("abc","ABC")
testGen "concatUnzip3 [(\"a\",\"AB\",\"\"),(\"bc\",\"C\",\"123\")] ==
(\"abc\",\"ABC\",\"123\")" $ concatUnzip3 [("a","AB",""),("bc","C","123")] ==
("abc","ABC","123")
@@ -243,6 +246,10 @@
testGen "appendl (1 :| [2,3]) [4,5] == 1 :| [2,3,4,5]" $ appendl (1 :|
[2,3]) [4,5] == 1 :| [2,3,4,5]
testGen "appendr [1,2,3] (4 :| [5]) == 1 :| [2,3,4,5]" $ appendr [1,2,3]
(4 :| [5]) == 1 :| [2,3,4,5]
testGen "(1 :| [3, 5, 3]) `union` (4 :| [5, 3, 5, 2]) == 1 :| [3, 5, 3, 4,
2]" $ (1 :| [3, 5, 3]) `union` (4 :| [5, 3, 5, 2]) == 1 :| [3, 5, 3, 4, 2]
+ testGen "Data.List.NonEmpty.Extra.nubOrd (1 :| [2, 3, 3, 4, 1, 2]) == 1 :|
[2, 3, 4]" $ Data.List.NonEmpty.Extra.nubOrd (1 :| [2, 3, 3, 4, 1, 2]) == 1 :|
[2, 3, 4]
+ testGen "\\xs -> Data.List.NonEmpty.Extra.nubOrd xs ==
Data.List.NonEmpty.Extra.nub xs" $ \xs -> Data.List.NonEmpty.Extra.nubOrd xs ==
Data.List.NonEmpty.Extra.nub xs
+ testGen "Data.List.NonEmpty.Extra.nubOrdBy (compare `on` Data.List.length)
(\"a\" :| [\"test\",\"of\",\"this\"]) == \"a\" :| [\"test\",\"of\"]" $
Data.List.NonEmpty.Extra.nubOrdBy (compare `on` Data.List.length) ("a" :|
["test","of","this"]) == "a" :| ["test","of"]
+ testGen "Data.List.NonEmpty.Extra.nubOrdOn Data.List.length (\"a\" :|
[\"test\",\"of\",\"this\"]) == \"a\" :| [\"test\",\"of\"]" $
Data.List.NonEmpty.Extra.nubOrdOn Data.List.length ("a" :|
["test","of","this"]) == "a" :| ["test","of"]
testGen "first succ (1,\"test\") == (2,\"test\")" $ first succ (1,"test")
== (2,"test")
testGen "second reverse (1,\"test\") == (1,\"tset\")" $ second reverse
(1,"test") == (1,"tset")
testGen "firstM (\\x -> [x-1, x+1]) (1,\"test\") ==
[(0,\"test\"),(2,\"test\")]" $ firstM (\x -> [x-1, x+1]) (1,"test") ==
[(0,"test"),(2,"test")]
@@ -259,38 +266,38 @@
testGen "withTempDir $ \\dir -> do writeFile (dir </> \"foo.txt\") \"\";
withCurrentDirectory dir $ doesFileExist \"foo.txt\"" $ withTempDir $ \dir ->
do writeFile (dir </> "foo.txt") ""; withCurrentDirectory dir $ doesFileExist
"foo.txt"
testGen "withTempDir $ \\dir -> do writeFile (dir </> \"test.txt\") \"\";
(== [dir </> \"test.txt\"]) <$> listContents dir" $ withTempDir $ \dir -> do
writeFile (dir </> "test.txt") ""; (== [dir </> "test.txt"]) <$> listContents
dir
let touch = mapM_ $ \x -> createDirectoryIfMissing True (takeDirectory x)
>> writeFile x ""
- let listTest op as bs = withTempDir $ \dir -> do touch $ map (dir </>) as;
res <- op dir; return $ map (drop (length dir + 1)) res == bs
+ let listTest op as bs = withTempDir $ \dir -> do touch $ map (dir </>) as;
res <- op dir; pure $ map (drop (length dir + 1)) res == bs
testGen "listTest listContents [\"bar.txt\",\"foo/baz.txt\",\"zoo\"]
[\"bar.txt\",\"foo\",\"zoo\"]" $ listTest listContents
["bar.txt","foo/baz.txt","zoo"] ["bar.txt","foo","zoo"]
testGen "listTest listDirectories [\"bar.txt\",\"foo/baz.txt\",\"zoo\"]
[\"foo\"]" $ listTest listDirectories ["bar.txt","foo/baz.txt","zoo"] ["foo"]
testGen "listTest listFiles [\"bar.txt\",\"foo/baz.txt\",\"zoo\"]
[\"bar.txt\",\"zoo\"]" $ listTest listFiles ["bar.txt","foo/baz.txt","zoo"]
["bar.txt","zoo"]
testGen "listTest listFilesRecursive [\"bar.txt\",\"zoo\",\"foo\" </>
\"baz.txt\"] [\"bar.txt\",\"zoo\",\"foo\" </> \"baz.txt\"]" $ listTest
listFilesRecursive ["bar.txt","zoo","foo" </> "baz.txt"] ["bar.txt","zoo","foo"
</> "baz.txt"]
- testGen "listTest (listFilesInside $ return . not . isPrefixOf \".\" .
takeFileName) [\"bar.txt\",\"foo\" </> \"baz.txt\",\".foo\" </>
\"baz2.txt\", \"zoo\"] [\"bar.txt\",\"zoo\",\"foo\" </> \"baz.txt\"]" $
listTest (listFilesInside $ return . not . isPrefixOf "." . takeFileName)
["bar.txt","foo" </> "baz.txt",".foo" </> "baz2.txt", "zoo"]
["bar.txt","zoo","foo" </> "baz.txt"]
- testGen "listTest (listFilesInside $ const $ return False) [\"bar.txt\"]
[]" $ listTest (listFilesInside $ const $ return False) ["bar.txt"] []
+ testGen "listTest (listFilesInside $ pure . not . isPrefixOf \".\" .
takeFileName) [\"bar.txt\",\"foo\" </> \"baz.txt\",\".foo\" </>
\"baz2.txt\", \"zoo\"] [\"bar.txt\",\"zoo\",\"foo\" </> \"baz.txt\"]" $
listTest (listFilesInside $ pure . not . isPrefixOf "." . takeFileName)
["bar.txt","foo" </> "baz.txt",".foo" </> "baz2.txt", "zoo"]
["bar.txt","zoo","foo" </> "baz.txt"]
+ testGen "listTest (listFilesInside $ const $ pure False) [\"bar.txt\"] []"
$ listTest (listFilesInside $ const $ pure False) ["bar.txt"] []
testGen "isWindows == (os == \"mingw32\")" $ isWindows == (os == "mingw32")
testGen "\\(filter isHexDigit -> s) -> fmap (== s) $ withTempFile $ \\file
-> do writeFile file s; readFile' file" $ \(filter isHexDigit -> s) -> fmap (==
s) $ withTempFile $ \file -> do writeFile file s; readFile' file
testGen "\\s -> withTempFile $ \\file -> do writeFileUTF8 file s; fmap (==
s) $ readFileUTF8' file" $ \s -> withTempFile $ \file -> do writeFileUTF8 file
s; fmap (== s) $ readFileUTF8' file
testGen "\\(ASCIIString s) -> withTempFile $ \\file -> do writeFileBinary
file s; fmap (== s) $ readFileBinary' file" $ \(ASCIIString s) -> withTempFile
$ \file -> do writeFileBinary file s; fmap (== s) $ readFileBinary' file
- testGen "captureOutput (print 1) == return (\"1\\n\",())" $ captureOutput
(print 1) == return ("1\n",())
- testGen "withTempFile doesFileExist == return True" $ withTempFile
doesFileExist == return True
- testGen "(doesFileExist =<< withTempFile return) == return False" $
(doesFileExist =<< withTempFile return) == return False
- testGen "withTempFile readFile' == return \"\"" $ withTempFile readFile'
== return ""
- testGen "withTempDir doesDirectoryExist == return True" $ withTempDir
doesDirectoryExist == return True
- testGen "(doesDirectoryExist =<< withTempDir return) == return False" $
(doesDirectoryExist =<< withTempDir return) == return False
- testGen "withTempDir listFiles == return []" $ withTempDir listFiles ==
return []
+ testGen "captureOutput (print 1) == pure (\"1\\n\",())" $ captureOutput
(print 1) == pure ("1\n",())
+ testGen "withTempFile doesFileExist == pure True" $ withTempFile
doesFileExist == pure True
+ testGen "(doesFileExist =<< withTempFile pure) == pure False" $
(doesFileExist =<< withTempFile pure) == pure False
+ testGen "withTempFile readFile' == pure \"\"" $ withTempFile readFile' ==
pure ""
+ testGen "withTempDir doesDirectoryExist == pure True" $ withTempDir
doesDirectoryExist == pure True
+ testGen "(doesDirectoryExist =<< withTempDir pure) == pure False" $
(doesDirectoryExist =<< withTempDir pure) == pure False
+ testGen "withTempDir listFiles == pure []" $ withTempDir listFiles == pure
[]
testGen "fileEq \"does_not_exist1\" \"does_not_exist2\" == undefined" $
erroneousIO $ fileEq "does_not_exist1" "does_not_exist2"
testGen "fileEq \"does_not_exist\" \"does_not_exist\" == undefined" $
erroneousIO $ fileEq "does_not_exist" "does_not_exist"
testGen "withTempFile $ \\f1 -> fileEq \"does_not_exist\" f1 == undefined"
$ erroneousIO $ withTempFile $ \f1 -> fileEq "does_not_exist" f1
testGen "withTempFile $ \\f1 -> withTempFile $ \\f2 -> fileEq f1 f2" $
withTempFile $ \f1 -> withTempFile $ \f2 -> fileEq f1 f2
testGen "withTempFile $ \\f1 -> withTempFile $ \\f2 -> writeFile f1 \"a\"
>> writeFile f2 \"a\" >> fileEq f1 f2" $ withTempFile $ \f1 -> withTempFile $
\f2 -> writeFile f1 "a" >> writeFile f2 "a" >> fileEq f1 f2
testGen "withTempFile $ \\f1 -> withTempFile $ \\f2 -> writeFile f1 \"a\"
>> writeFile f2 \"b\" >> notM (fileEq f1 f2)" $ withTempFile $ \f1 ->
withTempFile $ \f2 -> writeFile f1 "a" >> writeFile f2 "b" >> notM (fileEq f1
f2)
- testGen "fmap (round . fst) (duration $ sleep 1) == return 1" $ fmap
(round . fst) (duration $ sleep 1) == return 1
- testGen "timeout (-3) (print 1) == return Nothing" $ timeout (-3) (print
1) == return Nothing
+ testGen "fmap (round . fst) (duration $ sleep 1) == pure 1" $ fmap (round
. fst) (duration $ sleep 1) == pure 1
+ testGen "timeout (-3) (print 1) == pure Nothing" $ timeout (-3) (print 1)
== pure Nothing
testGen "timeout 0.1 (print 1) == fmap Just (print 1)" $ timeout 0.1
(print 1) == fmap Just (print 1)
- testGen "do (t, _) <- duration $ timeout 0.1 $ sleep 1000; print t; return
$ t < 1" $ do (t, _) <- duration $ timeout 0.1 $ sleep 1000; print t; return $
t < 1
- testGen "timeout 0.1 (sleep 2 >> print 1) == return Nothing" $ timeout
0.1 (sleep 2 >> print 1) == return Nothing
+ testGen "do (t, _) <- duration $ timeout 0.1 $ sleep 1000; print t; pure $
t < 1" $ do (t, _) <- duration $ timeout 0.1 $ sleep 1000; print t; pure $ t < 1
+ testGen "timeout 0.1 (sleep 2 >> print 1) == pure Nothing" $ timeout 0.1
(sleep 2 >> print 1) == pure Nothing
testGen "showDuration 3.435 == \"3.44s\"" $ showDuration 3.435 ==
"3.44s"
testGen "showDuration 623.8 == \"10m24s\"" $ showDuration 623.8 ==
"10m24s"
testGen "showDuration 62003.8 == \"17h13m\"" $ showDuration 62003.8 ==
"17h13m"
testGen "showDuration 1e8 == \"27777h47m\"" $ showDuration 1e8 ==
"27777h47m"
- testGen "do f <- offsetTime; xs <- replicateM 10 f; return $ xs == sort
xs" $ do f <- offsetTime; xs <- replicateM 10 f; return $ xs == sort xs
- testGen "do (a,_) <- duration $ sleep 1; return $ a >= 1 && a <= 1.5" $ do
(a,_) <- duration $ sleep 1; return $ a >= 1 && a <= 1.5
+ testGen "do f <- offsetTime; xs <- replicateM 10 f; pure $ xs == sort xs"
$ do f <- offsetTime; xs <- replicateM 10 f; pure $ xs == sort xs
+ testGen "do (a,_) <- duration $ sleep 1; pure $ a >= 1 && a <= 1.5" $ do
(a,_) <- duration $ sleep 1; pure $ a >= 1 && a <= 1.5
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/extra-1.6.20/test/TestUtil.hs
new/extra-1.7.1/test/TestUtil.hs
--- old/extra-1.6.20/test/TestUtil.hs 2020-02-11 23:14:17.000000000 +0100
+++ new/extra-1.7.1/test/TestUtil.hs 2020-02-28 10:28:02.000000000 +0100
@@ -46,7 +46,7 @@
testGen msg prop = testRaw msg $ do
r <- quickCheckResult prop
case r of
- Success{} -> return ()
+ Success{} -> pure ()
_ -> errorIO "Test failed"
testRaw :: String -> IO () -> IO ()
@@ -87,7 +87,7 @@
a == b = unsafePerformIO $ do
a <- try_ $ captureOutput a
b <- try_ $ captureOutput b
- if a == b then return True else
+ if a == b then pure True else
error $ show ("IO values not equal", a, b)
instance Show (IO a) where
@@ -96,10 +96,10 @@
instance Arbitrary a => Arbitrary (IO a) where
arbitrary = do
(prnt :: Maybe Int, thrw :: Maybe Int, res) <- arbitrary
- return $ do
+ pure $ do
whenJust prnt print
whenJust thrw (fail . show)
- return res
+ pure res
instance Eq SomeException where
a == b = show a == show b
