{-# LANGUAGE Safe #-}
{-# LANGUAGE CPP #-}

{-| Functions to remove duplicates from a list.

 = Performance
 To check the performance many benchmarks were done.
 Benchmarks were made on lists of 'Prelude.Int's and 'Data.Text.Text's.
 There were two types of list to use:

 * Lists which consist of many different elements

 * Lists which consist of many same elements


 Here are some recomendations for usage of particular functions based on benchmarking resutls.

 * 'hashNub' is faster than 'ordNub' when there're not so many different values in the list.

 * 'hashNub' is the fastest with 'Data.Text.Text'.

 * 'sortNub' has better performance than 'ordNub' but should be used when sorting is also needed.

 * 'unstableNub' has better performance than 'hashNub' but doesn't save the original order.
-}

module Universum.Nub
       ( hashNub
       , ordNub
       , sortNub
       , unstableNub
       ) where

#if !MIN_VERSION_hashable(1,4,0)
import Data.Eq (Eq)
#endif
import Data.Hashable (Hashable)
import Data.HashSet as HashSet
import Data.Ord (Ord)
import Prelude ((.))

import qualified Data.Set as Set

-- | Like 'Prelude.nub' but runs in @O(n * log n)@ time and requires 'Ord'.
--
-- >>> ordNub [3, 3, 3, 2, 2, -1, 1]
-- [3,2,-1,1]
ordNub :: (Ord a) => [a] -> [a]
ordNub :: [a] -> [a]
ordNub = Set a -> [a] -> [a]
forall a. Ord a => Set a -> [a] -> [a]
go Set a
forall a. Set a
Set.empty
  where
    go :: Set a -> [a] -> [a]
go Set a
_ []     = []
    go Set a
s (a
x:[a]
xs) =
      if a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
s
      then Set a -> [a] -> [a]
go Set a
s [a]
xs
      else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
s) [a]
xs

-- | Like 'Prelude.nub' but runs in @O(n * log_16(n))@ time and requires 'Hashable'.
--
-- >>> hashNub [3, 3, 3, 2, 2, -1, 1]
-- [3,2,-1,1]
#if MIN_VERSION_hashable(1,4,0)
hashNub :: (Hashable a) => [a] -> [a]
#else
hashNub :: (Eq a, Hashable a) => [a] -> [a]
#endif
hashNub :: [a] -> [a]
hashNub = HashSet a -> [a] -> [a]
forall a. Hashable a => HashSet a -> [a] -> [a]
go HashSet a
forall a. HashSet a
HashSet.empty
  where
    go :: HashSet a -> [a] -> [a]
go HashSet a
_ []     = []
    go HashSet a
s (a
x:[a]
xs) =
      if a
x a -> HashSet a -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet a
s
      then HashSet a -> [a] -> [a]
go HashSet a
s [a]
xs
      else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: HashSet a -> [a] -> [a]
go (a -> HashSet a -> HashSet a
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert a
x HashSet a
s) [a]
xs

-- | Like 'ordNub' but also sorts a list.
--
-- >>> sortNub [3, 3, 3, 2, 2, -1, 1]
-- [-1,1,2,3]
sortNub :: (Ord a) => [a] -> [a]
sortNub :: [a] -> [a]
sortNub = Set a -> [a]
forall a. Set a -> [a]
Set.toList (Set a -> [a]) -> ([a] -> Set a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList

-- | Like 'hashNub' but has better performance and also doesn't save the order.
--
-- >>> unstableNub [3, 3, 3, 2, 2, -1, 1]
-- [1,2,3,-1]
#if MIN_VERSION_hashable(1,4,0)
unstableNub :: (Hashable a) => [a] -> [a]
#else
unstableNub :: (Eq a, Hashable a) => [a] -> [a]
#endif
unstableNub :: [a] -> [a]
unstableNub = HashSet a -> [a]
forall a. HashSet a -> [a]
HashSet.toList (HashSet a -> [a]) -> ([a] -> HashSet a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList