{-# LANGUAGE DeriveDataTypeable #-}

-- |Operations on lists. This module re-exports all safe functions of

--  'Data.List', but wraps all partial functions which may fail. As such, this

--  module can be imported instead of "Data.List".

--

--  Partial functions are wrapped into the 'MonadThrow'-monad from

--  "Control.Monad.Catch" and as such, have appropriate failure cases for all

--  instances. E.g.:

--

--  * 'Nothing' for 'Maybe',

--  * the empty list for '[a]',

--  * 'IOException' for 'IO',

--  * lifted exceptions for monad transformers.

module Data.List.Safe (
   module LSafe,
   -- *Safe versions of standard functions.

   head,
   last,
   tail,
   init,
   foldl1,
   foldl1',
   foldr1,
   maximum,
   minimum,
   maximumBy,
   minimumBy,
   (!!),
   -- * Generic wrapper for partial functions.

   wrap,
   -- * Exceptions for empty lists and negative indices.

   -- |These are the only two exceptions that will be thrown.

   EmptyListException(..),
   NegativeIndexException(..),
   )where

import Prelude hiding (head, tail, init, last, foldl1, foldr1, maximum, minimum, (!!))

import Control.Monad.Catch
import qualified Data.List as L
import Data.List as LSafe hiding (head, last, tail, init, foldl1, foldl1', foldr1, maximum, minimum, maximumBy, minimumBy, (!!))
import Data.Typeable

-- |Signals that the list was empty or contained too few elements (in the case

--  or access by index).

data EmptyListException = EmptyListException deriving (Int -> EmptyListException -> ShowS
[EmptyListException] -> ShowS
EmptyListException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyListException] -> ShowS
$cshowList :: [EmptyListException] -> ShowS
show :: EmptyListException -> String
$cshow :: EmptyListException -> String
showsPrec :: Int -> EmptyListException -> ShowS
$cshowsPrec :: Int -> EmptyListException -> ShowS
Show, ReadPrec [EmptyListException]
ReadPrec EmptyListException
Int -> ReadS EmptyListException
ReadS [EmptyListException]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EmptyListException]
$creadListPrec :: ReadPrec [EmptyListException]
readPrec :: ReadPrec EmptyListException
$creadPrec :: ReadPrec EmptyListException
readList :: ReadS [EmptyListException]
$creadList :: ReadS [EmptyListException]
readsPrec :: Int -> ReadS EmptyListException
$creadsPrec :: Int -> ReadS EmptyListException
Read, EmptyListException -> EmptyListException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyListException -> EmptyListException -> Bool
$c/= :: EmptyListException -> EmptyListException -> Bool
== :: EmptyListException -> EmptyListException -> Bool
$c== :: EmptyListException -> EmptyListException -> Bool
Eq, Eq EmptyListException
EmptyListException -> EmptyListException -> Bool
EmptyListException -> EmptyListException -> Ordering
EmptyListException -> EmptyListException -> EmptyListException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EmptyListException -> EmptyListException -> EmptyListException
$cmin :: EmptyListException -> EmptyListException -> EmptyListException
max :: EmptyListException -> EmptyListException -> EmptyListException
$cmax :: EmptyListException -> EmptyListException -> EmptyListException
>= :: EmptyListException -> EmptyListException -> Bool
$c>= :: EmptyListException -> EmptyListException -> Bool
> :: EmptyListException -> EmptyListException -> Bool
$c> :: EmptyListException -> EmptyListException -> Bool
<= :: EmptyListException -> EmptyListException -> Bool
$c<= :: EmptyListException -> EmptyListException -> Bool
< :: EmptyListException -> EmptyListException -> Bool
$c< :: EmptyListException -> EmptyListException -> Bool
compare :: EmptyListException -> EmptyListException -> Ordering
$ccompare :: EmptyListException -> EmptyListException -> Ordering
Ord, Typeable)
-- |Singals that an element with a negative index was accessed.

