{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -fno-cse -fno-full-laziness #-}

module Data.Discrimination.Grouping
  ( Group(..)
  , Grouping(..)
  , Grouping1(..)
  -- * Combinators
  , nub, nubWith
  , group, groupWith
  , groupingEq
  , runGroup
  -- * Internals
  , hashing
  ) where

import Control.Monad hiding (mapM_)
import Control.Monad.Primitive
import Control.Monad.ST
import Data.Complex
import Data.Discrimination.Internal.WordMap as WordMap
import Data.Discrimination.Internal
import Data.Foldable hiding (concat)
import Data.Functor.Compose
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import Data.Functor.Contravariant.Generic
import Data.Hashable
import Data.Int
import Data.List.NonEmpty (NonEmpty)
import Data.Semigroup hiding (Any)
import Data.Primitive.MutVar
import Data.Promise
import Data.Proxy
import Data.Ratio
import Data.Typeable
import Data.Void
import Data.Word
import Numeric.Natural (Natural)
import Prelude hiding (read, concat, mapM_)
import Data.Functor.Classes (Eq1 (..))

-- | Productive Stable Unordered Discriminator

newtype Group a = Group
  { forall a.
Group a
-> forall (m :: * -> *) b.
   PrimMonad m =>
   (b -> m (b -> m ())) -> m (a -> b -> m ())
getGroup :: forall m b. PrimMonad m
             => (b -> m (b -> m ())) -> m (a -> b -> m ())
  } deriving Typeable

-- Note: Group should be
--
--     type role Group representational
--
-- but it isn't due PrimMonad not implying higher-order Coercible constraint.

instance Contravariant Group where
  contramap :: forall a' a. (a' -> a) -> Group a -> Group a'
contramap a' -> a
f Group a
m = forall a.
(forall (m :: * -> *) b.
 PrimMonad m =>
 (b -> m (b -> m ())) -> m (a -> b -> m ()))
-> Group a
Group forall a b. (a -> b) -> a -> b
$ \b -> m (b -> m ())
k -> do
    a -> b -> m ()
g <- forall a.
Group a
-> forall (m :: * -> *) b.
   PrimMonad m =>
   (b -> m (b -> m ())) -> m (a -> b -> m ())
getGroup Group a
m b -> m (b -> m ())
k
    forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> m ()
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
f)

instance Divisible Group where
  conquer :: forall a. Group a
conquer = forall a.
(forall (m :: * -> *) b.
 PrimMonad m =>
 (b -> m (b -> m ())) -> m (a -> b -> m ()))
-> Group a
Group forall a b. (a -> b) -> a -> b
$ \ (b -> m (b -> m ())
k :: b -> m (b -> m ())) -> do
    MutVar (PrimState m) (b -> m ())
v <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar forall a. HasCallStack => a
undefined
    forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar (PrimState m) (b -> m ())
v forall a b. (a -> b) -> a -> b
$ \b
b -> b -> m (b -> m ())
k b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar (PrimState m) (b -> m ())
v
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \ a
_ b
b -> forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (b -> m ())
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a b. (a -> b) -> a -> b
$ b
b)

  divide :: forall a b c. (a -> (b, c)) -> Group b -> Group c -> Group a
divide a -> (b, c)
f Group b
m Group c
n = forall a.
(forall (m :: * -> *) b.
 PrimMonad m =>
 (b -> m (b -> m ())) -> m (a -> b -> m ()))
-> Group a
Group forall a b. (a -> b) -> a -> b
$ \b -> m (b -> m ())
k -> do
    b -> (c, b) -> m ()
kbcd <- forall a.
Group a
-> forall (m :: * -> *) b.
   PrimMonad m =>
   (b -> m (b -> m ())) -> m (a -> b -> m ())
getGroup Group b
m forall a b. (a -> b) -> a -> b
$ \ (c
c, b
d) -> do
      c -> b -> m ()
kcd <- forall a.
Group a
-> forall (m :: * -> *) b.
   PrimMonad m =>
   (b -> m (b -> m ())) -> m (a -> b -> m ())
getGroup Group c
n b -> m (b -> m ())
k
      c -> b -> m ()
