{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}

module LinearAlgebra.TypedSpaces.Vector
       ( Vector (..) ) where

import qualified Data.Vector.Storable as L
import LinearAlgebra.TypedSpaces.Classes
import Data.Semigroup

newtype Vector i a = Vector { vector :: L.Vector a }
                   deriving (Show, Eq)

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

instance (Isomorphism Int i) => CIndexed (Vector i) i where
  (Vector v) ! n = v L.! (bw n)

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

instance CFunctor (Vector i) where

  type CFun (Vector i) a = L.Storable a
  cmap f (Vector v) = Vector (L.map f v)

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

instance CFoldable (Vector i) where

  type CFol (Vector i) a = L.Storable a

  cfoldr f x = L.foldr f x . vector
  cfoldr' f x = L.foldr' f x . vector
  cfoldl f x = L.foldl f x . vector
  cfoldl' f x = L.foldl' f x . vector
  clength = L.length . vector
  cmapM f (Vector v) = Vector <$> L.mapM f v
  cmapM_ f = L.mapM_ f . vector

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

instance (L.Storable a) => Semigroup (Vector i a) where

  (Vector v1) <> (Vector v2) = Vector (v1 L.++ v2)


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

instance (L.Storable a) => Monoid (Vector i a) where

  mempty = Vector L.empty
  mappend = (<>)

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

instance CZippable (Vector i) where

  czipWith f (Vector v1) (Vector v2) =
    Vector (L.zipWith f v1 v2)

  czipWith3 f (Vector v1) (Vector v2) (Vector v3) =
    Vector (L.zipWith3 f v1 v2 v3)

  czipWith4 f (Vector v1) (Vector v2) (Vector v3) (Vector v4)=
    Vector (L.zipWith4 f v1 v2 v3 v4)


instance (L.Storable a) => IsList (Vector i a) where

  type Item (Vector i a) = a

  fromList = Vector . L.fromList
  toList = L.toList . vector