Hello community, here is the log from the commit of package ghc-extra for openSUSE:Leap:15.2 checked in at 2020-03-13 10:56:50 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Leap:15.2/ghc-extra (Old) and /work/SRC/openSUSE:Leap:15.2/.ghc-extra.new.3160 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-extra" Fri Mar 13 10:56:50 2020 rev:12 rq:782963 version:1.6.20 Changes: -------- --- /work/SRC/openSUSE:Leap:15.2/ghc-extra/ghc-extra.changes 2020-02-19 18:38:57.126011011 +0100 +++ /work/SRC/openSUSE:Leap:15.2/.ghc-extra.new.3160/ghc-extra.changes 2020-03-13 10:56:51.676412695 +0100 @@ -1,0 +2,9 @@ +Thu Feb 27 14:18:04 UTC 2020 - [email protected] + +- Update extra to version 1.6.20. + 1.6.20, released 2020-02-16 + Add firstM, secondM + 1.6.19, released 2020-02-11 + #50, add headDef, lastDef, and dropEnd1 + +------------------------------------------------------------------- Old: ---- extra-1.6.18.tar.gz New: ---- extra-1.6.20.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-extra.spec ++++++ --- /var/tmp/diff_new_pack.PD8uei/_old 2020-03-13 10:56:52.108413002 +0100 +++ /var/tmp/diff_new_pack.PD8uei/_new 2020-03-13 10:56:52.108413002 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-extra # -# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2020 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name extra %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.6.18 +Version: 1.6.20 Release: 0 Summary: Extra functions I use License: BSD-3-Clause ++++++ extra-1.6.18.tar.gz -> extra-1.6.20.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.6.18/CHANGES.txt new/extra-1.6.20/CHANGES.txt --- old/extra-1.6.18/CHANGES.txt 2019-08-21 14:58:59.000000000 +0200 +++ new/extra-1.6.20/CHANGES.txt 2020-02-16 14:17:13.000000000 +0100 @@ -1,5 +1,9 @@ Changelog for Extra +1.6.20, released 2020-02-16 + Add firstM, secondM +1.6.19, released 2020-02-11 + #50, add headDef, lastDef, and dropEnd1 1.6.18, released 2019-08-21 Make errorIO include a call stack Make maximumOn and minimumOn apply the function once per element diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.6.18/LICENSE new/extra-1.6.20/LICENSE --- old/extra-1.6.18/LICENSE 2019-02-25 16:47:08.000000000 +0100 +++ new/extra-1.6.20/LICENSE 2020-02-10 14:40:40.000000000 +0100 @@ -1,4 +1,4 @@ -Copyright Neil Mitchell 2014-2019. +Copyright Neil Mitchell 2014-2020. All rights reserved. Redistribution and use in source and binary forms, with or without diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.6.18/extra.cabal new/extra-1.6.20/extra.cabal --- old/extra-1.6.18/extra.cabal 2019-08-21 14:59:07.000000000 +0200 +++ new/extra-1.6.20/extra.cabal 2020-02-16 14:17:19.000000000 +0100 @@ -1,13 +1,13 @@ cabal-version: >= 1.18 build-type: Simple name: extra -version: 1.6.18 +version: 1.6.20 license: BSD3 license-file: LICENSE category: Development author: Neil Mitchell <[email protected]> maintainer: Neil Mitchell <[email protected]> -copyright: Neil Mitchell 2014-2019 +copyright: Neil Mitchell 2014-2020 synopsis: Extra functions I use. description: A library of extra functions for the standard Haskell libraries. Most functions are simple additions, filling out missing functionality. A few functions are available in later versions of GHC, but this package makes them available back to GHC 7.2. @@ -15,7 +15,7 @@ The module "Extra" documents all functions provided by this library. Modules such as "Data.List.Extra" provide extra functions over "Data.List" and also reexport "Data.List". Users are recommended to replace "Data.List" imports with "Data.List.Extra" if they need the extra functionality. homepage: https://github.com/ndmitchell/extra#readme bug-reports: https://github.com/ndmitchell/extra/issues -tested-with: GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3 +tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3 extra-doc-files: CHANGES.txt diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.6.18/src/Control/Concurrent/Extra.hs new/extra-1.6.20/src/Control/Concurrent/Extra.hs --- old/extra-1.6.18/src/Control/Concurrent/Extra.hs 2019-02-25 16:55:33.000000000 +0100 +++ new/extra-1.6.20/src/Control/Concurrent/Extra.hs 2020-02-16 13:45:13.000000000 +0100 @@ -76,7 +76,7 @@ onceFork act = do bar <- newBarrier forkFinally act $ signalBarrier bar - return $ either throwIO return =<< waitBarrier bar + return $ eitherM throwIO return $ waitBarrier bar --------------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.6.18/src/Control/Exception/Extra.hs new/extra-1.6.20/src/Control/Exception/Extra.hs --- old/extra-1.6.18/src/Control/Exception/Extra.hs 2019-08-21 16:07:02.000000000 +0200 +++ new/extra-1.6.20/src/Control/Exception/Extra.hs 2019-08-23 14:45:24.000000000 +0200 @@ -71,10 +71,11 @@ ignore = void . try_ --- | Like error, but in the 'IO' monad. +-- | 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" +-- > seq (errorIO "foo") (print 1) == print 1 errorIO :: Partial => String -> IO a errorIO x = withFrozenCallStack $ evaluate $ error x diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.6.18/src/Control/Monad/Extra.hs new/extra-1.6.20/src/Control/Monad/Extra.hs --- old/extra-1.6.18/src/Control/Monad/Extra.hs 2019-04-22 20:25:59.000000000 +0200 +++ new/extra-1.6.20/src/Control/Monad/Extra.hs 2020-02-16 13:46:02.000000000 +0100 @@ -38,7 +38,7 @@ -- | 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 = maybe (return ()) f =<< mg +whenJustM mg f = maybeM (return ()) f mg -- | Like 'when', but return either 'Nothing' if the predicate was 'False', @@ -72,7 +72,7 @@ -- | Monadic generalisation of 'fromMaybe'. fromMaybeM :: Monad m => m a -> m (Maybe a) -> m a -fromMaybeM n x = maybe n pure =<< x +fromMaybeM n x = maybeM n pure x -- | Monadic generalisation of 'either'. @@ -204,8 +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 [] = return False -anyM p (x:xs) = ifM (p x) (return True) (anyM p xs) +anyM p = foldr ((||^) . p) (return False) -- | A version of 'all' lifted to a monad. Retains the short-circuiting behaviour. -- @@ -213,8 +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 [] = return True -allM p (x:xs) = ifM (p x) (allM p xs) (return False) +allM p = foldr ((&&^) . p) (return True) -- | A version of 'or' lifted to a monad. Retains the short-circuiting behaviour. -- @@ -240,10 +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 [] = return Nothing -findM p (x:xs) = ifM (p x) (return $ Just x) (findM p xs) +findM p = foldr (\x -> ifM (p x) (return $ Just x)) (return 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) = maybe (firstJustM p xs) (return . Just) =<< p x +firstJustM p (x:xs) = maybeM (firstJustM p xs) (return . Just) (p x) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.6.18/src/Data/List/Extra.hs new/extra-1.6.20/src/Data/List/Extra.hs --- old/extra-1.6.18/src/Data/List/Extra.hs 2019-06-17 12:23:14.000000000 +0200 +++ new/extra-1.6.20/src/Data/List/Extra.hs 2020-02-16 13:43:54.000000000 +0100 @@ -18,7 +18,8 @@ wordsBy, linesBy, breakOn, breakOnEnd, splitOn, split, chunksOf, -- * Basics - notNull, list, unsnoc, cons, snoc, drop1, mconcatMap, + headDef, lastDef, notNull, list, unsnoc, cons, snoc, + drop1, dropEnd1, mconcatMap, -- * Enum operations enumerate, -- * List operations @@ -98,6 +99,26 @@ allSame (x:xs) = all (x ==) xs +-- | A total 'head' with a default value. +-- +-- > headDef 1 [] == 1 +-- > headDef 1 [2,3,4] == 2 +-- > \x xs -> headDef x xs == fromMaybe x (listToMaybe xs) +headDef :: a -> [a] -> a +headDef d [] = d +headDef _ (x:_) = x + + +-- | A total 'last' with a default value. +-- +-- > lastDef 1 [] == 1 +-- > lastDef 1 [2,3,4] == 4 +-- > \x xs -> lastDef x xs == last (x:xs) +lastDef :: a -> [a] -> a +lastDef d xs = foldl (\_ x -> x) d xs -- I know this looks weird, but apparently this is the fastest way to do this: https://hackage.haskell.org/package/base-4.12.0.0/docs/src/GHC.List.html#last +{-# INLINE lastDef #-} + + -- | A composition of 'not' and 'null'. -- -- > notNull [] == False @@ -268,7 +289,7 @@ -- > \s -> fst (word1 s) == concat (take 1 $ words s) -- > \s -> words (snd $ word1 s) == drop 1 (words s) word1 :: String -> (String, String) -word1 = second (dropWhile isSpace) . break isSpace . dropWhile isSpace +word1 = second trimStart . break isSpace . trimStart -- | Split the first line off a string. -- @@ -378,7 +399,7 @@ where mx = f x --- | A version of 'maximum' where the comparison is done on some extracted value. +-- | A version of 'minimum' where the comparison is done on some extracted value. -- Raises an error if the list is empty. Only calls the function once per element. -- -- > minimumOn id [] == undefined @@ -510,6 +531,16 @@ drop1 (x:xs) = xs +-- | Equivalent to @dropEnd 1@, but likely to be faster and a single lexeme. +-- +-- > dropEnd1 "" == "" +-- > dropEnd1 "test" == "tes" +-- > \xs -> dropEnd 1 xs == dropEnd1 xs +dropEnd1 :: [a] -> [a] +dropEnd1 [] = [] +dropEnd1 (x:xs) = foldr (\z f y -> y : f z) (const []) xs x + + -- | Version on `concatMap` generalised to a `Monoid` rather than just a list. -- -- > mconcatMap Sum [1,2,3] == Sum 6 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.6.18/src/Data/Tuple/Extra.hs new/extra-1.6.20/src/Data/Tuple/Extra.hs --- old/extra-1.6.18/src/Data/Tuple/Extra.hs 2018-09-24 22:43:08.000000000 +0200 +++ new/extra-1.6.20/src/Data/Tuple/Extra.hs 2020-02-16 12:34:16.000000000 +0100 @@ -1,3 +1,4 @@ +{-# LANGUAGE TupleSections #-} -- | Extra functions for working with pairs and triples. -- Some of these functions are available in the "Control.Arrow" module, @@ -8,6 +9,8 @@ first, second, (***), (&&&), -- * More pair operations dupe, both, + -- * Monadic versions + firstM, secondM, -- * Operations on triple fst3, snd3, thd3, curry3, uncurry3 @@ -30,6 +33,18 @@ second :: (b -> b') -> (a, b) -> (a, b') second = Arrow.second +-- | Update the first component of a pair. +-- +-- > firstM (\x -> [x-1, x+1]) (1,"test") == [(0,"test"),(2,"test")] +firstM :: Functor m => (a -> m a') -> (a, b) -> m (a', b) +firstM f (a,b) = (,b) <$> f a + +-- | Update the second component of a pair. +-- +-- > secondM (\x -> [reverse x, x]) (1,"test") == [(1,"tset"),(1,"test")] +secondM :: Functor m => (b -> m b') -> (a, b) -> m (a, b') +secondM f (a,b) = (a,) <$> f b + -- | Given two functions, apply one to the first component and one to the second. -- A specialised version of 'Control.Arrow.***'. -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.6.18/src/Extra.hs new/extra-1.6.20/src/Extra.hs --- old/extra-1.6.18/src/Extra.hs 2019-05-31 22:06:00.000000000 +0200 +++ new/extra-1.6.20/src/Extra.hs 2020-02-16 12:34:30.000000000 +0100 @@ -23,13 +23,13 @@ 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, notNull, list, unsnoc, cons, snoc, drop1, 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, for, 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, -- * Data.Tuple.Extra -- | Extra functions available in @"Data.Tuple.Extra"@. - first, second, (***), (&&&), dupe, both, fst3, snd3, thd3, curry3, uncurry3, + first, second, (***), (&&&), dupe, both, firstM, secondM, fst3, snd3, thd3, curry3, uncurry3, -- * Data.Version.Extra -- | Extra functions available in @"Data.Version.Extra"@. readVersion, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.6.18/test/TestGen.hs new/extra-1.6.20/test/TestGen.hs --- old/extra-1.6.18/test/TestGen.hs 2019-08-21 14:55:18.000000000 +0200 +++ new/extra-1.6.20/test/TestGen.hs 2020-02-16 12:34:30.000000000 +0100 @@ -21,6 +21,7 @@ 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 "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 () @@ -88,6 +89,12 @@ testGen "allSame [] == True" $ allSame [] == True testGen "allSame (1:1:2:undefined) == False" $ allSame (1:1:2:undefined) == False testGen "\\xs -> allSame xs == (length (nub xs) <= 1)" $ \xs -> allSame xs == (length (nub xs) <= 1) + testGen "headDef 1 [] == 1" $ headDef 1 [] == 1 + testGen "headDef 1 [2,3,4] == 2" $ headDef 1 [2,3,4] == 2 + testGen "\\x xs -> headDef x xs == fromMaybe x (listToMaybe xs)" $ \x xs -> headDef x xs == fromMaybe x (listToMaybe xs) + testGen "lastDef 1 [] == 1" $ lastDef 1 [] == 1 + testGen "lastDef 1 [2,3,4] == 4" $ lastDef 1 [2,3,4] == 4 + testGen "\\x xs -> lastDef x xs == last (x:xs)" $ \x xs -> lastDef x xs == last (x:xs) testGen "notNull [] == False" $ notNull [] == False testGen "notNull [1] == True" $ notNull [1] == True testGen "\\xs -> notNull xs == not (null xs)" $ \xs -> notNull xs == not (null xs) @@ -182,6 +189,9 @@ testGen "drop1 \"\" == \"\"" $ drop1 "" == "" testGen "drop1 \"test\" == \"est\"" $ drop1 "test" == "est" testGen "\\xs -> drop 1 xs == drop1 xs" $ \xs -> drop 1 xs == drop1 xs + testGen "dropEnd1 \"\" == \"\"" $ dropEnd1 "" == "" + testGen "dropEnd1 \"test\" == \"tes\"" $ dropEnd1 "test" == "tes" + testGen "\\xs -> dropEnd 1 xs == dropEnd1 xs" $ \xs -> dropEnd 1 xs == dropEnd1 xs testGen "mconcatMap Sum [1,2,3] == Sum 6" $ mconcatMap Sum [1,2,3] == Sum 6 testGen "\\f xs -> mconcatMap f xs == concatMap f xs" $ \f xs -> mconcatMap f xs == concatMap f xs testGen "breakOn \"::\" \"a::b::c\" == (\"a\", \"::b::c\")" $ breakOn "::" "a::b::c" == ("a", "::b::c") @@ -235,6 +245,8 @@ 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 "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")] + testGen "secondM (\\x -> [reverse x, x]) (1,\"test\") == [(1,\"tset\"),(1,\"test\")]" $ secondM (\x -> [reverse x, x]) (1,"test") == [(1,"tset"),(1,"test")] testGen "(succ *** reverse) (1,\"test\") == (2,\"tset\")" $ (succ *** reverse) (1,"test") == (2,"tset") testGen "(succ &&& pred) 1 == (2,0)" $ (succ &&& pred) 1 == (2,0) testGen "dupe 12 == (12, 12)" $ dupe 12 == (12, 12) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/extra-1.6.18/test/TestUtil.hs new/extra-1.6.20/test/TestUtil.hs --- old/extra-1.6.18/test/TestUtil.hs 2019-04-22 20:25:59.000000000 +0200 +++ new/extra-1.6.20/test/TestUtil.hs 2020-02-11 23:14:17.000000000 +0100 @@ -24,6 +24,7 @@ import Data.IORef.Extra as X import Data.List.Extra as X hiding (union, unionBy) import Data.List.NonEmpty.Extra as X (NonEmpty(..), (|>), (|:), appendl, appendr, union, unionBy) +import Data.Maybe as X import Data.Monoid as X import Data.Tuple.Extra as X import Data.Typeable.Extra as X