kcd c
c b
d
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry c -> b -> m ()
kcd
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \ a
a b
d -> case a -> (b, c)
f a
a of
      (b
b, c
c) -> b -> (c, b) -> m ()
kbcd b
b (c
c, b
d)

instance Decidable Group where
  choose :: forall a b c. (a -> Either b c) -> Group b -> Group c -> Group a
choose a -> Either b c
f Group b
m Group c
n = forall a.
(forall (m :: * -> *) b.
 PrimMonad m =>
 (b -> m (b -> m ())) -> m (a -> b -> m ()))
-> Group a
Group forall a b. (a -> b) -> a -> b
$ \b -> m (b -> m ())
k -> do
    b -> b -> m ()
kb <- forall a.
Group a
-> forall (m :: * -> *) b.
   PrimMonad m =>
   (b -> m (b -> m ())) -> m (a -> b -> m ())
getGroup Group b
m b -> m (b -> m ())
k
    c -> b -> m ()
kc <- forall a.
Group a
-> forall (m :: * -> *) b.
   PrimMonad m =>
   (b -> m (b -> m ())) -> m (a -> b -> m ())
getGroup Group c
n b -> m (b -> m ())
k
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> b -> m ()
kb c -> b -> m ()
kc forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f)

  lose :: forall a. (a -> Void) -> Group a
lose a -> Void
k = forall a.
(forall (m :: * -> *) b.
 PrimMonad m =>
 (b -> m (b -> m ())) -> m (a -> b -> m ()))
-> Group a
Group forall a b. (a -> b) -> a -> b
$ \b -> m (b -> m ())
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Void
k)

instance Semigroup (Group a) where
  <> :: Group a -> Group a -> Group a
(<>) = forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\a
a -> (a
a,a
a))

instance Monoid (Group a) where
  mempty :: Group a
mempty = forall (f :: * -> *) a. Divisible f => f a
conquer
  mappend :: Group a -> Group a -> Group a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

--------------------------------------------------------------------------------
-- Primitives
--------------------------------------------------------------------------------

groupingWord64 :: Group Word64
groupingWord64 :: Group Word64
groupingWord64 = forall a.
(forall (m :: * -> *) b.
 PrimMonad m =>
 (b -> m (b -> m ())) -> m (a -> b -> m ()))
-> Group a
Group forall a b. (a -> b) -> a -> b
$ \b -> m (b -> m ())
k -> do
  MutVar (PrimState m) (WordMap (b -> m ()))
mt <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar forall a. WordMap a
WordMap.empty
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Word64
a b
b -> forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (WordMap (b -> m ()))
mt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WordMap (b -> m ())
m -> case forall v. Word64 -> WordMap v -> Maybe v
WordMap.lookup Word64
a WordMap (b -> m ())
m of
    Maybe (b -> m ())
Nothing -> b -> m (b -> m ())
k b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b -> m ()
p -> forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar (PrimState m) (WordMap (b -> m ()))
mt (forall v. Word64 -> v -> WordMap v -> WordMap v
insert Word64
a b -> m ()
p WordMap (b -> m ())
m)
    Just b -> m ()
n -> b -> m ()
n b
b

-- | This may be useful for pragmatically accelerating a grouping structure by
-- preclassifying by a hash function
--
-- Semantically,
--
-- @
-- grouping = hashing <> grouping
-- @
hashing :: Hashable a => Group a
hashing :: forall a. Hashable a => Group a
hashing = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a. Hashable a => a -> Int
hash forall a. Grouping a => Group a
grouping

--------------------------------------------------------------------------------
-- * Unordered Discrimination (for partitioning)
--------------------------------------------------------------------------------

-- | 'Eq' equipped with a compatible stable unordered discriminator.
--
-- Law:
--
-- @
-- 'groupingEq' x y ≡ (x '==' y)
-- @
--
-- /Note:/ 'Eq' is a moral super class of 'Grouping'.
-- It isn't because of some missing instances.
class Eq a => Grouping a where
  -- | For every surjection @f@,
  --
  -- @
  -- 'contramap' f 'grouping' ≡ 'grouping'
  -- @

  grouping :: Group a
  default grouping :: Deciding Grouping a => Group a
  grouping = forall (q :: * -> Constraint) a (f :: * -> *)
       (p :: (* -> Constraint) -> *).
