module FP.Prelude.Vector 
  ( module FP.Prelude.Vector
  , module Data.Vector.Unboxed
  ) where

import FP.Prelude.Core

import Data.Vector.Unboxed (Unbox)

import qualified Data.Vector         as Vector
import qualified Data.Vector.Unboxed as UVector

-- Boxed

type ๐• = Vector.Vector

instance Monoid (๐• a) where {null = Vector.empty;(โงบ) = (Vector.++)}
instance ToStream a (๐• a) where stream = stream โˆ˜ Vector.toList
instance ToFold a (๐• a) where fold = fold โˆ˜ stream
instance Lookup โ„• a (๐• a) where lookup n v = v Vector.!? ๐•š n

vec โˆท (ToFold a t) โ‡’ t โ†’ ๐• a
vec = Vector.fromList โˆ˜ list

-- Unboxed

type ๐•แต˜ = UVector.Vector

instance (Unbox a) โ‡’ Monoid (๐•แต˜ a) where {null = UVector.empty;(โงบ) = (UVector.++)}
instance (Unbox a) โ‡’ ToStream a (๐•แต˜ a) where stream = stream โˆ˜ UVector.toList
instance (Unbox a) โ‡’ ToFold a (๐•แต˜ a) where fold = fold โˆ˜ stream
instance (Unbox a) โ‡’ Lookup โ„• a (๐•แต˜ a) where lookup n v = v UVector.!? ๐•š n

uvec โˆท (ToFold a t,Unbox a) โ‡’ t โ†’ ๐•แต˜ a
uvec = UVector.fromList โˆ˜ list

-- Matrix

data ๐•„ a = Matrix 
  { matrixRowSize โˆท โ„•
  , matrixData โˆท ๐• a 
  }

instance Lookup (โ„•,โ„•) a (๐•„ a) where 
  lookup (i,j) (Matrix rowSize dat) = dat # (i ร— rowSize + j)

matrix โˆท (ToFold a t) โ‡’ โ„• โ†’ t โ†’ ๐•„ a
matrix n = Matrix n โˆ˜ vec

-- Unboxed Matrix

data ๐•„แต˜ a = UMatrix 
  { umatrixRowSize โˆท โ„•
  , umatrixData โˆท ๐•แต˜ a
  }

instance (Unbox a) โ‡’ Lookup (โ„•,โ„•) a (๐•„แต˜ a) where 
  lookup (i,j) (UMatrix rowSize dat) = dat # (i ร— rowSize + j)
  
umatrix โˆท (ToFold a t,Unbox a) โ‡’ โ„• โ†’ t โ†’ ๐•„แต˜ a
umatrix n = UMatrix n โˆ˜ uvec