-- |  You can create a @List@ in Elm with the @[1,2,3]@ syntax, so lists are used all over the place. This module has a bunch of functions to help you work with them!
module List
  ( List,

    -- * Create
    singleton,
    repeat,
    range,

    -- * Transform
    map,
    indexedMap,
    foldl,
    foldr,
    filter,
    filterMap,

    -- * Utilities
    length,
    reverse,
    member,
    all,
    any,
    maximum,
    minimum,
    sum,
    product,

    -- * Combine
    append,
    concat,
    concatMap,
    intersperse,
    map2,
    map3,
    map4,
    map5,

    -- * Sort
    sort,
    sortBy,
    sortWith,

    -- * Deconstruct
    isEmpty,
    head,
    tail,
    take,
    drop,
    partition,
    unzip,
  )
where

import Basics (Bool (..), Int, Num, Ord, Ordering (..), (-), (>>))
import qualified Data.Foldable
import qualified Data.List
import qualified Data.Maybe
import qualified Internal.Shortcut as Shortcut
import Maybe (Maybe (..))
import qualified Prelude

-- | In Haskell a list type is defined using square brackets. This alias allows
-- us to alternatively write the type like we would in Elm.
type List a = [a]

-- CREATE

-- | Create a list with only one element:
--
-- > singleton 1234 == [1234]
-- > singleton "hi" == ["hi"]
singleton :: a -> List a
singleton :: a -> List a
singleton a
value = [a
value]

-- | Create a list with *n* copies of a value:
--
-- > repeat 3 (0,0) == [(0,0),(0,0),(0,0)]
repeat :: Int -> a -> List a
repeat :: Int -> a -> List a
repeat =
  Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int) -> (Int -> a -> List a) -> Int -> a -> List a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> a -> List a
forall a. Int -> a -> [a]
Data.List.replicate

-- | Create a list of numbers, every element increasing by one.
--
-- You give the lowest and highest number that should be in the list.
--
-- > range 3 6 == [3, 4, 5, 6]
-- > range 3 3 == [3]
-- > range 6 3 == []
range :: Int -> Int -> List Int
range :: Int -> Int -> List Int
range Int
lo Int
hi =
  [Int
lo .. Int
hi]

-- TRANSFORM

-- | Apply a function to every element of a list.
--
-- > map sqrt [1,4,9] == [1,2,3]
-- > map not [True,False,True] == [False,True,False]
--
-- So @map func [ a, b, c ]@ is the same as @[ func a, func b, func c ]@
map :: (a -> b) -> List a -> List b
map :: (a -> b) -> List a -> List b
map =
  (a -> b) -> List a -> List b
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
Shortcut.map

-- | Same as @map@ but the function is also applied to the index of each element
-- (starting at zero).
--
-- > indexedMap Tuple.pair ["Tom","Sue","Bob"] == [ (0,"Tom"), (1,"Sue"), (2,"Bob") ]
indexedMap :: (Int -> a -> b) -> List a -> List b
indexedMap :: (Int -> a -> b) -> List a -> List b
indexedMap Int -> a -> b
f List a
xs =
  (Int -> a -> b) -> List Int -> List a -> List b
forall a b result.
(a -> b -> result) -> List a -> List b -> List result
map2 Int -> a -> b
f [Int
0 .. (List a -> Int
forall a. List a -> Int
length List a
xs Int -> Int -> Int
forall number. Num number => number -> number -> number
- Int
1)] List a
xs

-- | Reduce a list from the left.
--
-- > foldl (+)  0  [1,2,3] == 6
-- > foldl (::) [] [1,2,3] == [3,2,1]
--
-- So @foldl step state [1,2,3]@ is like saying:
--
-- > state
-- >   |> step 1
-- >   |> step 2
-- >   |> step 3
--
-- Note: This function is implemented using fold' to eagerly evaluate the
-- accumulator, preventing space leaks.
foldl :: (a -> b -> b) -> b -> List a -> b
foldl :: (a -> b -> b) -> b -> List a -> b
foldl a -> b -> b
func =
  (b -> a -> b) -> b -> List a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (\b
a a
b -> a -> b -> b
func a
b b
a)

