-- editorconfig-checker-disable-file
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}

module PlutusTx.List (
    uncons,
    null,
    length,
    map,
    and,
    or,
    any,
    all,
    elem,
    notElem,
    find,
    filter,
    listToMaybe,
    uniqueElement,
    findIndices,
    findIndex,
    foldr,
    foldl,
    revAppend,
    reverse,
    concat,
    concatMap,
    zip,
    unzip,
    (++),
    (!!),
    head,
    last,
    tail,
    take,
    drop,
    splitAt,
    nub,
    nubBy,
    zipWith,
    dropWhile,
    replicate,
    partition,
    sort,
    sortBy,
    elemBy,
    ) where

import PlutusTx.Bool (Bool (..), not, otherwise, (||))
import PlutusTx.Builtins (Integer)
import PlutusTx.Builtins qualified as Builtins
import PlutusTx.Eq (Eq, (/=), (==))
import PlutusTx.ErrorCodes
import PlutusTx.Ord (Ord, Ordering (..), compare, (<), (<=))
import PlutusTx.Trace (traceError)
import Prelude (Maybe (..), (.))

{- HLINT ignore -}

-- | Plutus Tx version of 'Data.List.uncons'.
uncons :: [a] -> Maybe (a, [a])
uncons :: forall a. [a] -> Maybe (a, [a])
uncons = \case
  [] -> Maybe (a, [a])
forall a. Maybe a
Nothing
  a