(Deciding q a, Decidable f) =>
p q -> (forall b. q b => f b) -> f a
deciding (forall {k} (t :: k). Proxy t
Proxy :: Proxy Grouping) forall a. Grouping a => Group a
grouping

instance Grouping Void where grouping :: Group Void
grouping = forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose forall a. a -> a
id
instance Grouping () where grouping :: Group ()
grouping = forall (f :: * -> *) a. Divisible f => f a
conquer
instance Grouping Word8 where grouping :: Group Word8
grouping = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a b. (Integral a, Num b) => a -> b
fromIntegral Group Word64
groupingWord64
instance Grouping Word16 where grouping :: Group Word16
grouping = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a b. (Integral a, Num b) => a -> b
fromIntegral Group Word64
groupingWord64
instance Grouping Word32 where grouping :: Group Word32
grouping = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a b. (Integral a, Num b) => a -> b
fromIntegral Group Word64
groupingWord64
instance Grouping Word64 where grouping :: Group Word64
grouping = Group Word64
groupingWord64
instance Grouping Word where grouping :: Group Word
grouping = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a b. (Integral a, Num b) => a -> b
fromIntegral Group Word64
groupingWord64
instance Grouping Int8 where grouping :: Group Int8
grouping = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a b. (Integral a, Num b) => a -> b
fromIntegral Group Word64
groupingWord64
instance Grouping Int16 where grouping :: Group Int16
grouping = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a b. (Integral a, Num b) => a -> b
fromIntegral Group Word64
groupingWord64
instance Grouping Int32 where grouping :: Group Int32
grouping = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a b. (Integral a, Num b) => a -> b
fromIntegral Group Word64
groupingWord64
instance Grouping Int64 where grouping :: Group Int64
grouping = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a b. (Integral a, Num b) => a -> b
fromIntegral Group Word64
groupingWord64
instance Grouping Int where grouping :: Group Int
grouping = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a b. (Integral a, Num b) => a -> b
fromIntegral Group Word64
groupingWord64
instance Grouping Char where grouping :: Group Char
grouping = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Group Word64
groupingWord64

instance Grouping Bool
instance Grouping Ordering
instance (Grouping a, Grouping b) => Grouping (a, b)
instance (Grouping a, Grouping b, Grouping c) => Grouping (a, b, c)
instance (Grouping a, Grouping b, Grouping c, Grouping d) => Grouping (a, b, c, d)
instance Grouping a => Grouping [a]
instance Grouping a => Grouping (NonEmpty a)
instance Grouping a => Grouping (Maybe a)
instance (Grouping a, Grouping b) => Grouping (Either a b)
instance Grouping a => Grouping (Complex a) where
  grouping :: Group (Complex a)
grouping = forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\(a
a :+ a
b) -> (a
a, a
b)) forall a. Grouping a => Group a
grouping forall a. Grouping a => Group a
grouping

instance Grouping Integer where
  grouping :: Group Integer
grouping = forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose Integer -> Either (Int, [Word]) (Either Int (Int, [Word]))
integerCases forall a. Grouping a => Group a
grouping (forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose forall a. a -> a
id forall a. Grouping a => Group a
grouping forall a. Grouping a => Group a
grouping)

instance Grouping Natural where
  grouping :: Group Natural
grouping = forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose Natural -> Either Word (Int, [Word])
naturalCases forall a. Grouping a => Group a
grouping forall a. Grouping a => Group a
grouping

#if __GLASGOW_HASKELL__ >= 800
instance Grouping a => Grouping (Ratio a) where
#else
instance (Grouping a, Integral a) => Grouping (Ratio a) where
#endif
  grouping :: Group (Ratio a)
grouping = forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\Ratio a
r -> (forall a. Ratio a -> a
numerator Ratio a
r, forall a. Ratio a -> a
denominator Ratio a
r)) forall a. Grouping a => Group a
grouping forall a. Grouping a => Group a
grouping

