{-# LANGUAGE GADTs #-}
module Numeric.LAPACK.Matrix.Mosaic.Generic where

import qualified Numeric.LAPACK.Matrix.Mosaic.Private as Mos
import qualified Numeric.LAPACK.Matrix.Layout.Private as Layout
import qualified Numeric.LAPACK.Vector as Vector
import Numeric.LAPACK.Matrix.Mosaic.Private
            (Mosaic, MosaicPacked, MosaicUnpacked)
import Numeric.LAPACK.Matrix.Layout.Private (Order, TriTransposed, uploOrder)
import Numeric.LAPACK.Matrix.Private (ShapeInt, shapeInt)

import qualified Numeric.Netlib.Class as Class

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

import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Storable (Storable)



fromList ::
   (Layout.Packing pack, Layout.Mirror mirror,
    Layout.UpLo uplo, Shape.C sh, Storable a) =>
   Order -> sh -> [a] -> Mosaic pack mirror uplo sh a
fromList order sh =
   CheckedArray.fromList
      (Layout.Mosaic Layout.autoPacking Layout.autoMirror
         Layout.autoUplo order sh)

autoFromList ::
   (Layout.Packing pack, Layout.Mirror mirror,
    Layout.UpLo uplo, Storable a) =>
   Order -> [a] -> Mosaic pack mirror uplo ShapeInt a
autoFromList order xs =
   let n = length xs
       packed = Layout.autoPacking
       name = "Triangular.autoFromList"
       size =
          case packed of
             Layout.Packed -> Layout.triangleExtent name n
             Layout.Unpacked -> Layout.squareExtent name n
   in Array.fromList
         (Layout.Mosaic packed Layout.autoMirror Layout.autoUplo
            order (shapeInt size))
         xs


transpose ::
   (Layout.UpLo uplo) =>
   Mosaic pack mirror uplo sh a -> Mosaic pack mirror (TriTransposed uplo) sh a
transpose (Array sh a) = Array (Layout.triangularTranspose sh) a

adjoint ::
   (Layout.UpLo uplo, Shape.C sh, Class.Floating a) =>
   Mosaic pack mirror uplo sh a -> Mosaic pack mirror (TriTransposed uplo) sh a
adjoint = transpose . Vector.conjugate


unpackDirty ::
   (Layout.UpLo uplo, Shape.C sh, Class.Floating a) =>
   Mosaic pack mirror uplo sh a ->
   MosaicUnpacked mirror uplo sh a
unpackDirty a =
   case Layout.mosaicPack $ Array.shape a of
      Layout.Unpacked -> a
      Layout.Packed -> unpackDirtyAux a

unpackDirtyAux ::
   (Layout.UpLo uplo, Shape.C sh, Class.Floating a) =>
   MosaicPacked mirror uplo sh a ->
   MosaicUnpacked mirror uplo sh a
unpackDirtyAux
      (Array (Layout.Mosaic Layout.Packed mirror uplo order sh) a) =
   Array.unsafeCreate
      (Layout.Mosaic Layout.Unpacked mirror uplo order sh) $
   \bPtr ->
      withForeignPtr a $ \aPtr ->
         Mos.unpack (uploOrder uplo order) (Shape.size sh) aPtr bPtr


pack ::
   (Layout.UpLo uplo, Shape.C sh, Class.Floating a) =>
   MosaicUnpacked mirror uplo sh a ->
   MosaicPacked mirror uplo sh a
pack (Array (Layout.Mosaic Layout.Unpacked mirror uplo order sh) a) =
   Array.unsafeCreate
      (Layout.Mosaic Layout.Packed mirror uplo order sh) $
   \bPtr ->
      withForeignPtr a $ \aPtr ->
         Mos.pack (uploOrder uplo order) (Shape.size sh) aPtr bPtr

withPack ::
   (Layout.Packing pack) =>
   (Layout.PackingSingleton pack -> Mosaic pack mirror uplo sh a) ->
   Mosaic pack mirror uplo sh a
withPack = ($ Layout.autoPacking)

repack ::
   (Layout.Packing pack, Layout.UpLo uplo,
    Shape.C sh, Class.Floating a) =>
   MosaicUnpacked mirror uplo sh a ->
   Mosaic pack mirror uplo sh a
repack a = withPack $ \packing ->
   case packing of
      Layout.Unpacked -> a
      Layout.Packed -> pack a