-- | Reduce a list from the right.
--
-- > foldr (+)  0  [1,2,3] == 6
-- > foldr (::) [] [1,2,3] == [1,2,3]
--
-- So @foldr step state [1,2,3]@ is like saying:
--
-- > state
-- >   |> step 3
-- >   |> step 2
-- >   |> step 1
foldr :: (a -> b -> b) -> b -> List a -> b
foldr :: (a -> b -> b) -> b -> List a -> b
foldr =
  (a -> b -> b) -> b -> List a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.List.foldr

-- | Keep elements that satisfy the test.
--
-- > filter isEven [1,2,3,4,5,6] == [2,4,6]
filter :: (a -> Bool) -> List a -> List a
filter :: (a -> Bool) -> List a -> List a
filter =
  (a -> Bool) -> List a -> List a
forall a. (a -> Bool) -> [a] -> [a]
Data.List.filter

-- | Filter out certain values. For example, maybe you have a bunch of strings
-- from an untrusted source and you want to turn them into numbers:
--
-- > numbers : List Int
-- > numbers =
-- >   filterMap String.toInt ["3", "hi", "12", "4th", "May"]
-- > -- numbers == [3, 12]
filterMap :: (a -> Maybe b) -> List a -> List b
filterMap :: (a -> Maybe b) -> List a -> List b
filterMap =
  (a -> Maybe b) -> List a -> List b
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe

-- UTILITIES

-- | Determine the length of a list.
--
-- > length [1,2,3] == 3
length :: List a -> Int
length :: List a -> Int
length =
  List a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length (List a -> Int) -> (Int -> Int) -> List a -> Int
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral

-- | Reverse a list.
-- > reverse [1,2,3,4] == [4,3,2,1]
reverse :: List a -> List a
reverse :: List a -> List a
reverse =
  List a -> List a
forall a. [a] -> [a]
Data.List.reverse

-- | Figure out whether a list contains a value.
--
-- > member 9 [1,2,3,4] == False
-- > member 4 [1,2,3,4] == True
member :: Prelude.Eq a => a -> List a -> Bool
member :: a -> List a -> Bool
member =
  a -> List a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem

-- | Determine if all elements satisfy some test.
--
-- > all isEven [2,4] == True
-- > all isEven [2,3] == False
-- > all isEven [] == True
all :: (a -> Bool) -> List a -> Bool
all :: (a -> Bool) -> List a -> Bool
all =
  (a -> Bool) -> List a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.List.all

-- | Determine if any elements satisfy some test.
--
-- > any isEven [2,3] == True
-- > any isEven [1,3] == False
-- > any isEven [] == False
any :: (a -> Bool) -> List a -> Bool
any :: (a -> Bool) -> List a -> Bool
any =
  (a -> Bool) -> List a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.List.any

-- | Find the maximum element in a non-empty list.
--
-- > maximum [1,4,2] == Just 4
-- > maximum []      == Nothing
maximum :: Ord a => List a -> Maybe a
maximum :: List a -> Maybe a
maximum List a
list =
  case List a
list of
    [] ->
      Maybe a
forall a. Maybe a
Nothing
    List a
_ ->
      a -> Maybe a
forall a. a -> Maybe a
Just (List a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.maximum List a
list)

-- | Find the minimum element in a non-empty list.
--
-- > minimum [3,2,1] == Just 1
-- > minimum []      == Nothing
minimum :: Ord a => List a -> Maybe a
minimum :: List a -> Maybe a
minimum List a
list =
  case List a
list of
    [] ->
      Maybe a
forall a. Maybe a
Nothing
    List a
_ ->
      a -> Maybe a
forall a. a -> Maybe a
Just (List a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.minimum List a
list)

-- | Get the sum of the list elements.
--
-- > sum [1,2,3,4] == 10
sum :: Num a => List a -> a
sum :: List a -> a
sum =
  List a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Data.Foldable.sum

-- | Get the product of the list elements.
--
-- > product [1,2,3,4] == 24
product :: Num a => List a -> a
product :: List a -> a
product =
  List a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Data.Foldable.product

-- COMBINE

-- | Put two lists together.
--
-- > append [1,1,2] [3,5,8] == [1,1,2,3,5,8]
-- > append ['a','b'] ['c'] == ['a','b','c']
--
-- You can also use the @(++)@ operator to append lists.
append :: List a -> List a -> List a
append :: List a -> List a -> List a
append =
  List a -> List a -> List a
