-- | @List@. Import as:

--

-- > import qualified RIO.List as L

--

-- This module does not export any partial functions.  For those, see

-- "RIO.List.Partial"

module RIO.List
  (
  -- * Basic functions

    (Data.List.++)
  , Data.List.uncons
  , Data.List.null
  , Data.List.length
  , headMaybe
  , lastMaybe
  , tailMaybe
  , initMaybe

  -- * List transformations

  , Data.List.map
  , Data.List.reverse

  , Data.List.intersperse
  , Data.List.intercalate
  , Data.List.transpose

  , Data.List.subsequences
  , Data.List.permutations

  -- * Reducing lists (folds)


  , Data.List.foldl
  , Data.List.foldl'
  , Data.List.foldr

  -- ** Special folds


  , Data.List.concat
  , Data.List.concatMap
  , Data.List.and
  , Data.List.or
  , Data.List.any
  , Data.List.all
  , Data.List.sum
  , Data.List.product
  , maximumMaybe
  , minimumMaybe
  , maximumByMaybe
  , minimumByMaybe

  -- * Building lists


  -- ** Scans

  , Data.List.scanl
  , Data.List.scanl'
  , Data.List.scanr
  , Data.List.scanl1
  , Data.List.scanr1

  -- ** Accumulating maps

  , Data.List.mapAccumL
  , Data.List.mapAccumR

  -- ** Infinite lists

  , Data.List.iterate
  , Data.List.repeat
  , Data.List.replicate
  , Data.List.cycle

  -- ** Unfolding

  , Data.List.unfoldr

  -- * Sublists


  -- ** Extracting sublists

  , Data.List.take
  , Data.List.drop
  , Data.List.splitAt

  , Data.List.takeWhile
  , Data.List.dropWhile
  , Data.List.dropWhileEnd
  , Data.List.span
  , Data.List.break

  , Data.List.stripPrefix
  , stripSuffix
  , dropPrefix
  , dropSuffix

  , Data.List.group

  , Data.List.inits
  , Data.List.tails

  -- ** Predicates

  , Data.List.isPrefixOf
  , Data.List.isSuffixOf
  , Data.List.isInfixOf
  , Data.List.isSubsequenceOf

  -- * Searching lists


  -- ** Searching by equality

  , Data.List.elem
  , Data.List.notElem
  , Data.List.lookup

  -- ** Searching with a predicate

  , Data.List.find
  , Data.List.filter
  , Data.List.partition

  -- * Indexing lists

  -- | These functions treat a list @xs@ as a indexed collection,

  -- with indices ranging from 0 to @'length' xs - 1@.


  , Data.List.elemIndex
  , Data.List.elemIndices

  , Data.List.findIndex
  , Data.List.findIndices

  -- * Zipping and unzipping lists


  , Data.List.zip
  , Data.List.zip3
  , Data.List.zip4
  , Data.List.zip5
  , Data.List.zip6
  , Data.List.zip7

  , Data.List.zipWith
  , Data.List.zipWith3
  , Data.List.zipWith4
  , Data.List.zipWith5
  , Data.List.zipWith6
  , Data.List.zipWith7

  , Data.List.unzip
  , Data.List.unzip3
  , Data.List.unzip4
  , Data.List.unzip5
  , Data.List.unzip6
  , Data.List.unzip7

  -- * Special lists


  -- ** Functions on strings

  , Data.List.lines
  , linesCR
  , Data.List.words
  , Data.List.unlines
  , Data.List.unwords

  -- ** \"Set\" operations


  , Data.List.nub

  , Data.List.delete
  , (Data.List.\\)

  , Data.List.union
  , Data.List.intersect

  -- ** Ordered lists

  , Data.List.sort
  , Data.List.sortOn
  , Data.List.insert

  -- * Generalized functions


  -- ** The \"@By@\" operations

  -- | By convention, overloaded functions have a non-overloaded

  -- counterpart whose name is suffixed with \`@By@\'.

  --

  -- It is often convenient to use these functions together with

  -- 'Data.Function.on', for instance @'sortBy' ('compare'

  -- \`on\` 'fst')@.


  -- *** User-supplied equality (replacing an @Eq@ context)

  -- | The predicate is assumed to define an equivalence.

  , Data.List.nubBy
  , Data.List.deleteBy
  , Data.List.deleteFirstsBy
  , Data.List.unionBy
  , Data.List.intersectBy
  , Data.List.groupBy

  -- *** User-supplied comparison (replacing an @Ord@ context)

  -- | The function is assumed to define a total ordering.

  , Data.List.sortBy
  , Data.List.insertBy

  -- ** The \"@generic@\" operations

  -- | The prefix \`@generic@\' indicates an overloaded function that

  -- is a generalized version of a "Prelude" function.


  , Data.List.genericLength
  , Data.List.genericTake
  , Data.List.genericDrop
  , Data.List.genericSplitAt
  , Data.List.genericIndex
  , Data.List.genericReplicate

  ) where

import qualified Data.List

import Data.List(stripPrefix)
import Data.Maybe (fromMaybe)

-- | Remove the suffix from the given list, if present

--

-- @since 0.0.0

stripSuffix :: Eq a
            => [a] -- ^ suffix

            -> [a]
            -> Maybe [a]
stripSuffix :: forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix [a]
suffix [a]
list =
  ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
suffix) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
list))

-- | Drop prefix if present, otherwise return original list.

--

-- @since 0.0.0.0

dropPrefix :: Eq a
           => [a] -- ^ prefix

           -> [a]
           -> [a]
dropPrefix :: forall a. Eq a => [a] -> [a] -> [a]
dropPrefix [a]
prefix [a]
t = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a]
t ([a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
prefix [a]
t)

-- | Drop prefix if present, otherwise return original list.

--

-- @since 0.0.0.0

dropSuffix :: Eq a
           => [a] -- ^ suffix

           -> [a]
           -> [a]
dropSuffix :: forall a. Eq a => [a] -> [a] -> [a]
dropSuffix [a]
suffix [a]
t = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a]
t ([a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix [a]
suffix [a]
t)

-- | 'linesCR' breaks a 'String' up into a list of `String`s at newline

-- 'Char's. It is very similar to 'lines', but it also removes any

-- trailing @'\r'@ 'Char's. The resulting 'String' values do not contain

-- newlines or trailing @'\r'@ characters.

--

-- @since 0.1.0.0

linesCR :: String -> [String]
linesCR :: String -> [String]
linesCR = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix String
"\r") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

safeListCall :: Foldable t => (t a -> b) -> t a -> Maybe b
safeListCall :: forall (t :: * -> *) a b.
Foldable t =>
(t a -> b) -> t a -> Maybe b
safeListCall t a -> b
f t a
xs
  | t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.List.null t a
xs = Maybe b
forall a. Maybe a
Nothing
  | Bool
otherwise = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ t a -> b
f t a
xs

-- | @since 0.1.3.0

headMaybe :: [a] -> Maybe a
headMaybe :: forall a. [a] -> Maybe a
headMaybe = ([a] -> a) -> [a] -> Maybe a
forall (t :: * -> *) a b.
Foldable t =>
(t a -> b) -> t a -> Maybe b
safeListCall [a] -> a
forall a. HasCallStack => [a] -> a
Data.List.head

-- | @since 0.1.3.0

lastMaybe :: [a] -> Maybe a
lastMaybe :: forall a. [a] -> Maybe a
lastMaybe = ([a] -> a) -> [a] -> Maybe a
forall (t :: * -> *) a b.
Foldable t =>
(t a -> b) -> t a -> Maybe b
safeListCall [a] -> a
forall a. HasCallStack => [a] -> a
Data.List.last

-- | @since 0.1.3.0

tailMaybe :: [a] -> Maybe [a]
tailMaybe :: forall a. [a] -> Maybe [a]
tailMaybe = ([a] -> [a]) -> [a] -> Maybe [a]
forall (t :: * -> *) a b.
Foldable t =>
(t a -> b) -> t a -> Maybe b
safeListCall [a] -> [a]
forall a. HasCallStack => [a] -> [a]
Data.List.tail

-- | @since 0.1.3.0

initMaybe :: [a] -> Maybe [a]
initMaybe :: forall a. [a] -> Maybe [a]
initMaybe = ([a] -> [a]) -> [a] -> Maybe [a]
forall (t :: * -> *) a b.
Foldable t =>
(t a -> b) -> t a -> Maybe b
safeListCall [a] -> [a]
forall a. HasCallStack => [a] -> [a]
Data.List.init

-- | @since 0.1.3.0

maximumMaybe :: (Ord a, Foldable t) => t a -> Maybe a
maximumMaybe :: forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Maybe a
maximumMaybe = (t a -> a) -> t a -> Maybe a
forall (t :: * -> *) a b.
Foldable t =>
(t a -> b) -> t a -> Maybe b
safeListCall t a -> a
forall a. Ord a => t a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.maximum

-- | @since 0.1.3.0

minimumMaybe :: (Ord a, Foldable t) => t a -> Maybe a
minimumMaybe :: forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Maybe a
minimumMaybe = (t a -> a) -> t a -> Maybe a
forall (t :: * -> *) a b.
Foldable t =>
(t a -> b) -> t a -> Maybe b
safeListCall t a -> a
forall a. Ord a => t a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.minimum

-- | @since 0.1.3.0

maximumByMaybe :: (Foldable t) => (a -> a -> Ordering) -> t a -> Maybe a
maximumByMaybe :: forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> Maybe a
maximumByMaybe a -> a -> Ordering
f = (t a -> a) -> t a -> Maybe a
forall (t :: * -> *) a b.
Foldable t =>
(t a -> b) -> t a -> Maybe b
safeListCall ((a -> a -> Ordering) -> t a -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
Data.List.maximumBy a -> a -> Ordering
f)

-- | @since 0.1.3.0

minimumByMaybe :: (Foldable t) => (a -> a -> Ordering) -> t a -> Maybe a
minimumByMaybe :: forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> Maybe a
minimumByMaybe a -> a -> Ordering
f = (t a -> a) -> t a -> Maybe a
forall (t :: * -> *) a b.
Foldable t =>
(t a -> b) -> t a -> Maybe b
safeListCall ((a -> a -> Ordering) -> t a -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
Data.List.minimumBy a -> a -> Ordering
f)