{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# OPTIONS_GHC -fno-cse -fno-full-laziness #-}
module Data.Discrimination.Sorting
  ( Sort(..)
  -- * Sorting
  , Sorting(..)
  , Sorting1(..)
  -- * Combinators
  -- $common
  , sort, sortWith, desc
  , sortingCompare
  -- * Container Construction
  , toMap
  , toMapWith
  , toMapWithKey
  , toIntMap
  , toIntMapWith
  , toIntMapWithKey
  , toSet
  , toIntSet
  -- * Internals
  , sortingNat
  , sortingBag
  , sortingSet
  ) where

import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.Bits
import Data.Discrimination.Grouping
import Data.Discrimination.Internal
import Data.Foldable as Foldable hiding (concat)
import Data.Functor.Compose
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import Data.Functor.Contravariant.Generic
import Data.Int
import Data.IntMap.Lazy as IntMap
import Data.IntSet as IntSet
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty)
import Data.Map as Map
import Data.Proxy
import Data.Semigroup hiding (Any)
import Data.Set as Set
import Data.Typeable
import Data.Void
import Data.Word
import Numeric.Natural (Natural)
import Prelude hiding (read, concat)

-- $setup
-- >>> import qualified Data.Map as Map
-- >>> import qualified Data.IntMap as IntMap

--------------------------------------------------------------------------------
-- * Common
--------------------------------------------------------------------------------


-- | Stable Ordered Discriminator

-- TODO: use [(a,b)] -> [NonEmpty b] to better indicate safety?
newtype Sort a = Sort { Sort a -> forall b. [(a, b)] -> [[b]]
runSort :: forall b. [(a,b)] -> [[b]] }
  deriving Typeable