forall a. Monoid a => a -> a -> a
Prelude.mappend

-- | Concatenate a bunch of lists into a single list:
--
-- > concat [[1,2],[3],[4,5]] == [1,2,3,4,5]
concat :: List (List a) -> List a
concat :: List (List a) -> List a
concat =
  List (List a) -> List a
forall a. Monoid a => [a] -> a
Prelude.mconcat

-- | Map a given function onto a list and flatten the resulting lists.
--
-- > concatMap f xs == concat (map f xs)
concatMap :: (a -> List b) -> List a -> List b
concatMap :: (a -> List b) -> List a -> List b
concatMap =
  (a -> List b) -> List a -> List b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
Shortcut.andThen

-- | Places the given value between all members of the given list.
--
-- > intersperse "on" ["turtles","turtles","turtles"] == ["turtles","on","turtles","on","turtles"]
intersperse :: a -> List a -> List a
intersperse :: a -> List a -> List a
intersperse =
  a -> List a -> List a
forall a. a -> [a] -> [a]
Data.List.intersperse

-- | Combine two lists, combining them with the given function.
-- If one list is longer, the extra elements are dropped.
--
-- > totals : List Int -> List Int -> List Int
-- > totals xs ys =
-- >   List.map2 (+) xs ys
-- >
-- > -- totals [1,2,3] [4,5,6] == [5,7,9]
-- >
-- > pairs : List a -> List b -> List (a,b)
-- > pairs xs ys =
-- >   List.map2 Tuple.pair xs ys
-- >
-- > -- pairs ["alice","bob","chuck"] [2,5,7,8]
-- > --   == [("alice",2),("bob",5),("chuck",7)]
--
-- __Note:__ This behaves differently than 'NriPrelude.map2', which produces
-- all combinations of elements from both lists.
map2 :: (a -> b -> result) -> List a -> List b -> List result
map2 :: (a -> b -> result) -> List a -> List b -> List result
map2 =
  (a -> b -> result) -> List a -> List b -> List result
forall a b result.
(a -> b -> result) -> List a -> List b -> List result
Data.List.zipWith

-- | __Note:__ This behaves differently than 'NriPrelude.map3', which produces
-- all combinations of elements from all lists.
map3 :: (a -> b -> c -> result) -> List a -> List b -> List c -> List result
map3 :: (a -> b -> c -> result)
-> List a -> List b -> List c -> List result
map3 =
  (a -> b -> c -> result)
-> List a -> List b -> List c -> List result
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
Data.List.zipWith3

-- | __Note:__ This behaves differently than 'NriPrelude.map4', which produces
-- all combinations of elements from all lists.
map4 :: (a -> b -> c -> d -> result) -> List a -> List b -> List c -> List d -> List result
map4 :: (a -> b -> c -> d -> result)
-> List a -> List b -> List c -> List d -> List result
map4 =
  (a -> b -> c -> d -> result)
-> List a -> List b -> List c -> List d -> List result
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
Data.List.zipWith4

-- | __Note:__ This behaves differently than 'NriPrelude.map5', which produces
-- all combinations of elements from all lists.
map5 :: (a -> b -> c -> d -> e -> result) -> List a -> List b -> List c -> List d -> List e -> List result
map5 :: (a -> b -> c -> d -> e -> result)
-> List a -> List b -> List c -> List d -> List e -> List result
map5 =
  (a -> b -> c -> d -> e -> result)
-> List a -> List b -> List c -> List d -> List e -> List result
forall a b c d e f.
(a -> b -> c -> d -> e -> f)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
Data.List.zipWith5

-- SORT

-- | Sort values from lowest to highest
--
-- > sort [3,1,5] == [1,3,5]
sort :: Ord a => List a -> List a
sort :: List a -> List a
sort =
  List a -> List a
forall a. Ord a => [a] -> [a]
Data.List.sort

