module Hunt.Common.DocIdSet
( DocIdSet(..)
, singleton
, null
, member
, fromList
, toIntSet
, toList
, difference
, union
, intersection
)
where
import Prelude hiding (null)
import Control.DeepSeq
import Control.Monad (mzero)
import Data.Aeson
import qualified Data.IntSet as S
import qualified Data.List as L
import Data.Monoid (Monoid (..))
import Data.Typeable
import Data.Binary (Binary (..))
import Hunt.Common.DocId
newtype DocIdSet = DIS { unDIS :: S.IntSet }
deriving (Eq, Show, NFData, Typeable)
instance Binary DocIdSet where
put = put . unDIS
get = get >>= return . DIS
instance Monoid DocIdSet where
mempty
= DIS S.empty
mappend (DIS s1) (DIS s2)
= DIS (S.union s1 s2)
instance ToJSON DocIdSet where
toJSON = toJSON . L.map DocId . S.toList . unDIS
instance FromJSON DocIdSet where
parseJSON x = do l <- parseJSON x
case fromL l of
Nothing -> mzero
Just s -> return $ DIS s
where
fromL :: [String] -> Maybe S.IntSet
fromL = L.foldr ins (Just S.empty)
where
ins _ Nothing = Nothing
ins xs (Just s) = case fromHex xs of
Nothing -> Nothing
Just i -> Just $ S.insert i s
difference :: DocIdSet -> DocIdSet -> DocIdSet
difference (DIS s1) (DIS s2) = DIS $ S.difference s1 s2
union :: DocIdSet -> DocIdSet -> DocIdSet
union (DIS s1) (DIS s2) = DIS $ S.union s1 s2
intersection :: DocIdSet -> DocIdSet -> DocIdSet
intersection (DIS s1) (DIS s2) = DIS $ S.intersection s1 s2
fromList :: [DocId] -> DocIdSet
fromList = DIS . S.fromList . L.map unDocId
toList :: DocIdSet -> [DocId]
toList = L.map DocId . S.toList . unDIS
toIntSet :: DocIdSet -> S.IntSet
toIntSet = unDIS
singleton :: DocId -> DocIdSet
singleton = DIS . S.singleton . unDocId
null :: DocIdSet -> Bool
null = S.null . unDIS
member :: DocId -> DocIdSet -> Bool
member x s = unDocId x `S.member` unDIS s