data NegativeIndexException = NegativeIndexException deriving (Int -> NegativeIndexException -> ShowS
[NegativeIndexException] -> ShowS
NegativeIndexException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NegativeIndexException] -> ShowS
$cshowList :: [NegativeIndexException] -> ShowS
show :: NegativeIndexException -> String
$cshow :: NegativeIndexException -> String
showsPrec :: Int -> NegativeIndexException -> ShowS
$cshowsPrec :: Int -> NegativeIndexException -> ShowS
Show, ReadPrec [NegativeIndexException]
ReadPrec NegativeIndexException
Int -> ReadS NegativeIndexException
ReadS [NegativeIndexException]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NegativeIndexException]
$creadListPrec :: ReadPrec [NegativeIndexException]
readPrec :: ReadPrec NegativeIndexException
$creadPrec :: ReadPrec NegativeIndexException
readList :: ReadS [NegativeIndexException]
$creadList :: ReadS [NegativeIndexException]
readsPrec :: Int -> ReadS NegativeIndexException
$creadsPrec :: Int -> ReadS NegativeIndexException
Read, NegativeIndexException -> NegativeIndexException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NegativeIndexException -> NegativeIndexException -> Bool
$c/= :: NegativeIndexException -> NegativeIndexException -> Bool
== :: NegativeIndexException -> NegativeIndexException -> Bool
$c== :: NegativeIndexException -> NegativeIndexException -> Bool
Eq, Eq NegativeIndexException
NegativeIndexException -> NegativeIndexException -> Bool
NegativeIndexException -> NegativeIndexException -> Ordering
NegativeIndexException
-> NegativeIndexException -> NegativeIndexException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NegativeIndexException
-> NegativeIndexException -> NegativeIndexException
$cmin :: NegativeIndexException
-> NegativeIndexException -> NegativeIndexException
max :: NegativeIndexException
-> NegativeIndexException -> NegativeIndexException
$cmax :: NegativeIndexException
-> NegativeIndexException -> NegativeIndexException
>= :: NegativeIndexException -> NegativeIndexException -> Bool
$c>= :: NegativeIndexException -> NegativeIndexException -> Bool
> :: NegativeIndexException -> NegativeIndexException -> Bool
$c> :: NegativeIndexException -> NegativeIndexException -> Bool
<= :: NegativeIndexException -> NegativeIndexException -> Bool
$c<= :: NegativeIndexException -> NegativeIndexException -> Bool
< :: NegativeIndexException -> NegativeIndexException -> Bool
$c< :: NegativeIndexException -> NegativeIndexException -> Bool
compare :: NegativeIndexException -> NegativeIndexException -> Ordering
$ccompare :: NegativeIndexException -> NegativeIndexException -> Ordering
Ord, Typeable)

instance Exception EmptyListException
instance Exception NegativeIndexException

-- |Takes a function that requires a non-empty list and wraps it in an instance

--  of 'MonadThrow'. For empty lists, an 'EmptyListException' is thrown.

wrap :: MonadThrow m => ([a] -> b) -> [a] -> m b
wrap :: forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap [a] -> b
_ [] = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM EmptyListException
EmptyListException
wrap [a] -> b
f [a]
xs = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a] -> b
f [a]
xs

-- |Extract the first element of a list. Empty lists throw an 'EmptyListException'.

head :: MonadThrow m => [a] -> m a
head :: forall (m :: * -> *) a. MonadThrow m => [a] -> m a
head = forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap forall a. [a] -> a
L.head

-- |Extract the last element of a list. Empty lists throw an 'EmptyListException'.

last :: MonadThrow m => [a] -> m a
last :: forall (m :: * -> *) a. MonadThrow m => [a] -> m a
last = forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap forall a. [a] -> a
L.last

-- |Extract the elements after the head of a list.

--  Empty lists throw an 'EmptyListException'.

tail :: MonadThrow m => [a] -> m [a]
tail :: forall (m :: * -> *) a. MonadThrow m => [a] -> m [a]
tail = forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap forall a. [a] -> [a]
L.tail

-- |Return all the elements of a list except the last one.

--  Empty lists throw an 'EmptyListException'.

init :: MonadThrow m => [a] -> m [a]
init :: forall (m :: * -> *) a. MonadThrow m => [a] -> m [a]
init = forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap forall a. [a] -> [a]
L.init

-- |'foldl1' is a variant of 'foldl' that has no starting value, and thus must