-- | Sort values by a derived property.
--
-- > alice = { name="Alice", height=1.62 }
-- > bob   = { name="Bob"  , height=1.85 }
-- > chuck = { name="Chuck", height=1.76 }
-- >
-- > sortBy .name   [chuck,alice,bob] == [alice,bob,chuck]
-- > sortBy .height [chuck,alice,bob] == [alice,chuck,bob]
-- >
-- > sortBy String.length ["mouse","cat"] == ["cat","mouse"]
sortBy :: Ord b => (a -> b) -> List a -> List a
sortBy :: (a -> b) -> List a -> List a
sortBy =
  (a -> b) -> List a -> List a
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn

-- | Sort values with a custom comparison function.
--
-- > sortWith flippedComparison [1,2,3,4,5] == [5,4,3,2,1]
-- > flippedComparison a b =
-- >     case compare a b of
-- >       LT -> GT
-- >       EQ -> EQ
-- >       GT -> LT
--
-- This is also the most general sort function, allowing you
-- to define any other: @sort == sortWith compare@
sortWith :: (a -> a -> Ordering) -> List a -> List a
sortWith :: (a -> a -> Ordering) -> List a -> List a
sortWith =
  (a -> a -> Ordering) -> List a -> List a
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy

-- DECONSTRUCT

-- | Determine if a list is empty.
--
-- > isEmpty [] == True
--
-- __Note:__ It is usually preferable to use a @case@ to test this so you do not
-- forget to handle the @(x :: xs)@ case as well!
isEmpty :: List a -> Bool
isEmpty :: List a -> Bool
isEmpty =
  List a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.List.null

-- | Extract the first element of a list.
--
-- > head [1,2,3] == Just 1
-- > head [] == Nothing
--
-- __Note:__ It is usually preferable to use a @case@ to deconstruct a @List@
-- because it gives you @(x :: xs)@ and you can work with both subparts.
head :: List a -> Maybe a
head :: List a -> Maybe a
head List a
xs =
  case List a
xs of
    a
x : List a
_ ->
      a -> Maybe a
forall a. a -> Maybe a
Just a
x
    [] ->
      Maybe a
forall a. Maybe a
Nothing

-- | Extract the rest of the list.
--
-- > tail [1,2,3] == Just [2,3]
-- > tail [] == Nothing
--
-- __Note:__ It is usually preferable to use a @case@ to deconstruct a @List@
-- because it gives you @(x :: xs)@ and you can work with both subparts.
tail :: List a -> Maybe (List a)
tail :: List a -> Maybe (List a)
tail List a
list =
  case List a
list of
    a
_ : List a
xs ->
      List a -> Maybe (List a)
forall a. a -> Maybe a
Just List a
xs
    [] ->
      Maybe (List a)
forall a. Maybe a
Nothing

-- | Take the first *n* members of a list.
--
-- > take 2 [1,2,3,4] == [1,2]
take :: Int -> List a -> List a
take :: Int -> List a -> List a
take =
  Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int)
-> (Int -> List a -> List a) -> Int -> List a -> List a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> List a -> List a
forall a. Int -> [a] -> [a]
Data.List.take

-- | Drop the first *n* members of a list.
--
-- > drop 2 [1,2,3,4] == [3,4]
drop :: Int -> List a -> List a
drop :: Int -> List a -> List a
drop =
  Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int)
-> (Int -> List a -> List a) -> Int -> List a -> List a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> List a -> List a
forall a. Int -> [a] -> [a]
Data.List.drop

-- | Partition a list based on some test. The first list contains all values
-- that satisfy the test, and the second list contains all the value that do not.
--
-- > partition (\x -> x < 3) [0,1,2,3,4,5] == ([0,1,2], [3,4,5])
-- > partition isEven        [0,1,2,3,4,5] == ([0,2,4], [1,3,5])
partition :: (a -> Bool) -> List a -> (List a, List a)
partition :: (a -> Bool) -> List a -> (List a, List a)
partition =
  (a -> Bool) -> List a -> (List a, List a)
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.partition

-- | Decompose a list of tuples into a tuple of lists.
--
-- > unzip [(0, True), (17, False), (1337, True)] == ([0,17,1337], [True,False,True])
unzip :: List (a, b) -> (List a, List b)
unzip :: List (a, b) -> (List a, List b)
unzip =
  List (a, b) -> (List a, List b)
forall a b. [(a, b)] -> ([a], [b])
Data.List.unzip