class Eq1 f => Grouping1 f where
  grouping1 :: Group a -> Group (f a)
  default grouping1 :: Deciding1 Grouping f => Group a -> Group (f a)
  grouping1 = forall (q :: * -> Constraint) (t :: * -> *) (f :: * -> *)
       (p :: (* -> Constraint) -> *) a.
(Deciding1 q t, Decidable f) =>
p q -> (forall b. q b => f b) -> f a -> f (t a)
deciding1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy Grouping) forall a. Grouping a => Group a
grouping

instance (Grouping1 f, Grouping1 g, Grouping a) => Grouping (Compose f g a) where
  grouping :: Group (Compose f g a)
grouping = forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` forall (f :: * -> *) a. Grouping1 f => Group a -> Group (f a)
grouping1 (forall (f :: * -> *) a. Grouping1 f => Group a -> Group (f a)
grouping1 forall a. Grouping a => Group a
grouping)


instance Grouping1 []
instance Grouping1 Maybe
instance Grouping1 NonEmpty
instance Grouping a => Grouping1 (Either a)
instance Grouping a => Grouping1 ((,) a)
instance (Grouping a, Grouping b) => Grouping1 ((,,) a b)
instance (Grouping a, Grouping b, Grouping c) => Grouping1 ((,,,) a b c)
instance (Grouping1 f, Grouping1 g) => Grouping1 (Compose f g) where
  grouping1 :: forall a. Group a -> Group (Compose f g a)
grouping1 Group a
f = forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` forall (f :: * -> *) a. Grouping1 f => Group a -> Group (f a)
grouping1 (forall (f :: * -> *) a. Grouping1 f => Group a -> Group (f a)
grouping1 Group a
f)
instance Grouping1 Complex where
  grouping1 :: forall a. Group a -> Group (Complex a)
grouping1 Group a
f = forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\(a
a :+ a
b) -> (a
a, a
b)) Group a
f Group a
f

-- | Valid definition for @('==')@ in terms of 'Grouping'.
groupingEq :: Grouping a => a -> a -> Bool
groupingEq :: forall a. Grouping a => a -> a -> Bool
groupingEq a
a a
b = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MutVar s Word8
rn <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar (Word8
0 :: Word8)
  a -> () -> ST s ()
k <- forall a.
Group a
-> forall (m :: * -> *) b.
   PrimMonad m =>
   (b -> m (b -> m ())) -> m (a -> b -> m ())
getGroup forall a. Grouping a => Group a
grouping forall a b. (a -> b) -> a -> b
$ \()
_ -> do
    forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar' MutVar s Word8
rn (forall a. Num a => a -> a -> a
+Word8
1)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. Monad m => a -> m a
return
  a -> () -> ST s ()
k a
a ()
  a -> () -> ST s ()
k a
b ()
  Word8
n <- forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s Word8
rn
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8
n forall a. Eq a => a -> a -> Bool
== Word8
1
{-# INLINE groupingEq #-}

runGroup :: Group a -> [(a,b)] -> [[b]]
runGroup :: forall a b. Group a -> [(a, b)] -> [[b]]
runGroup (Group forall (m :: * -> *) b.
PrimMonad m =>
(b -> m (b -> m ())) -> m (a -> b -> m ())
m) [(a, b)]
xs = forall a b. (forall s. Promise s a -> Lazy s b) -> a -> a
runLazy (\Promise s [[b]]
p0 -> do
    MutVar s (Promise s [[b]])
rp <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar Promise s [[b]]
p0
    a -> b -> Lazy s ()
f <- forall (m :: * -> *) b.
PrimMonad m =>
(b -> m (b -> m ())) -> m (a -> b -> m ())
m forall a b. (a -> b) -> a -> b
$ \ b
b -> do
      Promise s [[b]]
p <- forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Promise s [[b]])
rp
      Promise s [b]
q <- forall a s. a -> Lazy s (Promise s a)
promise []
      Promise s [[b]]
p' <- forall a s. a -> Lazy s (Promise s a)
promise []
      Promise s [[b]]
p forall s a. Promise s a -> a -> Lazy s ()
!= (b
b forall a. a -> [a] -> [a]
: forall s a. Promise s a -> a
demand Promise s [b]
q) forall a. a -> [a] -> [a]
: forall s a. Promise s a -> a
demand Promise s [[b]]
p'
      forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar s (Promise s [[b]])
rp Promise s [[b]]
p'
      MutVar s (Promise s [b])
rq <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar Promise s [b]
q
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \b
b' -> do
        Promise s [b]
q' <- forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Promise s [b])
rq
        Promise s [b]
q'' <- forall a s. a -> Lazy s (Promise s a)
promise []
        Promise s [b]
q' forall s a. Promise s a -> a -> Lazy s ()
!= b
b' forall a. a -> [a] -> [a]
: forall s a. Promise s a -> a
demand Promise s [b]
q''
        forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar s (Promise s [b])
rq Promise s [b]
q''
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> Lazy s ()
f) [(a, b)]
xs
  ) []

