{-# 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)
nubSort :: Ord a => [a] -> [a]
nubSort :: forall a. Ord a => [a] -> [a]
nubSort = forall {a}. Eq a => [a] -> [a]
nnub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
where
nnub :: [a] -> [a]
nnub [] = []
nnub [a
x] = [a
x]
nnub (a
x:[a]
xs) = a
x forall a. a -> [a] -> [a]
: [a] -> [a]
nnub (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==a
x) [a]
xs)
nubSortBy :: (a -> a -> Ordering) -> [a] -> [a]
nubSortBy :: forall a. (a -> a -> Ordering) -> [a] -> [a]
nubSortBy a -> a -> Ordering
cmp = [a] -> [a]
nnub forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Eq a => a -> a -> Bool
== Ordering
EQ
nnub :: [a] -> [a]
nnub [] = []
nnub [a
x] = [a
x]
nnub (a
x:[a]
xs) = a
x forall a. a -> [a] -> [a]
: [a] -> [a]
nnub (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
-==-a
x) [a]
xs)
isSubsetOf :: Ord a => [a] -> [a] -> Bool
[a]
xs isSubsetOf :: forall a. Ord a => [a] -> [a] -> Bool
`isSubsetOf` [a]
ys = forall a. Ord a => [a] -> [a]
nubSort [a]
xs forall a. Eq a => [a] -> [a] -> Bool
`isSubsequenceOf` forall a. Ord a => [a] -> [a]
nubSort [a]
ys
#if __GLASGOW_HASKELL__ < 710
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
isPermutationOf :: Ord a => [a] -> [a] -> Bool
isPermutationOf :: forall a. Ord a => [a] -> [a] -> Bool
isPermutationOf = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Ord a => [a] -> [a]
sort
isNub :: Ord a => [a] -> Bool
isNub :: forall a. Ord a => [a] -> Bool
isNub [a]
xs = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Ord a => [a] -> [a]
nubSort [a]
xs) forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
lookupId :: Eq a => a -> [(a,a)] -> a
lookupId :: forall a. Eq a => a -> [(a, a)] -> a
lookupId a
x = forall a. a -> Maybe a -> a
fromMaybe a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x
(+++) :: Ord a => [a] -> [a] -> [a]
+++ :: forall a. Ord a => [a] -> [a] -> [a]
(+++) = forall a. Ord a => [a] -> [a] -> [a]
nubMerge
infixr 5 +++
nubMergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy :: forall a. (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
xforall a. a -> [a] -> [a]
:forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp [a]
xs (a
yforall a. a -> [a] -> [a]
:[a]
ys)
Ordering
GT -> a
yforall a. a -> [a] -> [a]
:forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp (a
xforall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
Ordering
EQ -> a
xforall a. 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 forall a. [a] -> [a] -> [a]
++ [a]
ys
nubMerge :: Ord a => [a] -> [a] -> [a]
nubMerge :: forall a. Ord a => [a] -> [a] -> [a]
nubMerge = forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy 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