-- |
-- Module      : Data.Express.Utils.List
-- Copyright   : (c) 2019-2021 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- Re-exports the "Data.List" module along with additional functions over
-- lists.
{-# LANGUAGE CPP #-}
module Data.Express.Utils.List
  ( nubSort
  , nubSortBy
  , isPermutationOf
  , isSubsetOf
  , isNub
  , lookupId
  , (+++)
  , module Data.List
#if __GLASGOW_HASKELL__ < 710
  , isSubsequenceOf
#endif
#ifdef __HUGS__
  , intercalate
#endif
  )
where

import Data.Function (on)
import Data.List
import Data.Maybe (fromMaybe)

-- | /O(n log n)/.
-- Sorts and remove repetitions.
-- Equivalent to @nub . sort@.
--
-- > > nubSort [1,2,3]
-- > [1,2,3]
-- > > nubSort [3,2,1]
-- > [1,2,3]
-- > > nubSort [3,2,1,3,2,1]
-- > [1,2,3]
-- > > nubSort [3,3,1,1,2,2]
-- > [1,2,3]
nubSort :: Ord a => [a] -> [a]
nubSort :: [a] -> [a]
nubSort  =  [a] -> [a]
forall a. Eq a => [a] -> [a]
nnub ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort
  where
  -- linear nub of adjacent values
  nnub :: [a] -> [a]
nnub [] = []
  nnub [a
x] = [a
x]
  nnub (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
nnub ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x) [a]
xs)

-- | Like 'nubSort' but allows providing a function to 'compare' values.
nubSortBy :: (a -> a -> Ordering) -> [a] -> [a]
nubSortBy :: (a -> a -> Ordering) -> [a] -> [a]
nubSortBy a -> a -> Ordering
cmp  =  [a] -> [a]
nnub ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
cmp
  where
  a
x -==- :: a -> a -> Bool
-==- a
y  =  a
x a -> a -> Ordering
`cmp` a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
  -- linear nub of adjacent values
  nnub :: [a] -> [a]
nnub [] = []
  nnub [a
x] = [a
x]
  nnub (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
nnub ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
-==-a
x) [a]
xs)

-- | /O(n log n)/.
-- Checks that all elements of the first list are elements of the second.
isSubsetOf :: Ord a => [a] -> [a] -> Bool
[a]
xs isSubsetOf :: [a] -> [a] -> Bool
`isSubsetOf` [a]
ys  =  [a] -> [a]
forall a. Ord a => [a] -> [a]
nubSort [a]
xs [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSubsequenceOf` [a] -> [a]
forall a. Ord a => [a] -> [a]
nubSort [a]
ys


#if __GLASGOW_HASKELL__ < 710
-- only exported from Data.List since base 4.8.0.0
isSubsequenceOf :: Eq a => [a] -> [a] -> Bool
isSubsequenceOf []    _                    =  True
isSubsequenceOf (_:_) []                   =  False
isSubsequenceOf (x:xs) (y:ys) | x == y     =     xs  `isSubsequenceOf` ys
                              | otherwise  =  (x:xs) `isSubsequenceOf` ys
#endif

-- | /O(n log n)/.
-- Checks that all elements of the first list are elements of the second.
isPermutationOf :: Ord a => [a] -> [a] -> Bool
isPermutationOf :: [a] -> [a] -> Bool
isPermutationOf  =  [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([a] -> [a] -> Bool) -> ([a] -> [a]) -> [a] -> [a] -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` [a] -> [a]
forall a. Ord a => [a] -> [a]
sort

-- | /O(n log n)/.
-- Checks that all elements are unique.
-- This function is a faster equivalent to the following:
--
-- > isNub xs  =  nub xs == xs
--
-- Examples:
--
-- > isNub []       =  True
-- > isNub [1,2,3]  =  True
-- > isNub [2,1,2]  =  False
isNub :: Ord a => [a] -> Bool
isNub :: [a] -> Bool
isNub [a]
xs  =  [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> [a]
forall a. Ord a => [a] -> [a]
nubSort [a]
xs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs

-- | /O(n)/.
-- Like 'lookup' but returns the key itself if nothing is found.
--
-- > > lookupId 5 [(1,2),(3,4)]
-- > 5
--
-- > > lookupId 5 [(1,2),(3,4),(5,6)]
-- > 6
lookupId :: Eq a => a -> [(a,a)] -> a
lookupId :: a -> [(a, a)] -> a
lookupId a
x = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Maybe a -> a) -> ([(a, a)] -> Maybe a) -> [(a, a)] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [(a, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x

-- | Merges two lists discarding repeated elements.
--
-- The argument lists need to be in order.
--
-- > > [1,10,100] +++ [9,10,11]
-- > [1,9,10,11,100]
(+++) :: Ord a => [a] -> [a] -> [a]
+++ :: [a] -> [a] -> [a]
(+++)  =  [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
nubMerge
infixr 5 +++

-- | Like 'nubMerge' but allows providing a function to 'compare' values.
nubMergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp (a
x:[a]
xs) (a
y:[a]
ys)  =  case a
x a -> a -> Ordering
`cmp` a
y of
                                 Ordering
LT -> a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
                                 Ordering
GT -> a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
                                 Ordering
EQ -> a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp [a]
xs [a]
ys
nubMergeBy a -> a -> Ordering
_ [a]
xs [a]
ys  =  [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys

-- | Merges two lists discarding repeated elements.
--
-- The argument lists need to be in order.
nubMerge :: Ord a => [a] -> [a] -> [a]
nubMerge :: [a] -> [a] -> [a]
nubMerge  =  (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

#ifdef __HUGS__
intercalate :: [a] -> [[a]] -> [a]
intercalate xs xss  =  concat (intersperse xs xss)
  where
  intersperse :: a -> [a] -> [a]
  intersperse _ []        =  []
  intersperse sep (x:xs)  =  x : prependToAll sep xs
    where
    prependToAll :: a -> [a] -> [a]
    prependToAll _   []      =  []
    prependToAll sep (x:xs)  =  sep : x : prependToAll sep xs
#endif