module Hunt.DocTable.HashedDocTable
(
Documents (..)
, DocMap
, fromMap
)
where
import Data.Binary (Binary (..))
import Control.DeepSeq
import Hunt.Common.BasicTypes
import Hunt.Common.DocId (DocId, mkDocId)
import Hunt.Common.DocIdMap (DocIdMap)
import qualified Hunt.Common.DocIdMap as DM
import Hunt.Common.DocIdSet (DocIdSet)
import Hunt.Common.Document (Document (..), DocumentWrapper (..))
import Hunt.DocTable
import Hunt.Utility
type DocMap e
= DocIdMap e
newtype Documents e
= Documents { idToDoc :: DocMap e }
deriving (Eq, Show)
mkDocuments :: NFData e => DocMap e -> Documents e
mkDocuments m = Documents $! m
instance NFData e => NFData (Documents e) where
rnf (Documents e) = rnf e
instance (DocumentWrapper e, Binary e) => Binary (Documents e) where
put = put . idToDoc
get = get >>= return . mkDocuments
empty' :: (DocTable (Documents e), DocumentWrapper e) => Documents e
empty' = mkDocuments DM.empty
fromMap :: (DocTable (Documents e), DocumentWrapper e) =>
(Document -> e) -> DocIdMap Document -> Documents e
fromMap = fromMap'
instance (DocumentWrapper e) =>
DocTable (Documents e) where
type DValue (Documents e) = e
null = return . null'
size = return . size'
lookup = return .:: lookup'
lookupByURI = return .:: lookupByURI'
union = return .:: unionDocs'
disjoint = return .:: disjoint'
insert = return .:: insert'
update = return .::: update'
delete = return .:: delete'
difference = return .:: difference'
map = return .:: map'
filter = return .:: filter'
toMap = return . toMap'
empty = empty'
null' :: (DocumentWrapper e) => Documents e -> Bool
null'
= DM.null . idToDoc
size' :: (DocumentWrapper e) => Documents e -> Int
size'
= DM.size . idToDoc
lookup' :: (Monad m, DocumentWrapper e) => DocId -> Documents e -> m e
lookup' i d
= maybe (fail "") return
. DM.lookup i
. idToDoc
$ d
lookupByURI' :: (Monad m, DocumentWrapper e) => URI -> Documents e -> m DocId
lookupByURI' u d
= maybe (fail "") (const $ return i)
. DM.lookup i
. idToDoc
$ d
where
i = mkDocId u
disjoint' :: (DocumentWrapper e) => Documents e -> Documents e -> Bool
disjoint' dt1 dt2
= DM.null $ DM.intersection (idToDoc dt1) (idToDoc dt2)
unionDocs' :: (DocumentWrapper e) => Documents e -> Documents e -> Documents e
unionDocs' dt1 dt2
| disjoint' dt1 dt2
= unionDocs'' dt1 dt2
| otherwise
= error
"HashedDocTable.unionDocs: doctables are not disjoint"
where
unionDocs'' :: (DocumentWrapper e) => Documents e -> Documents e -> Documents e
unionDocs'' dt1' dt2'
= mkDocuments $ idToDoc dt1' `DM.union` idToDoc dt2'
insert' :: (DocumentWrapper e) => e -> Documents e -> (DocId, Documents e)
insert' d ds
= maybe reallyInsert (const (newId, ds)) (lookup' newId ds)
where
newId
= mkDocId . uri . unwrap $ d
reallyInsert
= (newId, mkDocuments $ DM.insert newId d $ idToDoc ds)
update' :: (DocumentWrapper e) => DocId -> e -> Documents e -> Documents e
update' i d ds
= mkDocuments $ DM.insert i d $ idToDoc ds
delete' :: (DocumentWrapper e) => DocId -> Documents e -> Documents e
delete' d ds
= mkDocuments $ DM.delete d $ idToDoc ds
difference' :: (DocumentWrapper e) => DocIdSet -> Documents e -> Documents e
difference' s ds
= mkDocuments $ idToDoc ds `DM.diffWithSet` s
map' :: (DocumentWrapper e) => (e -> e) -> Documents e -> Documents e
map' f d
= mkDocuments $ DM.map f (idToDoc d)
filter' :: (DocumentWrapper e) => (e -> Bool) -> Documents e -> Documents e
filter' p d
= mkDocuments $ DM.filter p (idToDoc d)
fromMap' :: (DocumentWrapper e) => (Document -> e) -> DocIdMap Document -> Documents e
fromMap' f itd
= mkDocuments $ DM.map f itd
toMap' :: Documents e -> DocIdMap e
toMap'
= idToDoc