{-# LANGUAGE
GeneralizedNewtypeDeriving
, DeriveFunctor
, DeriveFoldable
, DeriveTraversable
, FlexibleContexts
, MultiParamTypeClasses
, OverloadedLists
, TupleSections
, FlexibleInstances
#-}
module Data.Set.Ordered.Many where
import Data.Mergeable
import Data.Foldable as Fold
import Data.Traversable
import Data.Maybe (fromJust, isJust, mapMaybe)
import Data.Vector (Vector, (!?))
import qualified Data.Vector as Vector
import Control.Applicative
import Control.Monad.Fix
import Control.Monad.State
import Control.Monad.Base
import Test.QuickCheck
import System.IO.Unsafe (unsafePerformIO)
newtype OMSet a = OMSet {unOMSet :: Vector a}
deriving ( Eq
, Show
, Functor
, Applicative
, Monad
, Fold.Foldable
, Traversable
)
instance Mergeable OMSet where
mergeMap f (OMSet xs) = mergeMap f xs
instance MonadBase Gen Gen where
liftBase = id
instance (Arbitrary a, Ord a, Show a) => Arbitrary (OMSet a) where
arbitrary = OMSet <$> sized go
where
go s = do x <- arbitrary
xs <- go' s x
let xss = Vector.cons x xs
pure xss
go' :: (Ord a, Arbitrary a) => Int -> a -> Gen (Vector a)
go' 0 _ = pure []
go' s' prev = do
next <- arbitrary `suchThat` (>= prev)
(Vector.cons next) <$> go' (s' - 1) next
(\\) :: Eq a => OMSet a -> OMSet a -> OMSet a
(\\) = difference
null :: Eq a => OMSet a -> Bool
null (OMSet xs) = Vector.null xs
size :: OMSet a -> Int
size (OMSet xs) = Vector.length xs
member :: Eq a => a -> OMSet a -> Bool
member x (OMSet xs) = Vector.elem x xs
notMember :: Eq a => a -> OMSet a -> Bool
notMember x = not . member x
lookup :: Eq a => a -> OMSet a -> Maybe a
lookup x (OMSet xs) = Vector.find (== x) xs
isSubsetOf :: Eq a => OMSet a -> OMSet a -> Bool
isSubsetOf (OMSet xs) (OMSet ys) = Vector.all (`Vector.elem` ys) xs
isProperSubsetOf :: Eq a => OMSet a -> OMSet a -> Bool
isProperSubsetOf xs ys = xs /= ys && isSubsetOf xs ys
empty :: OMSet a
empty = OMSet Vector.empty
singleton :: a -> OMSet a
singleton = OMSet . Vector.singleton
insert :: Ord a => a -> OMSet a -> OMSet a
insert x (OMSet xs) =
let (ps,ss) = Vector.span (<= x) xs
in OMSet (ps <> Vector.singleton x <> ss)
delete :: Eq a => a -> OMSet a -> OMSet a
delete x (OMSet xs) = OMSet (Vector.filter (/= x) xs)
union :: Ord a => OMSet a -> OMSet a -> OMSet a
union xs ys = foldr insert xs ys
difference :: Eq a => OMSet a -> OMSet a -> OMSet a
difference (OMSet xs) (OMSet ys) = OMSet (Vector.foldr go [] xs)
where
go x soFar | Vector.elem x ys = soFar
| otherwise = Vector.cons x soFar
intersection :: Ord a => OMSet a -> OMSet a -> OMSet a
intersection (OMSet xs') (OMSet ys') = OMSet (go xs' ys')
where
go :: Ord a => Vector a -> Vector a -> Vector a
go xss yss = case (,) <$> xss Vector.!? 0 <*> yss Vector.!? 0 of
Nothing -> []
Just (x,y)
| x < y -> go xss (Vector.drop 1 yss)
| x == y -> [x,y] <> go (Vector.drop 1 xss) (Vector.drop 1 yss)
| otherwise -> go (Vector.drop 1 xss) yss
filter :: (a -> Bool) -> OMSet a -> OMSet a
filter p (OMSet xs) = OMSet (Vector.filter p xs)
partition :: (a -> Bool) -> OMSet a -> (OMSet a, OMSet a)
partition p (OMSet xs) = let (l,r) = Vector.partition p xs in (OMSet l, OMSet r)
map :: (a -> b) -> OMSet a -> OMSet b
map f (OMSet xs) = OMSet (Vector.map f xs)
mapMaybe :: (a -> Maybe b) -> OMSet a -> OMSet b
mapMaybe f (OMSet xs) = OMSet (Vector.mapMaybe f xs)