module Data.NonEmpty.Set (
   T,
   insert,
   singleton,
   member,
   size,
   fromList,
   fromAscList,
   toAscList,
   fetch,
   flatten,
   union,
   unionLeft,
   unionRight,

   findMin,
   findMax,
   delete,
   deleteMin,
   deleteMax,
   deleteFindMin,
   deleteFindMax,
   minView,
   maxView,
   ) where

import qualified Data.NonEmpty.Class as C
import qualified Data.NonEmpty as NonEmpty

import qualified Data.Set as Set
import Data.Set (Set, )

import Control.Monad (mzero, )
import Control.Applicative (liftA2)
import Control.DeepSeq (NFData, rnf, )
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Tuple.HT (forcePair, mapSnd, )

import qualified Test.QuickCheck as QC


{-
The first field will always contain the smallest element.
We do not use the NonEmpty data type here
since it is easy to break this invariant using NonEmpty.!:.
The custom type is also consistent with Map.
-}
data T a = Cons a (Set a)
   deriving (T a -> T a -> Bool
forall a. Eq a => T a -> T a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T a -> T a -> Bool
$c/= :: forall a. Eq a => T a -> T a -> Bool
== :: T a -> T a -> Bool
$c== :: forall a. Eq a => T a -> T a -> Bool
Eq, T a -> T a -> Bool
T a -> T a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (T a)
forall a. Ord a => T a -> T a -> Bool
forall a. Ord a => T a -> T a -> Ordering
forall a. Ord a => T a -> T a -> T a
min :: T a -> T a -> T a
$cmin :: forall a. Ord a => T a -> T a -> T a
max :: T a -> T a -> T a
$cmax :: forall a. Ord a => T a -> T a -> T a
>= :: T a -> T a -> Bool
$c>= :: forall a. Ord a => T a -> T a -> Bool
> :: T a -> T a -> Bool
$c> :: forall a. Ord a => T a -> T a -> Bool
<= :: T a -> T a -> Bool
$c<= :: forall a. Ord a => T a -> T a -> Bool
< :: T a -> T a -> Bool
$c< :: forall a. Ord a => T a -> T a -> Bool
compare :: T a -> T a -> Ordering
$ccompare :: forall a. Ord a => T a -> T a -> Ordering
Ord)

instance (Show a) => Show (T a) where
   showsPrec :: Int -> T a -> ShowS
showsPrec Int
p T a
xs =
      Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
10) forall a b. (a -> b) -> a -> b
$
         String -> ShowS
showString String
"NonEmptySet.fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (forall a. T a -> T [] a
toAscList T a
xs)


instance (NFData a) => NFData (T a) where
   rnf :: T a -> ()
rnf = forall (f :: * -> *) a. (NFData f, NFData a) => f a -> ()
C.rnf

instance C.NFData T where
   rnf :: forall a. NFData a => T a -> ()
rnf (Cons a
x Set a
xs) = forall a. NFData a => a -> ()
rnf (a
x, forall (f :: * -> *) a. (NFData f, NFData a) => f a -> ()
C.rnf Set a
xs)


instance (QC.Arbitrary a, Ord a) => QC.Arbitrary (T a) where
   arbitrary :: Gen (T a)
arbitrary = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Ord a => a -> Set a -> T a
insert forall a. Arbitrary a => Gen a
QC.arbitrary forall a. Arbitrary a => Gen a
QC.arbitrary
   shrink :: T a -> [T a]
shrink = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. Ord a => Set a -> Maybe (T a)
fetch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
QC.shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => T a -> Set a
flatten


