Skip to content
Snippets Groups Projects
Commit 7336d9ef authored by Ryan Scott's avatar Ryan Scott
Browse files

Patch extra-1.7.12 to adapt to (!?) in base

parent 83192dbb
No related branches found
No related tags found
No related merge requests found
diff --git a/src/Data/List/Extra.hs b/src/Data/List/Extra.hs
index 4b4fbe5..2a476cc 100644
--- a/src/Data/List/Extra.hs
+++ b/src/Data/List/Extra.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE TupleSections, ConstraintKinds #-}
+{-# LANGUAGE TupleSections, ConstraintKinds, CPP #-}
+{-# 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 :: 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 #-}
+#if __GLASGOW_HASKELL__ < 907
-- | A total variant of the list index function `(!!)`.
--
-- > [2,3,4] !? 1 == Just 3
@@ -169,6 +171,7 @@ xs !? n
0 -> Just x
_ -> r (k-1)) (const Nothing) xs n
{-# INLINABLE (!?) #-}
+#endif
-- | A composition of 'not' and 'null'.
--
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment