content: -- ----------------------------------------------------------------------------
  
  {- |
    Module     : Holumbus.Query.Result
    Copyright  : Copyright (C) 2007 Timo B. Huebel
    License    : MIT
  
    Maintainer : Timo B. Huebel (tbh@holumbus.org)
    Stability  : experimental
    Portability: portable
  
    The data type for results of Holumbus queries.
  
    The result of a query is defined in terms of two partial results,
    the documents containing the search terms and the words which
    are possible completions of the serach terms.
  
  -}
  
  -- ----------------------------------------------------------------------------
  
  module Holumbus.Query.Result
    (
    -- * Result data types
      Result (..)
    , DocHits
    , DocContextHits
    , DocWordHits
    , WordHits
    , WordContextHits
    , WordDocHits
    , DocInfo (..)
    , WordInfo (..)
    , Score
  
    -- * Construction
    , emptyResult
  
    -- * Query
    , null
    , sizeDocHits
    , sizeWordHits
    , maxScoreDocHits
    , maxScoreWordHits
    , getDocuments
  
    -- * Transform
    , setDocScore
    , setWordScore
  
    -- * Picklers
    , xpDocHits
    , xpWordHits
    )
  where
  
  import           Prelude               hiding (null)
  
  import           Control.DeepSeq
  import           Control.Monad         (liftM2)
  
  import           Data.Binary           (Binary (..))
  import           Data.Function
  import qualified Data.List             as L
  import           Data.Map              (Map)
  import qualified Data.Map              as M
  
  import           Holumbus.Index.Common
  import           Holumbus.Utility
  
  import           Text.XML.HXT.Core
  
  -- ----------------------------------------------------------------------------
  
  -- | The combined result type for Holumbus queries.
  data Result a           = Result
                            { docHits  :: (DocHits a)  -- ^ The documents matching the query.
                            , wordHits :: WordHits     -- ^ The words which are completions of the query terms.
                            }
                            deriving (Eq, Show)
  
  -- | Information about an document.
  data DocInfo a          = DocInfo
                            { document :: (Document a) -- ^ The document itself.
                            , docScore :: Score        -- ^ The score for the document (initial score for all documents is @0.0@).
                            }
                            deriving (Eq, Show)
  
  -- | Information about a word.
  data WordInfo           = WordInfo
                            { terms     :: Terms    -- ^ The search terms that led to this very word.
                            , wordScore :: Score    -- ^ The frequency of the word in the document for a context.
                            }
                            deriving (Eq, Show)
  
  -- | A mapping from a document to it's score and the contexts where it was found.
  type DocHits a          = DocIdMap (DocInfo a, DocContextHits)
  
  -- | A mapping from a context to the words of the document that were found in this context.
  type DocContextHits     = Map Context DocWordHits
  
  -- | A mapping from a word of the document in a specific context to it's positions.
  type DocWordHits        = Map Word Positions
  
  -- | A mapping from a word to it's score and the contexts where it was found.
  type WordHits           = Map Word (WordInfo, WordContextHits)
  
  -- | A mapping from a context to the documents that contain the word that were found in this context.
  type WordContextHits    = Map Context WordDocHits
  
  -- | A mapping from a document containing the word to the positions of the word.
  type WordDocHits        = Occurrences
  
  -- | The score of a hit (either a document hit or a word hit).
  type Score              = Float
  
  -- | The original search terms entered by the user.
  type Terms              = [String]
  
  -- ----------------------------------------------------------------------------
  
  instance Binary a => Binary (Result a) where
    put (Result dh wh)    = put dh >> put wh
    get                   = liftM2 Result get get
  
  instance Binary a => Binary (DocInfo a) where
    put (DocInfo d s)     = put d >> put s
    get                   = liftM2 DocInfo get get
  
  instance Binary WordInfo where
    put (WordInfo t s)    = put t >> put s
    get                   = liftM2 WordInfo get get
  
  instance NFData a => NFData (Result a) where
    rnf (Result dh wh)    = rnf dh `seq` rnf wh
  
  instance NFData a => NFData (DocInfo a) where
    rnf (DocInfo d s)     = rnf d `seq` rnf s
  
  instance NFData WordInfo where
    rnf (WordInfo t s)    = rnf t `seq` rnf s
  
  instance XmlPickler a => XmlPickler (Result a) where
    xpickle               = xpElem "result" $
                            xpWrap ( \ (dh, wh) -> Result dh wh
                                   , \ (Result dh wh) -> (dh, wh)
                                   ) (xpPair xpDocHits xpWordHits)
  
  instance XmlPickler a => XmlPickler (DocInfo a) where
    xpickle               = xpWrap ( \ (d, s) -> DocInfo d s
                                   , \ (DocInfo d s) -> (d, s)
                                   ) xpDocInfo'
      where
      xpDocInfo'          = xpPair xpickle (xpAttr "score" xpPrim)
  
  instance XmlPickler WordInfo where
    xpickle               = xpWrap ( \ (t, s) -> WordInfo t s
                                   , \ (WordInfo t s) -> (t, s)
                                   ) xpWordInfo
      where
      xpWordInfo          = xpPair (xpAttr "term" xpTerms)
                                   (xpAttr "score" xpPrim)
      xpTerms             = xpWrap (split ",", L.intercalate ",") xpText0
  
  -- ----------------------------------------------------------------------------
  
  -- | The XML pickler for the document hits. Will be sorted by score.
  xpDocHits               :: XmlPickler a => PU (DocHits a)
  xpDocHits               = xpElem "dochits" $
                            xpWrap ( fromListDocIdMap
                                   , toListSorted
                                   ) (xpList xpDocHit)
    where
    toListSorted          = L.sortBy (compare `on` (docScore . fst . snd)) . toListDocIdMap -- Sort by score
    xpDocHit              = xpElem "doc" $
                            xpPair (xpAttr "idref" xpDocId)
                                   (xpPair xpickle xpDocContextHits)
  
  -- | The XML pickler for the contexts in which the documents were found.
  xpDocContextHits        :: PU DocContextHits
  xpDocContextHits        = xpWrap (M.fromList, M.toList) $
                            xpList xpDocContextHit
    where
    xpDocContextHit       = xpElem "context" $
                            xpPair (xpAttr "name" xpText) xpDocWordHits
  
  -- | The XML pickler for the words and positions found in a document.
  xpDocWordHits           :: PU DocWordHits
  xpDocWordHits           = xpWrap (M.fromList, M.toList) (xpList xpDocWordHit)
    where
    xpDocWordHit          = xpElem "word" $
                            xpPair (xpAttr "w" xpText) xpPositions
  
  -- | The XML pickler for the word hits. Will be sorted alphabetically by the words.
  xpWordHits              :: PU WordHits
  xpWordHits              = xpElem "wordhits" $
                            xpWrap (M.fromList, toListSorted) $
                            xpList xpWordHit
    where
    toListSorted          = L.sortBy (compare `on` fst) . M.toList -- Sort by word
    xpWordHit             = xpElem "word" $
                            xpPair (xpAttr "w" xpText)
                                   (xpPair xpickle xpWordContextHits)
  
  -- | The XML pickler for the contexts in which the words were found.
  xpWordContextHits       :: PU WordContextHits
  xpWordContextHits       = xpWrap (M.fromList, M.toList) $
                            xpList xpWordContextHit
    where
    xpWordContextHit      = xpElem "context" $
                            xpPair (xpAttr "name" xpText) xpWordDocHits
  
  -- | The XML pickler for the documents and positions where the word occurs (reusing existing pickler).
  xpWordDocHits           :: PU WordDocHits
  xpWordDocHits           = xpOccurrences
  
  -- ----------------------------------------------------------------------------
  
  -- | Create an empty result.
  emptyResult             :: Result a
  emptyResult             = Result emptyDocIdMap M.empty
  
  -- | Query the number of documents in a result.
  sizeDocHits             :: Result a -> Int
  sizeDocHits             = sizeDocIdMap . docHits
  
  -- | Query the number of documents in a result.
  sizeWordHits            :: Result a -> Int
  sizeWordHits            = M.size . wordHits
  
  -- | Query the maximum score of the documents.
  maxScoreDocHits         :: Result a -> Score
  maxScoreDocHits         = (foldDocIdMap (\(di, _) r -> max (docScore di) r) 0.0) . docHits
  
  -- | Query the maximum score of the words.
  maxScoreWordHits        :: Result a -> Score
  maxScoreWordHits        = (M.fold (\(wi, _) r -> max (wordScore wi) r) 0.0) . wordHits
  
  -- | Test if the result contains anything.
  null                    :: Result a -> Bool
  null                    = nullDocIdMap . docHits
  
  -- | Set the score in a document info.
  setDocScore             :: Score -> DocInfo a -> DocInfo a
  setDocScore s (DocInfo d _)
                          = DocInfo d s
  
  -- | Set the score in a word info.
  setWordScore            :: Score -> WordInfo -> WordInfo
  setWordScore s (WordInfo t _)
                          = WordInfo t s
  
  -- | Extract all documents from a result
  getDocuments            :: Result a -> [Document a]
  getDocuments r          = map (document . fst . snd) $
                            toListDocIdMap (docHits r)
  
  -- ----------------------------------------------------------------------------
  