--------------------------------------------------------------------------------
-- * Combinators
--------------------------------------------------------------------------------

-- | /O(n)/. Similar to 'Data.List.group', except we do not require groups to be clustered.
--
-- This combinator still operates in linear time, at the expense of storing history.
--
-- The result equivalence classes are __not__ sorted, but the grouping is stable.
--
-- @
-- 'group' = 'groupWith' 'id'
-- @
group :: Grouping a => [a] -> [[a]]
group :: forall a. Grouping a => [a] -> [[a]]
group [a]
as = forall a b. Group a -> [(a, b)] -> [[b]]
runGroup forall a. Grouping a => Group a
grouping [(a
a, a
a) | a
a <- [a]
as]

-- | /O(n)/. This is a replacement for 'GHC.Exts.groupWith' using discrimination.
--
-- The result equivalence classes are __not__ sorted, but the grouping is stable.
groupWith :: Grouping b => (a -> b) -> [a] -> [[a]]
groupWith :: forall b a. Grouping b => (a -> b) -> [a] -> [[a]]
groupWith a -> b
f [a]
as = forall a b. Group a -> [(a, b)] -> [[b]]
runGroup forall a. Grouping a => Group a
grouping [(a -> b
f a
a, a
a) | a
a <- [a]
as]

-- | /O(n)/. This upgrades 'Data.List.nub' from @Data.List@ from /O(n^2)/ to /O(n)/ by using
-- productive unordered discrimination.
--
-- @
-- 'nub' = 'nubWith' 'id'
-- 'nub' as = 'head' 'Control.Applicative.<$>' 'group' as
-- @
nub :: Grouping a => [a] -> [a]
nub :: forall a. Grouping a => [a] -> [a]
nub = forall b a. Grouping b => (a -> b) -> [a] -> [a]
nubWith forall a. a -> a
id

-- | /O(n)/. Online 'nub' with a Schwartzian transform.
--
-- @
-- 'nubWith' f as = 'head' 'Control.Applicative.<$>' 'groupWith' f as
-- @
nubWith :: Grouping b => (a -> b) -> [a] -> [a]
nubWith :: forall b a. Grouping b => (a -> b) -> [a] -> [a]
nubWith a -> b
f [a]
xs = forall a b. (forall s. Promise s a -> Lazy s b) -> a -> a
runLazy (\Promise s [a]
p0 -> do
    MutVar s (Promise s [a])
rp <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar Promise s [a]
p0
    b -> a -> Lazy s ()
k <- forall a.
Group a
-> forall (m :: * -> *) b.
   PrimMonad m =>
   (b -> m (b -> m ())) -> m (a -> b -> m ())
getGroup forall a. Grouping a => Group a
grouping forall a b. (a -> b) -> a -> b
$ \a
a -> do
      Promise s [a]
p' <- forall a s. a -> Lazy s (Promise s a)
promise []
      Promise s [a]
p <- forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Promise s [a])
rp
      Promise s [a]
p forall s a. Promise s a -> a -> Lazy s ()
!= a
a forall a. a -> [a] -> [a]
: forall s a. Promise s a -> a
demand Promise s [a]
p'
      forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar s (Promise s [a])
rp Promise s [a]
p'
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \ a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\a
x -> b -> a -> Lazy s ()
k (a -> b
f a
x) a
x) [a]
xs
  ) []