{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Biobase.Types.Score where

import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import Data.Primitive.Types

import Biobase.Types.Ring



-- | Some default instances. Left out the Num one, so that you have to
-- explicitly instanciate if you want to go around the Ring structure.

newtype Score = Score {unScore :: Int}
  deriving (Show, Read, Eq, Ord)



-- | Ring operations over Score values.

instance Ring Score where
  (Score a) .+. (Score b) = Score $ a `min` b
  {-# INLINE (.+.) #-}
  (Score a) .*. (Score b) = Score $ a + b
  {-# INLINE (.*.) #-}
  neg (Score a) = Score $ negate a
  {-# INLINE neg #-}
  one = Score 0
  {-# INLINE one #-}
  zero = Score 10000000
  {-# INLINE zero #-}
  isZero (Score a) = a >= 1000000
  {-# INLINE isZero #-}



-- * Vector instances.

deriving instance VGM.MVector VU.MVector Score
deriving instance VG.Vector VU.Vector Score
deriving instance VU.Unbox Score
deriving instance Prim Score