module Hunt.Common.DocIdMap
( DocIdMap(..)
, empty
, singleton
, null
, member
, lookup
, insert
, delete
, insertWith
, size
, sizeWithLimit
, union
, intersection
, difference
, diffWithSet
, unionWith
, intersectionWith
, differenceWith
, unionsWith
, map
, filter
, filterWithKey
, mapWithKey
, traverseWithKey
, foldr
, foldrWithKey
, foldl
, fromList
, fromDocIdSet
, fromAscList
, toList
, keys
, elems
)
where
import Prelude hiding (filter, foldl, foldr,
lookup, map, null)
import qualified Prelude as P
import Control.Applicative (Applicative (..), (<$>))
import Control.Arrow (first)
import Control.DeepSeq
import Control.Monad (foldM, mzero)
import Data.Aeson
import Data.Binary (Binary (..))
import Data.Foldable hiding (fold, foldl, foldr, toList)
import qualified Data.HashMap.Strict as HM
import qualified Data.IntMap.BinTree.Strict as IM
import qualified Data.List as L
import Data.Monoid (Monoid (..), (<>))
import qualified Data.Text as T
import Data.Typeable
import Hunt.Common.DocId
import Hunt.Common.DocIdSet (DocIdSet (..), toIntSet)
newtype DocIdMap v
= DIM { unDIM :: IM.IntMap v }
deriving (Eq, Show, Foldable, Functor, NFData, Typeable)
instance Monoid v => Monoid (DocIdMap v) where
mempty = DIM IM.empty
mappend = unionWith (<>)
instance Binary v => Binary (DocIdMap v) where
put = put . unDIM
get = get >>= return . DIM
instance ToJSON v => ToJSON (DocIdMap v) where
toJSON = object . L.map toJ . IM.toList . unDIM
where
toJ (k, v) = (T.pack . toHex $ k) .= toJSON v
instance FromJSON v => FromJSON (DocIdMap v) where
parseJSON (Object o) = DIM <$> foldM parsePair IM.empty (HM.toList o)
where
parsePair res (k, v)
= case fromHex . T.unpack $ k of
Nothing -> mzero
Just k' -> do
v' <- parseJSON v
return $ IM.insert k' v' res
parseJSON _ = mzero
liftDIM :: (IM.IntMap v -> IM.IntMap r) ->
DocIdMap v -> DocIdMap r
liftDIM f = DIM . f . unDIM
liftDIM2 :: (IM.IntMap v -> IM.IntMap w -> IM.IntMap x) ->
DocIdMap v -> DocIdMap w -> DocIdMap x
liftDIM2 f x y = DIM $ f (unDIM x) (unDIM y)
empty :: DocIdMap v
empty = DIM $ IM.empty
singleton :: DocId -> v -> DocIdMap v
singleton d v = insert d v empty
null :: DocIdMap v -> Bool
null = IM.null . unDIM
member :: DocId -> DocIdMap v -> Bool
member x = IM.member (unDocId x) . unDIM
lookup :: DocId -> DocIdMap v -> Maybe v
lookup x = IM.lookup (unDocId x) . unDIM
insert :: DocId -> v -> DocIdMap v -> DocIdMap v
insert x y = liftDIM $ IM.insert (unDocId x) y
delete :: DocId -> DocIdMap v -> DocIdMap v
delete x = liftDIM $ IM.delete (unDocId x)
insertWith :: (v -> v -> v) -> DocId -> v -> DocIdMap v -> DocIdMap v
insertWith f x y = liftDIM $ IM.insertWith f (unDocId x) y
size :: DocIdMap v -> Int
size = IM.size . unDIM
sizeWithLimit :: Int -> DocIdMap v -> Maybe Int
sizeWithLimit limit = IM.sizeWithLimit limit . unDIM
union :: DocIdMap v -> DocIdMap v -> DocIdMap v
union = liftDIM2 $ IM.union
intersection :: DocIdMap v -> DocIdMap v -> DocIdMap v
intersection = liftDIM2 $ IM.intersection
difference :: DocIdMap v -> DocIdMap w -> DocIdMap v
difference = liftDIM2 $ IM.difference
diffWithSet :: DocIdMap v -> DocIdSet -> DocIdMap v
diffWithSet m s = m `difference` (DIM $ IM.fromSet (const ()) (unDIS s))
unionWith :: (v -> v -> v) -> DocIdMap v -> DocIdMap v -> DocIdMap v
unionWith f = liftDIM2 $ IM.unionWith f
intersectionWith :: (v -> v -> v) -> DocIdMap v -> DocIdMap v -> DocIdMap v
intersectionWith f = liftDIM2 $ IM.intersectionWith f
differenceWith :: (v -> v -> Maybe v) -> DocIdMap v -> DocIdMap v -> DocIdMap v
differenceWith f = liftDIM2 $ IM.differenceWith f
unionsWith :: (v -> v -> v) -> [DocIdMap v] -> DocIdMap v
unionsWith f = DIM . IM.unionsWith f . P.map unDIM
map :: (v -> r) -> DocIdMap v -> DocIdMap r
map f = liftDIM $ IM.map f
mapWithKey :: (DocId -> v -> r) -> DocIdMap v -> DocIdMap r
mapWithKey f = liftDIM $ IM.mapWithKey (f . DocId)
filter :: (v -> Bool) -> DocIdMap v -> DocIdMap v
filter p = liftDIM $ IM.filter p
filterWithKey :: (DocId -> v -> Bool) -> DocIdMap v -> DocIdMap v
filterWithKey p = liftDIM $ IM.filterWithKey (p . DocId)
traverseWithKey :: Applicative t => (DocId -> a -> t b) -> DocIdMap a -> t (DocIdMap b)
traverseWithKey f = (pure DIM <*>) . IM.traverseWithKey (f . DocId) . unDIM
foldr :: (v -> b -> b) -> b -> DocIdMap v -> b
foldr f u = IM.foldr f u . unDIM
foldrWithKey :: (DocId -> v -> b -> b) -> b -> DocIdMap v -> b
foldrWithKey f u = IM.foldrWithKey (f . DocId) u . unDIM
foldl :: (b -> v -> b) -> b -> DocIdMap v -> b
foldl f u = IM.foldl f u . unDIM
fromList :: [(DocId, v)] -> DocIdMap v
fromList = DIM . IM.fromList . L.map (first unDocId)
fromDocIdSet :: (Int -> v) -> DocIdSet -> DocIdMap v
fromDocIdSet f s = DIM $ IM.fromSet f (toIntSet s)
fromAscList :: [(DocId, v)] -> DocIdMap v
fromAscList = DIM . IM.fromAscList . L.map (first unDocId)
toList :: DocIdMap v -> [(DocId, v)]
toList = L.map (first DocId) . IM.toList . unDIM
keys :: DocIdMap v -> [DocId]
keys = L.map DocId . IM.keys . unDIM
elems :: DocIdMap v -> [v]
elems = IM.elems . unDIM