{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Fixed.Binary.VectorSpace () where

import Data.Bits

import Data.AdditiveGroup
import Data.AffineSpace
import Data.Basis
import Data.VectorSpace

import Data.Fixed.Binary

instance ( HasResolution r, Bits a, Bits (Super a), Integral a
         , Integral (Super a), SuperTypeable a) =>
         AdditiveGroup (Fixed r a) where
  {-# INLINE zeroV #-}
  zeroV = 0
  {-# INLINE (^+^) #-}
  (^+^) = (+)
  {-# INLINE negateV #-}
  negateV = negate

instance ( HasResolution r, Bits a, Bits (Super a), Integral a
         , Integral (Super a), SuperTypeable a) =>
         AffineSpace (Fixed r a) where
  type Diff (Fixed r a) = Fixed r a
  {-# INLINE (.-.) #-}
  (.-.) = (-)
  {-# INLINE (.+^) #-}
  (.+^) = (+)

instance ( HasResolution r, Bits a, Bits (Super a), Integral a
         , Integral (Super a), SuperTypeable a) =>
         HasBasis (Fixed r a) where
  type Basis (Fixed r a) = ()
  {-# INLINE basisValue #-}
  basisValue ~() = 1
  {-# INLINE decompose #-}
  decompose s = [((), s)]
  {-# INLINE decompose' #-}
  decompose' s = const s

instance ( HasResolution r, Bits a, Bits (Super a), Integral a
         , Integral (Super a), SuperTypeable a) =>
         VectorSpace (Fixed r a) where
  type Scalar (Fixed r a) = Fixed r a
  {-# INLINE (*^) #-}
  (*^) = (*)

instance ( HasResolution r, Bits a, Bits (Super a), Integral a
         , Integral (Super a), SuperTypeable a) =>
         InnerSpace (Fixed r a) where
  {-# INLINE (<.>) #-}
  (<.>) = (*)