{- |
We cannot have a reasonable @instance Insert Set@,
since the @instance Insert (NonEmpty Set)@
would preserve duplicate leading elements, whereas 'Set' does not.

However, the @instance Insert NonEmpty@ is not the problem.
A general type like

> insertSet :: (Insert f, Ord a) => a -> f a -> NonEmpty f a

cannot work, since it can be instantiated to

> insertSet :: (Ord a) => a -> NonEmpty Set a -> NonEmpty (NonEmpty Set) a

and this is obviously wrong:
@insertSet x (singleton x)@ has only one element, not two.
-}
insert :: Ord a => a -> Set a -> T a
insert :: forall a. Ord a => a -> Set a -> T a
insert = forall a. Ord a => ((a, a) -> a) -> a -> Set a -> T a
insertGen forall a b. (a, b) -> a
fst

insertGen :: Ord a => ((a,a) -> a) -> a -> Set a -> T a
insertGen :: forall a. Ord a => ((a, a) -> a) -> a -> Set a -> T a
insertGen (a, a) -> a
select a
y Set a
xt =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> Set a -> T a
Cons forall a b. (a -> b) -> a -> b
$
   forall a. a -> Maybe a -> a
fromMaybe (a
y, Set a
xt) forall a b. (a -> b) -> a -> b
$ do
      (a
x,Set a
xs) <- forall a. Set a -> Maybe (a, Set a)
Set.minView Set a
xt
      case forall a. Ord a => a -> a -> Ordering
compare a
y a
x of
         Ordering
GT -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, forall a. Ord a => a -> Set a -> Set a
Set.insert a
y Set a
xs)
         Ordering
EQ -> forall (m :: * -> *) a. Monad m => a -> m a
return ((a, a) -> a
select (a
y,a
x), Set a
xs)
         Ordering
LT -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

singleton :: a -> T a
singleton :: forall a. a -> T a
singleton a
a = forall a. a -> Set a -> T a
Cons a
a forall a. Set a
Set.empty

member :: (Ord a) => a -> T a -> Bool
member :: forall a. Ord a => a -> T a -> Bool
member a
y (Cons a
x Set a
xs) =
   a
yforall a. Eq a => a -> a -> Bool
==a
x Bool -> Bool -> Bool
|| forall a. Ord a => a -> Set a -> Bool
Set.member a
y Set a
xs

size :: T a -> Int
size :: forall a. T a -> Int
size (Cons a
_ Set a
xs) = Int
1 forall a. Num a => a -> a -> a
+ forall a. Set a -> Int
Set.size Set a
xs


findMin :: T a -> a
findMin :: forall a. T a -> a
findMin (Cons a
x Set a
_) = a
x

findMax :: T a -> a
findMax :: forall a. T a -> a
findMax (Cons a
x Set a
xs) =
   if forall a. Set a -> Bool
Set.null Set a
xs then a
x else forall a. Set a -> a
Set.findMax Set a
xs


delete :: (Ord k) => k -> T k -> Set k
delete :: forall k. Ord k => k -> T k -> Set k
delete k
y (Cons k
x Set k
xs) =
   if k
y forall a. Eq a => a -> a -> Bool
== k
x then Set k
xs else forall a. Ord a => a -> Set a -> Set a
Set.insert k
x forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
Set.delete k
y Set k
xs

deleteMin :: T a -> Set a
deleteMin :: forall a. T a -> Set a
deleteMin (Cons a
_ Set a
xs) = Set a
xs

deleteMax :: (Ord a) => T a -> Set a
deleteMax :: forall a. Ord a => T a -> Set a
deleteMax (Cons a
x Set a
xs) =
   if forall a. Set a -> Bool
Set.null Set a
xs then forall a. Set a
Set.empty else forall a. Ord a => a -> Set a -> Set a
Set.insert a
x forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Set a
Set.deleteMax Set a
xs


deleteFindMin :: T a -> (a, Set a)
deleteFindMin :: forall a. T a -> (a, Set a)
deleteFindMin (Cons a
x Set a
xs) = (a
x, Set a
xs)

deleteFindMax :: (Ord a) => T a -> (a, Set a)
deleteFindMax :: forall a. Ord a => T a -> (a, Set a)
deleteFindMax (Cons a
x Set a
xs) =
   if forall a. Set a -> Bool
