{-# LANGUAGE TypeFamilies #-}
module Numeric.LAPACK.ShapeStatic where

import Numeric.LAPACK.Matrix.Shape.Private (UnaryProxy)

import qualified Data.FixedLength as FL

import qualified Data.Array.Comfort.Storable as Array
import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Storable (Array)

import qualified Type.Data.Num.Unary as Unary
import Type.Data.Num (integralFromProxy)
import Type.Base.Proxy (Proxy(Proxy))

import Foreign.Storable (Storable)

import Text.Printf (printf)


{- |
'ZeroBased' denotes a range starting at zero and has a certain length.
-}
newtype ZeroBased n = ZeroBased {ZeroBased n -> UnaryProxy n
zeroBasedSize :: UnaryProxy n}
   deriving (ZeroBased n -> ZeroBased n -> Bool
(ZeroBased n -> ZeroBased n -> Bool)
-> (ZeroBased n -> ZeroBased n -> Bool) -> Eq (ZeroBased n)
forall n. ZeroBased n -> ZeroBased n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZeroBased n -> ZeroBased n -> Bool
$c/= :: forall n. ZeroBased n -> ZeroBased n -> Bool
== :: ZeroBased n -> ZeroBased n -> Bool
$c== :: forall n. ZeroBased n -> ZeroBased n -> Bool
Eq, Int -> ZeroBased n -> ShowS
[ZeroBased n] -> ShowS
ZeroBased n -> String
(Int -> ZeroBased n -> ShowS)
-> (ZeroBased n -> String)
-> ([ZeroBased n] -> ShowS)
-> Show (ZeroBased n)
forall n. Natural n => Int -> ZeroBased n -> ShowS
forall n. Natural n => [ZeroBased n] -> ShowS
forall n. Natural n => ZeroBased n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZeroBased n] -> ShowS
$cshowList :: forall n. Natural n => [ZeroBased n] -> ShowS
show :: ZeroBased n -> String
$cshow :: forall n. Natural n => ZeroBased n -> String
showsPrec :: Int -> ZeroBased n -> ShowS
$cshowsPrec :: forall n. Natural n => Int -> ZeroBased n -> ShowS
Show)

instance (Unary.Natural n) => Shape.C (ZeroBased n) where
   size :: ZeroBased n -> Int
size = ZeroBased n -> Int
forall sh. C sh => sh -> Int
Shape.uncheckedSize
   uncheckedSize :: ZeroBased n -> Int
uncheckedSize (ZeroBased UnaryProxy n
len) = UnaryProxy n -> Int
forall x y. (Integer x, Num y) => Proxy x -> y
integralFromProxy UnaryProxy n
len

instance (Unary.Natural n) => Shape.Indexed (ZeroBased n) where
   type Index (ZeroBased n) = FL.Index n
   indices :: ZeroBased n -> [Index (ZeroBased n)]
indices ZeroBased n
_len = T n (Index n) -> [Index n]
forall n a. Natural n => T n a -> [a]
FL.toList T n (Index n)
forall n. Natural n => T n (Index n)
FL.indices
   offset :: ZeroBased n -> Index (ZeroBased n) -> Int
offset = ZeroBased n -> Index (ZeroBased n) -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.uncheckedOffset
   uncheckedOffset :: ZeroBased n -> Index (ZeroBased n) -> Int
uncheckedOffset ZeroBased n
_len = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> (Index n -> Word) -> Index n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index n -> Word
forall n. Natural n => Index n -> Word
FL.numFromIndex
   inBounds :: ZeroBased n -> Index (ZeroBased n) -> Bool
inBounds ZeroBased n
_len Index (ZeroBased n)
_ix = Bool
True

instance (Unary.Natural n) => Shape.InvIndexed (ZeroBased n) where
   -- could be implemented using new fixed-length-0.2.1:FL.indexFromNum
   indexFromOffset :: ZeroBased n -> Int -> Index (ZeroBased n)
indexFromOffset ZeroBased n
len Int
k =
      case (Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
k, Int -> [Index n] -> [Index n]
forall a. Int -> [a] -> [a]
drop Int
k ([Index n] -> [Index n]) -> [Index n] -> [Index n]
forall a b. (a -> b) -> a -> b
$ ZeroBased n -> [Index (ZeroBased n)]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices ZeroBased n
len) of
         (Bool
True, Index n
i:[Index n]
_) -> Index (ZeroBased n)
Index n
i
         (Bool, [Index n])
_ -> -- cf. comfort-array:Shape.errorIndexFromOffset
            String -> Index n
forall a. HasCallStack => String -> a
error (String -> Index n) -> String -> Index n
forall a b. (a -> b) -> a -> b
$
            String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"indexFromOffset (ShapeStatic.ZeroBased): index %d out of range" Int
k

instance (Unary.Natural n) => Shape.Static (ZeroBased n) where
   static :: ZeroBased n
static = UnaryProxy n -> ZeroBased n
forall n. UnaryProxy n -> ZeroBased n
ZeroBased UnaryProxy n
forall a. Proxy a
Proxy


vector :: (Unary.Natural n, Storable a) => FL.T n a -> Array (ZeroBased n) a
vector :: T n a -> Array (ZeroBased n) a
vector = ZeroBased n -> [a] -> Array (ZeroBased n) a
forall sh a. (C sh, Storable a) => sh -> [a] -> Array sh a
Array.fromList (UnaryProxy n -> ZeroBased n
forall n. UnaryProxy n -> ZeroBased n
ZeroBased UnaryProxy n
forall a. Proxy a
Proxy) ([a] -> Array (ZeroBased n) a)
-> (T n a -> [a]) -> T n a -> Array (ZeroBased n) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T n a -> [a]
forall n a. Natural n => T n a -> [a]
FL.toList