{- |
Module      : Antelude.List
Description : Contains some functions for Lists, and reexports the Data.List module.
Maintainer  : dneavesdev@pm.me
-}
module Antelude.List
    ( -- * Rexports
      module ListExp
      -- * New and Reconstructed for safety
    , append
    , atIndex
    , combine
    , cons
    , contains
    , difference
    , head
    , init
    , last
    , prepend
    , tail
    ) where

import safe           Antelude.Function              ( (<|), (|>) )
import safe           Antelude.Internal.TypesClasses
    ( Bool
    , Eq
    , Int
    , Maybe (..)
    , Ordering (..)
    )
import safe qualified Antelude.Internal.TypesClasses as ATC ( List )

import safe           Data.List                      as ListExp hiding
    ( head
    , init
    , last
    , tail
    , (++)
    , (\\)
    )
import safe qualified Data.List                      as List

import safe           Prelude                        ( Ord (compare) )


-- | A safe implementation of 'head'. Returns 'Nothing' if if the 'List' is empty.
head :: ATC.List a -> Maybe a
head :: forall a. List a -> Maybe a
head List a
lst = case List a
lst of
  []    -> Maybe a
forall a. Maybe a
Nothing
  [a
x]   -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  a
x : List a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x


-- | A safe implementation of 'last'. Returns 'Nothing' if if the 'List' is empty.
last :: ATC.List a -> Maybe a
last :: forall a. List a -> Maybe a
last List a
lst = case List a -> List a
forall a. [a] -> [a]
List.reverse List a
lst of
  []    -> Maybe a
forall a. Maybe a
Nothing
  [a
x]   -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  a
x : List a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x


-- | A safe implementation of 'tail'. Returns 'Nothing' if if the 'List' is empty.
tail :: ATC.List a -> Maybe (ATC.List a)
tail :: forall a. List a -> Maybe (List a)
tail List a
lst = case List a
lst of
  a
_ : List a
xs -> List a -> Maybe (List a)
forall a. a -> Maybe a
Just List a
xs
  List a
_      -> Maybe (List a)
forall a. Maybe a
Nothing


-- | A safe implementation of 'init'. Returns 'Nothing' if if the 'List' is empty.
init :: ATC.List a -> Maybe (ATC.List a)
init :: forall a. List a -> Maybe (List a)
init List a
lst = case List a -> List a
forall a. [a] -> [a]
List.reverse List a
lst of
  a
_ : List a
xs -> List a -> Maybe (List a)
forall a. a -> Maybe a
Just (List a -> Maybe (List a)) -> List a -> Maybe (List a)
forall a b. (a -> b) -> a -> b
<| List a -> List a
forall a. [a] -> [a]
List.reverse List a
xs
  List a
_      -> Maybe (List a)
forall a. Maybe a
Nothing


{- |
   Obtain the element at the given index, starting at 0. 'Nothing' if the index is not valid.
-}
atIndex :: Int -> ATC.List a -> Maybe a
atIndex :: forall a. Int -> List a -> Maybe a
atIndex Int
index List a
lst = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
index Int
0 of
  Ordering
LT ->
    Maybe a
forall a. Maybe a
Nothing
  Ordering
_ ->
    List a
lst
      List a -> (List a -> List a) -> List a
forall a b. a -> (a -> b) -> b
|> Int -> List a -> List a
forall a. Int -> [a] -> [a]
List.drop
        Int
index
      List a -> (List a -> Maybe a) -> Maybe a
forall a b. a -> (a -> b) -> b
|> List a -> Maybe a
forall a. List a -> Maybe a
head

-- | Defined as 'Data.List.elem'. See if something is a member of a list
contains :: Eq a => a -> ATC.List a -> Bool
contains :: forall a. Eq a => a -> List a -> Bool
contains = a -> [a] -> Bool
forall a. Eq a => a -> List a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
List.elem


{- |
   Defined as '(Data.List.\\)':

   The (\\\\) function is list difference (non-associative). In the result of xs \\\\ ys, the first occurrence of each element of ys in turn (if any) has been removed from xs. Thus (xs <> ys) \\\\ xs == ys.
-}
difference :: (Eq a) => ATC.List a -> ATC.List a -> ATC.List a
difference :: forall a. Eq a => List a -> List a -> List a
difference = [a] -> [a] -> [a]
forall a. Eq a => List a -> List a -> List a
(List.\\)


-- | Defined as '(Data.List.++)'. You could use (Antelude.<>) instead.
combine :: ATC.List a -> ATC.List a -> ATC.List a
combine :: forall a. List a -> List a -> List a
combine = [a] -> [a] -> [a]
forall a. List a -> List a -> List a
(List.++)


-- | Add an item to the end of a 'List'.
append :: a -> ATC.List a -> ATC.List a
append :: forall a. a -> List a -> List a
append a
new List a
lst = List a -> List a -> List a
forall a. List a -> List a -> List a
combine List a
lst [a
new]


-- | Add an item to the beginning of a 'List'.
prepend :: a -> ATC.List a -> ATC.List a
prepend :: forall a. a -> List a -> List a
prepend a
new List a
lst = a
new a -> List a -> List a
forall a. a -> List a -> List a
: List a
lst


-- | Defined as 'prepend'. Add an item to the beginning of a 'List'.
cons :: a -> ATC.List a -> ATC.List a
cons :: forall a. a -> List a -> List a
cons = a -> List a -> List a
forall a. a -> List a -> List a
prepend