-- | Fast immutable arrays. The elements in an array must have the same type.
module Array
  ( -- * Arrays
    Array,

    -- * Creation
    empty,
    initialize,
    repeat,
    fromList,

    -- * Query
    isEmpty,
    length,
    get,

    -- * Manipulate
    set,
    push,
    append,
    slice,

    -- * Lists
    toList,
    toIndexedList,

    -- * Transform
    map,
    indexedMap,
    foldr,
    foldl,
    filter,
  )
where

import Basics
  ( Bool,
    Int,
    clamp,
    (&&),
    (+),
    (-),
    (<),
    (<=),
    (<|),
    (>>),
  )
import qualified Data.Foldable
import Data.Vector ((!?), (++), (//))
import qualified Data.Vector
import List (List)
import qualified List
import Maybe (Maybe (..))
import qualified Tuple
import Prelude (otherwise)
import qualified Prelude

-- | Representation of fast immutable arrays. You can create arrays of integers
-- (@Array Int@) or strings (@Array String@) or any other type of value you can
-- dream up.
newtype Array a = Array (Data.Vector.Vector a)
  deriving (Array a -> Array a -> Bool
(Array a -> Array a -> Bool)
-> (Array a -> Array a -> Bool) -> Eq (Array a)
forall a. Eq a => Array a -> Array a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Array a -> Array a -> Bool
$c/= :: forall a. Eq a => Array a -> Array a -> Bool
== :: Array a -> Array a -> Bool
$c== :: forall a. Eq a => Array a -> Array a -> Bool
Prelude.Eq, Int -> Array a -> ShowS
[Array a] -> ShowS
Array a -> String
(Int -> Array a -> ShowS)
-> (Array a -> String) -> ([Array a] -> ShowS) -> Show (Array a)
forall a. Show a => Int -> Array a -> ShowS
forall a. Show a => [Array a] -> ShowS
forall a. Show a => Array a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Array a] -> ShowS
$cshowList :: forall a. Show a => [Array a] -> ShowS
show :: Array a -> String
$cshow :: forall a. Show a => Array a -> String
showsPrec :: Int -> Array a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Array a -> ShowS
Prelude.Show)

-- | Helper function to unwrap an array
unwrap :: Array a -> Data.Vector.Vector a
unwrap :: Array a -> Vector a
unwrap (Array Vector a
v) = Vector a
v

-- | Return an empty array.
--
-- > length empty == 0
empty :: Array a
empty :: Array a
empty =
  Vector a -> Array a
forall a. Vector a -> Array a
Array Vector a
forall a. Vector a
Data.Vector.empty

-- | Determine if an array is empty.
--
-- > isEmpty empty == True
isEmpty :: Array a -> Bool
isEmpty :: Array a -> Bool
isEmpty = Array a -> Vector a
forall a. Array a -> Vector a
unwrap (Array a -> Vector a) -> (Vector a -> Bool) -> Array a -> Bool
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Vector a -> Bool
forall a. Vector a -> Bool
Data.Vector.null

-- | Return the length of an array.
--
-- > length (fromList [1,2,3]) == 3
length :: Array a -> Int
length :: Array a -> Int
length =
  Array a -> Vector a
forall a. Array a -> Vector a
unwrap
    (Array a -> Vector a) -> (Vector a -> Int) -> Array a -> Int
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Vector a -> Int
forall a. Vector a -> Int
Data.Vector.length
    (Vector a -> Int) -> (Int -> Int) -> Vector 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

-- | Initialize an array. @initialize n f@ creates an array of length @n@ with
-- the element at index @i@ initialized to the result of @(f i)@.
--
-- > initialize 4 identity    == fromList [0,1,2,3]
-- > initialize 4 (\n -> n*n) == fromList [0,1,4,9]
-- > initialize 4 (always 0)  == fromList [0,0,0,0]
initialize :: Int -> (Int -> a) -> Array a
initialize :: Int -> (Int -> a) -> Array a
initialize Int
n Int -> a
f =
  Vector a -> Array a
forall a. Vector a -> Array a
Array
    (Vector a -> Array a) -> Vector a -> Array a
forall a b. (a -> b) -> a -> b
<| Int -> (Int -> a) -> Vector a
forall a. Int -> (Int -> a) -> Vector a
Data.Vector.generate
      (Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int
n)
      (Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int) -> (Int -> a) -> Int -> a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> a
f)

-- | Creates an array with a given length, filled with a default element.
--
-- > repeat 5 0     == fromList [0,0,0,0,0]
-- > repeat 3 "cat" == fromList ["cat","cat","cat"]
--
-- Notice that @repeat 3 x@ is the same as @initialize 3 (always x)@.
repeat :: Int -> a -> Array a
repeat :: Int -> a -> Array a
repeat Int
n a
e =
  Vector a -> Array a
forall a. Vector a -> Array a
Array
    (Vector a -> Array a) -> Vector a -> Array a