Set.null Set a
xs
     then (a
x, forall a. Set a
Set.empty)
     else forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a. Ord a => a -> Set a -> Set a
Set.insert a
x) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> (a, Set a)
Set.deleteFindMax Set a
xs


minView :: T a -> (a, Set a)
minView :: forall a. T a -> (a, Set a)
minView (Cons a
x Set a
xs) = (a
x,Set a
xs)

maxView :: (Ord a) => T a -> (a, Set a)
maxView :: forall a. Ord a => T a -> (a, Set a)
maxView (Cons a
x Set a
xs) =
   forall a b. (a, b) -> (a, b)
forcePair forall a b. (a -> b) -> a -> b
$
   case forall a. Set a -> Maybe (a, Set a)
Set.maxView Set a
xs of
      Maybe (a, Set a)
Nothing -> (a
x,Set a
xs)
      Just (a
y,Set a
ys) -> (a
y, forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
ys)


fromList :: (Ord a) => NonEmpty.T [] a -> T a
fromList :: forall a. Ord a => T [] a -> T a
fromList (NonEmpty.Cons a
x [a]
xs) = forall a. Ord a => a -> Set a -> T a
insert a
x forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs

fromAscList :: (Ord a) => NonEmpty.T [] a -> T a
fromAscList :: forall a. Ord a => T [] a -> T a
fromAscList (NonEmpty.Cons a
x [a]
xs) = forall a. a -> Set a -> T a
Cons a
x forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> Set a
Set.fromAscList [a]
xs

toAscList :: T a -> NonEmpty.T [] a
toAscList :: forall a. T a -> T [] a
toAscList (Cons a
x Set a
xs) = forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons a
x forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toAscList Set a
xs

fetch :: (Ord a) => Set a -> Maybe (T a)
fetch :: forall a. Ord a => Set a -> Maybe (T a)
fetch  =  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> Set a -> T a
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Maybe (a, Set a)
Set.minView

flatten :: (Ord a) => T a -> Set a
flatten :: forall a. Ord a => T a -> Set a
flatten (Cons a
x Set a
xs) = forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
xs

union :: (Ord a) => T a -> T a -> T a
union :: forall a. Ord a => T a -> T a -> T a
union (Cons a
x Set a
xs) (Cons a
y Set a
ys) =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> Set a -> T a
Cons forall a b. (a -> b) -> a -> b
$
   case forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
xs Set a
ys of
      Set a
zs ->
         case forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
            Ordering
LT -> (a
x, forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
zs forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton a
y)
            Ordering
GT -> (a
y, forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
zs)
            Ordering
EQ -> (a
x, Set a
zs)

unionLeft :: (Ord a) => Set a -> T a -> T a
unionLeft :: forall a. Ord a => Set a -> T a -> T a
unionLeft Set a
xs (Cons a
y Set a
ys) =
   forall a. Ord a => ((a, a) -> a) -> a -> Set a -> T a
insertGen forall a b. (a, b) -> b
snd a
y forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
xs Set a
ys

unionRight :: (Ord a) => T a -> Set a -> T a
unionRight :: forall a. Ord a => T a -> Set a -> T a
unionRight (Cons a
x Set a
xs) Set a
ys =
   forall a. Ord a => ((a, a) -> a) -> a -> Set a -> T a
insertGen forall a b. (a, b) -> a
fst a
x forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
xs Set a
ys


{-
According Set functions are only available since containers-0.5.2, i.e. GHC-7.8.

elemAt :: Int -> T a -> a
elemAt k (Cons x xs) =
   if k==0 then x else Set.elemAt (pred k) xs

deleteAt :: Int -> T a -> Set a
deleteAt k (Cons _ xs) =
   if k==0 then xs else Set.deleteAt (pred k) xs
-}