{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-}
module Data.SearchEngine.DocFeatVals (
    DocFeatVals,
    featureValue,
    create,
  ) where

import Data.SearchEngine.DocTermIds (vecIndexIx, vecCreateIx)
import Data.Vector (Vector)
import Data.Ix (Ix)


-- | Storage for the non-term feature values i a document.
--
newtype DocFeatVals feature = DocFeatVals (Vector Float)
  deriving (Int -> DocFeatVals feature -> ShowS
forall feature. Int -> DocFeatVals feature -> ShowS
forall feature. [DocFeatVals feature] -> ShowS
forall feature. DocFeatVals feature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocFeatVals feature] -> ShowS
$cshowList :: forall feature. [DocFeatVals feature] -> ShowS
show :: DocFeatVals feature -> String
$cshow :: forall feature. DocFeatVals feature -> String
showsPrec :: Int -> DocFeatVals feature -> ShowS
$cshowsPrec :: forall feature. Int -> DocFeatVals feature -> ShowS
Show)

featureValue :: (Ix feature, Bounded feature) => DocFeatVals feature -> feature -> Float
featureValue :: forall feature.
(Ix feature, Bounded feature) =>
DocFeatVals feature -> feature -> Float
featureValue (DocFeatVals Vector Float
featVec) = forall ix a. (Ix ix, Bounded ix) => Vector a -> ix -> a
vecIndexIx Vector Float
featVec

create :: (Ix feature, Bounded feature) =>
          (feature -> Float) -> DocFeatVals feature
create :: forall feature.
(Ix feature, Bounded feature) =>
(feature -> Float) -> DocFeatVals feature
create feature -> Float
docFeatVals =
    forall feature. Vector Float -> DocFeatVals feature
DocFeatVals (forall ix a. (Ix ix, Bounded ix) => (ix -> a) -> Vector a
vecCreateIx feature -> Float
docFeatVals)