module Hunt.DocTable
where
import Prelude hiding (filter, lookup, map, null)
import Control.Applicative (Applicative, (<$>))
import Control.Monad
import Data.Aeson
import Data.Maybe (catMaybes, fromJust)
import Data.Set (Set)
import qualified Data.Set as S
import Hunt.Common.BasicTypes
import Hunt.Common.DocId
import Hunt.Common.DocIdMap (DocIdMap (..))
import qualified Hunt.Common.DocIdMap as DM
import Hunt.Common.DocIdSet (DocIdSet)
import qualified Hunt.Common.DocIdSet as DS
import Hunt.Common.Document (Document,
DocumentWrapper (wrap, unwrap))
class (DocumentWrapper (DValue i)) => DocTable i where
type DValue i :: *
null :: (Monad m) => i -> m Bool
size :: (Monad m) => i -> m Int
lookup :: (Monad m) => DocId -> i -> m (Maybe (DValue i))
lookupByURI :: (Monad m) => URI -> i -> m (Maybe DocId)
union :: (Monad m) => i -> i -> m i
disjoint :: (Monad m) => i -> i -> m Bool
insert :: (Monad m) => DValue i -> i -> m (DocId, i)
update :: (Monad m) => DocId -> DValue i -> i -> m i
adjust :: (Monad m) => (DValue i -> m (DValue i)) -> DocId -> i -> m i
adjust f did d =
maybe (return d) (upd d did <=< f) =<< lookup did d
where upd i docid v = update docid v i
adjustByURI :: (Monad m) => (DValue i -> m (DValue i)) -> URI -> i -> m i
adjustByURI f uri d
= maybe (return d) (flip (adjust f) d) =<< lookupByURI uri d
delete :: (Monad m) => DocId -> i -> m i
deleteByURI :: (Monad m) => URI -> i -> m i
deleteByURI u ds
= maybe (return ds) (flip delete ds) =<< lookupByURI u ds
difference :: (Monad m) => DocIdSet -> i -> m i
differenceByURI :: (Monad m) => Set URI -> i -> m i
differenceByURI uris d = do
ids <- liftM (DS.fromList . catMaybes) . mapM (flip lookupByURI d) . S.toList $ uris
difference ids d
map :: (Monad m) => (DValue i -> DValue i) -> i -> m i
filter :: (Monad m) => (DValue i -> Bool) -> i -> m i
toMap :: (Monad m) => i -> m (DocIdMap (DValue i))
empty :: i
restrict :: (Functor m, Monad m, Applicative m, DocTable i) => DocIdSet -> i -> m i
restrict is dt
= foldM ins empty $ DS.toList is
where
ins m i = do v <- fromJust <$> lookup i dt
update i v m
toJSON'DocTable :: (Functor m, Monad m, Applicative m, DocTable i) => i -> m Value
toJSON'DocTable dt
= do didm <- DM.map unwrap <$> toMap dt
return $ toJSON didm
fromJSON'DocTable :: (Functor m, Monad m, Applicative m, DocTable i) => Value -> m i
fromJSON'DocTable v
= foldM ins empty $ dm'
where
ins res (did, doc) = update did doc res
dm :: DocIdMap Document
dm = case fromJSON v of
Error _ -> DM.empty
Success m -> m
dm'= DM.toList . DM.map wrap $ dm