{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
module Numeric.LAPACK.Matrix.Shape (
   module Numeric.LAPACK.Matrix.Shape,
   Layout.Order(..),
   Layout.flipOrder,
   Omni.height,
   Omni.width,
   Omni.extent,
   Omni.squareSize,
   Omni.order,
   Omni.TriDiag,
   Omni.DiagSingleton(..),
   Omni.Property,
   Omni.PowerStrip,
   Omni.PowerStripSingleton(..),
   Omni.powerStripSingleton,
   Omni.Strip,
   Omni.StripSingleton(..),
   Omni.stripSingleton,
   Arbitrary,
   Unit,
   LayoutPriv.Filled,
   LayoutPriv.Empty,
   Bands,
   Layout.addOffDiagonals,
   Layout.Packing,
   Layout.Packed,
   Layout.Unpacked,
   ) where

import qualified Numeric.LAPACK.Matrix.Shape.Omni as Omni
import qualified Numeric.LAPACK.Matrix.Layout.Private as LayoutPriv
import qualified Numeric.LAPACK.Matrix.Layout as Layout
import Numeric.LAPACK.Matrix.Shape.Omni (Omni(..), Arbitrary, Unit)
import Numeric.LAPACK.Matrix.Layout.Private
         (Bands, UnaryProxy, Empty, Filled, Order, Packed, Unpacked)
import Numeric.LAPACK.Matrix.Extent.Private (Small, Big, Shape, Size)

import qualified Data.Array.Comfort.Shape as Shape

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


type Full = Omni Unpacked Arbitrary Filled Filled

type General = Full Size Big Big

general :: Order -> height -> width -> General height width
general order height width =
   Full $ Layout.general order height width

type Tall = Full Size Big Small

tall ::
   (Shape.C height, Shape.C width) =>
   Order -> height -> width -> Tall height width
tall order height width =
   Full $ Layout.tall order height width

type Wide = Full Size Small Big

wide ::
   (Shape.C height, Shape.C width) =>
   Order -> height -> width -> Wide height width
wide order height width =
   Full $ Layout.wide order height width

type LiberalSquare = Full Size Small Small

liberalSquare ::
   (Shape.C height, Shape.C width) =>
   Order -> height -> width -> LiberalSquare height width
liberalSquare order height width =
   Full $ Layout.liberalSquare order height width

type Square sh = Full Shape Small Small sh sh

square :: (Shape.C sh) => Order -> sh -> Square sh
square order sh = Full $ Layout.square order sh


type Quadratic pack property lower upper size =
      QuadraticMeas pack property lower upper Shape size size
type QuadraticMeas pack property lower upper meas height width =
      Omni pack property lower upper meas Small Small height width

type Hermitian size =
      Quadratic Packed Omni.HermitianUnknownDefiniteness Filled Filled size

hermitian :: Order -> sh -> Hermitian sh
hermitian order size = Hermitian $ Layout.hermitian order size


type Diagonal size = Quadratic Packed Arbitrary Empty Empty size

diagonal :: Order -> size -> Diagonal size
diagonal order size =
   Banded $
   Layout.bandedSquare
      (Unary.unary Unary.zero, Unary.unary Unary.zero) order size

type Identity size = Quadratic Packed Unit Empty Empty size

identity :: Order -> size -> Identity size
identity order size =
   UnitBandedTriangular $
   Layout.bandedSquare
      (Unary.unary Unary.zero, Unary.unary Unary.zero) order size



type UpLo lo up = (UpLoC lo up, UpLoC up lo)

class (DiagUpLoC lo up) => UpLoC lo up where
   switchUpLo :: f Empty Filled -> f Filled Empty -> f lo up

instance UpLoC Empty  Filled where switchUpLo f _ = f
instance UpLoC Filled Empty  where switchUpLo _ f = f


type DiagUpLo lo up = (DiagUpLoC lo up, DiagUpLoC up lo)

class (Omni.PowerStrip lo, Omni.PowerStrip up) => DiagUpLoC lo up where
   switchDiagUpLo ::
      f Empty Empty -> f Empty Filled -> f Filled Empty -> f lo up

instance DiagUpLoC Empty  Empty  where switchDiagUpLo f _ _ = f
instance DiagUpLoC Empty  Filled where switchDiagUpLo _ f _ = f
instance DiagUpLoC Filled Empty  where switchDiagUpLo _ _ f = f


data UpLoSingleton lo up where
   Lower :: UpLoSingleton Filled Empty
   Upper :: UpLoSingleton Empty Filled

autoUplo :: (UpLo lo up) => UpLoSingleton lo up
autoUplo = switchUpLo Upper Lower



type Triangular lo diag up size = Quadratic Packed diag lo up size

triangular ::
   (DiagUpLo lo up, Omni.TriDiag diag) =>
   Order -> size -> Triangular lo diag up size
triangular order size =
   runGenTriangularDiag $
   Omni.switchTriDiag
      (GenTriangularDiag $ unitTriangular order size)
      (GenTriangularDiag $ arbitraryTriangular order size)

unitTriangular ::
   (DiagUpLo lo up) =>
   Order -> size -> Triangular lo Unit up size
unitTriangular order size =
   runGenTriangularLoUp $
   switchDiagUpLo
      (GenTriangularLoUp $ identity order size)
      (GenTriangularLoUp $ UpperTriangular $
       Layout.upperTriangular order size)
      (GenTriangularLoUp $ LowerTriangular $
       Layout.lowerTriangular order size)

arbitraryTriangular ::
   (DiagUpLo lo up) =>
   Order -> size -> Triangular lo Arbitrary up size
arbitraryTriangular order size =
   runGenTriangularLoUp $
   switchDiagUpLo
      (GenTriangularLoUp $ diagonal order size)
      (GenTriangularLoUp $ upperTriangular order size)
      (GenTriangularLoUp $ lowerTriangular order size)


newtype GenTriangularDiag lo up size a diag =
   GenTriangularDiag {
      runGenTriangularDiag :: Triangular lo diag up size
   }

newtype GenTriangularLoUp diag size a lo up =
   GenTriangularLoUp {
      runGenTriangularLoUp :: Triangular lo diag up size
   }


type LowerTriangular size = Quadratic Packed Arbitrary Filled Empty size

lowerTriangular :: Order -> size -> LowerTriangular size
lowerTriangular order size =
   LowerTriangular $ Layout.lowerTriangular order size


type UpperTriangular size = Quadratic Packed Arbitrary Empty Filled size

upperTriangular :: Order -> size -> UpperTriangular size
upperTriangular order size =
   UpperTriangular $ Layout.upperTriangular order size


type Symmetric size = Quadratic Packed Omni.Symmetric Filled Filled size

symmetric :: Order -> size -> Symmetric size
symmetric order size = Symmetric $ Layout.symmetric order size


type Banded sub super meas vert horiz =
      Omni Packed Arbitrary (Bands sub) (Bands super) meas vert horiz

bandedOffDiagonals ::
   Omni Packed property (Bands sub) (Bands super)
      meas vert horiz height width ->
   (UnaryProxy sub, UnaryProxy super)
bandedOffDiagonals _ = (Proxy, Proxy)


type BandedGeneral sub super =
      Omni Packed Arbitrary (Bands sub) (Bands super) Size Big Big

bandedGeneral ::
   (Unary.Natural sub, Unary.Natural super,
    Shape.C height, Shape.C width) =>
   (UnaryProxy sub, UnaryProxy super) -> Order -> height -> width ->
   BandedGeneral sub super height width
bandedGeneral offDiag order height width =
   Banded $ Layout.bandedGeneral offDiag order height width

type BandedTriangular sub super size =
      Quadratic Packed Arbitrary (Bands sub) (Bands super) size
type BandedLower sub size = BandedTriangular sub TypeNum.U0 size
type BandedUpper super size = BandedTriangular TypeNum.U0 super size

type BandedUnitTriangular sub super size =
      Quadratic Packed Unit (Bands sub) (Bands super) size
type BandedUnitLower sub size = BandedUnitTriangular sub TypeNum.U0 size
type BandedUnitUpper super size = BandedUnitTriangular TypeNum.U0 super size


type BandedHermitian offDiag size =
      Quadratic Packed Omni.HermitianUnknownDefiniteness
         (Bands offDiag) (Bands offDiag) size

bandedHermitian ::
   (Unary.Natural offDiag) =>
   UnaryProxy offDiag -> Order -> size -> BandedHermitian offDiag size
bandedHermitian numOff order size =
   BandedHermitian $ Layout.bandedHermitian numOff order size

-- | For Hermitian eigenvalues
type RealDiagonal size = BandedHermitian TypeNum.U0 size

{- | For singular values

However, diagonal matrices produced by singular value decomposition
may be non-square and Hermitian must be square.
-}
type PositiveDiagonal size =
      Quadratic Packed Omni.HermitianPositiveDefinite Empty Empty size


type
   UpperQuasitriangular size =
      Quadratic Unpacked Arbitrary (Bands TypeNum.U1) Filled size