forall a b. (a -> b) -> a -> b
<| Int -> a -> Vector a
forall a. Int -> a -> Vector a
Data.Vector.replicate (Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int
n) a
e

-- | Create an array from a 'List'.
fromList :: List a -> Array a
fromList :: List a -> Array a
fromList =
  List a -> Vector a
forall a. [a] -> Vector a
Data.Vector.fromList (List a -> Vector a) -> (Vector a -> Array a) -> List a -> Array a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Vector a -> Array a
forall a. Vector a -> Array a
Array

-- | Return @Just@ the element at the index or @Nothing@ if the index is out of range.
--
-- > get  0   (fromList [0,1,2]) == Just 0
-- > get  2   (fromList [0,1,2]) == Just 2
-- > get  5   (fromList [0,1,2]) == Nothing
-- > get (-1) (fromList [0,1,2]) == Nothing
get :: Int -> Array a -> Maybe a
get :: Int -> Array a -> Maybe a
get Int
i Array a
array =
  Array a -> Vector a
forall a. Array a -> Vector a
unwrap Array a
array Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
!? Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int
i

-- | Set the element at a particular index. Returns an updated array.
--
-- If the index is out of range, the array is unaltered.
--
-- > set 1 7 (fromList [1,2,3]) == fromList [1,7,3]
set :: Int -> a -> Array a -> Array a
set :: Int -> a -> Array a -> Array a
set Int
i a
value Array a
array = Vector a -> Array a
forall a. Vector a -> Array a
Array Vector a
result
  where
    len :: Int
len = Array a -> Int
forall a. Array a -> Int
length Array a
array
    vector :: Vector a
vector = Array a -> Vector a
forall a. Array a -> Vector a
unwrap Array a
array
    result :: Vector a
result
      | Int
0 Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
< Int
len = Vector a
vector Vector a -> [(Int, a)] -> Vector a
forall a. Vector a -> [(Int, a)] -> Vector a
// [(Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int
i, a
value)]
      | Bool
otherwise = Vector a
vector

-- | Push an element onto the end of an array.
--
-- > push 3 (fromList [1,2]) == fromList [1,2,3]
push :: a -> Array a -> Array a
push :: a -> Array a -> Array a
push a
a (Array Vector a
vector) =
  Vector a -> Array a
forall a. Vector a -> Array a
Array (Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
Data.Vector.snoc Vector a
vector a
a)

-- | Create a list of elements from an array.
--
-- > toList (fromList [3,5,8]) == [3,5,8]
toList :: Array a -> List a
toList :: Array a -> List a
toList = Array a -> Vector a
forall a. Array a -> Vector a
unwrap (Array a -> Vector a) -> (Vector a -> List a) -> Array a -> List a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Vector a -> List a
forall a. Vector a -> [a]
Data.Vector.toList

-- | Create an indexed list from an array. Each element of the array will be
-- paired with its index.
--
-- > toIndexedList (fromList ["cat","dog"]) == [(0,"cat"), (1,"dog")]
toIndexedList :: Array a -> List (Int, a)
toIndexedList :: Array a -> List (Int, a)
toIndexedList =
  Array a -> Vector a
forall a. Array a -> Vector a
unwrap
    (Array a -> Vector a)
-> (Vector a -> List (Int, a)) -> Array a -> List (Int, a)
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Vector a -> Vector (Int, a)
forall a. Vector a -> Vector (Int, a)
Data.Vector.indexed
    (Vector a -> Vector (Int, a))
-> (Vector (Int, a) -> List (Int, a)) -> Vector a -> List (Int, a)
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Vector (Int, a) -> [(Int, a)]
forall a. Vector a -> [a]
Data.Vector.toList
    (Vector (Int, a) -> [(Int, a)])
-> ([(Int, a)] -> List (Int, a))
-> Vector (Int, a)
-> List (Int, a)
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> ((Int, a) -> (Int, a)) -> [(Int, a)] -> List (Int, a)
forall a b. (a -> b) -> List a -> List b
List.map ((Int -> Int) -> (Int, a) -> (Int, a)
forall a x b. (a -> x) -> (a, b) -> (x, b)
Tuple.mapFirst Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)

-- | Reduce an array from the right. Read @foldr@ as fold from the right.
--
-- > foldr (+) 0 (repeat 3 5) == 15
foldr :: (a -> b -> b) -> b -> Array a -> b
foldr :: (a -> b -> b) -> b -> Array a -> b
foldr a -> b -> b
f b
value Array a
array = (a -> b -> b) -> b -> Vector a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr a -> b -> b
f b
value (Array a -> Vector a
forall a. Array a -> Vector a
unwrap Array a
array)

