{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Numeric.LAPACK.Matrix.Array.Mosaic where

import qualified Numeric.LAPACK.Matrix.Mosaic.Basic as Mosaic
import qualified Numeric.LAPACK.Matrix.Array.Private as ArrMatrix
import qualified Numeric.LAPACK.Matrix.Shape.Omni as Omni
import qualified Numeric.LAPACK.Matrix.Layout.Private as Layout
import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import Numeric.LAPACK.Matrix.Array.Private (Square, Quadratic, FullQuadratic)
import Numeric.LAPACK.Matrix.Shape.Omni (Arbitrary, Unit)
import Numeric.LAPACK.Matrix.Layout.Private
         (Empty, Filled, Bands, Packed, Unpacked)

import qualified Numeric.Netlib.Class as Class

import qualified Type.Data.Num.Unary.Literal as TypeNum

import qualified Data.Array.Comfort.Storable.Unchecked as Array
import qualified Data.Array.Comfort.Shape as Shape


type Symmetric sh = SymmetricP Packed sh
type SymmetricP pack sh = FullQuadratic pack Omni.Symmetric sh
type Hermitian sh = HermitianP Packed sh
type HermitianP pack sh =
      FullQuadratic pack Omni.HermitianUnknownDefiniteness sh
type HermitianPosDef sh = HermitianPosDefP Packed sh
type HermitianPosDefP pack sh =
      FullQuadratic pack Omni.HermitianPositiveDefinite sh
type HermitianPosSemidef sh = HermitianPosSemidefP Packed sh
type HermitianPosSemidefP pack sh =
      FullQuadratic pack Omni.HermitianPositiveSemidefinite sh

{- |
The definiteness tags mean:

* @neg  == False@: There is no @x@ with @x^T * A * x < 0@.
* @zero == False@: There is no @x@ with @x^T * A * x = 0@.
* @pos  == False@: There is no @x@ with @x^T * A * x > 0@.

If a tag is @True@ then this imposes no further restriction on the matrix.
-}
type FlexHermitian neg zero pos sh = FlexHermitianP Packed neg zero pos sh
type FlexHermitianP pack neg zero pos sh =
      FullQuadratic pack (Omni.Hermitian neg zero pos) sh

type Lower sh = FlexLower Arbitrary sh
type Upper sh = FlexUpper Arbitrary sh

type LowerP pack sh = FlexLowerP pack Arbitrary sh
type UpperP pack sh = FlexUpperP pack Arbitrary sh

type UnitLower sh = FlexLower Unit sh
type UnitUpper sh = FlexUpper Unit sh

type UnitLowerP pack sh = FlexLowerP pack Unit sh
type UnitUpperP pack sh = FlexUpperP pack Unit sh

type FlexLower diag sh = Quadratic Packed diag Filled Empty sh
type FlexUpper diag sh = Quadratic Packed diag Empty Filled sh

type FlexLowerP pack diag sh = Quadratic pack diag Filled Empty sh
type FlexUpperP pack diag sh = Quadratic pack diag Empty Filled sh

type QuasiUpper sh = Quadratic Unpacked Arbitrary (Bands TypeNum.U1) Filled sh

type Triangular lo diag up sh = TriangularP Packed lo diag up sh
type TriangularP pack lo diag up sh = Quadratic pack diag lo up sh


assureMirrored ::
   (Layout.Packing pack, Layout.Mirror mirror, Layout.UpLo uplo) =>
   (meas ~ Extent.Shape, vert ~ Extent.Small, horiz ~ Extent.Small) =>
   (Omni.FromPlain pack prop lower upper meas vert horiz sh sh) =>
   (Omni.Plain pack prop lower upper meas vert horiz sh sh
    ~
    Layout.Mosaic pack mirror uplo sh) =>
   (Shape.C sh, Class.Floating a) =>
   Square sh a -> Quadratic pack prop lower upper sh a
assureMirrored =
   ArrMatrix.lift0 . Mosaic.repack .
   Array.mapShape Layout.mosaicFromSquare . ArrMatrix.toVector