module Antelude.List
(
module ListExp
, 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) )
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
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
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
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
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
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
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.\\)
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.++)
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]
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
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