mkSort :: (forall b. [(a, b)] -> [[b]]) -> Sort a
mkSort :: (forall b. [(a, b)] -> [[b]]) -> Sort a
mkSort forall b. [(a, b)] -> [[b]]
f = (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
Sort ((forall b. [(a, b)] -> [[b]]) -> Sort a)
-> (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a b. (a -> b) -> a -> b
$ \[(a, b)]
xs -> case [(a, b)]
xs of
  []       -> []
  [(a
_, b
v)] -> [[b
v]]
  [(a, b)]
_        -> [(a, b)] -> [[b]]
forall b. [(a, b)] -> [[b]]
f [(a, b)]
xs

type role Sort representational

instance Contravariant Sort where
  contramap :: (a -> b) -> Sort b -> Sort a
contramap a -> b
f (Sort forall b. [(b, b)] -> [[b]]
g) = (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
Sort ((forall b. [(a, b)] -> [[b]]) -> Sort a)
-> (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a b. (a -> b) -> a -> b
$ [(b, b)] -> [[b]]
forall b. [(b, b)] -> [[b]]
g ([(b, b)] -> [[b]]) -> ([(a, b)] -> [(b, b)]) -> [(a, b)] -> [[b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (b, b)) -> [(a, b)] -> [(b, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, b) -> (b, b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f)

instance Divisible Sort where
  conquer :: Sort a
conquer = (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
mkSort ((forall b. [(a, b)] -> [[b]]) -> Sort a)
-> (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a b. (a -> b) -> a -> b
$ [b] -> [[b]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([b] -> [[b]]) -> ([(a, b)] -> [b]) -> [(a, b)] -> [[b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> b) -> [(a, b)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd
  divide :: (a -> (b, c)) -> Sort b -> Sort c -> Sort a
divide a -> (b, c)
k (Sort forall b. [(b, b)] -> [[b]]
l) (Sort forall b. [(c, b)] -> [[b]]
r) = (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
Sort ((forall b. [(a, b)] -> [[b]]) -> Sort a)
-> (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a b. (a -> b) -> a -> b
$ \[(a, b)]
xs ->
    [(b, (c, b))] -> [[(c, b)]]
forall b. [(b, b)] -> [[b]]
l [ (b
b, (c
c, b
d)) | (a
a,b
d) <- [(a, b)]
xs, let (b
b, c
c) = a -> (b, c)
k a
a] [[(c, b)]] -> ([(c, b)] -> [[b]]) -> [[b]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(c, b)] -> [[b]]
forall b. [(c, b)] -> [[b]]
r

instance Decidable Sort where
  lose :: (a -> Void) -> Sort a
lose a -> Void
k = (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
Sort ((forall b. [(a, b)] -> [[b]]) -> Sort a)
-> (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a b. (a -> b) -> a -> b
$ ((a, b) -> [b]) -> [(a, b)] -> [[b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Void -> [b]
forall a. Void -> a
absurd(Void -> [b]) -> ((a, b) -> Void) -> (a, b) -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Void
k(a -> Void) -> ((a, b) -> a) -> (a, b) -> Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, b) -> a
forall a b. (a, b) -> a
fst)
  choose :: (a -> Either b c) -> Sort b -> Sort c -> Sort a
choose a -> Either b c
f (Sort forall b. [(b, b)] -> [[b]]
l) (Sort forall b. [(c, b)] -> [[b]]
r) = (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
mkSort ((forall b. [(a, b)] -> [[b]]) -> Sort a)
-> (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a b. (a -> b) -> a -> b
$ \[(a, b)]
xs -> let
      ys :: [(Either b c, b)]
ys = ((a, b) -> (Either b c, b)) -> [(a, b)] -> [(Either b c, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Either b c) -> (a, b) -> (Either b c, b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> Either b c
f) [(a, b)]
xs
    in [(b, b)] -> [[b]]
forall b. [(b, b)] -> [[b]]
l [ (b
k,b
v) | (Left b
k, b
v) <- [(Either b c, b)]
ys]
    [[b]] -> [[b]] -> [[b]]
forall a. [a] -> [a] -> [a]
++ [(c, b)] -> [[b]]
forall b. [(c, b)] -> [[b]]
r [ (c
k,b
v) | (Right c
k, b
v) <- [(Either b c, b)]
ys]

instance Semigroup (Sort a) where
  Sort forall b. [(a, b)] -> [[b]]
l <> :: Sort a -> Sort a -> Sort a
<> Sort forall b. [(a, b)] -> [[b]]
r = (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
Sort ((forall b. [(a, b)] -> [[b]]) -> Sort a)
-> (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a b. (a -> b) -> a -> b
$ \[(a, b)]
xs -> [(a, (a, b))] -> [[(a, b)]]
forall b. [(a, b)] -> [[b]]
l [ ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x, (a, b)
x) | (a, b)
x <- [(a, b)]
xs ] [[(a, b)]] -> ([(a, b)] -> [[b]]) -> [[b]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(a, b)] -> [[b]]
forall b. [(a, b)] -> [[b]]
r

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

--------------------------------------------------------------------------------
-- * Ordered Discrimination
--------------------------------------------------------------------------------

-- | 'Ord' equipped with a compatible stable, ordered discriminator.
--
-- Law:
--
-- @
-- 'sortingCompare' x y ≡ 'compare' x y
-- @
class Grouping a => Sorting a where
  -- | For every strictly monotone-increasing function @f@:
  --
  -- @
  -- 'contramap' f 'sorting' ≡ 'sorting'
  -- @
  sorting :: Sort a
  default sorting :: Deciding Sorting a => Sort a
  sorting = Proxy Sorting -> (forall b. Sorting b => Sort b) -> Sort a
forall (q :: * -> Constraint) a (f :: * -> *)
       (p :: (* -> Constraint) -> *).
(Deciding q a, Decidable f) =>
p q -> (forall b. q b => f b) -> f a
deciding (Proxy Sorting
forall k (t :: k). Proxy t
Proxy :: Proxy Sorting) forall b. Sorting b => Sort b
sorting

instance Sorting () where
  sorting :: Sort ()
sorting = Sort ()
forall (f :: * -> *) a. Divisible f => f a
conquer

instance Sorting Integer where
  sorting :: Sort Integer
sorting = (Integer -> Either (Int, [Word]) (Either Int (Int, [Word])))
-> Sort (Int, [Word])
-> Sort (Either Int (Int, [Word]))
-> Sort Integer
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 (Sort (Int, [Word]) -> Sort (Int, [Word])
forall a. Sort a -> Sort a
desc Sort (Int, [Word])
forall b. Sorting b => Sort b
sorting) ((Either Int (Int, [Word]) -> Either Int (Int, [Word]))
-> Sort Int
-> Sort (Int, [Word])
-> Sort (Either Int (Int, [Word]))
forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose Either Int (Int, [Word]) -> Either Int (Int, [Word])
forall a. a -> a
id Sort Int
forall b. Sorting b => Sort b
sorting Sort (Int, [Word])
forall b. Sorting b => Sort b
sorting)

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

instance Sorting Word8 where
  sorting :: Sort Word8
sorting = (Word8 -> Int) -> Sort Int -> Sort Word8
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Sort Int
sortingNat Int
256)

instance Sorting Word16 where
  sorting :: Sort Word16
sorting = (Word16 -> Int) -> Sort Int -> Sort Word16
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Sort Int
sortingNat Int
65536)

instance Sorting Word32 where
  sorting :: Sort Word32
sorting = (forall b. [(Word32, b)] -> [[b]]) -> Sort Word32
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
Sort ([(Word32, b)] -> [[b]]
forall a b. Eq a => [(a, b)] -> [[b]]
runs ([(Word32, b)] -> [[b]])
-> ([(Word32, b)] -> [[(Word32, b)]]) -> [(Word32, b)] -> [[b]]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Sort Int -> forall b. [(Int, b)] -> [[b]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort (Int -> Sort Int
sortingNat Int
65536) ([(Int, (Word32, b))] -> [[(Word32, b)]])
-> ([(Word32, b)] -> [(Int, (Word32, b))])
-> [(Word32, b)]
-> [[(Word32, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Int, (Word32, b))]] -> [(Int, (Word32, b))]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Int, (Word32, b))]] -> [(Int, (Word32, b))])
-> ([(Word32, b)] -> [[(Int, (Word32, b))]])
-> [(Word32, b)]
-> [(Int, (Word32, b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sort Int -> forall b. [(Int, b)] -> [[b]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort (Int -> Sort Int
sortingNat Int
65536) ([(Int, (Int, (Word32, b)))] -> [[(Int, (Word32, b))]])
-> ([(Word32, b)] -> [(Int, (Int, (Word32, b)))])
-> [(Word32, b)]
-> [[(Int, (Word32, b))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word32, b) -> (Int, (Int, (Word32, b))))
-> [(Word32, b)] -> [(Int, (Int, (Word32, b)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32, b) -> (Int, (Int, (Word32, b)))
forall a a a b.
(Integral a, Bits a, Bits a, Num a, Num a) =>
(a, b) -> (a, (a, (a, b)))
radices) where
    radices :: (a, b) -> (a, (a, (a, b)))
radices (a
x,b
b) = (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xffff, (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
x Int
16), (a
x,b
b)))


instance Sorting Word64 where
  sorting :: Sort Word64
sorting = (forall b. [(Word64, b)] -> [[b]]) -> Sort Word64
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
Sort ([(Word64, b)] -> [[b]]
forall a b. Eq a => [(a, b)] -> [[b]]
runs ([(Word64, b)] -> [[b]])
-> ([(Word64, b)] -> [[(Word64, b)]]) -> [(Word64, b)] -> [[b]]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Sort Int -> forall b. [(Int, b)] -> [[b]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort (Int -> Sort Int
sortingNat Int
65536) ([(Int, (Word64, b))] -> [[(Word64, b)]])
-> ([(Word64, b)] -> [(Int, (Word64, b))])
-> [(Word64, b)]
-> [[(Word64, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Int, (Word64, b))]] -> [(Int, (Word64, b))]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Int, (Word64, b))]] -> [(Int, (Word64, b))])
-> ([(Word64, b)] -> [[(Int, (Word64, b))]])
-> [(Word64, b)]
-> [(Int, (Word64, b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sort Int -> forall b. [(Int, b)] -> [[b]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort (Int -> Sort Int
sortingNat Int
65536) ([(Int, (Int, (Word64, b)))] -> [[(Int, (Word64, b))]])
-> ([(Word64, b)] -> [(Int, (Int, (Word64, b)))])
-> [(Word64, b)]
-> [[(Int, (Word64, b))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Int, (Int, (Word64, b)))]] -> [(Int, (Int, (Word64, b)))]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
                         ([[(Int, (Int, (Word64, b)))]] -> [(Int, (Int, (Word64, b)))])
-> ([(Word64, b)] -> [[(Int, (Int, (Word64, b)))]])
-> [(Word64, b)]
-> [(Int, (Int, (Word64, b)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sort Int -> forall b. [(Int, b)] -> [[b]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort (Int -> Sort Int
sortingNat Int
65536) ([(Int, (Int, (Int, (Word64, b))))]
 -> [[(Int, (Int, (Word64, b)))]])
-> ([(Word64, b)] -> [(Int, (Int, (Int, (Word64, b))))])
-> [(Word64, b)]
-> [[(Int, (Int, (Word64, b)))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Int, (Int, (Int, (Word64, b))))]]
-> [(Int, (Int, (Int, (Word64, b))))]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Int, (Int, (Int, (Word64, b))))]]
 -> [(Int, (Int, (Int, (Word64, b))))])
-> ([(Word64, b)] -> [[(Int, (Int, (Int, (Word64, b))))]])
-> [(Word64, b)]
-> [(Int, (Int, (Int, (Word64, b))))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sort Int -> forall b. [(Int, b)] -> [[b]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort (Int -> Sort Int
sortingNat Int
65536) ([(Int, (Int, (Int, (Int, (Word64, b)))))]
 -> [[(Int, (Int, (Int, (Word64, b))))]])
-> ([(Word64, b)] -> [(Int, (Int, (Int, (Int, (Word64, b)))))])
-> [(Word64, b)]
-> [[(Int, (Int, (Int, (Word64, b))))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, b) -> (Int, (Int, (Int, (Int, (Word64, b))))))
-> [(Word64, b)] -> [(Int, (Int, (Int, (Int, (Word64, b)))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64, b) -> (Int, (Int, (Int, (Int, (Word64, b)))))
forall a a a a a b.
(Integral a, Bits a, Bits a, Bits a, Bits a, Num a, Num a, Num a,
 Num a) =>
(a, b) -> (a, (a, (a, (a, (a, b)))))
radices)
    where
      radices :: (a, b) -> (a, (a, (a, (a, (a, b)))))
radices (a
x,b
b) = (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xffff, (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
x Int
16) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xffff
                    , (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
x Int
32) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xffff, (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
x Int
48)
                    , (a
x,b
b)))))


instance Sorting Word where
  sorting :: Sort Word
sorting
    | (Word
forall a. Bounded a => a
maxBound :: Word) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
4294967295 = (Word -> Word32) -> Sort Word32 -> Sort Word
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word -> Word32) Sort Word32
forall b. Sorting b => Sort b
sorting
    | Bool
otherwise                        = (Word -> Word64) -> Sort Word64 -> Sort Word
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word -> Word64) Sort Word64
forall b. Sorting b => Sort b
sorting

instance Sorting Int8 where
  sorting :: Sort Int8
sorting = (Int8 -> Int) -> Sort Int -> Sort Int8
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\Int8
x -> Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
128) (Int -> Sort Int
sortingNat Int
256)

instance Sorting Int16 where
  sorting :: Sort Int16
sorting = (Int16 -> Int) -> Sort Int -> Sort Int16
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\Int16
x -> Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32768) (Int -> Sort Int
sortingNat Int
65536)

instance Sorting Int32 where
  sorting :: Sort Int32
sorting = (Int32 -> Word32) -> Sort Word32 -> Sort Int32
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\Int32
x -> Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
x Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
forall a. Bounded a => a
minBound) :: Word32) Sort Word32
forall b. Sorting b => Sort b
sorting

instance Sorting Int64 where
  sorting :: Sort Int64
sorting = (Int64 -> Word64) -> Sort Word64 -> Sort Int64
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\Int64
x -> Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
forall a. Bounded a => a
minBound) :: Word64) Sort Word64
forall b. Sorting b => Sort b
sorting

instance Sorting Int where
  sorting :: Sort Int
sorting = (Int -> Word) -> Sort Word -> Sort Int
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\Int
x -> Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
forall a. Bounded a => a
minBound) :: Word) Sort Word
forall b. Sorting b => Sort b
sorting

instance Sorting Char where
  sorting :: Sort Char
sorting = (forall b. [(Char, b)] -> [[b]]) -> Sort Char
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
Sort ([(Int, b)] -> [[b]]
forall a b. Eq a => [(a, b)] -> [[b]]
runs ([(Int, b)] -> [[b]])
-> ([(Char, b)] -> [[(Int, b)]]) -> [(Char, b)] -> [[b]]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Sort Int -> forall b. [(Int, b)] -> [[b]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort (Int -> Sort Int
sortingNat Int
1087) ([(Int, (Int, b))] -> [[(Int, b)]])
-> ([(Char, b)] -> [(Int, (Int, b))])
-> [(Char, b)]
-> [[(Int, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Int, (Int, b))]] -> [(Int, (Int, b))]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Int, (Int, b))]] -> [(Int, (Int, b))])
-> ([(Char, b)] -> [[(Int, (Int, b))]])
-> [(Char, b)]
-> [(Int, (Int, b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sort Int -> forall b. [(Int, b)] -> [[b]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort (Int -> Sort Int
sortingNat Int
1024) ([(Int, (Int, (Int, b)))] -> [[(Int, (Int, b))]])
-> ([(Char, b)] -> [(Int, (Int, (Int, b)))])
-> [(Char, b)]
-> [[(Int, (Int, b))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, b) -> (Int, (Int, (Int, b))))
-> [(Char, b)] -> [(Int, (Int, (Int, b)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, b) -> (Int, (Int, (Int, b)))
forall a b. Enum a => (a, b) -> (Int, (Int, (Int, b)))
radices) where
    radices :: (a, b) -> (Int, (Int, (Int, b)))
radices (a
c,b
b) = (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3ff, (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
x Int
10, (Int
x,b
b))) where
      x :: Int
x = a -> Int
forall a. Enum a => a -> Int
fromEnum a
c

instance Sorting Void
instance Sorting Bool
instance Sorting Ordering
instance Sorting a => Sorting [a]
instance Sorting a => Sorting (NonEmpty a)
instance Sorting a => Sorting (Maybe a)
instance (Sorting a, Sorting b) => Sorting (Either a b)
instance (Sorting a, Sorting b) => Sorting (a, b)
instance (Sorting a, Sorting b, Sorting c) => Sorting (a, b, c)
instance (Sorting a, Sorting b, Sorting c, Sorting d) => Sorting (a, b, c, d)
instance (Sorting1 f, Sorting1 g, Sorting a) => Sorting (Compose f g a) where
  sorting :: Sort (Compose f g a)
sorting = Compose f g a -> f (g a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose f g a -> f (g a))
-> Sort (f (g a)) -> Sort (Compose f g a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
`contramap` Sort (g a) -> Sort (f (g a))
forall (f :: * -> *) a. Sorting1 f => Sort a -> Sort (f a)
sorting1 (Sort a -> Sort (g a)
forall (f :: * -> *) a. Sorting1 f => Sort a -> Sort (f a)
sorting1 Sort a
forall b. Sorting b => Sort b
sorting)

class Grouping1 f => Sorting1 f  where
  sorting1 :: Sort a -> Sort (f a)
  default sorting1 :: Deciding1 Sorting f => Sort a -> Sort (f a)
  sorting1 = Proxy Sorting
-> (forall b. Sorting b => Sort b) -> Sort a -> Sort (f a)
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 (Proxy Sorting
forall k (t :: k). Proxy t
Proxy :: Proxy Sorting) forall b. Sorting b => Sort b
sorting

instance (Sorting1 f, Sorting1 g) => Sorting1 (Compose f g) where
  sorting1 :: Sort a -> Sort (Compose f g a)
sorting1 Sort a
f = Compose f g a -> f (g a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose f g a -> f (g a))
-> Sort (f (g a)) -> Sort (Compose f g a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
`contramap` Sort (g a) -> Sort (f (g a))
forall (f :: * -> *) a. Sorting1 f => Sort a -> Sort (f a)
sorting1 (Sort a -> Sort (g a)
forall (f :: * -> *) a. Sorting1 f => Sort a -> Sort (f a)
sorting1 Sort a
f)

instance Sorting1 []
instance Sorting1 NonEmpty
instance Sorting1 Maybe
instance Sorting a => Sorting1 (Either a)

-- | Valid definition for 'compare' in terms of 'Sorting'.
sortingCompare :: Sorting a => a -> a -> Ordering
sortingCompare :: a -> a -> Ordering
sortingCompare a
a a
b = case Sort a -> [(a, Ordering)] -> [[Ordering]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort a
forall b. Sorting b => Sort b
sorting [(a
a,Ordering
LT),(a
b,Ordering
GT)] of
  [Ordering
r]:[[Ordering]]
_ -> Ordering
r
  [[Ordering]]
_     -> Ordering
EQ
{-# INLINE sortingCompare #-}

--------------------------------------------------------------------------------
-- * Utilities
--------------------------------------------------------------------------------

sortingNat :: Int -> Sort Int
sortingNat :: Int -> Sort Int
sortingNat Int
n = (forall b. [(Int, b)] -> [[b]]) -> Sort Int
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
mkSort ((forall b. [(Int, b)] -> [[b]]) -> Sort Int)
-> (forall b. [(Int, b)] -> [[b]]) -> Sort Int
forall a b. (a -> b) -> a -> b
$ \[(Int, b)]
xs -> ([b] -> Bool) -> [[b]] -> [[b]]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (Bool -> Bool
not (Bool -> Bool) -> ([b] -> Bool) -> [b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null) (Int -> ([b] -> b -> [b]) -> [(Int, b)] -> [[b]]
forall v. Int -> ([v] -> v -> [v]) -> [(Int, v)] -> [[v]]
bdiscNat Int
n [b] -> b -> [b]
forall a. [a] -> a -> [a]
upd [(Int, b)]
xs) where
  upd :: [a] -> a -> [a]
upd [a]
vs a
v = a
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
vs
{-# INLINE sortingNat #-}

--------------------------------------------------------------------------------
-- * Collections
--------------------------------------------------------------------------------

-- | Construct a stable ordered discriminator that sorts a list as multisets of elements from another stable ordered discriminator.
--
-- The resulting discriminator only cares about the set of keys and their multiplicity, and is sorted as if we'd
-- sorted each key in turn before comparing.
sortingBag :: Foldable f => Sort k -> Sort (f k)
sortingBag :: Sort k -> Sort (f k)
sortingBag = ([Int] -> Int -> [Int]) -> Sort k -> Sort (f k)
forall (f :: * -> *) k.
Foldable f =>
([Int] -> Int -> [Int]) -> Sort k -> Sort (f k)
sortingColl [Int] -> Int -> [Int]
updateBag

-- | Construct a stable ordered discriminator that sorts a list as sets of elements from another stable ordered discriminator.
--
-- The resulting discriminator only cares about the set of keys, and is sorted as if we'd
-- sorted each key in turn before comparing.
sortingSet :: Foldable f => Sort k -> Sort (f k)
sortingSet :: Sort k -> Sort (f k)
sortingSet = ([Int] -> Int -> [Int]) -> Sort k -> Sort (f k)
forall (f :: * -> *) k.
Foldable f =>
([Int] -> Int -> [Int]) -> Sort k -> Sort (f k)
sortingColl [Int] -> Int -> [Int]
updateSet

sortingColl :: Foldable f => ([Int] -> Int -> [Int]) -> Sort k -> Sort (f k)
sortingColl :: ([Int] -> Int -> [Int]) -> Sort k -> Sort (f k)
sortingColl [Int] -> Int -> [Int]
upd Sort k
r = (forall b. [(f k, b)] -> [[b]]) -> Sort (f k)
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
Sort ((forall b. [(f k, b)] -> [[b]]) -> Sort (f k))
-> (forall b. [(f k, b)] -> [[b]]) -> Sort (f k)
forall a b. (a -> b) -> a -> b
$ \[(f k, b)]
xss -> let
    ([f k]
kss, [b]
vs)           = [(f k, b)] -> ([f k], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(f k, b)]
xss
    elemKeyNumAssocs :: [(k, Int)]
elemKeyNumAssocs    = [[k]] -> [(k, Int)]
forall k. [[k]] -> [(k, Int)]
groupNum (f k -> [k]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (f k -> [k]) -> [f k] -> [[k]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f k]
kss)
    keyNumBlocks :: [[Int]]
keyNumBlocks        = Sort k -> [(k, Int)] -> [[Int]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort k
r [(k, Int)]
elemKeyNumAssocs
    keyNumElemNumAssocs :: [(Int, Int)]
keyNumElemNumAssocs = [[Int]] -> [(Int, Int)]
forall k. [[k]] -> [(k, Int)]
groupNum [[Int]]
keyNumBlocks
    sigs :: [[Int]]
sigs                = Int -> ([Int] -> Int -> [Int]) -> [(Int, Int)] -> [[Int]]
forall v. Int -> ([v] -> v -> [v]) -> [(Int, v)] -> [[v]]
bdiscNat ([f k] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [f k]
kss) [Int] -> Int -> [Int]
upd [(Int, Int)]
keyNumElemNumAssocs
    yss :: [([Int], b)]
yss                 = [[Int]] -> [b] -> [([Int], b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Int]]
sigs [b]
vs
  in ([b] -> Bool) -> [[b]] -> [[b]]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (Bool -> Bool
not (Bool -> Bool) -> ([b] -> Bool) -> [b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null) ([[b]] -> [[b]]) -> [[b]] -> [[b]]
forall a b. (a -> b) -> a -> b
$ Sort Int -> Sort [Int]
forall (f :: * -> *) a. Sorting1 f => Sort a -> Sort (f a)
sorting1 (Int -> Sort Int
sortingNat ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
keyNumBlocks)) Sort [Int] -> [([Int], b)] -> [[b]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
`runSort` [([Int], b)]
yss

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

desc :: Sort a -> Sort a
desc :: Sort a -> Sort a
desc (Sort forall b. [(a, b)] -> [[b]]
l) = (forall b. [(a, b)] -> [[b]]) -> Sort a
forall a. (forall b. [(a, b)] -> [[b]]) -> Sort a
Sort ([[b]] -> [[b]]
forall a. [a] -> [a]
reverse ([[b]] -> [[b]]) -> ([(a, b)] -> [[b]]) -> [(a, b)] -> [[b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> [[b]]
forall b. [(a, b)] -> [[b]]
l)

-- $common
-- Useful combinators.

-- | / O(n)/. Sort a list using discrimination.
--
-- @
-- 'sort' = 'sortWith' 'id'
-- @
sort :: Sorting a => [a] -> [a]
sort :: [a] -> [a]
sort [a]
as = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Sort a -> [(a, a)] -> [[a]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort a
forall b. Sorting b => Sort b
sorting [ (a
a,a
a) | a
a <- [a]
as ]

-- | /O(n)/. Sort a list with a Schwartzian transformation by using discrimination.
--
-- This linear time replacement for 'GHC.Exts.sortWith' and 'Data.List.sortOn' uses discrimination.
sortWith :: Sorting b => (a -> b) -> [a] -> [a]
sortWith :: (a -> b) -> [a] -> [a]
sortWith a -> b
f [a]
as = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Sort b -> [(b, a)] -> [[a]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort b
forall b. Sorting b => Sort b
sorting [ (a -> b
f a
a, a
a) | a
a <- [a]
as ]

--------------------------------------------------------------------------------
-- * Containers
--------------------------------------------------------------------------------

-- | /O(n)/. Construct a 'Map'.
--
-- This is an asymptotically faster version of 'Data.Map.fromList', which exploits ordered discrimination.
--
-- >>> toMap []
-- fromList []
--
-- >>> toMap [(5,"a"), (3 :: Int,"b"), (5, "c")]
-- fromList [(3,"b"),(5,"c")]
--
-- >>> Map.fromList [(5,"a"), (3 :: Int,"b"), (5, "c")]
-- fromList [(3,"b"),(5,"c")]
--
-- >>> toMap [(5,"c"), (3,"b"), (5 :: Int, "a")]
-- fromList [(3,"b"),(5,"a")]
--
-- >>> Map.fromList [(5,"c"), (3,"b"), (5 :: Int, "a")]
-- fromList [(3,"b"),(5,"a")]
--
toMap :: Sorting k => [(k, v)] -> Map k v
toMap :: [(k, v)] -> Map k v
toMap [(k, v)]
kvs = [(k, v)] -> Map k v
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(k, v)] -> Map k v) -> [(k, v)] -> Map k v
forall a b. (a -> b) -> a -> b
$ [(k, v)] -> (k, v)
forall a. [a] -> a
last ([(k, v)] -> (k, v)) -> [[(k, v)]] -> [(k, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort k -> [(k, (k, v))] -> [[(k, v)]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort k
forall b. Sorting b => Sort b
sorting [ ((k, v) -> k
forall a b. (a, b) -> a
fst (k, v)
kv, (k, v)
kv) | (k, v)
kv <- [(k, v)]
kvs ]

-- | /O(n)/. Construct a 'Map', combining values.
--
-- This is an asymptotically faster version of 'Data.Map.fromListWith', which exploits ordered discrimination.
--
-- (Note: values combine in anti-stable order for compatibility with 'Data.Map.fromListWith')
--
-- >>> toMapWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5 :: Int,"c")]
-- fromList [(3,"ab"),(5,"cba")]
--
-- >>> Map.fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5 :: Int,"c")]
-- fromList [(3,"ab"),(5,"cba")]
--
-- >>> toMapWith (++) []
-- fromList []
toMapWith :: Sorting k => (v -> v -> v) -> [(k, v)] -> Map k v
toMapWith :: (v -> v -> v) -> [(k, v)] -> Map k v
toMapWith v -> v -> v
f [(k, v)]
kvs0 = [(k, v)] -> Map k v
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(k, v)] -> Map k v) -> [(k, v)] -> Map k v
forall a b. (a -> b) -> a -> b
$ [(k, v)] -> (k, v)
go ([(k, v)] -> (k, v)) -> [[(k, v)]] -> [(k, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort k -> [(k, (k, v))] -> [[(k, v)]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort k
forall b. Sorting b => Sort b
sorting [ ((k, v) -> k
forall a b. (a, b) -> a
fst (k, v)
kv, (k, v)
kv) | (k, v)
kv <- [(k, v)]
kvs0 ] where
  go :: [(k, v)] -> (k, v)
go ((k
k,v
v):[(k, v)]
kvs) = (k
k, (v -> (k, v) -> v) -> v -> [(k, v)] -> v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl (((k, v) -> v -> v) -> v -> (k, v) -> v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (v -> v -> v
f (v -> v -> v) -> ((k, v) -> v) -> (k, v) -> v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, v) -> v
forall a b. (a, b) -> b
snd)) v
v [(k, v)]
kvs)
  go []          = [Char] -> (k, v)
forall a. HasCallStack => [Char] -> a
error [Char]
"bad sort"

-- | /O(n)/. Construct a 'Map', combining values with access to the key.
--
-- This is an asymptotically faster version of 'Data.Map.fromListWithKey', which exploits ordered discrimination.
--
-- (Note: the values combine in anti-stable order for compatibility with 'Data.Map.fromListWithKey')
--
-- >>> let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value
-- >>> toMapWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5 :: Int,"c")]
-- fromList [(3,"3:a|b"),(5,"5:c|5:b|a")]
--
-- >>> toMapWithKey f []
-- fromList []
toMapWithKey :: Sorting k => (k -> v -> v -> v) -> [(k, v)] -> Map k v
toMapWithKey :: (k -> v -> v -> v) -> [(k, v)] -> Map k v
toMapWithKey k -> v -> v -> v
f [(k, v)]
kvs0 = [(k, v)] -> Map k v
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(k, v)] -> Map k v) -> [(k, v)] -> Map k v
forall a b. (a -> b) -> a -> b
$ [(k, v)] -> (k, v)
go ([(k, v)] -> (k, v)) -> [[(k, v)]] -> [(k, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort k -> [(k, (k, v))] -> [[(k, v)]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort k
forall b. Sorting b => Sort b
sorting [ ((k, v) -> k
forall a b. (a, b) -> a
fst (k, v)
kv, (k, v)
kv) | (k, v)
kv <- [(k, v)]
kvs0 ] where
  go :: [(k, v)] -> (k, v)
go ((k
k,v
v):[(k, v)]
kvs) = (k
k, (v -> (k, v) -> v) -> v -> [(k, v)] -> v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl (((k, v) -> v -> v) -> v -> (k, v) -> v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> v -> v -> v
f k
k (v -> v -> v) -> ((k, v) -> v) -> (k, v) -> v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, v) -> v
forall a b. (a, b) -> b
snd)) v
v [(k, v)]
kvs)
  go []          = [Char] -> (k, v)
forall a. HasCallStack => [Char] -> a
error [Char]
"bad sort"

-- | /O(n)/. Construct an 'IntMap'.
--
-- >>> toIntMap []
-- fromList []
--
-- >>> toIntMap [(5,"a"), (3,"b"), (5, "c")]
-- fromList [(3,"b"),(5,"c")]
--
-- >>> IntMap.fromList [(5,"a"), (3,"b"), (5, "c")]
-- fromList [(3,"b"),(5,"c")]
--
-- >>> toIntMap [(5,"c"), (3,"b"), (5, "a")]
-- fromList [(3,"b"),(5,"a")]
--
-- >>> IntMap.fromList [(5,"c"), (3,"b"), (5, "a")]
-- fromList [(3,"b"),(5,"a")]
--
toIntMap :: [(Int, v)] -> IntMap v
toIntMap :: [(Int, v)] -> IntMap v
toIntMap [(Int, v)]
kvs = [(Int, v)] -> IntMap v
forall a. [(Int, a)] -> IntMap a
IntMap.fromDistinctAscList ([(Int, v)] -> IntMap v) -> [(Int, v)] -> IntMap v
forall a b. (a -> b) -> a -> b
$ [(Int, v)] -> (Int, v)
forall a. [a] -> a
last ([(Int, v)] -> (Int, v)) -> [[(Int, v)]] -> [(Int, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort Int -> [(Int, (Int, v))] -> [[(Int, v)]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort Int
forall b. Sorting b => Sort b
sorting [ ((Int, v) -> Int
forall a b. (a, b) -> a
fst (Int, v)
kv, (Int, v)
kv) | (Int, v)
kv <- [(Int, v)]
kvs ]

-- | /O(n)/. Construct an 'IntMap', combining values.
--
-- This is an asymptotically faster version of 'Data.IntMap.Lazy.fromListWith', which exploits ordered discrimination.
--
-- (Note: values combine in anti-stable order for compatibility with 'Data.IntMap.Lazy.fromListWith')
--
-- >>> toIntMapWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")]
-- fromList [(3,"ab"),(5,"cba")]
--
-- >>> IntMap.fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")]
-- fromList [(3,"ab"),(5,"cba")]
--
-- >>> toIntMapWith (++) []
-- fromList []
toIntMapWith :: (v -> v -> v) -> [(Int, v)] -> IntMap v
toIntMapWith :: (v -> v -> v) -> [(Int, v)] -> IntMap v
toIntMapWith v -> v -> v
f [(Int, v)]
kvs0 = [(Int, v)] -> IntMap v
forall a. [(Int, a)] -> IntMap a
IntMap.fromDistinctAscList ([(Int, v)] -> IntMap v) -> [(Int, v)] -> IntMap v
forall a b. (a -> b) -> a -> b
$ [(Int, v)] -> (Int, v)
go ([(Int, v)] -> (Int, v)) -> [[(Int, v)]] -> [(Int, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort Int -> [(Int, (Int, v))] -> [[(Int, v)]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort Int
forall b. Sorting b => Sort b
sorting [ ((Int, v) -> Int
forall a b. (a, b) -> a
fst (Int, v)
kv, (Int, v)
kv) | (Int, v)
kv <- [(Int, v)]
kvs0 ] where
  go :: [(Int, v)] -> (Int, v)
go ((Int
k,v
v):[(Int, v)]
kvs) = (Int
k, (v -> (Int, v) -> v) -> v -> [(Int, v)] -> v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl (((Int, v) -> v -> v) -> v -> (Int, v) -> v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (v -> v -> v
f (v -> v -> v) -> ((Int, v) -> v) -> (Int, v) -> v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, v) -> v
forall a b. (a, b) -> b
snd)) v
v [(Int, v)]
kvs)
  go []          = [Char] -> (Int, v)
forall a. HasCallStack => [Char] -> a
error [Char]
"bad sort"

-- | /O(n)/. Construct a 'Map', combining values with access to the key.
--
-- This is an asymptotically faster version of 'Data.IntMap.Lazy.fromListWithKey', which exploits ordered discrimination.
--
-- (Note: the values combine in anti-stable order for compatibility with 'Data.IntMap.Lazy.fromListWithKey')
--
-- >>> let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value
-- >>> toIntMapWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")]
-- fromList [(3,"3:a|b"),(5,"5:c|5:b|a")]
--
-- >>> IntMap.fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")]
-- fromList [(3,"3:a|b"),(5,"5:c|5:b|a")]
--
-- >>> toIntMapWithKey f []
-- fromList []
toIntMapWithKey :: (Int -> v -> v -> v) -> [(Int, v)] -> IntMap v
toIntMapWithKey :: (Int -> v -> v -> v) -> [(Int, v)] -> IntMap v
toIntMapWithKey Int -> v -> v -> v
f [(Int, v)]
kvs0 = [(Int, v)] -> IntMap v
forall a. [(Int, a)] -> IntMap a
IntMap.fromDistinctAscList ([(Int, v)] -> IntMap v) -> [(Int, v)] -> IntMap v
forall a b. (a -> b) -> a -> b
$ [(Int, v)] -> (Int, v)
go ([(Int, v)] -> (Int, v)) -> [[(Int, v)]] -> [(Int, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort Int -> [(Int, (Int, v))] -> [[(Int, v)]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort Int
forall b. Sorting b => Sort b
sorting [ ((Int, v) -> Int
forall a b. (a, b) -> a
fst (Int, v)
kv, (Int, v)
kv) | (Int, v)
kv <- [(Int, v)]
kvs0 ] where
  go :: [(Int, v)] -> (Int, v)
go ((Int
k,v
v):[(Int, v)]
kvs) = (Int
k, (v -> (Int, v) -> v) -> v -> [(Int, v)] -> v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl (((Int, v) -> v -> v) -> v -> (Int, v) -> v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> v -> v -> v
f Int
k (v -> v -> v) -> ((Int, v) -> v) -> (Int, v) -> v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, v) -> v
forall a b. (a, b) -> b
snd)) v
v [(Int, v)]
kvs)
  go []          = [Char] -> (Int, v)
forall a. HasCallStack => [Char] -> a
error [Char]
"bad sort"

-- | /O(n)/. Construct a 'Set' in linear time.
--
-- This is an asymptotically faster version of 'Data.Set.fromList', which exploits ordered discrimination.
toSet :: Sorting k => [k] -> Set k
toSet :: [k] -> Set k
toSet [k]
kvs = [k] -> Set k
forall a. [a] -> Set a
Set.fromDistinctAscList ([k] -> Set k) -> [k] -> Set k
forall a b. (a -> b) -> a -> b
$ [k] -> k
forall a. [a] -> a
last ([k] -> k) -> [[k]] -> [k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort k -> [(k, k)] -> [[k]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort k
forall b. Sorting b => Sort b
sorting [ (k
kv, k
kv) | k
kv <- [k]
kvs ]

-- | /O(n)/. Construct an 'IntSet' in linear time.
--
-- This is an asymptotically faster version of 'Data.IntSet.fromList', which exploits ordered discrimination.
toIntSet :: [Int] -> IntSet
toIntSet :: [Int] -> IntSet
toIntSet [Int]
kvs = [Int] -> IntSet
IntSet.fromDistinctAscList ([Int] -> IntSet) -> [Int] -> IntSet
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. [a] -> a
last ([Int] -> Int) -> [[Int]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sort Int -> [(Int, Int)] -> [[Int]]
forall a. Sort a -> forall b. [(a, b)] -> [[b]]
runSort Sort Int
forall b. Sorting b => Sort b
sorting [ (Int
kv, Int
kv) | Int
kv <- [Int]
kvs ]