x : [a]
xs -> (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
x, [a]
xs)
{-# INLINEABLE uncons #-}

-- | Test whether a list is empty.
null :: [a] -> Bool
null :: forall a. [a] -> Bool
null = \case
  [] -> Bool
True
  [a]
_ -> Bool
False
{-# INLINEABLE null #-}

length :: [a] -> Integer
length :: forall a. [a] -> Integer
length = [a] -> Integer
forall a. [a] -> Integer
go
 where
  go :: [a] -> Integer
go = \case
    [] -> Integer
0
    a
_ : [a]
xs -> Integer -> Integer -> Integer
Builtins.addInteger Integer
1 ([a] -> Integer
go [a]
xs)
{-# INLINEABLE length #-}

{-| Plutus Tx version of 'Data.List.map'.

  >>> map (\i -> i + 1) [1, 2, 3]
  [2,3,4]
-}
map :: forall a b. (a -> b) -> [a] -> [b]
map :: forall a b. (a -> b) -> [a] -> [b]
map a -> b
f = [a] -> [b]
go
 where
  go :: [a] -> [b]
  go :: [a] -> [b]
go = \case
    [] -> []
    a
x : [a]
xs -> a -> b
f a
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [a] -> [b]
go [a]
xs
{-# INLINEABLE map #-}

-- | Returns the conjunction of a list of Bools.
and :: [Bool] -> Bool
and :: [Bool] -> Bool
and = \case
  [] -> Bool
True
  Bool
x : [Bool]
xs -> if Bool
x then [Bool] -> Bool
and [Bool]
xs else Bool
False
{-# INLINEABLE and #-}

-- | Returns the disjunction of a list of Bools.
or :: [Bool] -> Bool
or :: [Bool] -> Bool
or = \case
  [] -> Bool
False
  Bool
x : [Bool]
xs -> if Bool
x then Bool
True else [Bool] -> Bool
or [Bool]
xs
{-# INLINEABLE or #-}

-- | Determines whether any element of the structure satisfies the predicate.
any :: forall a. (a -> Bool) -> [a] -> Bool
any :: forall a. (a -> Bool) -> [a] -> Bool
any a -> Bool
f = [a] -> Bool
go
 where
  go :: [a] -> Bool
  go :: [a] -> Bool
go = \case
    [] -> Bool
False
    a
x : [a]
xs -> if a -> Bool
f a
x then Bool
True else [a] -> Bool
go [a]
xs
{-# INLINEABLE any #-}

-- | Determines whether all elements of the list satisfy the predicate.
all :: forall a. (a -> Bool) -> [a] -> Bool
all :: forall a. (a -> Bool) -> [a] -> Bool
all a -> Bool
f = [a] -> Bool
go
 where
  go :: [a] -> Bool
  go :: [a] -> Bool
go = \case
    [] -> Bool
True
    a
x : [a]
xs -> if a -> Bool
f a
x then [a] -> Bool
go [a]
xs else Bool
False
-- The pragma improves some of the budget tests.
{-# INLINEABLE all #-}

-- | Does the element occur in the list?
elem :: (Eq a) => a -> [a] -> Bool
elem :: forall a. Eq a => a -> [a] -> Bool
elem = (a -> Bool) -> [a] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
any ((a -> Bool) -> [a] -> Bool)
-> (a -> a -> Bool) -> a -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINEABLE elem #-}

-- | The negation of `elem`.
notElem :: (Eq a) => a -> [a] -> Bool
notElem :: forall a. Eq a => a -> [a] -> Bool
notElem a
a = Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
elem a
a
{-# INLINEABLE notElem #-}

-- | Returns the leftmost element matching the predicate, or `Nothing` if there's no such element.
find :: forall a. (a -> Bool) -> [a] -> Maybe a
find :: forall a. (a -> Bool) -> [a] -> Maybe a
find a -> Bool
f = [a] -> Maybe a
go
 where
  go :: [a] -> Maybe a
  go :: [a] -> Maybe a
go = \case
    [] -> Maybe a
forall a. Maybe a
Nothing
    a
x : [a]
xs -> if a -> Bool
f a
x then a -> Maybe a
forall a. a -> Maybe a
Just a
x else [a] -> Maybe a
go [a]
xs
{-# INLINEABLE find #-}

{-| Plutus Tx version of 'Data.List.foldr'.

  >>> foldr (\i s -> s + i) 0 [1, 2, 3, 4]
  10
-}
foldr :: forall a b. (a -> b -> b) -> b -> [a] -> b
foldr :: forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> b -> b
f b
acc = [a] -> b
go
 where
  go :: [a] -> b
  go :: [a] -> b
go = \case
    [] -> b
acc
    a
x : [a]
xs -> a -> b -> b
f a
x ([a] -> b
go [a]
xs)
{-# INLINEABLE foldr #-}

{-| Plutus Tx velsion of 'Data.List.foldl'.

  >>> foldl (\s i -> s + i) 0 [1, 2, 3, 4]
  10
-}
foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b
foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b
foldl b -> a -> b
f = b -> [a] -> b
go
 where
  go :: b -> [a] -> b
  go :: b -> [a] -> b
go b
acc = \case
    [] -> b
acc
    a
x : [a]
xs -> b -> [a] -> b
go (b -> a -> b
f b
acc a
x) [a]
xs
{-# INLINEABLE foldl #-}

{-| Plutus Tx version of '(Data.List.++)'.

  >>> [0, 1, 2] ++ [1, 2, 3, 4]
  [0,1,2,1,2,3,4]
-}
infixr 5 ++

(++) :: [a] -> [a] -> [a]
++ :: forall a. [a] -> [a] -> [a]
(++) [a]
l [a]
r = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (:) [a]
r [a]
l
{-# INLINEABLE (++) #-}

{-| Plutus Tx version of 'Data.List.concat'.

  >>> concat [[1, 2], [3], [4, 5]]
  [1,2,3,4,5]
-}
concat :: [[a]] -> [a]
concat :: forall a. [[a]] -> [a]
concat = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) []
{-# INLINEABLE concat #-}

-- | Plutus Tx version of 'Data.List.concatMap'.
concatMap :: (a -> [b]) -> [a] -> [b]
concatMap :: forall a b. (a -> [b]) -> [a] -> [b]
concatMap a -> [b]
f = (a -> [b] -> [b]) -> [b] -> [a] -> [b]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\a
x [b]
ys -> a -> [b]
f a
x [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b]
ys) []
{-# INLINEABLE concatMap #-}

{-| Plutus Tx version of 'Data.List.filter'.

  >>> filter (> 1) [1, 2, 3, 4]
  [2,3,4]
-}
filter :: (a -> Bool) -> [a] -> [a]
filter :: forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\a
e [a]
xs -> if a -> Bool
p a
e then a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs else [a]
xs) []
{-# INLINEABLE filter #-}

-- | Plutus Tx version of 'Data.List.listToMaybe'.
listToMaybe :: [a] -> Maybe a
listToMaybe :: forall a. [a] -> Maybe a
listToMaybe []      = Maybe a
forall a. Maybe a
Nothing
listToMaybe (a
x : [a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
{-# INLINEABLE listToMaybe #-}

-- | Return the element in the list, if there is precisely one.
uniqueElement :: [a] -> Maybe a
uniqueElement :: forall a. [a] -> Maybe a
uniqueElement [a
x] = a -> Maybe a
forall a. a -> Maybe a
Just a
x
uniqueElement [a]
_   = Maybe a
forall a. Maybe a
Nothing
{-# INLINEABLE uniqueElement #-}

-- | Plutus Tx version of 'Data.List.findIndices'.
findIndices :: (a -> Bool) -> [a] -> [Integer]
findIndices :: forall a. (a -> Bool) -> [a] -> [Integer]
findIndices a -> Bool
p = Integer -> [a] -> [Integer]
go Integer
0
 where
  go :: Integer -> [a] -> [Integer]
go Integer
i [a]
l = case [a]
l of
    [] -> []
    (a
x : [a]
xs) -> let indices :: [Integer]
indices = Integer -> [a] -> [Integer]
go (Integer -> Integer -> Integer
Builtins.addInteger Integer
i Integer
1) [a]
xs in if a -> Bool
p a
x then Integer
i Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
indices else [Integer]
indices
{-# INLINEABLE findIndices #-}

-- | Plutus Tx version of 'Data.List.findIndex'.
findIndex :: (a -> Bool) -> [a] -> Maybe Integer
findIndex :: forall a. (a -> Bool) -> [a] -> Maybe Integer
findIndex a -> Bool
f = Integer -> [a] -> Maybe Integer
go Integer
0
 where
  go :: Integer -> [a] -> Maybe Integer
go Integer
i = \case
    [] -> Maybe Integer
forall a. Maybe a
Nothing
    a
x : [a]
xs -> if a -> Bool
f a
x then Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i else Integer -> [a] -> Maybe Integer
go (Integer -> Integer -> Integer
Builtins.addInteger Integer
i Integer
1) [a]
xs
{-# INLINEABLE findIndex #-}

{-| Plutus Tx version of '(GHC.List.!!)'.

  >>> [10, 11, 12] !! 2
  12
-}
infixl 9 !!
(!!) :: forall a. [a] -> Integer -> a
[a]
_   !! :: forall a. [a] -> Integer -> a
!! Integer
n0 | Integer
n0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = BuiltinString -> a
forall a. BuiltinString -> a
traceError BuiltinString
negativeIndexError
[a]
xs0 !! Integer
n0 = Integer -> [a] -> a
go Integer
n0 [a]
xs0
  where
    go :: Integer -> [a] -> a
    go :: Integer -> [a] -> a
go Integer
_ []       = BuiltinString -> a
forall a. BuiltinString -> a
traceError BuiltinString
indexTooLargeError
    go Integer
n (a
x : [a]
xs) =
        if Integer -> Integer -> Bool
Builtins.equalsInteger Integer
n Integer
0
            then a
x
            else Integer -> [a] -> a
go (Integer -> Integer -> Integer
Builtins.subtractInteger Integer
n Integer
1) [a]
xs
{-# INLINABLE (!!) #-}

{-| Cons each element of the first list to the second one in reverse order (i.e. the last element
of the first list is the head of the result).

> revAppend xs ys === reverse xs ++ ys

>>> revAppend "abc" "de"
"cbade"
-}
revAppend :: forall a. [a] -> [a] -> [a]
revAppend :: forall a. [a] -> [a] -> [a]
revAppend = [a] -> [a] -> [a]
rev
 where
  rev :: [a] -> [a] -> [a]
  rev :: [a] -> [a] -> [a]
rev [] [a]
a       = [a]
a
  rev (a
x : [a]
xs) [a]
a = [a] -> [a] -> [a]
rev [a]
xs (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
a)
{-# INLINEABLE revAppend #-}

-- | Plutus Tx version of 'Data.List.reverse'.
reverse :: [a] -> [a]
reverse :: forall a. [a] -> [a]
reverse [a]
l = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
revAppend [a]
l []
{-# INLINEABLE reverse #-}

-- | Plutus Tx version of 'Data.List.zip'.
zip :: forall a b. [a] -> [b] -> [(a, b)]
zip :: forall a b. [a] -> [b] -> [(a, b)]
zip = [a] -> [b] -> [(a, b)]
go
 where
  go :: [a] -> [b] -> [(a, b)]
  go :: [a] -> [b] -> [(a, b)]
go [] [b]
_bs            = []
  go [a]
_as []            = []
  go (a
a : [a]
as) (b
b : [b]
bs) = (a
a, b
b) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, b)]
go [a]
as [b]
bs
{-# INLINEABLE zip #-}

-- | Plutus Tx version of 'Data.List.unzip'.
unzip :: forall a b. [(a, b)] -> ([a], [b])
unzip :: forall a b. [(a, b)] -> ([a], [b])
unzip = [(a, b)] -> ([a], [b])
go
 where
  go :: [(a, b)] -> ([a], [b])
  go :: [(a, b)] -> ([a], [b])
go [] = ([], [])
  go ((a
x, b
y) : [(a, b)]
xys) = case [(a, b)] -> ([a], [b])
go [(a, b)]
xys of
    ([a]
xs, [b]
ys) -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs, b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ys)
{-# INLINEABLE unzip #-}

-- | Plutus Tx version of 'Data.List.head'.
head :: [a] -> a
head :: forall a. [a] -> a
head []      = BuiltinString -> a
forall a. BuiltinString -> a
traceError BuiltinString
headEmptyListError
head (a
x : [a]
_) = a
x
{-# INLINEABLE head #-}

-- | Plutus Tx version of 'Data.List.last'.
last :: [a] -> a
last :: forall a. [a] -> a
last []       = BuiltinString -> a
forall a. BuiltinString -> a
traceError BuiltinString
lastEmptyListError
last [a
x]      = a
x
last (a
_ : [a]
xs) = [a] -> a
forall a. [a] -> a
last [a]
xs
{-# INLINEABLE last #-}

-- | Plutus Tx version of 'Data.List.tail'.
tail :: [a] -> [a]
tail :: forall a. [a] -> [a]
tail (a
_ : [a]
as) = [a]
as
tail []       = BuiltinString -> [a]
forall a. BuiltinString -> a
traceError BuiltinString
tailEmptyListError
{-# INLINEABLE tail #-}

-- | Plutus Tx version of 'Data.List.take'.
take :: forall a. Integer -> [a] -> [a]
take :: forall a. Integer -> [a] -> [a]
take = Integer -> [a] -> [a]
go
 where
  go :: Integer -> [a] -> [a]
  go :: Integer -> [a] -> [a]
go Integer
n [a]
_ | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = []
  go Integer
_ [] = []
  go Integer
n (a
x : [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Integer -> [a] -> [a]
go (Integer -> Integer -> Integer
Builtins.subtractInteger Integer
n Integer
1) [a]
xs
{-# INLINEABLE take #-}

-- | Plutus Tx version of 'Data.List.drop'.
drop :: forall a. Integer -> [a] -> [a]
drop :: forall a. Integer -> [a] -> [a]
drop = Integer -> [a] -> [a]
go
 where
  go :: Integer -> [a] -> [a]
  go :: Integer -> [a] -> [a]
go Integer
n [a]
xs | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = [a]
xs
  go Integer
_ [] = []
  go Integer
n (a
_ : [a]
xs) = Integer -> [a] -> [a]
go (Integer -> Integer -> Integer
Builtins.subtractInteger Integer
n Integer
1) [a]
xs
{-# INLINEABLE drop #-}

-- | Plutus Tx version of 'Data.List.splitAt'.
splitAt :: forall a. Integer -> [a] -> ([a], [a])
splitAt :: forall a. Integer -> [a] -> ([a], [a])
splitAt Integer
n [a]
xs
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = ([], [a]
xs)
  | Bool
otherwise = Integer -> [a] -> ([a], [a])
go Integer
n [a]
xs
 where
  go :: Integer -> [a] -> ([a], [a])
  go :: Integer -> [a] -> ([a], [a])
go Integer
_ [] = ([], [])
  go Integer
m (a
y : [a]
ys)
    | Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = ([a
y], [a]
ys)
    | Bool
otherwise = case Integer -> [a] -> ([a], [a])
go (Integer -> Integer -> Integer
Builtins.subtractInteger Integer
m Integer
1) [a]
ys of
        ([a]
zs, [a]
ws) -> (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
zs, [a]
ws)
{-# INLINEABLE splitAt #-}

-- | Plutus Tx version of 'Data.List.nub'.
nub :: (Eq a) => [a] -> [a]
nub :: forall a. Eq a => [a] -> [a]
nub = (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINEABLE nub #-}

elemBy :: forall a. (a -> a -> Bool) -> a -> [a] -> Bool
elemBy :: forall a. (a -> a -> Bool) -> a -> [a] -> Bool
elemBy a -> a -> Bool
eq a
y = [a] -> Bool
go
 where
  go :: [a] -> Bool
  go :: [a] -> Bool
go []       = Bool
False
  go (a
x : [a]
xs) = a
x a -> a -> Bool
`eq` a
y Bool -> Bool -> Bool
|| [a] -> Bool
go [a]
xs
{-# INLINEABLE elemBy #-}

-- | Plutus Tx version of 'Data.List.nubBy'.
nubBy :: (a -> a -> Bool) -> [a] -> [a]
nubBy :: forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy a -> a -> Bool
eq [a]
l = [a] -> [a] -> [a]
nubBy' [a]
l []
 where
  nubBy' :: [a] -> [a] -> [a]
nubBy' [] [a]
_ = []
  nubBy' (a
y : [a]
ys) [a]
xs
    | (a -> a -> Bool) -> a -> [a] -> Bool
forall a. (a -> a -> Bool) -> a -> [a] -> Bool
elemBy a -> a -> Bool
eq a
y [a]
xs = [a] -> [a] -> [a]
nubBy' [a]
ys [a]
xs
    | Bool
otherwise = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
nubBy' [a]
ys (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
{-# INLINEABLE nubBy #-}

-- | Plutus Tx version of 'Data.List.zipWith'.
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> c
f = [a] -> [b] -> [c]
go
 where
  go :: [a] -> [b] -> [c]
  go :: [a] -> [b] -> [c]
go [] [b]
_              = []
  go [a]
_ []              = []
  go (a
x : [a]
xs) (b
y : [b]
ys) = a -> b -> c
f a
x b
y c -> [c] -> [c]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [c]
go [a]
xs [b]
ys
{-# INLINEABLE zipWith #-}

-- | Plutus Tx version of 'Data.List.dropWhile'.
dropWhile :: forall a. (a -> Bool) -> [a] -> [a]
dropWhile :: forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
p = [a] -> [a]
go
 where
  go :: [a] -> [a]
  go :: [a] -> [a]
go [] = []
  go xs :: [a]
xs@(a
x : [a]
xs')
    | a -> Bool
p a
x = [a] -> [a]
go [a]
xs'
    | Bool
otherwise = [a]
xs
{-# INLINEABLE dropWhile #-}

-- | Plutus Tx version of 'Data.List.replicate'.
replicate :: forall a. Integer -> a -> [a]
replicate :: forall a. Integer -> a -> [a]
replicate Integer
n0 a
x = Integer -> [a]
go Integer
n0
 where
  go :: Integer -> [a]
go Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = []
  go Integer
n = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Integer -> [a]
go (Integer -> Integer -> Integer
Builtins.subtractInteger Integer
n Integer
1)
{-# INLINEABLE replicate #-}

-- | Plutus Tx version of 'Data.List.partition'.
partition :: (a -> Bool) -> [a] -> ([a], [a])
partition :: forall a. (a -> Bool) -> [a] -> ([a], [a])
partition a -> Bool
p [a]
xs = (a -> ([a], [a]) -> ([a], [a])) -> ([a], [a]) -> [a] -> ([a], [a])
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr ((a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
forall a. (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
select a -> Bool
p) ([], []) [a]
xs
{-# INLINEABLE partition #-}

select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
select :: forall a. (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
select a -> Bool
p a
x ~([a]
ts, [a]
fs)
  | a -> Bool
p a
x = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ts, [a]
fs)
  | Bool
otherwise = ([a]
ts, a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
fs)

-- | Plutus Tx version of 'Data.List.sort'.
sort :: (Ord a) => [a] -> [a]
sort :: forall a. Ord a => [a] -> [a]
sort = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINEABLE sort #-}

-- | Plutus Tx version of 'Data.List.sortBy'.
sortBy :: (a -> a -> Ordering) -> [a] -> [a]
sortBy :: forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
cmp [a]
l = [[a]] -> [a]
mergeAll ([a] -> [[a]]
sequences [a]
l)
 where
  sequences :: [a] -> [[a]]
sequences (a
a : a
b : [a]
xs)
    | a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = a -> [a] -> [a] -> [[a]]
descending a
b [a
a] [a]
xs
    | Bool
otherwise = a -> ([a] -> [a]) -> [a] -> [[a]]
ascending a
b (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [a]
xs
  sequences [a]
xs = [[a]
xs]

  descending :: a -> [a] -> [a] -> [[a]]
descending a
a [a]
as (a
b : [a]
bs)
    | a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = a -> [a] -> [a] -> [[a]]
descending a
b (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as) [a]
bs
  descending a
a [a]
as [a]
bs = (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
sequences [a]
bs

  ascending :: a -> ([a] -> [a]) -> [a] -> [[a]]
ascending a
a [a] -> [a]
as (a
b : [a]
bs)
    | a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = a -> ([a] -> [a]) -> [a] -> [[a]]
ascending a
b (\[a]
ys -> [a] -> [a]
as (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys)) [a]
bs
  ascending a
a [a] -> [a]
as [a]
bs =
    let x :: [a]
x = [a] -> [a]
as [a
a]
     in [a]
x [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
sequences [a]
bs

  mergeAll :: [[a]] -> [a]
mergeAll [[a]
x] = [a]
x
  mergeAll [[a]]
xs  = [[a]] -> [a]
mergeAll ([[a]] -> [[a]]
mergePairs [[a]]
xs)

  mergePairs :: [[a]] -> [[a]]
mergePairs ([a]
a : [a]
b : [[a]]
xs) =
    let x :: [a]
x = [a] -> [a] -> [a]
merge [a]
a [a]
b
     in [a]
x [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
mergePairs [[a]]
xs
  mergePairs [[a]]
xs = [[a]]
xs

  merge :: [a] -> [a] -> [a]
merge as :: [a]
as@(a
a : [a]
as') bs :: [a]
bs@(a
b : [a]
bs')
    | a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
as [a]
bs'
    | Bool
otherwise = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
as' [a]
bs
  merge [] [a]
bs = [a]
bs
  merge [a]
as [] = [a]
as
{-# INLINEABLE sortBy #-}