{-# LANGUAGE CPP, NoImplicitPrelude #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Trustworthy #-}
module Data.List.Compat (
  module Base

#if !(MIN_VERSION_base(4,21,0))
, compareLength
, inits1
, tails1
#endif

#if MIN_VERSION_base(4,18,0) && !(MIN_VERSION_base(4,20,0))
, List
#endif

#if !(MIN_VERSION_base(4,19,0))
, (!?)
, unsnoc
#endif

#if !(MIN_VERSION_base(4,15,0))
, singleton
#endif

#if !(MIN_VERSION_base(4,11,0))
, iterate'
#endif
) where

import Data.List as Base

#if MIN_VERSION_base(4,18,0) && !(MIN_VERSION_base(4,20,0))
import GHC.List (List)
#endif

#if !(MIN_VERSION_base(4,21,0))
import Data.List.NonEmpty (NonEmpty(..))
import GHC.Exts (build)
import Prelude.Compat hiding (foldr, null)
#endif

#if !(MIN_VERSION_base(4,11,0))
-- | 'iterate\'' is the strict version of 'iterate'.
--
-- It ensures that the result of each application of force to weak head normal
-- form before proceeding.
{-# NOINLINE [1] iterate' #-}
iterate' :: (a -> a) -> a -> [a]
iterate' f x =
    let x' = f x
    in x' `seq` (x : iterate' f x')

{-# INLINE [0] iterate'FB #-} -- See Note [Inline FB functions]
iterate'FB :: (a -> b -> b) -> (a -> a) -> a -> b
iterate'FB c f x0 = go x0
  where go x =
            let x' = f x
            in x' `seq` (x `c` go x')

{-# RULES
"iterate'"    [~1] forall f x.   iterate' f x = build (\c _n -> iterate'FB c f x)
"iterate'FB"  [1]                iterate'FB (:) = iterate'
 #-}
#endif

#if !(MIN_VERSION_base(4,15,0))
-- | Produce singleton list.
--
-- >>> singleton True
-- [True]
--
-- /Since: 4.14.0.0/
--
singleton :: a -> [a]
singleton x = [x]
#endif

#if !(MIN_VERSION_base(4,19,0))
infixl 9 !?
-- | List index (subscript) operator, starting from 0. Returns 'Nothing'
-- if the index is out of bounds
--
-- >>> ['a', 'b', 'c'] !? 0
-- Just 'a'
-- >>> ['a', 'b', 'c'] !? 2
-- Just 'c'
-- >>> ['a', 'b', 'c'] !? 3
-- Nothing
-- >>> ['a', 'b', 'c'] !? (-1)
-- Nothing
--
-- This is the total variant of the partial '!!' operator.
--
-- WARNING: This function takes linear time in the index.
(!?) :: [a] -> Int -> Maybe a

{-# INLINABLE (!?) #-}
[a]
xs !? :: forall a. [a] -> Int -> Maybe a
!? Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = (a -> (Int -> Maybe a) -> Int -> Maybe a)
-> (Int -> Maybe a) -> [a] -> Int -> Maybe a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x Int -> Maybe a
r Int
k -> case Int
k of
                                   Int
0 -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
                                   Int
_ -> Int -> Maybe a
r (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) (Maybe a -> Int -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) [a]
xs Int
n

-- | \(\mathcal{O}(n)\). Decompose a list into 'init' and 'last'.
--
-- * If the list is empty, returns 'Nothing'.
-- * If the list is non-empty, returns @'Just' (xs, x)@,
-- where @xs@ is the 'init'ial part of the list and @x@ is its 'last' element.
--
-- /Since: 4.19.0.0/
--
-- >>> unsnoc []
-- Nothing
-- >>> unsnoc [1]
-- Just ([],1)
-- >>> unsnoc [1, 2, 3]
-- Just ([1,2],3)
--
-- Laziness:
--
-- >>> fst <$> unsnoc [undefined]
-- Just []
-- >>> head . fst <$> unsnoc (1 : undefined)
-- Just *** Exception: Prelude.undefined
-- >>> head . fst <$> unsnoc (1 : 2 : undefined)
-- Just 1
--
-- 'unsnoc' is dual to 'uncons': for a finite list @xs@
--
-- > unsnoc xs = (\(hd, tl) -> (reverse tl, hd)) <$> uncons (reverse xs)
--
unsnoc :: [a] -> Maybe ([a], a)
-- The lazy pattern ~(a, b) is important to be productive on infinite lists
-- and not to be prone to stack overflows.
-- Expressing the recursion via 'foldr' provides for list fusion.
unsnoc :: forall a. [a] -> Maybe ([a], a)
unsnoc = (a -> Maybe ([a], a) -> Maybe ([a], a))
-> Maybe ([a], a) -> [a] -> Maybe ([a], a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (([a], a) -> Maybe ([a], a))
-> (Maybe ([a], a) -> ([a], a)) -> Maybe ([a], a) -> Maybe ([a], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], a) -> (([a], a) -> ([a], a)) -> Maybe ([a], a) -> ([a], a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([], a
x) (\(~([a]
a, a
b)) -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
a, a
b))) Maybe ([a], a)
forall a. Maybe a
Nothing
{-# INLINABLE unsnoc #-}
#endif

#if !(MIN_VERSION_base(4,21,0))
-- | 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 [] 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 :: forall a. [a] -> Int -> Ordering
compareLength [a]
xs Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Ordering
GT
  | Bool
otherwise = (a -> (Int -> Ordering) -> Int -> Ordering)
-> (Int -> Ordering) -> [a] -> Int -> Ordering
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\a
_ Int -> Ordering
f Int
m -> if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> Ordering
f (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) else Ordering
GT)
    (\Int
m -> if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Ordering
LT else Ordering
EQ)
    [a]
xs
    Int
n

inits1, tails1 :: [a] -> [NonEmpty a]

-- | The 'inits1' function returns all non-empty initial segments of the
-- argument, shortest first.
--
-- @since 4.21.0.0
--
-- ==== __Laziness__
--
-- Note that 'inits1' has the following strictness property:
-- @inits1 (xs ++ _|_) = inits1 xs ++ _|_@
--
-- In particular,
-- @inits1 _|_ = _|_@
--
-- ==== __Examples__
--
-- >>> inits1 "abc"
-- ['a' :| "",'a' :| "b",'a' :| "bc"]
--
-- >>> inits1 []
-- []
--
-- inits1 is productive on infinite lists:
--
-- >>> take 3 $ inits1 [1..]
-- [1 :| [],1 :| [2],1 :| [2,3]]
inits1 :: forall a. [a] -> [NonEmpty a]
inits1 [] = []
inits1 (a
x : [a]
xs) = ([a] -> NonEmpty a) -> [[a]] -> [NonEmpty a]
forall a b. (a -> b) -> [a] -> [b]
map (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|) ([a] -> [[a]]
forall a. [a] -> [[a]]
inits [a]
xs)

-- | \(\mathcal{O}(n)\). The 'tails1' function returns all non-empty final
-- segments of the argument, longest first.
--
-- @since 4.21.0.0
--
-- ==== __Laziness__
--
-- Note that 'tails1' has the following strictness property:
-- @tails1 _|_ = _|_@
--
-- >>> tails1 undefined
-- *** Exception: Prelude.undefined
--
-- >>> drop 1 (tails1 [undefined, 1, 2])
-- [1 :| [2],2 :| []]
--
-- ==== __Examples__
--
-- >>> tails1 "abc"
-- ['a' :| "bc",'b' :| "c",'c' :| ""]
--
-- >>> tails1 [1, 2, 3]
-- [1 :| [2,3],2 :| [3],3 :| []]
--
-- >>> tails1 []
-- []
{-# INLINABLE tails1 #-}
tails1 :: forall a. [a] -> [NonEmpty a]
tails1 [a]
lst = (forall b. (NonEmpty a -> b -> b) -> b -> b) -> [NonEmpty a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\NonEmpty a -> b -> b
c b
n ->
  let tails1Go :: [a] -> b
tails1Go [] = b
n
      tails1Go (a
x : [a]
xs) = (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs) NonEmpty a -> b -> b
`c` [a] -> b
tails1Go [a]
xs
  in [a] -> b
tails1Go [a]
lst)
#endif