{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ViewPatterns       #-}
{-# OPTIONS_HADDOCK not-home    #-}

-- |
-- Module      : Data.IntSet.NonEmpty.Internal
-- Copyright   : (c) Justin Le 2018
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Unsafe internal-use functions used in the implementation of
-- "Data.IntSet.NonEmpty".  These functions can potentially be used to break
-- the abstraction of 'NEIntSet' and produce unsound sets, so be wary!
module Data.IntSet.NonEmpty.Internal (
    NEIntSet(..)
  , Key
  , nonEmptySet
  , withNonEmpty
  , toSet
  , singleton
  , fromList
  , toList
  , union
  , unions
  , valid
  , insertMinSet
  , insertMaxSet
  , disjointSet
  ) where

import           Control.DeepSeq
import           Control.Monad
import           Data.Data
import           Data.Function
import           Data.IntSet.Internal    (IntSet(..), Key)
import           Data.List.NonEmpty      (NonEmpty(..))
import           Data.Semigroup
import           Data.Semigroup.Foldable (Foldable1)
import           Text.Read
import qualified Data.Aeson              as A
import qualified Data.Foldable           as F
import qualified Data.IntSet             as S
import qualified Data.Semigroup.Foldable as F1

-- | A non-empty (by construction) set of integers.  At least one value
-- exists in an @'NEIntSet' a@ at all times.
--
-- Functions that /take/ an 'NEIntSet' can safely operate on it with the
-- assumption that it has at least one item.
--
-- Functions that /return/ an 'NEIntSet' provide an assurance that the
-- result has at least one item.
--
-- "Data.IntSet.NonEmpty" re-exports the API of "Data.IntSet", faithfully
-- reproducing asymptotics, typeclass constraints, and semantics.
-- Functions that ensure that input and output sets are both non-empty
-- (like 'Data.IntSet.NonEmpty.insert') return 'NEIntSet', but functions that
-- might potentially return an empty map (like 'Data.IntSet.NonEmpty.delete')
-- return a 'IntSet' instead.
--
-- You can directly construct an 'NEIntSet' with the API from
-- "Data.IntSet.NonEmpty"; it's more or less the same as constructing a normal
-- 'IntSet', except you don't have access to 'Data.IntSet.empty'.  There are also
-- a few ways to construct an 'NEIntSet' from a 'IntSet':
--
-- 1.  The 'nonEmptySet' smart constructor will convert a @'IntSet' a@ into
--     a @'Maybe' ('NEIntSet' a)@, returning 'Nothing' if the original 'IntSet'
--     was empty.
-- 2.  You can use the 'Data.IntSet.NonEmpty.insertIntSet' family of functions to
--     insert a value into a 'IntSet' to create a guaranteed 'NEIntSet'.
-- 3.  You can use the 'Data.IntSet.NonEmpty.IsNonEmpty' and
--     'Data.IntSet.NonEmpty.IsEmpty' patterns to "pattern match" on a 'IntSet'
--     to reveal it as either containing a 'NEIntSet' or an empty map.
-- 4.  'withNonEmpty' offers a continuation-based interface
--     for deconstructing a 'IntSet' and treating it as if it were an 'NEIntSet'.
--
-- You can convert an 'NEIntSet' into a 'IntSet' with 'toSet' or
-- 'Data.IntSet.NonEmpty.IsNonEmpty', essentially "obscuring" the non-empty
-- property from the type.
data NEIntSet =
    NEIntSet { NEIntSet -> Key
neisV0     :: !Key   -- ^ invariant: must be smaller than smallest value in set
             , NEIntSet -> IntSet
neisIntSet :: !IntSet
             }
  deriving (Typeable)

instance Eq NEIntSet where
    NEIntSet
t1 == :: NEIntSet -> NEIntSet -> Bool
== NEIntSet
t2  = IntSet -> Key
S.size (NEIntSet -> IntSet
neisIntSet NEIntSet
t1) forall a. Eq a => a -> a -> Bool
== IntSet -> Key
S.size (NEIntSet -> IntSet
neisIntSet NEIntSet
t2)
             Bool -> Bool -> Bool
&& NEIntSet -> NonEmpty Key
toList NEIntSet
t1 forall a. Eq a => a -> a -> Bool
== NEIntSet -> NonEmpty Key
toList NEIntSet
t2

instance Ord NEIntSet where
    compare :: NEIntSet -> NEIntSet -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEIntSet -> NonEmpty Key
toList
    < :: NEIntSet -> NEIntSet -> Bool
(<)     = forall a. Ord a => a -> a -> Bool
(<) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEIntSet -> NonEmpty Key
toList
    > :: NEIntSet -> NEIntSet -> Bool
(>)     = forall a. Ord a => a -> a -> Bool
(>) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEIntSet -> NonEmpty Key
toList
    <= :: NEIntSet -> NEIntSet -> Bool
(<=)    = forall a. Ord a => a -> a -> Bool
(<=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEIntSet -> NonEmpty Key
toList
    >= :: NEIntSet -> NEIntSet -> Bool
(>=)    = forall a. Ord a => a -> a -> Bool
(>=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEIntSet -> NonEmpty Key
toList

instance Show NEIntSet where
    showsPrec :: Key -> NEIntSet -> ShowS
showsPrec Key
p NEIntSet
xs = Bool -> ShowS -> ShowS
showParen (Key
p forall a. Ord a => a -> a -> Bool
> Key
10) forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"fromList (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (NEIntSet -> NonEmpty Key
toList NEIntSet
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"

instance Read NEIntSet where
    readPrec :: ReadPrec NEIntSet
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Key -> ReadPrec a -> ReadPrec a
prec Key
10 forall a b. (a -> b) -> a -> b
$ do
      Ident String
"fromList" <- ReadPrec Lexeme
lexP
      NonEmpty Key
xs <- forall a. ReadPrec a -> ReadPrec a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Key -> ReadPrec a -> ReadPrec a
prec Key
10 forall a b. (a -> b) -> a -> b
$ forall a. Read a => ReadPrec a
readPrec
      forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty Key -> NEIntSet
fromList NonEmpty Key
xs)

    readListPrec :: ReadPrec [NEIntSet]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

instance NFData NEIntSet where
    rnf :: NEIntSet -> ()
rnf (NEIntSet Key
x IntSet
s) = forall a. NFData a => a -> ()
rnf Key
x seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IntSet
s

-- Data instance code from Data.IntSet.Internal
--
-- Copyright   :  (c) Daan Leijen 2002
--                (c) Joachim Breitner 2011
instance Data NEIntSet where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NEIntSet -> c NEIntSet
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z NEIntSet
is = forall g. g -> c g
z NonEmpty Key -> NEIntSet
fromList forall d b. Data d => c (d -> b) -> d -> c b
`f` (NEIntSet -> NonEmpty Key
toList NEIntSet
is)
  toConstr :: NEIntSet -> Constr
toConstr NEIntSet
_     = Constr
fromListConstr
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NEIntSet
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Key
constrIndex Constr
c of
    Key
1 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z NonEmpty Key -> NEIntSet
fromList)
    Key
_ -> forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: NEIntSet -> DataType
dataTypeOf NEIntSet
_   = DataType
intSetDataType

fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
intSetDataType String
"fromList" [] Fixity
Prefix

intSetDataType :: DataType
intSetDataType :: DataType
intSetDataType = String -> [Constr] -> DataType
mkDataType String
"Data.IntSet.NonEmpty.Internal.NEIntSet" [Constr
fromListConstr]


instance A.ToJSON NEIntSet where
    toJSON :: NEIntSet -> Value
toJSON     = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEIntSet -> IntSet
toSet
    toEncoding :: NEIntSet -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
A.toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEIntSet -> IntSet
toSet

instance A.FromJSON NEIntSet where
    parseJSON :: Value -> Parser NEIntSet
parseJSON = forall r. r -> (NEIntSet -> r) -> IntSet -> r
withNonEmpty (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err) forall (f :: * -> *) a. Applicative f => a -> f a
pure
            forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. FromJSON a => Value -> Parser a
A.parseJSON
      where
        err :: String
err = String
"NEIntSet: Non-empty set expected, but empty set found"


-- | /O(log n)/. Smart constructor for an 'NEIntSet' from a 'IntSet'.  Returns
-- 'Nothing' if the 'IntSet' was originally actually empty, and @'Just' n@
-- with an 'NEIntSet', if the 'IntSet' was not empty.
--
-- 'nonEmptySet' and @'maybe' 'Data.IntSet.empty' 'toSet'@ form an
-- isomorphism: they are perfect structure-preserving inverses of
-- eachother.
--
-- See 'Data.IntSet.NonEmpty.IsNonEmpty' for a pattern synonym that lets you
-- "match on" the possiblity of a 'IntSet' being an 'NEIntSet'.
--
-- > nonEmptySet (Data.IntSet.fromList [3,5]) == Just (fromList (3:|[5]))
nonEmptySet :: IntSet -> Maybe NEIntSet
nonEmptySet :: IntSet -> Maybe NEIntSet
nonEmptySet = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry) Key -> IntSet -> NEIntSet
NEIntSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Key, IntSet)
S.minView
{-# INLINE nonEmptySet #-}

-- | /O(log n)/. A general continuation-based way to consume a 'IntSet' as if
-- it were an 'NEIntSet'. @'withNonEmpty' def f@ will take a 'IntSet'.  If set is
-- empty, it will evaluate to @def@.  Otherwise, a non-empty set 'NEIntSet'
-- will be fed to the function @f@ instead.
--
-- @'nonEmptySet' == 'withNonEmpty' 'Nothing' 'Just'@
withNonEmpty
    :: r                   -- ^ value to return if set is empty
    -> (NEIntSet -> r)     -- ^ function to apply if set is not empty
    -> IntSet
    -> r
withNonEmpty :: forall r. r -> (NEIntSet -> r) -> IntSet -> r
withNonEmpty r
def NEIntSet -> r
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe r
def NEIntSet -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe NEIntSet
nonEmptySet
{-# INLINE withNonEmpty #-}

-- | /O(log n)/.
-- Convert a non-empty set back into a normal possibly-empty map, for usage
-- with functions that expect 'IntSet'.
--
-- Can be thought of as "obscuring" the non-emptiness of the set in its
-- type.  See the 'Data.IntSet.NonEmpty.IsNotEmpty' pattern.
--
-- 'nonEmptySet' and @'maybe' 'Data.IntSet.empty' 'toSet'@ form an
-- isomorphism: they are perfect structure-preserving inverses of
-- eachother.
--
-- > toSet (fromList ((3,"a") :| [(5,"b")])) == Data.IntSet.fromList [(3,"a"), (5,"b")]
toSet :: NEIntSet -> IntSet
toSet :: NEIntSet -> IntSet
toSet (NEIntSet Key
x IntSet
s) = Key -> IntSet -> IntSet
insertMinSet Key
x IntSet
s
{-# INLINE toSet #-}

-- | /O(1)/. Create a singleton set.
singleton :: Key -> NEIntSet
singleton :: Key -> NEIntSet
singleton Key
x = Key -> IntSet -> NEIntSet
NEIntSet Key
x IntSet
S.empty
{-# INLINE singleton #-}

-- | /O(n*log n)/. Create a set from a list of elements.

-- TODO: write manually and optimize to be equivalent to
-- 'fromDistinctAscList' if items are ordered, just like the actual
-- 'S.fromList'.
fromList :: NonEmpty Key -> NEIntSet
fromList :: NonEmpty Key -> NEIntSet
fromList (Key
x :| [Key]
s) = forall r. r -> (NEIntSet -> r) -> IntSet -> r
withNonEmpty (Key -> NEIntSet
singleton Key
x) (forall a. Semigroup a => a -> a -> a
<> Key -> NEIntSet
singleton Key
x)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key] -> IntSet
S.fromList
                  forall a b. (a -> b) -> a -> b
$ [Key]
s
{-# INLINE fromList #-}

-- | /O(n)/. Convert the set to a non-empty list of elements.
toList :: NEIntSet -> NonEmpty Key
toList :: NEIntSet -> NonEmpty Key
toList (NEIntSet Key
x IntSet
s) = Key
x forall a. a -> [a] -> NonEmpty a
:| IntSet -> [Key]
S.toList IntSet
s
{-# INLINE toList #-}

-- | /O(m*log(n\/m + 1)), m <= n/. The union of two sets, preferring the first set when
-- equal elements are encountered.
union
    :: NEIntSet
    -> NEIntSet
    -> NEIntSet
union :: NEIntSet -> NEIntSet -> NEIntSet
union n1 :: NEIntSet
n1@(NEIntSet Key
x1 IntSet
s1) n2 :: NEIntSet
n2@(NEIntSet Key
x2 IntSet
s2) = case forall a. Ord a => a -> a -> Ordering
compare Key
x1 Key
x2 of
    Ordering
LT -> Key -> IntSet -> NEIntSet
NEIntSet Key
x1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> IntSet -> IntSet
S.union IntSet
s1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEIntSet -> IntSet
toSet forall a b. (a -> b) -> a -> b
$ NEIntSet
n2
    Ordering
EQ -> Key -> IntSet -> NEIntSet
NEIntSet Key
x1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> IntSet -> IntSet
S.union IntSet
s1         forall a b. (a -> b) -> a -> b
$ IntSet
s2
    Ordering
GT -> Key -> IntSet -> NEIntSet
NEIntSet Key
x2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> IntSet -> IntSet
S.union (NEIntSet -> IntSet
toSet NEIntSet
n1) forall a b. (a -> b) -> a -> b
$ IntSet
s2
{-# INLINE union #-}

-- | The union of a non-empty list of sets
unions
    :: Foldable1 f
    => f NEIntSet
    -> NEIntSet
unions :: forall (f :: * -> *). Foldable1 f => f NEIntSet -> NEIntSet
unions (forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
F1.toNonEmpty->(NEIntSet
s :| [NEIntSet]
ss)) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' NEIntSet -> NEIntSet -> NEIntSet
union NEIntSet
s [NEIntSet]
ss
{-# INLINE unions #-}

-- | Left-biased union
instance Semigroup NEIntSet where
    <> :: NEIntSet -> NEIntSet -> NEIntSet
(<>) = NEIntSet -> NEIntSet -> NEIntSet
union
    {-# INLINE (<>) #-}
    sconcat :: NonEmpty NEIntSet -> NEIntSet
sconcat = forall (f :: * -> *). Foldable1 f => f NEIntSet -> NEIntSet
unions
    {-# INLINE sconcat #-}

-- | /O(n)/. Test if the internal set structure is valid.
valid :: NEIntSet -> Bool
valid :: NEIntSet -> Bool
valid (NEIntSet Key
x IntSet
s) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Key
x forall a. Ord a => a -> a -> Bool
<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (IntSet -> Maybe (Key, IntSet)
S.minView IntSet
s)







-- | /O(log n)/. Insert new value into a set where values are
-- /strictly greater than/ the new values  That is, the new value must be
-- /strictly less than/ all values present in the 'IntSet'.  /The precondition
-- is not checked./
--
-- At the moment this is simply an alias for @Data.IntSet.insert@, but it's
-- left here as a placeholder in case this eventually gets implemented in
-- a more efficient way.

-- TODO: implementation
insertMinSet :: Key -> IntSet -> IntSet
insertMinSet :: Key -> IntSet -> IntSet
insertMinSet = Key -> IntSet -> IntSet
S.insert
{-# INLINABLE insertMinSet #-}

-- | /O(log n)/. Insert new value into a set where values are /strictly
-- less than/ the new value.  That is, the new value must be /strictly
-- greater than/ all values present in the 'IntSet'.  /The precondition is not
-- checked./
--
-- At the moment this is simply an alias for @Data.IntSet.insert@, but it's
-- left here as a placeholder in case this eventually gets implemented in
-- a more efficient way.

-- TODO: implementation
insertMaxSet :: Key -> IntSet -> IntSet
insertMaxSet :: Key -> IntSet -> IntSet
insertMaxSet = Key -> IntSet -> IntSet
S.insert
{-# INLINABLE insertMaxSet #-}

-- ---------------------------------------------
-- | CPP for new functions not in old containers
-- ---------------------------------------------

-- | Comptability layer for 'Data.IntSet.disjoint'.
disjointSet :: IntSet -> IntSet -> Bool
#if MIN_VERSION_containers(0,5,11)
disjointSet :: IntSet -> IntSet -> Bool
disjointSet = IntSet -> IntSet -> Bool
S.disjoint
#else
disjointSet xs = S.null . S.intersection xs
#endif
{-# INLINE disjointSet #-}