{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE ConstraintKinds           #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE UndecidableInstances      #-}
{-# LANGUAGE MultiParamTypeClasses     #-}

-- ----------------------------------------------------------------------------
{- |
  The index interface.
-}
-- ----------------------------------------------------------------------------


module Hunt.Index
where

import           Prelude                hiding (map)

import           GHC.Exts               (Constraint)

import           Control.Arrow          (second)

import qualified Data.List              as L

import           Hunt.Common.BasicTypes
import           Hunt.Common.DocId
import           Hunt.Common.DocIdSet   (DocIdSet)
import qualified Hunt.Common.DocIdSet   as DS
import           Hunt.Common.IntermediateValue

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

-- | The index type class which needs to be implemented to be used by the 'Interpreter'.
--   The type parameter @i@ is the implementation.
--   The implementation must have a value type parameter.
class (IndexValue (IVal i)) => Index i where
  -- | The key type of the index.
  type IKey i :: *
  type IVal i :: *

  type ICon i :: Constraint
  type ICon i = ()

  -- | General lookup function.
  search        :: ICon i => TextSearchOp -> IKey i -> i -> [(IKey i, IntermediateValue)]

  searchSc      :: ICon i => TextSearchOp -> IKey i -> i -> [(IKey i, (Score, IntermediateValue))]
  searchSc op k ix = addDefScore $ search op k ix

  -- | Search within a range of two keys.
  lookupRange   :: ICon i => IKey i -> IKey i -> i -> [(IKey i, IntermediateValue)]

  lookupRangeSc :: ICon i => IKey i -> IKey i -> i -> [(IKey i, (Score, IntermediateValue))]
  lookupRangeSc k1 k2 ix
                = addDefScore $ lookupRange k1 k2 ix

  -- | Insert occurrences.
  --   This is more efficient than folding with 'insert'.
  insertList    :: ICon i =>
                   [(IKey i, IntermediateValue)] -> i -> i

  -- | Insert occurrences.
  insert        :: ICon i =>
                   IKey i -> IntermediateValue -> i -> i
  insert   k v  = insertList [(k,v)]

  -- | Delete as batch job.
  --   This is more efficient than folding with 'delete'.
  deleteDocs    :: ICon i => DocIdSet -> i -> i

  -- | Delete occurrences.
  delete        :: ICon i => DocId -> i -> i
  delete        = deleteDocs . DS.singleton

  -- | Empty index.
  empty         :: ICon i => i

  -- | Convert an index to a list.
  --   Can be used for easy conversion between different index implementations.
  toList        :: ICon i => i -> [(IKey i, IntermediateValue)]

  -- | Convert a list of key-value pairs to an index.
  fromList      :: ICon i => [(IKey i, IntermediateValue)] -> i

  -- | Merge two indexes with a combining function.
  unionWith     :: ICon i
                => (IVal i -> IVal i -> IVal i)
                -> i -> i -> i

  --   Merge two indexes with combining functions.
  --   The second index may have another value type than the first one.
  --   Conversion and merging of the indexes is done in a single step.
  --   This is much more efficient than mapping the second index and calling 'unionWith'.
  --  unionWithConv :: (ICon i, ICon i2)
  --                => IVal i)2 -> IVal i) -> (v -> v2 -> IVal i)
  --                -> i -> i2 -> i

  -- TODO: non-rigid map
  -- | Map a function over the values of the index.
  map           :: ICon i
                => (IVal i -> IVal i)
                -> i -> i
  map f = mapMaybe (Just . f)

  -- | Updates a value or deletes it if the result of the function is 'Nothing'.
  mapMaybe      :: ICon i
                => (IVal i -> Maybe (IVal i))
                -> i -> i

  -- | Keys of the index.
  keys          :: ICon i
                => i -> [IKey i]

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

