{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -O2 #-}
module Data.Continuous.Set.Lifted
  ( Set
  , Inclusivity(..)
  , singleton
  , member
  , empty
  , universe
  , null
  , universal
  ) where

import Prelude hiding (lookup,map,foldr,negate,null)

import Data.Semigroup (Semigroup)
import Data.Primitive (Array)
import Data.Continuous.Set.Internal (Inclusivity(..))
import qualified Data.Semigroup as SG
import qualified Data.Continuous.Set.Internal as I

-- | A diet set. Currently, the data constructor for this type is
-- exported. Please do not use it. It will be moved to an internal
-- module at some point.
newtype Set a = Set (I.Set Array a)

-- | /O(1)/ Create a continuous interval set with a single interval.
singleton :: Ord a
  => Maybe (Inclusivity,a) -- ^ lower bound
  -> Maybe (Inclusivity,a) -- ^ upper bound
  -> Set a
singleton :: forall a.
Ord a =>
Maybe (Inclusivity, a) -> Maybe (Inclusivity, a) -> Set a
singleton Maybe (Inclusivity, a)
lo Maybe (Inclusivity, a)
hi = forall a. Set Array a -> Set a
Set (forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Ord a) =>
Maybe (Inclusivity, a) -> Maybe (Inclusivity, a) -> Set arr a
I.singleton Maybe (Inclusivity, a)
lo Maybe (Inclusivity, a)
hi)

-- | /O(log n)/ Returns @True@ if the element is a member of the continuous
-- interval set.
member :: Ord a => a -> Set a -> Bool
member :: forall a. Ord a => a -> Set a -> Bool
member a
a (Set Set Array a
s) = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Ord a) =>
a -> Set arr a -> Bool
I.member a
a Set Array a
s

empty :: Set a
empty :: forall a. Set a
empty = forall a. Set Array a -> Set a
Set forall (arr :: * -> *) a. Contiguous arr => Set arr a
I.empty

universe :: Set a
universe :: forall a. Set a
universe = forall a. Set Array a -> Set a
Set forall (arr :: * -> *) a. Contiguous arr => Set arr a
I.universe

null :: Set a -> Bool
null :: forall a. Set a -> Bool
null (Set Set Array a
s) = forall (arr :: * -> *) a. Contiguous arr => Set arr a -> Bool
I.null Set Array a
s

universal :: Set a -> Bool
universal :: forall a. Set a -> Bool
universal (Set Set Array a
s) = forall (arr :: * -> *) a. Contiguous arr => Set arr a -> Bool
I.universal Set Array a
s

instance Show a => Show (Set a) where
  showsPrec :: Int -> Set a -> ShowS
showsPrec Int
p (Set Set Array a
s) = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Show a) =>
Int -> Set arr a -> ShowS
I.showsPrec Int
p Set Array a
s

instance Eq a => Eq (Set a) where
  Set Set Array a
x == :: Set a -> Set a -> Bool
== Set Set Array a
y = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Eq a) =>
Set arr a -> Set arr a -> Bool
I.equals Set Array a
x Set Array a
y

instance (Ord a) => Semigroup (Set a) where
  Set Set Array a
x <> :: Set a -> Set a -> Set a
<> Set Set Array a
y = forall a. Set Array a -> Set a
Set (forall (arr :: * -> *) a.
(Ord a, ContiguousU arr, Element arr a) =>
Set arr a -> Set arr a -> Set arr a
I.append Set Array a
x Set Array a
y)

instance (Ord a, Enum a) => Monoid (Set a) where
  mempty :: Set a
mempty = forall a. Set Array a -> Set a
Set forall (arr :: * -> *) a. Contiguous arr => Set arr a
I.empty
  mappend :: Set a -> Set a -> Set a
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)