HashedDocTable.hs

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies      #-}

-- ----------------------------------------------------------------------------

{- |
  Module     : Hunt.Index.HashedDocTable
  Copyright  : Copyright (C) 2012 Uwe Schmidt
  License    : MIT

  Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
  Stability  : experimental

  A more space efficient substitute for Hunt.Index.Documents
  and a more flexible implementation than Hunt.Index.CompactDocuments.

  DocIds are computed by a hash function, so the inverse map from 'URI's to 'DocId's
  is substituted by the hash function.

  MurmurHash2 64-bit is used as the hash function.
  https://sites.google.com/site/murmurhash/

  It is a fast non-cryptographic hash function with good performance and
  hash distribution properties.
  http://programmers.stackexchange.com/a/145633
-}

-- ----------------------------------------------------------------------------

module Hunt.DocTable.HashedDocTable
    (
      -- * Documents type
      Documents (..)
    , DocMap

      -- * Conversion
    , 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

-- ------------------------------------------------------------

-- | The table which is used to map a document to an artificial id and vice versa.
type DocMap e
  = DocIdMap e

-- | The 'DocTable' implementation. Maps 'DocId's to 'Document's.
newtype Documents e
  = Documents { idToDoc :: DocMap e }     -- ^ A mapping from a document id to
                                          --   the document itself.
  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

--- ------------------------------------------------------------

-- | An empty document table.
empty' :: (DocTable (Documents e), DocumentWrapper e) => Documents e
empty' = mkDocuments DM.empty

-- | Build a 'DocTable' from a 'DocIdMap' (maps 'DocId's to 'Document's)
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'

  -- Returns the number of unique documents in the table.
  size        = return . size'

  -- Lookup a document by its id.
  lookup      = return .:: lookup'

  -- Lookup the id of a document by an URI.
  lookupByURI = return .:: lookupByURI'

  -- Union of two disjoint document tables. It is assumed, that the DocIds and the document uris
  -- of both indexes are disjoint. If only the sets of uris are disjoint, the DocIds can be made
  -- disjoint by adding maxDocId of one to the DocIds of the second, e.g. with editDocIds
  union       = return .:: unionDocs'

  -- Test whether the doc ids of both tables are disjoint.
  disjoint    = return .:: disjoint'

  -- Insert a document into the table. Returns a tuple of the id for that document and the
  -- new table. If a document with the same URI is already present, its id will be returned
  -- and the table is returned unchanged.
  insert      = return .:: insert'

  -- Update a document with a certain DocId.
  update      = return .::: update'

  -- Removes the document with the specified id from the table.
  delete      = return .:: delete'

  -- Deletes a set of Docs by Id from the table.
  difference  = return .:: difference'

  -- Update documents (through mapping over all documents).
  map         = return .:: map'

  -- Filters all documents that satisfy the predicate.
  filter      = return .:: filter'

  -- Convert document table to a single map.
  toMap       = return . toMap'

  -- | Empty 'DocTable'.
  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

-- ------------------------------------------------------------