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

import qualified Data.Array.Comfort.Shape as Shape


{- |
Uses the indices of the second shape,
but the list of indices is restricted by the size of the first shape.
-}
data Min sh0 sh1 = Min {minShape0 :: sh0, minShape1 :: sh1}
   deriving (Eq, Show)

instance (Shape.C sh0, Shape.C sh1) => Shape.C (Min sh0 sh1) where
   size (Min sh0 sh1) = min (Shape.size sh0) (Shape.size sh1)
   uncheckedSize (Min sh0 sh1) =
      min (Shape.uncheckedSize sh0) (Shape.uncheckedSize sh1)

instance (Shape.C sh0, Shape.Indexed sh1) => Shape.Indexed (Min sh0 sh1) where
   type Index (Min sh0 sh1) = Shape.Index sh1
   indices (Min sh0 sh1) = take (Shape.size sh0) $ Shape.indices sh1
   offset (Min sh0 sh1) ix =
      let k = Shape.uncheckedOffset sh1 ix
      in if k<Shape.size sh0
            then k
            else error "Shape.Min.offset: index exceeds size of first shape"
   uncheckedOffset (Min _sh0 sh1) ix = Shape.uncheckedOffset sh1 ix
   inBounds (Min sh0 sh1) ix =
      Shape.inBounds sh1 ix  &&  Shape.uncheckedOffset sh1 ix < Shape.size sh0

instance
   (Shape.C sh0, Shape.InvIndexed sh1) =>
      Shape.InvIndexed (Min sh0 sh1) where
   indexFromOffset (Min sh0 sh1) k =
      if k<Shape.size sh0
         then Shape.indexFromOffset sh1 k
         else error
               "Shape.Min.indexFromOffset: offset exceeds size of first shape"
   uncheckedIndexFromOffset (Min _sh0 sh1) k =
      Shape.uncheckedIndexFromOffset sh1 k