--  be applied to non-empty lists. Empty lists throw an 'EmptyListException'.

foldl1 :: MonadThrow m => (a -> a -> a) -> [a] -> m a
foldl1 :: forall (m :: * -> *) a. MonadThrow m => (a -> a -> a) -> [a] -> m a
foldl1 = forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
L.foldl1

-- |A strict version of 'foldl1'.

foldl1' :: MonadThrow m => (a -> a -> a) -> [a] -> m a
foldl1' :: forall (m :: * -> *) a. MonadThrow m => (a -> a -> a) -> [a] -> m a
foldl1' = forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> [a] -> a
L.foldl1'

-- |'foldr1' is a variant of 'foldr' that has no starting value, and thus must

--  be applied to non-empty lists. Empty lists throw an 'EmptyListException'.

foldr1 :: MonadThrow m => (a -> a -> a) -> [a] -> m a
foldr1 :: forall (m :: * -> *) a. MonadThrow m => (a -> a -> a) -> [a] -> m a
foldr1 = forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
L.foldr1

-- |'maximum' returns the maximum value from a list, which must be non-empty,

--  finite, and of an ordered type. It is a special case of 'maximumBy', which

--  allows the programmer to supply their own comparison function.

--  Empty lists throw an 'EmptyListException'.

maximum :: (MonadThrow m, Ord a) => [a] -> m a
maximum :: forall (m :: * -> *) a. (MonadThrow m, Ord a) => [a] -> m a
maximum = forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
L.maximum

-- |'minimum' returns the maximum value from a list, which must be non-empty,

--  finite, and of an ordered type. It is a special case of 'minimumBy', which

--  allows the programmer to supply their own comparison function.

--  Empty lists throw an 'EmptyListException'.

minimum :: (MonadThrow m, Ord a) => [a] -> m a
minimum :: forall (m :: * -> *) a. (MonadThrow m, Ord a) => [a] -> m a
minimum = forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
L.minimum

-- |The 'maximumBy' function takes a comparison function and a list and returns

--  the greatest element of the list by the comparison function. The list must

--  be finite and non-empty. Empty lists throw an 'EmptyListException'.

maximumBy :: MonadThrow m => (a -> a -> Ordering) -> [a] -> m a
maximumBy :: forall (m :: * -> *) a.
MonadThrow m =>
(a -> a -> Ordering) -> [a] -> m a
maximumBy = forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
L.maximumBy

-- |The 'minimumBy' function takes a comparison function and a list and returns

--  the least element of the list by the comparison function. The list must

--  be finite and non-empty. Empty lists throw an 'EmptyListException'.

minimumBy :: MonadThrow m => (a -> a -> Ordering) -> [a] -> m a
minimumBy :: forall (m :: * -> *) a.
MonadThrow m =>
(a -> a -> Ordering) -> [a] -> m a
minimumBy = forall (m :: * -> *) a b. MonadThrow m => ([a] -> b) -> [a] -> m b
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
L.minimumBy

-- |List index (subscript) operator, starting from 0. Indices larger than

--  @length xs - 1@ throw an 'EmptyListException', negative indices throw

--  an 'NegativeIndexException'.

(!!) :: (MonadThrow m, Integral n) => [a] -> n -> m a
!! :: forall (m :: * -> *) n a.
(MonadThrow m, Integral n) =>
[a] -> n -> m a
(!!) [a]
xs n
i = forall (m :: * -> *) n a.
(MonadThrow m, Integral n) =>
[a] -> n -> m a
index [a]
xs (forall a. Integral a => a -> Integer
toInteger n
i)
   where
      index :: [a] -> n -> m a
index [] n
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM EmptyListException
EmptyListException
      index (a
x:[a]
xs) n
n | n
n forall a. Eq a => a -> a -> Bool
== n
0 = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
                     | n
n forall a. Ord a => a -> a -> Bool
< n
0 = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM NegativeIndexException
NegativeIndexException
                     | Bool
otherwise = forall (m :: * -> *) n a.
(MonadThrow m, Integral n) =>
[a] -> n -> m a
(!!) [a]
xs (n
nforall a. Num a => a -> a -> a
-n
1)