extra 1.7.12 → 1.8.1
raw patch · 13 files changed
Files
- CHANGES.txt +20/−1
- Generate.hs +7/−2
- LICENSE +1/−1
- README.md +1/−1
- extra.cabal +4/−3
- src/Control/Monad/Extra.hs +53/−1
- src/Data/Foldable/Extra.hs +10/−0
- src/Data/List/Extra.hs +55/−16
- src/Data/List/NonEmpty/Extra.hs +41/−1
- src/Data/Monoid/Extra.hs +17/−0
- src/Extra.hs +6/−2
- test/TestGen.hs +12/−6
- test/TestUtil.hs +1/−1
CHANGES.txt view
@@ -1,5 +1,24 @@-Changelog for Extra+Changelog for Extra (* = breaking change) +1.8.1, released 2025-11-23+ #118, future proof for GHC 9.16 gaining nubOrd and nubOrdBy+ Test with GHC 9.12+1.8, released 2024-10-19+ #109, add guarded to lift predicates into Alternatives+* #112, make Data.List.Extra.compareLength work on list/int only+ #112, add compareLength to List.NonEmpty and Foldable+1.7.16, released 2024-05-11+ Fix to actually work with GHC 9.10+1.7.15, released 2024-05-10+ #111, work with GHC 9.10+ Test with GHC 9.8+1.7.14, released 2023-07-01+ #106, add compatibility with GHC 9.7+ #103, future-proof against addition of Data.List.unsnoc+1.7.13, released 2023-04-22+ #102, add mwhen :: Monoid a => Bool -> a -> a+ #99, make replace with an empty from intersperse the replacement+ #101, future-proof against addition of Data.List.!? 1.7.12, released 2022-09-02 #98, make both lazy in its argument #98, make first3,second3,third3 lazy in their argument
Generate.hs view
@@ -1,5 +1,9 @@ -- This module generates the files src/Extra.hs and test/TestGen.hs.--- Either call "runghc Generate" or start "ghci" and use ":generate".+-- Typical usage is run:+--+-- * `cabal test` to install the necessary packages+-- * `cabal exec ghci` to get into GHCi+-- * `:go` or `:generate` to run this generator module Generate(main) where @@ -47,6 +51,7 @@ ,"-- See Generate.hs for details of how to generate" ,"" ,"{-# LANGUAGE ExtendedDefaultRules, ScopedTypeVariables, TypeApplications, ViewPatterns #-}"+ ,"{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}" ,"module TestGen(tests) where" ,"import TestUtil" ,"import qualified Data.Ord"@@ -81,7 +86,7 @@ hidden :: String -> [String] hidden "Data.List.NonEmpty.Extra" = words- "cons snoc sortOn union unionBy nubOrd nubOrdBy nubOrdOn (!?) foldl1' repeatedly"+ "cons snoc sortOn union unionBy nubOrd nubOrdBy nubOrdOn (!?) foldl1' repeatedly compareLength" hidden _ = [] notHidden :: String -> String -> Bool
LICENSE view
@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2014-2022.+Copyright Neil Mitchell 2014-2025. All rights reserved. Redistribution and use in source and binary forms, with or without
README.md view
@@ -1,4 +1,4 @@-# Extra [](https://hackage.haskell.org/package/extra) [](https://www.stackage.org/package/extra) [](https://github.com/ndmitchell/extra/actions)+# Extra [](https://hackage.haskell.org/package/extra) [](https://www.stackage.org/package/extra) [](https://github.com/ndmitchell/extra/actions) 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.10. A few examples:
extra.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.18 build-type: Simple name: extra-version: 1.7.12+version: 1.8.1 license: BSD3 license-file: LICENSE category: Development author: Neil Mitchell <ndmitchell@gmail.com> maintainer: Neil Mitchell <ndmitchell@gmail.com>-copyright: Neil Mitchell 2014-2022+copyright: Neil Mitchell 2014-2025 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==9.0, GHC==8.10, GHC==8.8, GHC==8.6+tested-with: GHC==9.12, GHC==9.10, GHC==9.8, GHC==9.6, GHC==9.4, GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8 extra-doc-files: CHANGES.txt@@ -52,6 +52,7 @@ Data.IORef.Extra Data.List.Extra Data.List.NonEmpty.Extra+ Data.Monoid.Extra Data.Tuple.Extra Data.Typeable.Extra Data.Version.Extra
src/Control/Monad/Extra.hs view
@@ -11,6 +11,7 @@ whenMaybe, whenMaybeM, unit, maybeM, fromMaybeM, eitherM,+ guarded, guardedA, -- * Loops loop, loopM, whileM, whileJustM, untilJustM, -- * Lists@@ -34,10 +35,12 @@ -- -- > whenJust Nothing print == pure () -- > whenJust (Just 1) print == print 1+{-# INLINABLE whenJust #-} whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m () whenJust mg f = maybe (pure ()) f mg -- | Like 'whenJust', but where the test can be monadic.+{-# INLINABLE whenJustM #-} 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 (pure ()) f mg@@ -48,18 +51,21 @@ -- > pureIf @Maybe False 5 == Nothing -- > pureIf @[] True 5 == [5] -- > pureIf @[] False 5 == []+{-# INLINABLE pureIf #-} pureIf :: (Alternative m) => Bool -> a -> m a pureIf b a = if b then pure a else empty -- | Like 'when', but return either 'Nothing' if the predicate was 'False',--- of 'Just' with the result of the computation.+-- or 'Just' with the result of the computation. -- -- > whenMaybe True (print 1) == fmap Just (print 1) -- > whenMaybe False (print 1) == pure Nothing+{-# INLINABLE whenMaybe #-} whenMaybe :: Applicative m => Bool -> m a -> m (Maybe a) whenMaybe b x = if b then Just <$> x else pure Nothing -- | Like 'whenMaybe', but where the test can be monadic.+{-# INLINABLE whenMaybeM #-} whenMaybeM :: Monad m => m Bool -> m a -> m (Maybe a) -- Can't reuse whenMaybe on GHC 7.8 or lower because Monad does not imply Applicative whenMaybeM mb x = do@@ -70,33 +76,59 @@ -- with overloaded return types. -- -- > \(x :: Maybe ()) -> unit x == x+{-# INLINABLE unit #-} unit :: m () -> m () unit = id -- | Monadic generalisation of 'maybe'.+{-# INLINABLE maybeM #-} maybeM :: Monad m => m b -> (a -> m b) -> m (Maybe a) -> m b maybeM n j x = maybe n j =<< x -- | Monadic generalisation of 'fromMaybe'.+{-# INLINABLE fromMaybeM #-} fromMaybeM :: Monad m => m a -> m (Maybe a) -> m a fromMaybeM n x = maybeM n pure x -- | Monadic generalisation of 'either'.+{-# INLINABLE eitherM #-} eitherM :: Monad m => (a -> m c) -> (b -> m c) -> m (Either a b) -> m c eitherM l r x = either l r =<< x +-- | Either lifts a value into an alternative context or gives a+-- minimal value depending on a predicate. Works with 'Alternative's.+--+-- > guarded even 2 == [2]+-- > guarded odd 2 == Nothing+-- > guarded (not.null) "My Name" == Just "My Name"+{-# INLINABLE guarded #-}+guarded :: Alternative m => (a -> Bool) -> a -> m a+guarded pred x = if pred x then pure x else empty++-- | A variant of `guarded` using 'Functor'-wrapped values.+--+-- > guardedA (return . even) 42 == Just [42]+-- > guardedA (return . odd) 42 == Just []+-- > guardedA (const Nothing) 42 == (Nothing :: Maybe [Int])+{-# INLINABLE guardedA #-}+guardedA :: (Functor f, Alternative m) => (a -> f Bool) -> a -> f (m a)+guardedA pred x = fmap inner (pred x)+ where inner b = if b then pure x else empty+ -- | A variant of 'foldM' that has no base case, and thus may only be applied to non-empty lists. -- -- > fold1M (\x y -> Just x) [] == undefined -- > fold1M (\x y -> Just $ x + y) [1, 2, 3] == Just 6+{-# INLINABLE fold1M #-} fold1M :: (Partial, Monad m) => (a -> a -> m a) -> [a] -> m a fold1M f (x:xs) = foldM f x xs fold1M f xs = error "fold1M: empty list" -- | Like 'fold1M' but discards the result.+{-# INLINABLE fold1M_ #-} fold1M_ :: (Partial, Monad m) => (a -> a -> m a) -> [a] -> m () fold1M_ f xs = fold1M f xs >> pure () @@ -107,6 +139,7 @@ -- -- > partitionM (Just . even) [1,2,3] == Just ([2], [1,3]) -- > partitionM (const Nothing) [1,2,3] == Nothing+{-# INLINABLE partitionM #-} partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a]) partitionM f [] = pure ([], []) partitionM f (x:xs) = do@@ -123,10 +156,12 @@ -- | Like 'concatMapM', but has its arguments flipped, so can be used -- instead of the common @fmap concat $ forM@ pattern.+{-# INLINABLE concatForM #-} concatForM :: Monad m => [a] -> (a -> m [b]) -> m [b] concatForM = flip concatMapM -- | A version of 'mconcatMap' that works with a monadic predicate.+{-# INLINABLE mconcatMapM #-} mconcatMapM :: (Monad m, Monoid b) => (a -> m b) -> [a] -> m b mconcatMapM f = liftM mconcat . mapM f @@ -142,6 +177,7 @@ -- or 'Right' to abort the loop. -- -- > loop (\x -> if x < 10 then Left $ x * 2 else Right $ show x) 1 == "16"+{-# INLINABLE loop #-} loop :: (a -> Either a b) -> a -> b loop act x = case act x of Left x -> loop act x@@ -149,6 +185,7 @@ -- | A monadic version of 'loop', where the predicate returns 'Left' as a seed for the next loop -- or 'Right' to abort the loop.+{-# INLINABLE loopM #-} loopM :: Monad m => (a -> m (Either a b)) -> a -> m b loopM act x = do res <- act x@@ -164,6 +201,7 @@ -- @ -- -- If you need some state persisted between each test, use 'loopM'.+{-# INLINABLE whileM #-} whileM :: Monad m => m Bool -> m () whileM act = do b <- act@@ -171,6 +209,7 @@ -- | Keep running an operation until it becomes a 'Nothing', accumulating the -- monoid results inside the 'Just's as the result of the overall loop.+{-# INLINABLE whileJustM #-} whileJustM :: (Monad m, Monoid a) => m (Maybe a) -> m a whileJustM act = go mempty where@@ -182,6 +221,7 @@ -- | Keep running an operation until it becomes a 'Just', then return the value -- inside the 'Just' as the result of the overall loop.+{-# INLINABLE untilJustM #-} untilJustM :: Monad m => m (Maybe a) -> m a untilJustM act = do res <- act@@ -192,18 +232,22 @@ -- Booleans -- | Like 'when', but where the test can be monadic.+{-# INLINABLE whenM #-} whenM :: Monad m => m Bool -> m () -> m () whenM b t = ifM b t (pure ()) -- | Like 'unless', but where the test can be monadic.+{-# INLINABLE unlessM #-} unlessM :: Monad m => m Bool -> m () -> m () unlessM b f = ifM b (pure ()) f -- | Like @if@, but where the test can be monadic.+{-# INLINABLE ifM #-} ifM :: Monad m => m Bool -> m a -> m a -> m a ifM b t f = do b <- b; if b then t else f -- | Like 'not', but where the test can be monadic.+{-# INLINABLE notM #-} notM :: Functor m => m Bool -> m Bool notM = fmap not @@ -214,6 +258,7 @@ -- > Just True ||^ undefined == Just True -- > Just False ||^ Just True == Just True -- > Just False ||^ Just False == Just False+{-# INLINABLE (||^) #-} (||^) :: Monad m => m Bool -> m Bool -> m Bool (||^) a b = ifM a (pure True) b @@ -224,6 +269,7 @@ -- > Just False &&^ undefined == Just False -- > Just True &&^ Just True == Just True -- > Just True &&^ Just False == Just False+{-# INLINABLE (&&^) #-} (&&^) :: Monad m => m Bool -> m Bool -> m Bool (&&^) a b = ifM a b (pure False) @@ -232,6 +278,7 @@ -- > anyM Just [False,True ,undefined] == Just True -- > anyM Just [False,False,undefined] == undefined -- > \(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs)+{-# INLINABLE anyM #-} anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool anyM p = foldr ((||^) . p) (pure False) @@ -240,6 +287,7 @@ -- > allM Just [True,False,undefined] == Just False -- > allM Just [True,True ,undefined] == undefined -- > \(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs)+{-# INLINABLE allM #-} allM :: Monad m => (a -> m Bool) -> [a] -> m Bool allM p = foldr ((&&^) . p) (pure True) @@ -248,6 +296,7 @@ -- > orM [Just False,Just True ,undefined] == Just True -- > orM [Just False,Just False,undefined] == undefined -- > \xs -> Just (or xs) == orM (map Just xs)+{-# INLINABLE orM #-} orM :: Monad m => [m Bool] -> m Bool orM = anyM id @@ -256,6 +305,7 @@ -- > andM [Just True,Just False,undefined] == Just False -- > andM [Just True,Just True ,undefined] == undefined -- > \xs -> Just (and xs) == andM (map Just xs)+{-# INLINABLE andM #-} andM :: Monad m => [m Bool] -> m Bool andM = allM id @@ -266,10 +316,12 @@ -- > findM (Just . isUpper) "teST" == Just (Just 'S') -- > findM (Just . isUpper) "test" == Just Nothing -- > findM (Just . const True) ["x",undefined] == Just (Just "x")+{-# INLINABLE findM #-} findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a) 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.+{-# INLINABLE firstJustM #-} firstJustM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b) firstJustM p [] = pure Nothing firstJustM p (x:xs) = maybeM (firstJustM p xs) (pure . Just) (p x)
src/Data/Foldable/Extra.hs view
@@ -11,6 +11,7 @@ , andM , findM , firstJustM+ , compareLength ) where import Data.Foldable@@ -59,3 +60,12 @@ -- | A generalization of 'Control.Monad.Extra.firstJustM' to 'Foldable' instances. firstJustM :: (Foldable f, Monad m) => (a -> m (Maybe b)) -> f a -> m (Maybe b) firstJustM p = MX.firstJustM p . toList++-- | Lazily compare the length of a 'Foldable' with a number.+--+-- > compareLength [1,2,3] 1 == GT+-- > compareLength [1,2] 2 == EQ+-- > \(xs :: [Int]) n -> compareLength xs n == compare (length xs) n+-- > compareLength (1:2:3:undefined) 2 == GT+compareLength :: Foldable f => f a -> Int -> Ordering+compareLength = foldr (\_ acc n -> if n > 0 then acc (n - 1) else GT) (compare 0)
src/Data/List/Extra.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE TupleSections, ConstraintKinds #-}+{-# LANGUAGE CPP, TupleSections, ConstraintKinds #-}+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-} -- | This module extends "Data.List" with extra functions of a similar nature. -- The package also exports the existing "Data.List" functions.@@ -156,6 +157,7 @@ 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 #-} +#if __GLASGOW_HASKELL__ <= 906 -- | A total variant of the list index function `(!!)`. -- -- > [2,3,4] !? 1 == Just 3@@ -169,6 +171,7 @@ 0 -> Just x _ -> r (k-1)) (const Nothing) xs n {-# INLINABLE (!?) #-}+#endif -- | A composition of 'not' and 'null'. --@@ -187,6 +190,7 @@ list nil cons [] = nil list nil cons (x:xs) = cons x xs +#if __GLASGOW_HASKELL__ <= 906 -- | If the list is empty returns 'Nothing', otherwise returns the 'init' and the 'last'. -- -- > unsnoc "test" == Just ("tes",'t')@@ -197,6 +201,7 @@ unsnoc [x] = Just ([], x) unsnoc (x:xs) = Just (x:a, b) where Just (a,b) = unsnoc xs+#endif -- | Append an element to the start of a list, an alias for '(:)'. --@@ -286,7 +291,7 @@ -- -- > concatUnzip [("a","AB"),("bc","C")] == ("abc","ABC") concatUnzip :: [([a], [b])] -> ([a], [b])-concatUnzip = (concat *** concat) . unzip+concatUnzip = (concat *** concat) . Prelude.unzip -- | A merging of 'unzip3' and 'concat'. --@@ -491,7 +496,8 @@ -- > \xs -> map fst (groupSort xs) == sort (nub (map fst xs)) -- > \xs -> concatMap snd (groupSort xs) == map snd (sortOn fst xs) groupSort :: Ord k => [(k, v)] -> [(k, [v])]-groupSort = map (\x -> (fst $ head x, map snd x)) . groupOn fst . sortOn fst+groupSort = map (\x -> (fst $ headErr x, map snd x)) . groupOn fst . sortOn fst+ where headErr (x:_) = x -- | A combination of 'group' and 'sort', using a part of the value to compare on. --@@ -549,15 +555,17 @@ | otherwise = y : mergeBy f (x:xs) ys --- | Replace a subsequence everywhere it occurs. The first argument must--- not be the empty list.+-- | Replace a subsequence everywhere it occurs. -- -- > replace "el" "_" "Hello Bella" == "H_lo B_la" -- > replace "el" "e" "Hello" == "Helo"--- > replace "" "e" "Hello" == undefined--- > \xs ys -> not (null xs) ==> replace xs xs ys == ys-replace :: (Partial, Eq a) => [a] -> [a] -> [a] -> [a]-replace [] _ _ = error "Extra.replace, first argument cannot be empty"+-- > replace "" "x" "Hello" == "xHxexlxlxox"+-- > replace "" "x" "" == "x"+-- > \xs ys -> replace xs xs ys == ys+replace :: Eq a => [a] -> [a] -> [a] -> [a]+replace [] to xs = go xs+ where go [] = to+ go (x:xs) = to ++ x : go xs replace from to xs | Just xs <- stripPrefix from xs = to ++ replace from to xs replace from to (x:xs) = x : replace from to xs replace from to [] = []@@ -808,6 +816,7 @@ f (x:xs) = x : f xs f [] = [] +#if __GLASGOW_HASKELL__ <= 914 -- | /O(n log n)/. The 'nubOrd' function removes duplicate elements from a list. -- In particular, it keeps only the first occurrence of each element. -- Unlike the standard 'nub' operator, this version requires an 'Ord' instance@@ -818,6 +827,7 @@ -- > \xs -> nubOrd xs == nub xs nubOrd :: Ord a => [a] -> [a] nubOrd = nubOrdBy compare+#endif -- | A version of 'nubOrd' which operates on a portion of the value. --@@ -825,6 +835,7 @@ nubOrdOn :: Ord b => (a -> b) -> [a] -> [a] nubOrdOn f = map snd . nubOrdBy (compare `on` fst) . map (f &&& id) +#if __GLASGOW_HASKELL__ <= 914 -- | A version of 'nubOrd' with a custom predicate. -- -- > nubOrdBy (compare `on` length) ["a","test","of","this"] == ["a","test","of"]@@ -833,6 +844,7 @@ where f seen [] = [] f seen (x:xs) | memberRB cmp x seen = f seen xs | otherwise = x : f (insertRB cmp x seen) xs+#endif --------------------------------------------------------------------- -- OKASAKI RED BLACK TREE@@ -894,14 +906,41 @@ zipWithLongest f [] ys = map (f Nothing . Just) ys zipWithLongest f xs [] = map ((`f` Nothing) . Just) xs --- | Lazily compare the length of a 'Foldable' with a number.+#if __GLASGOW_HASKELL__ <= 910+-- | Use 'compareLength' @xs@ @n@ as a safer and faster alternative+-- to 'compare' ('length' @xs@) @n@. Similarly, it's better+-- to write @compareLength xs 10 == LT@ instead of @length xs < 10@. ----- > compareLength [1,2,3] 1 == GT--- > compareLength [1,2] 2 == EQ--- > \(xs :: [Int]) n -> compareLength xs n == compare (length xs) n--- > compareLength (1:2:3:undefined) 2 == GT-compareLength :: (Ord b, Num b, Foldable f) => f a -> b -> Ordering-compareLength = foldr (\_ acc n -> if n > 0 then acc (n - 1) else GT) (compare 0)+-- While 'length' would force and traverse+-- the entire spine of @xs@ (which could even diverge if @xs@ is infinite),+-- 'compareLength' traverses at most @n@ elements to determine its result.+--+-- >>> compareLength [] 0+-- EQ+-- >>> compareLength [] 1+-- LT+-- >>> compareLength ['a'] 1+-- EQ+-- >>> compareLength ['a', 'b'] 1+-- GT+-- >>> compareLength [0..] 100+-- GT+-- >>> compareLength undefined (-1)+-- GT+-- >>> compareLength ('a' : undefined) 0+-- GT+--+-- @since 4.21.0.0+--+compareLength :: [a] -> Int -> Ordering+compareLength xs n+ | n < 0 = GT+ | otherwise = foldr+ (\_ f m -> if m > 0 then f (m - 1) else GT)+ (\m -> if m > 0 then LT else EQ)+ xs+ n+#endif -- | Lazily compare the length of two 'Foldable's. -- > comparingLength [1,2,3] [False] == GT
src/Data/List/NonEmpty/Extra.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-} -- | Extra functions for working with 'NonEmpty' lists. The package -- also exports the existing "Data.List.NonEmpty" functions.@@ -9,7 +10,8 @@ sortOn, union, unionBy, nubOrd, nubOrdBy, nubOrdOn, maximum1, minimum1, maximumBy1, minimumBy1, maximumOn1, minimumOn1,- foldl1', repeatedly+ foldl1', repeatedly,+ compareLength ) where import Data.Function@@ -62,11 +64,13 @@ appendr :: [a] -> NonEmpty a -> NonEmpty a appendr l nel = foldr cons nel l +#if __GLASGOW_HASKELL__ <= 908 -- | Sort by comparing the results of a function applied to each element. -- The sort is stable, and the function is evaluated only once for -- each element. sortOn :: Ord b => (a -> b) -> NonEmpty a -> NonEmpty a sortOn f = fromList . List.sortOn f . toList+#endif -- | Return the union of two non-empty lists. Duplicates, and elements of the -- first list, are removed from the the second list, but if the first list@@ -76,18 +80,22 @@ union :: Eq a => NonEmpty a -> NonEmpty a -> NonEmpty a union = unionBy (==) +#if __GLASGOW_HASKELL__ <= 914 -- | @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+#endif +#if __GLASGOW_HASKELL__ <= 914 -- | @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+#endif -- | @nubOrdOn@ for 'NonEmpty'. Behaves the same as 'Data.List.Extra.nubOrdOn'. --@@ -134,3 +142,35 @@ repeatedly :: (NonEmpty a -> (b, [a])) -> NonEmpty a -> NonEmpty b repeatedly f (a :| as) = b :| List.repeatedlyNE f as' where (b, as') = f (a :| as)++#if __GLASGOW_HASKELL__ <= 910+-- | Use 'compareLength' @xs@ @n@ as a safer and faster alternative+-- to 'compare' ('length' @xs@) @n@. Similarly, it's better+-- to write @compareLength xs 10 == LT@ instead of @length xs < 10@.+--+-- While 'length' would force and traverse+-- the entire spine of @xs@ (which could even diverge if @xs@ is infinite),+-- 'compareLength' traverses at most @n@ elements to determine its result.+--+-- >>> compareLength ('a' :| []) 1+-- EQ+-- >>> compareLength ('a' :| ['b']) 3+-- LT+-- >>> compareLength (0 :| [1..]) 100+-- GT+-- >>> compareLength undefined 0+-- GT+-- >>> compareLength ('a' :| 'b' : undefined) 1+-- GT+--+-- @since 4.21.0.0+--+compareLength :: NonEmpty a -> Int -> Ordering+compareLength xs n+ | n < 1 = GT+ | otherwise = foldr+ (\_ f m -> if m > 0 then f (m - 1) else GT)+ (\m -> if m > 0 then LT else EQ)+ xs+ n+#endif
+ src/Data/Monoid/Extra.hs view
@@ -0,0 +1,17 @@++-- | Extra functions for working with monoids.+module Data.Monoid.Extra(+ module Data.Monoid,+ -- * Extra operations+ mwhen+ ) where++import Data.Monoid++-- | Like 'Control.Monad.when', but operating on a 'Monoid'. If the first argument+-- is 'True' returns the second, otherwise returns 'mempty'.+--+-- > mwhen True "test" == "test"+-- > mwhen False "test" == ""+mwhen :: Monoid a => Bool -> a -> a+mwhen b x = if b then x else mempty
src/Extra.hs view
@@ -14,7 +14,7 @@ Partial, retry, retryBool, errorWithoutStackTrace, showException, stringException, errorIO, assertIO, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool, -- * Control.Monad.Extra -- | Extra functions available in @"Control.Monad.Extra"@.- whenJust, whenJustM, pureIf, 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,+ whenJust, whenJustM, pureIf, whenMaybe, whenMaybeM, unit, maybeM, fromMaybeM, eitherM, guarded, guardedA, 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,@@ -27,6 +27,9 @@ -- * Data.List.NonEmpty.Extra -- | Extra functions available in @"Data.List.NonEmpty.Extra"@. (|:), (|>), appendl, appendr, maximum1, minimum1, maximumBy1, minimumBy1, maximumOn1, minimumOn1,+ -- * Data.Monoid.Extra+ -- | Extra functions available in @"Data.Monoid.Extra"@.+ mwhen, -- * Data.Tuple.Extra -- | Extra functions available in @"Data.Tuple.Extra"@. first, second, (***), (&&&), dupe, both, firstM, secondM, fst3, snd3, thd3, first3, second3, third3, curry3, uncurry3,@@ -59,7 +62,8 @@ import Data.Either.Extra import Data.IORef.Extra import Data.List.Extra-import Data.List.NonEmpty.Extra hiding (cons, snoc, sortOn, union, unionBy, nubOrd, nubOrdBy, nubOrdOn, (!?), foldl1', repeatedly)+import Data.List.NonEmpty.Extra hiding (cons, snoc, sortOn, union, unionBy, nubOrd, nubOrdBy, nubOrdOn, (!?), foldl1', repeatedly, compareLength)+import Data.Monoid.Extra import Data.Tuple.Extra import Data.Version.Extra import Numeric.Extra
test/TestGen.hs view
@@ -2,6 +2,7 @@ -- See Generate.hs for details of how to generate {-# LANGUAGE ExtendedDefaultRules, ScopedTypeVariables, TypeApplications, ViewPatterns #-}+{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-} module TestGen(tests) where import TestUtil import qualified Data.Ord@@ -37,6 +38,12 @@ testGen "whenMaybe True (print 1) == fmap Just (print 1)" $ whenMaybe True (print 1) == fmap Just (print 1) 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 "guarded even 2 == [2]" $ guarded even 2 == [2]+ testGen "guarded odd 2 == Nothing" $ guarded odd 2 == Nothing+ testGen "guarded (not.null) \"My Name\" == Just \"My Name\"" $ guarded (not.null) "My Name" == Just "My Name"+ testGen "guardedA (return . even) 42 == Just [42]" $ guardedA (return . even) 42 == Just [42]+ testGen "guardedA (return . odd) 42 == Just []" $ guardedA (return . odd) 42 == Just []+ testGen "guardedA (const Nothing) 42 == (Nothing :: Maybe [Int])" $ guardedA (const Nothing) 42 == (Nothing :: Maybe [Int]) 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 testGen "partitionM (Just . even) [1,2,3] == Just ([2], [1,3])" $ partitionM (Just . even) [1,2,3] == Just ([2], [1,3])@@ -190,8 +197,9 @@ testGen "\\xs ys -> merge (sort xs) (sort ys) == sort (xs ++ ys)" $ \xs ys -> merge (sort xs) (sort ys) == sort (xs ++ ys) testGen "replace \"el\" \"_\" \"Hello Bella\" == \"H_lo B_la\"" $ replace "el" "_" "Hello Bella" == "H_lo B_la" testGen "replace \"el\" \"e\" \"Hello\" == \"Helo\"" $ replace "el" "e" "Hello" == "Helo"- testGen "replace \"\" \"e\" \"Hello\" == undefined" $ erroneous $ replace "" "e" "Hello"- testGen "\\xs ys -> not (null xs) ==> replace xs xs ys == ys" $ \xs ys -> not (null xs) ==> replace xs xs ys == ys+ testGen "replace \"\" \"x\" \"Hello\" == \"xHxexlxlxox\"" $ replace "" "x" "Hello" == "xHxexlxlxox"+ testGen "replace \"\" \"x\" \"\" == \"x\"" $ replace "" "x" "" == "x"+ testGen "\\xs ys -> replace xs xs ys == ys" $ \xs ys -> replace xs xs ys == ys testGen "breakEnd isLower \"youRE\" == (\"you\",\"RE\")" $ breakEnd isLower "youRE" == ("you","RE") testGen "breakEnd isLower \"youre\" == (\"youre\",\"\")" $ breakEnd isLower "youre" == ("youre","") testGen "breakEnd isLower \"YOURE\" == (\"\",\"YOURE\")" $ breakEnd isLower "YOURE" == ("","YOURE")@@ -262,15 +270,13 @@ testGen "zipWithLongest (,) \"a\" \"xyz\" == [(Just 'a', Just 'x'), (Nothing, Just 'y'), (Nothing, Just 'z')]" $ zipWithLongest (,) "a" "xyz" == [(Just 'a', Just 'x'), (Nothing, Just 'y'), (Nothing, Just 'z')] testGen "zipWithLongest (,) \"a\" \"x\" == [(Just 'a', Just 'x')]" $ zipWithLongest (,) "a" "x" == [(Just 'a', Just 'x')] testGen "zipWithLongest (,) \"\" \"x\" == [(Nothing, Just 'x')]" $ zipWithLongest (,) "" "x" == [(Nothing, Just 'x')]- testGen "compareLength [1,2,3] 1 == GT" $ compareLength [1,2,3] 1 == GT- testGen "compareLength [1,2] 2 == EQ" $ compareLength [1,2] 2 == EQ- testGen "\\(xs :: [Int]) n -> compareLength xs n == compare (length xs) n" $ \(xs :: [Int]) n -> compareLength xs n == compare (length xs) n- testGen "compareLength (1:2:3:undefined) 2 == GT" $ compareLength (1:2:3:undefined) 2 == GT testGen "comparingLength [1,2,3] [False] == GT" $ comparingLength [1,2,3] [False] == GT testGen "comparingLength [1,2] \"ab\" == EQ" $ comparingLength [1,2] "ab" == EQ testGen "\\(xs :: [Int]) (ys :: [Int]) -> comparingLength xs ys == Data.Ord.comparing length xs ys" $ \(xs :: [Int]) (ys :: [Int]) -> comparingLength xs ys == Data.Ord.comparing length xs ys testGen "comparingLength [1,2] (1:2:3:undefined) == LT" $ comparingLength [1,2] (1:2:3:undefined) == LT testGen "comparingLength (1:2:3:undefined) [1,2] == GT" $ comparingLength (1:2:3:undefined) [1,2] == GT+ testGen "mwhen True \"test\" == \"test\"" $ mwhen True "test" == "test"+ testGen "mwhen False \"test\" == \"\"" $ mwhen False "test" == "" 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")]
test/TestUtil.hs view
@@ -24,7 +24,7 @@ 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.Monoid.Extra as X import Data.Tuple.Extra as X import Data.Version.Extra as X import Numeric.Extra as X