-- | Reduce an array from the left. Read @foldl@ as fold from the left.
--
-- > foldl (:) [] (fromList [1,2,3]) == [3,2,1]
foldl :: (a -> b -> b) -> b -> Array a -> b
foldl :: (a -> b -> b) -> b -> Array a -> b
foldl a -> b -> b
f b
value Array a
array =
  (b -> a -> b) -> b -> Vector a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (\b
a a
b -> a -> b -> b
f a
b b
a) b
value (Array a -> Vector a
forall a. Array a -> Vector a
unwrap Array a
array)

-- | Keep elements that pass the test.
--
-- > filter isEven (fromList [1,2,3,4,5,6]) == (fromList [2,4,6])
filter :: (a -> Bool) -> Array a -> Array a
filter :: (a -> Bool) -> Array a -> Array a
filter a -> Bool
f (Array Vector a
vector) =
  Vector a -> Array a
forall a. Vector a -> Array a
Array ((a -> Bool) -> Vector a -> Vector a
forall a. (a -> Bool) -> Vector a -> Vector a
Data.Vector.filter a -> Bool
f Vector a
vector)

-- | Apply a function on every element in an array.
--
-- > map sqrt (fromList [1,4,9]) == fromList [1,2,3]
map :: (a -> b) -> Array a -> Array b
map :: (a -> b) -> Array a -> Array b
map a -> b
f (Array Vector a
vector) =
  Vector b -> Array b
forall a. Vector a -> Array a
Array ((a -> b) -> Vector a -> Vector b
forall a b. (a -> b) -> Vector a -> Vector b
Data.Vector.map a -> b
f Vector a
vector)

-- | Apply a function on every element with its index as first argument.
--
-- > indexedMap (*) (fromList [5,5,5]) == fromList [0,5,10]
indexedMap :: (Int -> a -> b) -> Array a -> Array b
indexedMap :: (Int -> a -> b) -> Array a -> Array b
indexedMap Int -> a -> b
f (Array Vector a
vector) =
  Vector b -> Array b
forall a. Vector a -> Array a
Array ((Int -> a -> b) -> Vector a -> Vector b
forall a b. (Int -> a -> b) -> Vector a -> Vector b
Data.Vector.imap (Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int) -> (Int -> a -> b) -> Int -> a -> b
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> a -> b
f) Vector a
vector)

-- | Append two arrays to a new one.
--
-- > append (repeat 2 42) (repeat 3 81) == fromList [42,42,81,81,81]
append :: Array a -> Array a -> Array a
append :: Array a -> Array a -> Array a
append (Array Vector a
first) (Array Vector a
second) =
  Vector a -> Array a
forall a. Vector a -> Array a
Array (Vector a
first Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
++ Vector a
second)

-- | Get a sub-section of an array: @(slice start end array)@. The @start@ is a
-- zero-based index where we will start our slice. The @end@ is a zero-based index
-- that indicates the end of the slice. The slice extracts up to but not including
-- @end@.
--
-- > slice  0  3 (fromList [0,1,2,3,4]) == fromList [0,1,2]
-- > slice  1  4 (fromList [0,1,2,3,4]) == fromList [1,2,3]
--
-- Both the @start@ and @end@ indexes can be negative, indicating an offset from
-- the end of the array.
--
-- > slice  1    (-1) (fromList [0,1,2,3,4]) == fromList [1,2,3]
-- > slice  (-2) 5    (fromList [0,1,2,3,4]) == fromList [3,4]
--
-- This makes it pretty easy to @pop@ the last element off of an array:
-- @slice 0 -1 array@
slice :: Int -> Int -> Array a -> Array a
slice :: Int -> Int -> Array a -> Array a
slice Int
from Int
to (Array Vector a
vector)
  | Int
sliceLen Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
<= Int
0 = Array a
forall a. Array a
empty
  | Bool
otherwise = Vector a -> Array a
forall a. Vector a -> Array a
Array (Vector a -> Array a) -> Vector a -> Array a
forall a b. (a -> b) -> a -> b
<| Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
Data.Vector.slice Int
from' Int
sliceLen Vector a
vector
  where
    len :: Int
len = Vector a -> Int
forall a. Vector a -> Int
Data.Vector.length Vector a
vector
    handleNegative :: Int -> Int
handleNegative Int
value
      | Int
value Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
< Int
0 = Int
len Int -> Int -> Int
forall number. Num number => number -> number -> number
+ Int
value
      | Bool
otherwise = Int
value
    normalize :: Int -> Int
normalize =
      Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
        (Int -> Int) -> (Int -> Int) -> Int -> Int
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Int
handleNegative
        (Int -> Int) -> (Int -> Int) -> Int -> Int
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Int -> Int -> Int
forall number. Ord number => number -> number -> number -> number
clamp Int
0 Int
len
    from' :: Int
from' = Int -> Int
normalize Int
from
    to' :: Int
to' = Int -> Int
normalize Int
to
    sliceLen :: Int
sliceLen = Int
to' Int -> Int -> Int
forall number. Num number => number -> number -> number
- Int
from'