-- editorconfig-checker-disable-file {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} module PlutusTx.List ( uncons, null, map, and, or, any, all, elem, notElem, find, filter, listToMaybe, uniqueElement, findIndices, findIndex, foldr, foldl, revAppend, reverse, concat, concatMap, zip, unzip, (++), (!!), indexBuiltinList, head, last, tail, take, drop, splitAt, nub, nubBy, zipWith, dropWhile, replicate, partition, sort, sortBy, ) where import PlutusTx.Bool (Bool (..), not, otherwise, (||)) import PlutusTx.Builtins (Integer) import PlutusTx.Builtins qualified as Builtins import PlutusTx.Builtins.Internal qualified as BI import PlutusTx.Eq (Eq, (/=), (==)) import PlutusTx.ErrorCodes import PlutusTx.Ord (Ord, Ordering (..), compare, (<), (<=)) import PlutusTx.Trace (traceError) import Prelude (Maybe (..), (.)) {- HLINT ignore -} {-# INLINABLE uncons #-} -- | 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) {-# INLINABLE null #-} -- | Test whether a list is empty. null :: [a] -> Bool null :: forall a. [a] -> Bool null = \case [] -> Bool True [a] _ -> Bool False {-# INLINABLE map #-} -- | 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 {-# INLINABLE and #-} -- | 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 {-# INLINABLE or #-} -- | 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 {-# INLINABLE any #-} -- | 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 -- The pragma improves some of the budget tests. {-# INLINABLE all #-} -- | 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 {-# INLINABLE elem #-} -- | 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 (==) {-# INLINABLE notElem #-} -- | 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 {-# INLINABLE find #-} -- | 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 {-# INLINABLE foldr #-} -- | 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) {-# INLINABLE foldl #-} -- | 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 {-# INLINABLE (++) #-} -- | 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 {-# INLINABLE concat #-} -- | 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] (++) [] {-# INLINABLE concatMap #-} -- | 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) [] {-# INLINABLE filter #-} -- | 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 ea -> [a] -> [a] forall a. a -> [a] -> [a] :[a] xs else [a] xs) [] {-# INLINABLE listToMaybe #-} -- | 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 {-# INLINABLE uniqueElement #-} -- | 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 {-# INLINABLE findIndices #-} -- | 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 iInteger -> [Integer] -> [Integer] forall a. a -> [a] -> [a] :[Integer] indices else [Integer] indices {-# INLINABLE findIndex #-} -- | 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 {-# INLINABLE (!!) #-} -- | 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 -- | Index operator for builtin lists. -- -- >>> indexBuiltinList (toBuiltin [10, 11, 12]) 2 -- 12 -- indexBuiltinList :: forall a. BI.BuiltinList a -> Integer -> a indexBuiltinList :: forall a. BuiltinList a -> Integer -> a indexBuiltinList BuiltinList a xs0 Integer i0 | Integer i0 Integer -> Integer -> Bool `Builtins.lessThanInteger` Integer 0 = BuiltinString -> a forall a. BuiltinString -> a traceError BuiltinString builtinListNegativeIndexError | Bool otherwise = BuiltinList a -> Integer -> a go BuiltinList a xs0 Integer i0 where go :: BI.BuiltinList a -> Integer -> a go :: BuiltinList a -> Integer -> a go BuiltinList a xs Integer i = BuiltinList a -> (() -> () -> a) -> (a -> BuiltinList a -> () -> a) -> () -> a forall a r. BuiltinList a -> (() -> r) -> (a -> BuiltinList a -> r) -> r Builtins.matchList BuiltinList a xs (\() _ -> BuiltinString -> () -> a forall a. BuiltinString -> a traceError BuiltinString builtinListIndexTooLargeError) ( \a hd BuiltinList a tl () _ -> if Integer i Integer -> Integer -> Bool `Builtins.equalsInteger` Integer 0 then a hd else BuiltinList a -> Integer -> a go BuiltinList a tl (Integer -> Integer -> Integer Builtins.subtractInteger Integer i Integer 1) ) () {-# INLINABLE revAppend #-} -- | 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 xa -> [a] -> [a] forall a. a -> [a] -> [a] :[a] a) {-# INLINABLE reverse #-} -- | 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 [] {-# INLINABLE zip #-} -- | Plutus Tx version of 'Data.List.zip'. zip :: [a] -> [b] -> [(a,b)] zip :: forall a b. [a] -> [b] -> [(a, b)] zip [] [b] _bs = [] zip [a] _as [] = [] zip (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)] forall a b. [a] -> [b] -> [(a, b)] zip [a] as [b] bs {-# INLINABLE unzip #-} -- | Plutus Tx version of 'Data.List.unzip'. unzip :: [(a,b)] -> ([a], [b]) unzip :: forall a b. [(a, b)] -> ([a], [b]) unzip [] = ([], []) unzip ((a x, b y) : [(a, b)] xys) = case [(a, b)] -> ([a], [b]) forall a b. [(a, b)] -> ([a], [b]) unzip [(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) {-# INLINABLE head #-} -- | 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 {-# INLINABLE last #-} -- | 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 {-# INLINABLE tail #-} -- | 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 {-# INLINABLE take #-} -- | Plutus Tx version of 'Data.List.take'. take :: Integer -> [a] -> [a] take :: forall a. Integer -> [a] -> [a] take Integer n [a] _ | Integer n Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool <= Integer 0 = [] take Integer _ [] = [] take Integer n (a x:[a] xs) = a x a -> [a] -> [a] forall a. a -> [a] -> [a] : Integer -> [a] -> [a] forall a. Integer -> [a] -> [a] take (Integer -> Integer -> Integer Builtins.subtractInteger Integer n Integer 1) [a] xs {-# INLINABLE drop #-} -- | Plutus Tx version of 'Data.List.drop'. drop :: Integer -> [a] -> [a] drop :: forall a. Integer -> [a] -> [a] drop Integer n [a] xs | Integer n Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool <= Integer 0 = [a] xs drop Integer _ [] = [] drop Integer n (a _:[a] xs) = Integer -> [a] -> [a] forall a. Integer -> [a] -> [a] drop (Integer -> Integer -> Integer Builtins.subtractInteger Integer n Integer 1) [a] xs {-# INLINABLE splitAt #-} -- | Plutus Tx version of 'Data.List.splitAt'. splitAt :: 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]) forall a. Integer -> [a] -> ([a], [a]) go Integer n [a] xs where go :: Integer -> [a] -> ([a], [a]) go :: forall a. 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]) forall a. Integer -> [a] -> ([a], [a]) go (Integer -> Integer -> Integer Builtins.subtractInteger Integer m Integer 1) [a] ys of ([a] zs, [a] ws) -> (a ya -> [a] -> [a] forall a. a -> [a] -> [a] :[a] zs, [a] ws) {-# INLINABLE nub #-} -- | 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 (==) {-# INLINABLE elemBy #-} -- | Plutus Tx version of 'Data.List.elemBy'. 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 {-# INLINABLE nubBy #-} -- | 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 ya -> [a] -> [a] forall a. a -> [a] -> [a] :[a] xs) {-# INLINABLE zipWith #-} -- | 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 {-# INLINABLE dropWhile #-} -- | 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 {-# INLINABLE replicate #-} -- | 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) {-# INLINABLE partition #-} -- | 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 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 xa -> [a] -> [a] forall a. a -> [a] -> [a] :[a] ts,[a] fs) | Bool otherwise = ([a] ts, a xa -> [a] -> [a] forall a. a -> [a] -> [a] :[a] fs) {-# INLINABLE sort #-} -- | 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 {-# INLINABLE sortBy #-} -- | 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 aa -> [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 aa -> [a] -> [a] forall a. a -> [a] -> [a] :[a] as) [a] bs descending a a [a] as [a] bs = (a aa -> [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 aa -> [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 ba -> [a] -> [a] forall a. a -> [a] -> [a] :[a] -> [a] -> [a] merge [a] as [a] bs' | Bool otherwise = a aa -> [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