-- | Monadic version of 'Index'.
--   'Index' instances are automatically instance of this type class.
class Monad m => IndexM m i where
  -- | The key type of the index.
  type IKeyM     i :: *

  -- | The value type of the index.
  type IValM     i :: *

  type IConM     i :: Constraint
  type IConM     i = ()

  -- | Monadic version of 'search'.
  searchM      :: IConM i => TextSearchOp -> IKeyM i -> i -> m [(IKeyM i, IntermediateValue)]

  -- | Monadic version of 'search' with (default) scoring.
  searchMSc     :: IConM i => TextSearchOp -> IKeyM i -> i -> m [(IKeyM i, (Score, IntermediateValue))]
  searchMSc op k ix
                = searchM op k ix >>= return . addDefScore

  -- | Monadic version of 'lookupRangeM'.
  lookupRangeM :: IConM i => IKeyM i -> IKeyM i -> i -> m [(IKeyM i, IntermediateValue)]

  lookupRangeMSc :: IConM i => IKeyM i -> IKeyM i -> i -> m [(IKeyM i, (Score, IntermediateValue))]
  lookupRangeMSc k1 k2 ix
                = lookupRangeM k1 k2 ix >>= return . addDefScore

  -- | Monadic version of 'insertList'.
  insertListM  :: IConM i =>
                  [(IKeyM i, IntermediateValue)] -> i -> m (i)

  -- | Monadic version of 'insert'.
  insertM      :: IConM i =>
                  IKeyM i -> IntermediateValue -> i -> m (i)
  insertM k v  = insertListM [(k,v)]

  -- | Monadic version of 'deleteDocs'.
  deleteDocsM  :: IConM i => DocIdSet -> i -> m (i)

  -- | Monadic version of 'delete'.
  deleteM      :: IConM i => DocId -> i -> m (i)
  deleteM k i  = deleteDocsM (DS.singleton k) i

  -- | Monadic version of 'empty'.
  emptyM       :: IConM i => m (i)

  -- | Monadic version of 'toList'.
  toListM      :: IConM i => i -> m [(IKeyM i, IntermediateValue)]

  -- | Monadic version of 'fromList'.
  fromListM    :: IConM i => [(IKeyM i, IntermediateValue)] -> m (i)

  -- | Monadic version of 'unionWith'.
  unionWithM   :: IConM i =>
                  (IValM i -> IValM i -> IValM i) ->
                  i -> i -> m (i)

  --  Monadic version of 'unionWithConv'.
  -- unionWithConvM :: (IConM i, Monad m, IConM i2)
  --               => IVal i)2 -> IVal i) -> (v -> v2 -> IVal i)
  --               -> i -> i2 -> m (i)

  -- | Monadic version of 'map'.
  mapM         :: IConM i
               => (IValM i -> IValM i)
               -> i -> m (i)
  mapM f = mapMaybeM (Just . f)

  -- | Monadic version of 'mapMaybe'.
  mapMaybeM    :: IConM i
               => (IValM i -> Maybe (IValM i))
               -> i -> m (i)

  -- | Monadic version of 'keys'.
  keysM        :: IConM i
               => i -> m [IKeyM i]

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

instance (Index i, Monad m) => IndexM m i where
  type IKeyM i             = IKey i
  type IValM i             = IVal i
  type IConM i             = ICon i

  searchM   op s i           = return $  search op s i
  searchMSc op s i           = return $  searchSc op s i
  lookupRangeM   l u i       = return $  lookupRange   l u i
  lookupRangeMSc l u i       = return $  lookupRangeSc l u i
  insertListM  vs i          = return $! insertList vs i
  deleteDocsM ds i           = return $! deleteDocs ds i
  insertM k v i              = return $! insert k v i
  deleteM k i                = return $! delete k i
  emptyM                     = return $! empty
  toListM i                  = return $  toList i
  fromListM l                = return $! fromList l
  unionWithM f i1 i2         = return $! unionWith f i1 i2
--  unionWithConvM f1 f2 i1 i2 = return $! unionWithConv f1 f2 i1 i2
  mapM f i                   = return $! map f i
  mapMaybeM f i              = return $! mapMaybe f i
  keysM i                    = return $  keys i

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

addDefScore :: [(a, b)] -> [(a, (Score, b))]
addDefScore = L.map (second (\ x -> (defScore, x)))

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