{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Rank2Types #-}
module Numeric.LAPACK.Matrix.Shape.Omni (
   Omni(..),
   Unit,
   Arbitrary,
   Symmetric,
   Hermitian,
   HermitianUnknownDefiniteness,
   HermitianPositiveDefinite,
   HermitianPositiveSemidefinite,
   HermitianNegativeDefinite,
   HermitianNegativeSemidefinite,
   hermitianSet,
   TriDiag(switchTriDiag),
   DiagSingleton(..),
   autoDiag,
   charFromTriDiag,
   packTag,
   Property,
   property,
   PropertySingleton(..),
   propertySingleton,
   Strip(..),
   strips,
   StripSingleton(..),
   stripSingleton,
   PowerStrip(..),
   PowerStripSingleton(..),
   powerStripSingleton,
   powerStrips,
   BandedTriangular,
   BandedTriangularSingleton(BandedLower, BandedUpper, BandedDiagonal),
   bandedTriangularSingleton,
   extent,
   height, width, squareSize,
   mapHeight, mapWidth, mapSquareSize,
   order,
   transpose,
   Plain,
   ToPlain, toPlain,
   FromPlain, fromPlain,
   toFull, fromFull,
   toBanded, toBandedHermitian,
   MultipliedBands,
   MultipliedStrip,
   MultipliedProperty,
   UnitIfTriangular,
   MergeUnit,
   Quadratic,
   quadratic,
   uncheckedDiagonal,
   Power(..),
   powerSingleton,
   ) where

import qualified Numeric.LAPACK.Matrix.Layout.Private as Layout
import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import qualified Numeric.LAPACK.Matrix.Extent.Strict as ExtentS
import Numeric.LAPACK.Matrix.Extent.Private (Extent, Small, Shape, Size)
import Numeric.LAPACK.Matrix.Layout.Private
         (Bands, Empty, Filled, Packed, Unpacked)

import qualified Data.Array.Comfort.Shape as Shape

import qualified Type.Data.Num.Unary as Unary
import qualified Type.Data.Bool as TBool
import Type.Data.Num.Unary.Literal (U0)
import Type.Data.Bool (False, True)
import Type.Base.Proxy (Proxy(Proxy))

import qualified Control.DeepSeq as DeepSeq



data Unit
data Arbitrary

class (Property diag) => TriDiag diag where
   switchTriDiag :: f Unit -> f Arbitrary -> f diag
instance TriDiag Unit where switchTriDiag f _ = f
instance TriDiag Arbitrary where switchTriDiag _ f = f

autoDiag :: TriDiag diag => DiagSingleton diag
autoDiag = switchTriDiag Unit Arbitrary

charFromTriDiag :: TriDiag diag => DiagSingleton diag -> Char
charFromTriDiag diag = case diag of Unit -> 'U'; Arbitrary -> 'N'


data DiagSingleton diag where
   Unit :: DiagSingleton Unit
   Arbitrary :: DiagSingleton Arbitrary

instance Eq (DiagSingleton diag) where
   Unit == Unit  =  True
   Arbitrary == Arbitrary  =  True

instance Show (DiagSingleton diag) where
   show Unit = "Unit"
   show Arbitrary = "Arbitrary"

instance DeepSeq.NFData (DiagSingleton diag) where
   rnf Unit = ()
   rnf Arbitrary = ()


data Symmetric

data Hermitian neg zero pos
type HermitianUnknownDefiniteness  = Hermitian True  True  True
type HermitianPositiveDefinite     = Hermitian False False True
type HermitianPositiveSemidefinite = Hermitian False True  True
type HermitianNegativeDefinite     = Hermitian True  False False
type HermitianNegativeSemidefinite = Hermitian True  True  False

{- |
Impossible:

> instance Definiteness False False False where
> instance Definiteness True  False True  where

The last one is impossible for this reason:

Given @x@ and @y@ with @x^T*A*x < 0@ and @y^T*A*y > 0@.
Because of the intermediate value theorem
there must be a @k@ from @[0,1]@ with
@z = k*x + (1-k)*y@ and @z^T*A*z = 0@.
-}
class Definiteness neg zero pos where
instance Definiteness True  True  True  where
instance Definiteness True  True  False where
instance Definiteness False True  True  where
instance Definiteness True  False False where
instance Definiteness False True  False where
instance Definiteness False False True  where

hermitianSet ::
   (TBool.C neg, TBool.C zero, TBool.C pos) =>
   Omni pack (Hermitian neg zero pos)
      lower upper meas vert horiz height width ->
   (TBool.Singleton neg, TBool.Singleton zero, TBool.Singleton pos)
hermitianSet _ = (TBool.singleton, TBool.singleton, TBool.singleton)



class Property property where
   switchProperty ::
      f Arbitrary ->
      f Unit ->
      f Symmetric ->
      (forall neg zero pos.
         (TBool.C neg, TBool.C zero, TBool.C pos) =>
         f (Hermitian neg zero pos)) ->
      f property

instance Property Arbitrary where switchProperty f _ _ _ = f
instance Property Unit where switchProperty _ f _ _ = f
instance Property Symmetric where switchProperty _ _ f _ = f
instance
   (TBool.C neg, TBool.C zero, TBool.C pos) =>
      Property (Hermitian neg zero pos) where
   switchProperty _ _ _ f = f

data PropertySingleton property where
   PropArbitrary :: PropertySingleton Arbitrary
   PropUnit      :: PropertySingleton Unit
   PropSymmetric :: PropertySingleton Symmetric
   PropHermitian ::
      (TBool.C neg, TBool.C zero, TBool.C pos) =>
      PropertySingleton (Hermitian neg zero pos)

propertySingleton ::
   (Property property) => PropertySingleton property
propertySingleton =
   switchProperty PropArbitrary PropUnit PropSymmetric PropHermitian

property ::
   (Property property) =>
   Omni pack property lower upper meas vert horiz height width ->
   PropertySingleton property
property _ = propertySingleton


class
   (MultipliedBands c Filled ~ Filled, MultipliedBands c Empty ~ c) =>
      Strip c where
   switchStrip ::
      (forall offDiag. Unary.Natural offDiag => f (Bands offDiag)) ->
      f Filled ->
      f c
instance (Unary.Natural offDiag) => Strip (Bands offDiag) where
   switchStrip f _ = f
instance Strip Filled where
   switchStrip _ f = f


data StripSingleton c where
   StripBands ::
      (Unary.Natural offDiag) =>
      Unary.HeadSingleton offDiag -> StripSingleton (Bands offDiag)
   StripFilled :: StripSingleton Filled

stripSingleton :: (Strip c) => StripSingleton c
stripSingleton = switchStrip (StripBands Unary.headSingleton) StripFilled

strips ::
   (Strip lower, Strip upper) =>
   Omni pack property lower upper meas vert horiz height width ->
   (StripSingleton lower, StripSingleton upper)
strips _ = (stripSingleton, stripSingleton)



{- |
'PowerStrip' is either 'Empty' or 'Filled'.
These are the 'Strip's that are preserved in matrix powers.

Pun intended.
-}
class (Strip c) => PowerStrip c where
   switchPowerStrip :: f Empty -> f Filled -> f c
instance (offDiag ~ U0) => PowerStrip (Bands offDiag) where
   switchPowerStrip f _ = f
instance PowerStrip Filled where
   switchPowerStrip _ f = f

data PowerStripSingleton c where
   Empty :: PowerStripSingleton Empty
   Filled :: PowerStripSingleton Filled

powerStripSingleton :: (PowerStrip c) => PowerStripSingleton c
powerStripSingleton = switchPowerStrip Empty Filled

powerStrips ::
   (PowerStrip lower, PowerStrip upper) =>
   Omni pack property lower upper meas vert horiz height width ->
   (PowerStripSingleton lower, PowerStripSingleton upper)
powerStrips _ = (powerStripSingleton, powerStripSingleton)


packTag ::
   (Layout.Packing pack) =>
   Omni pack propery lower upper meas vert horiz height width ->
   Layout.PackingSingleton pack
packTag _ = Layout.autoPacking


type PowerQuadratic pack property lower upper sh =
      Power pack property lower upper Shape Small Small sh sh

data Power pack property lower upper meas vert horiz height width where
   PowerIdentity ::
      (Layout.Packing pack) =>
      PowerQuadratic pack Unit Empty Empty sh
   PowerDiagonal ::
      (Layout.Packing pack) =>
      Power pack property Empty Empty meas vert horiz height width
   PowerUpperTriangular ::
      (Layout.Packing pack, TriDiag diag) =>
      PowerQuadratic pack diag Empty Filled sh
   PowerLowerTriangular ::
      (Layout.Packing pack, TriDiag diag) =>
      PowerQuadratic pack diag Filled Empty sh
   PowerSymmetric ::
      (Layout.Packing pack) =>
      PowerQuadratic pack Symmetric Filled Filled sh
   PowerHermitian ::
      (Layout.Packing pack, TBool.C neg, TBool.C zero, TBool.C pos) =>
      PowerQuadratic pack (Hermitian neg zero pos) Filled Filled sh
   PowerFull ::
      Power Unpacked property lower upper meas vert horiz height width

powerSingleton ::
   (Layout.Packing pack, Property property,
    PowerStrip lower, PowerStrip upper,
    Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   Omni pack property lower upper meas vert horiz height width ->
   Power pack property lower upper meas vert horiz height width
powerSingleton shape =
   case packTag shape of
      Layout.Packed ->
         case (shape, powerStrips shape) of
            (UpperTriangular _, _) -> PowerUpperTriangular
            (LowerTriangular _, _) -> PowerLowerTriangular
            (Symmetric _, _) -> PowerSymmetric
            (Hermitian _, _) -> PowerHermitian
            (Banded _, (Empty, Empty)) -> PowerDiagonal
            (BandedHermitian _, (Empty, Empty)) -> PowerDiagonal
            (UnitBandedTriangular _, (Empty, Empty)) -> PowerIdentity
      Layout.Unpacked ->
         case (extent shape, property shape, powerStrips shape) of
            (Extent.Square _, PropUnit, (Empty, Empty)) ->
               PowerIdentity
            (Extent.Square _, _, (Empty, Empty)) ->
               PowerDiagonal
            (Extent.Square _, PropArbitrary, (Empty, Filled)) ->
               PowerUpperTriangular
            (Extent.Square _, PropArbitrary, (Filled, Empty)) ->
               PowerLowerTriangular
            (Extent.Square _, PropUnit, (Empty, Filled)) ->
               PowerUpperTriangular
            (Extent.Square _, PropUnit, (Filled, Empty)) ->
               PowerLowerTriangular
            (Extent.Square _, PropSymmetric, (Filled, Filled)) ->
               PowerSymmetric
            (Extent.Square _, PropHermitian, (Filled, Filled)) ->
               PowerHermitian
            _ -> PowerFull


class
   (Unary.Natural sub, Unary.Natural super) =>
      BandedTriangular sub super where
   switchBandedTriangular ::
      f Unary.Zero Unary.Zero ->
      (forall offDiag. Unary.Natural offDiag =>
         f Unary.Zero (Unary.Succ offDiag)) ->
      (forall offDiag. Unary.Natural offDiag =>
         f (Unary.Succ offDiag) Unary.Zero) ->
      f sub super
instance BandedTriangular Unary.Zero Unary.Zero where
   switchBandedTriangular f _ _ = f
instance (Unary.Natural super) =>
      BandedTriangular Unary.Zero (Unary.Succ super) where
   switchBandedTriangular _ f _ = f
instance (Unary.Natural sub) =>
      BandedTriangular (Unary.Succ sub) Unary.Zero where
   switchBandedTriangular _ _ f = f

data BandedTriangularSingleton sub super where
   BandedDiagonal :: BandedTriangularSingleton Unary.Zero Unary.Zero
   BandedUpper ::
      Unary.Natural offDiag =>
         BandedTriangularSingleton Unary.Zero (Unary.Succ offDiag)
   BandedLower ::
      Unary.Natural offDiag =>
         BandedTriangularSingleton (Unary.Succ offDiag) Unary.Zero

bandedTriangularSingleton ::
   (BandedTriangular sub super) =>
   Layout.Banded sub super meas vert horiz height width ->
   BandedTriangularSingleton sub super
bandedTriangularSingleton _ =
   switchBandedTriangular BandedDiagonal BandedUpper BandedLower


data Omni pack property lower upper meas vert horiz height width where
   Full ::
      (Property property, Strip lower, Strip upper) =>
      Layout.Full meas vert horiz height width ->
      Omni Unpacked property lower upper meas vert horiz height width

   UpperTriangular ::
      (TriDiag diag) =>
      Layout.UpperTriangular size ->
      Omni Packed diag Empty Filled Shape Small Small size size
   LowerTriangular ::
      (TriDiag diag) =>
      Layout.LowerTriangular size ->
      Omni Packed diag Filled Empty Shape Small Small size size

   Symmetric ::
      Layout.Symmetric size ->
      Omni Packed Symmetric Filled Filled Shape Small Small size size
   Hermitian ::
      (TBool.C neg, TBool.C zero, TBool.C pos) =>
      Layout.Hermitian size ->
      Omni Packed (Hermitian neg zero pos)
         Filled Filled Shape Small Small size size

   Banded ::
      (Unary.Natural sub, Unary.Natural super) =>
      Layout.Banded sub super meas vert horiz height width ->
      Omni Packed Arbitrary
         (Bands sub) (Bands super) meas vert horiz height width

   UnitBandedTriangular ::
      (BandedTriangular sub super, BandedTriangular super sub) =>
      Layout.BandedSquare sub super size ->
      Omni Packed Unit (Bands sub) (Bands super) Shape Small Small size size

   BandedHermitian ::
      (TBool.C neg, TBool.C zero, TBool.C pos, Unary.Natural offDiag) =>
      Layout.BandedHermitian offDiag size ->
      Omni Packed (Hermitian neg zero pos)
         (Bands offDiag) (Bands offDiag) Shape Small Small size size

deriving instance
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Eq height, Eq width) =>
   Eq (Omni pack property lower upper meas vert horiz height width)

deriving instance
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Show height, Show width) =>
   Show (Omni pack property lower upper meas vert horiz height width)

instance
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    DeepSeq.NFData height, DeepSeq.NFData width) =>
   DeepSeq.NFData
         (Omni pack property lower upper meas vert horiz height width) where
      rnf omni =
         case omni of
            Full shape -> DeepSeq.rnf shape
            UpperTriangular shape -> DeepSeq.rnf shape
            LowerTriangular shape -> DeepSeq.rnf shape
            Symmetric shape -> DeepSeq.rnf shape
            Hermitian shape -> DeepSeq.rnf shape
            Banded shape -> DeepSeq.rnf shape
            UnitBandedTriangular shape -> DeepSeq.rnf shape
            BandedHermitian shape -> DeepSeq.rnf shape


{- |
Construct a shape from order, dimensions and type information.
-}
class
   (Property property, Strip lower, Strip upper,
    ExtentS.Measured meas vert, ExtentS.Measured meas horiz) =>
      Cons pack property lower upper meas vert horiz where
   cons ::
      (Shape.C height, Shape.C width) =>
      (ExtentS.MeasureTarget meas height ~ ExtentS.MeasureTarget meas width) =>
      Layout.Order -> ExtentS.Dimension meas height width ->
      Omni pack property lower upper meas vert horiz height width

instance
   (Strip lower, Strip upper,
    ExtentS.Measured meas vert, ExtentS.Measured meas horiz) =>
      Cons Unpacked Arbitrary lower upper meas vert horiz where
   cons order_ = Full . Layout.Full order_ . ExtentS.consChecked

instance
   (TriDiag diag, Shape ~ meas, Small ~ vert, Small ~ horiz) =>
      Cons Packed diag Empty Filled meas vert horiz where
   cons order_ = UpperTriangular . Layout.upperTriangular  order_

instance
   (TriDiag diag, Shape ~ meas, Small ~ vert, Small ~ horiz) =>
      Cons Packed diag Filled Empty meas vert horiz where
   cons order_ = LowerTriangular . Layout.lowerTriangular order_

instance
   (Shape ~ meas, Small ~ vert, Small ~ horiz) =>
      Cons Packed Symmetric Filled Filled meas vert horiz where
   cons order_ = Symmetric . Layout.symmetric order_

instance
   (TBool.C neg, TBool.C zero, TBool.C pos,
    Shape ~ meas, Small ~ vert, Small ~ horiz) =>
      Cons Packed (Hermitian neg zero pos) Filled Filled meas vert horiz where
   cons order_ = Hermitian . Layout.hermitian order_

instance
   (ExtentS.Measured meas vert, ExtentS.Measured meas horiz,
    Unary.Natural sub, Unary.Natural super) =>
      Cons Packed Arbitrary (Bands sub) (Bands super) meas vert horiz where
   cons order_ =
      Banded . Layout.Banded (Proxy,Proxy) order_ . ExtentS.consChecked

instance
   (BandedTriangular sub super, BandedTriangular super sub,
    Shape ~ meas, Small ~ vert, Small ~ horiz) =>
      Cons Packed Unit (Bands sub) (Bands super) meas vert horiz where
   cons order_ =
      UnitBandedTriangular . Layout.Banded (Proxy,Proxy) order_ .
      Extent.square

instance
   (TBool.C neg, TBool.C zero, TBool.C pos, Unary.Natural sub, sub ~ super,
    Shape ~ meas, Small ~ vert, Small ~ horiz) =>
      Cons
         Packed (Hermitian neg zero pos) (Bands sub) (Bands super)
         meas vert horiz where
   cons order_ = BandedHermitian . Layout.BandedHermitian Proxy order_



class Quadratic pack property lower upper where
   quadratic ::
      (Shape.C sh) =>
      Layout.Order -> sh ->
      Omni pack property lower upper Shape Small Small sh sh

instance
   (Strip lower, Strip upper) =>
      Quadratic Unpacked Arbitrary lower upper where
   quadratic = cons

instance (TriDiag diag) => Quadratic Packed diag Empty Filled where
   quadratic = cons

instance (TriDiag diag) => Quadratic Packed diag Filled Empty where
   quadratic = cons

instance Quadratic Packed Symmetric Filled Filled where
   quadratic = cons

instance
   (TBool.C neg, TBool.C zero, TBool.C pos) =>
      Quadratic Packed (Hermitian neg zero pos) Filled Filled where
   quadratic = cons

instance
   (Unary.Natural sub, Unary.Natural super) =>
      Quadratic Packed Arbitrary (Bands sub) (Bands super) where
   quadratic = cons

instance
   (BandedTriangular sub super, BandedTriangular super sub) =>
      Quadratic Packed Unit (Bands sub) (Bands super) where
   quadratic = cons

instance
   (TBool.C neg, TBool.C zero, TBool.C pos, sub ~ super, Unary.Natural super) =>
      Quadratic Packed (Hermitian neg zero pos) (Bands sub) (Bands super) where
   quadratic = cons



class FromPlain pack property lower upper meas vert horiz height width where
   type Plain pack property lower upper meas vert horiz height width
   fromPlain ::
      Plain pack property lower upper meas vert horiz height width ->
      Omni pack property lower upper meas vert horiz height width

class
   FromPlain pack property lower upper meas vert horiz height width =>
      ToPlain pack property lower upper meas vert horiz height width where
   toPlain ::
      Omni pack property lower upper meas vert horiz height width ->
      Plain pack property lower upper meas vert horiz height width


instance
   FromPlain Unpacked Arbitrary Filled Filled meas vert horiz height width
      where
   type Plain Unpacked Arbitrary Filled Filled meas vert horiz height width =
            Layout.Full meas vert horiz height width
   fromPlain = Full

instance
   ToPlain Unpacked Arbitrary Filled Filled meas vert horiz height width
      where
   toPlain (Full shape) = shape


instance
   (Layout.Packing pack, TriDiag diag, height ~ width) =>
      FromPlain pack diag Empty Filled Shape Small Small height width where
   type Plain pack diag Empty Filled Shape Small Small height width =
            Layout.UpperTriangularP pack height
   fromPlain = fromMosaic UpperTriangular

instance
   (Layout.Packing pack, TriDiag diag, height ~ width) =>
      ToPlain pack diag Empty Filled Shape Small Small height width where
   toPlain (UpperTriangular shape) = shape
   toPlain (Full shape) = Layout.mosaicFromSquare shape


instance
   (Layout.Packing pack, TriDiag diag, height ~ width) =>
      FromPlain pack diag Filled Empty Shape Small Small height width where
   type Plain pack diag Filled Empty Shape Small Small height width =
            Layout.LowerTriangularP pack height
   fromPlain = fromMosaic LowerTriangular

instance
   (Layout.Packing pack, TriDiag diag, height ~ width) =>
      ToPlain pack diag Filled Empty Shape Small Small height width where
   toPlain (LowerTriangular shape) = shape
   toPlain (Full shape) = Layout.mosaicFromSquare shape


instance
   (Layout.Packing pack, height ~ width) =>
      FromPlain pack Symmetric Filled Filled Shape Small Small height width
         where
   type Plain pack Symmetric Filled Filled Shape Small Small height width =
            Layout.SymmetricP pack height
   fromPlain = fromMosaic Symmetric

instance
   (Layout.Packing pack, height ~ width) =>
      ToPlain pack Symmetric Filled Filled Shape Small Small height width where
   toPlain (Symmetric shape) = shape
   toPlain (Full shape) = Layout.mosaicFromSquare shape


instance
   (Layout.Packing pack,
    TBool.C neg, TBool.C zero, TBool.C pos, height ~ width) =>
      FromPlain pack (Hermitian neg zero pos) Filled Filled
            Shape Small Small height width
         where
   type Plain pack (Hermitian neg zero pos) Filled Filled
            Shape Small Small height width =
         Layout.HermitianP pack height
   fromPlain = fromMosaic Hermitian

instance
   (Layout.Packing pack,
    TBool.C neg, TBool.C zero, TBool.C pos, height ~ width) =>
      ToPlain pack (Hermitian neg zero pos) Filled Filled
            Shape Small Small height width
         where
   toPlain (Hermitian shape) = shape
   toPlain (Full shape) = Layout.mosaicFromSquare shape

fromMosaic ::
   (Layout.Packing pack, Property property, Strip lower, Strip upper) =>
   (Layout.Mosaic Packed mirror uplo sh ->
    Omni Packed property lower upper Shape Small Small sh sh) ->
   Layout.Mosaic pack mirror uplo sh ->
   Omni pack property lower upper Shape Small Small sh sh
fromMosaic packedShape shape = withPacking $ \pack ->
   case pack of
      Layout.Packed -> packedShape shape
      Layout.Unpacked -> Full $ Layout.squareFromMosaic shape

withPacking ::
   (Layout.Packing pack, Property property, Strip lower, Strip upper) =>
   (Layout.PackingSingleton pack ->
    Omni pack property lower upper meas vert horiz height width) ->
   Omni pack property lower upper meas vert horiz height width
withPacking f = f Layout.autoPacking


instance
   (Unary.Natural sub, Unary.Natural super) =>
   FromPlain Packed Arbitrary
      (Bands sub) (Bands super) meas vert horiz height width
         where
   type Plain Packed Arbitrary
            (Bands sub) (Bands super) meas vert horiz height width =
         Layout.Banded sub super meas vert horiz height width
   fromPlain = Banded

instance
   (Unary.Natural sub, Unary.Natural super) =>
   ToPlain Packed Arbitrary
      (Bands sub) (Bands super) meas vert horiz height width
         where
   toPlain (Banded shape) = shape


instance
   (BandedTriangular sub super, BandedTriangular super sub, height ~ width) =>
   FromPlain Packed Unit
      (Bands sub) (Bands super) Shape Small Small height width
         where
   type Plain Packed Unit
            (Bands sub) (Bands super) Shape Small Small height width =
            Layout.BandedSquare sub super height
   fromPlain = UnitBandedTriangular

instance
   (BandedTriangular sub super, BandedTriangular super sub, height ~ width) =>
   ToPlain Packed Unit (Bands sub) (Bands super) Shape Small Small height width
      where
   toPlain (UnitBandedTriangular shape) = shape


instance
   (Unary.Natural sub, sub ~ super, height ~ width,
    TBool.C neg, TBool.C zero, TBool.C pos) =>
      FromPlain Packed (Hermitian neg zero pos) (Bands sub) (Bands super)
         Shape Small Small height width where
   type
      Plain
         Packed (Hermitian neg zero pos) (Bands sub) (Bands super)
         Shape Small Small height width =
      Layout.BandedHermitian sub height
   fromPlain = BandedHermitian

instance
   (Unary.Natural sub, sub ~ super, height ~ width,
    TBool.C neg, TBool.C zero, TBool.C pos) =>
      ToPlain Packed (Hermitian neg zero pos) (Bands sub) (Bands super)
         Shape Small Small height width where
   toPlain (BandedHermitian shape) = shape


fromFull ::
   (Property property, Strip lower, Strip upper) =>
   Layout.Full meas vert horiz height width ->
   Omni Unpacked property lower upper meas vert horiz height width
fromFull = Full

toFull ::
   (Property property, Strip lower, Strip upper) =>
   Omni Unpacked property lower upper meas vert horiz height width ->
   Layout.Full meas vert horiz height width
toFull (Full shape) = shape


newtype FromDiagonal size diag =
   FromDiagonal {
      getFromDiagonal ::
         Layout.BandedSquare U0 U0 size ->
         Omni Packed diag Empty Empty Shape Small Small size size
   }

uncheckedDiagonal ::
   (Layout.Packing pack, TriDiag diag) =>
   Layout.Order -> size ->
   Omni pack diag Empty Empty Shape Small Small size size
uncheckedDiagonal order_ size = withPacking $ \pack ->
   case pack of
      Layout.Packed ->
         getFromDiagonal
            (switchTriDiag
               (FromDiagonal UnitBandedTriangular)
               (FromDiagonal Banded))
            (Layout.Banded (Proxy,Proxy) order_ (Extent.square size))
      Layout.Unpacked ->
         Full (Layout.Full order_ (Extent.square size))

_fromDiagonal ::
   (TriDiag diag) =>
   Layout.Diagonal size ->
   Omni Packed diag Empty Empty Shape Small Small size size
_fromDiagonal (Layout.Banded _offDiag order_ size) =
   uncheckedDiagonal order_ (Extent.squareSize size)

_toDiagonal ::
   (TriDiag diag) =>
   Omni Packed diag Empty Empty Shape Small Small size size ->
   Layout.Diagonal size
_toDiagonal omni =
   case omni of
      Banded sh -> sh
      UnitBandedTriangular sh -> sh
      BandedHermitian (Layout.BandedHermitian k order_ size) ->
         Layout.Banded (k,k) order_ (Extent.square size)


_fromUpperTriangular ::
   (Layout.Packing pack) =>
   (TriDiag diag) =>
   Layout.UpperTriangularP pack size ->
   Omni pack diag Empty Filled Shape Small Small size size
_fromUpperTriangular = fromMosaic UpperTriangular

_toUpperTriangular ::
   (TriDiag diag) =>
   Omni pack diag Empty Filled Shape Small Small size size ->
   Layout.UpperTriangularP pack size
_toUpperTriangular (UpperTriangular shape) = shape
_toUpperTriangular (Full shape) = Layout.mosaicFromSquare shape


_fromLowerTriangular ::
   (Layout.Packing pack) =>
   (TriDiag diag) =>
   Layout.LowerTriangularP pack size ->
   Omni pack diag Filled Empty Shape Small Small size size
_fromLowerTriangular = fromMosaic LowerTriangular

_toLowerTriangular ::
   (TriDiag diag) =>
   Omni pack diag Filled Empty Shape Small Small size size ->
   Layout.LowerTriangularP pack size
_toLowerTriangular (LowerTriangular shape) = shape
_toLowerTriangular (Full shape) = Layout.mosaicFromSquare shape


_fromSymmetric ::
   (Layout.Packing pack) =>
   Layout.SymmetricP pack size ->
   Omni pack Symmetric Filled Filled Shape Small Small size size
_fromSymmetric = fromMosaic Symmetric

_toSymmetric ::
   Omni pack Symmetric Filled Filled Shape Small Small size size ->
   Layout.SymmetricP pack size
_toSymmetric (Symmetric shape) = shape
_toSymmetric (Full shape) = Layout.mosaicFromSquare shape


_fromHermitian ::
   (Layout.Packing pack) =>
   (TBool.C neg, TBool.C zero, TBool.C pos) =>
   Layout.HermitianP pack size ->
   Omni pack (Hermitian neg zero pos) Filled Filled Shape Small Small size size
_fromHermitian = fromMosaic Hermitian

_toHermitian ::
   (TBool.C neg, TBool.C zero, TBool.C pos) =>
   Omni pack (Hermitian neg zero pos)
      Filled Filled Shape Small Small size size ->
   Layout.HermitianP pack size
_toHermitian (Hermitian shape) = shape
_toHermitian (Full shape) = Layout.mosaicFromSquare shape


_fromBanded ::
   (Unary.Natural sub, Unary.Natural super) =>
   Layout.Banded sub super meas vert horiz height width ->
   Omni Packed Arbitrary (Bands sub) (Bands super) meas vert horiz height width
_fromBanded = Banded

toBanded ::
   (Unary.Natural sub, Unary.Natural super) =>
   Omni Packed Arbitrary
      (Bands sub) (Bands super) meas vert horiz height width ->
   Layout.Banded sub super meas vert horiz height width
toBanded (Banded shape) = shape


_fromUnitBandedTriangular ::
   (BandedTriangular sub super, BandedTriangular super sub) =>
   Layout.Banded sub super Shape Small Small size size ->
   Omni Packed Unit (Bands sub) (Bands super) Shape Small Small size size
_fromUnitBandedTriangular = UnitBandedTriangular

_toUnitBandedTriangular ::
   (BandedTriangular sub super, BandedTriangular super sub) =>
   Omni Packed Unit (Bands sub) (Bands super) Shape Small Small size size ->
   Layout.Banded sub super Shape Small Small size size
_toUnitBandedTriangular (UnitBandedTriangular shape) = shape


_fromBandedHermitian ::
   (TBool.C neg, TBool.C zero, TBool.C pos, Unary.Natural offDiag) =>
   Layout.BandedHermitian offDiag size ->
   Omni Packed (Hermitian neg zero pos)
      (Bands offDiag) (Bands offDiag) Shape Small Small size size
_fromBandedHermitian = BandedHermitian

toBandedHermitian ::
   (TBool.C neg, TBool.C zero, TBool.C pos, Unary.Natural offDiag) =>
   Omni Packed (Hermitian neg zero pos)
      (Bands offDiag) (Bands offDiag) Shape Small Small size size ->
   Layout.BandedHermitian offDiag size
toBandedHermitian (BandedHermitian shape) = shape



height ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   Omni pack property lower upper meas vert horiz height width -> height
height omni =
   case omni of
      Full shape -> Layout.fullHeight shape
      UpperTriangular shape -> Layout.mosaicSize shape
      LowerTriangular shape -> Layout.mosaicSize shape
      Symmetric shape -> Layout.mosaicSize shape
      Hermitian shape -> Layout.mosaicSize shape
      Banded shape -> Layout.bandedHeight shape
      UnitBandedTriangular shape -> Layout.bandedHeight shape
      BandedHermitian shape -> Layout.bandedHermitianSize shape

width ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   Omni pack property lower upper meas vert horiz height width -> width
width omni =
   case omni of
      Full shape -> Layout.fullWidth shape
      UpperTriangular shape -> Layout.mosaicSize shape
      LowerTriangular shape -> Layout.mosaicSize shape
      Symmetric shape -> Layout.mosaicSize shape
      Hermitian shape -> Layout.mosaicSize shape
      Banded shape -> Layout.bandedWidth shape
      UnitBandedTriangular shape -> Layout.bandedWidth shape
      BandedHermitian shape -> Layout.bandedHermitianSize shape

squareSize :: Omni pack property lower upper Shape Small Small sh sh -> sh
squareSize = height

extent ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   Omni pack property lower upper meas vert horiz height width ->
   Extent meas vert horiz height width
extent omni =
   case omni of
      Full shape -> Layout.fullExtent shape
      UpperTriangular shape -> Extent.square $ Layout.mosaicSize shape
      LowerTriangular shape -> Extent.square $ Layout.mosaicSize shape
      Symmetric shape -> Extent.square $ Layout.mosaicSize shape
      Hermitian shape -> Extent.square $ Layout.mosaicSize shape
      Banded shape -> Layout.bandedExtent shape
      UnitBandedTriangular shape -> Layout.bandedExtent shape
      BandedHermitian shape ->
         Extent.square $ Layout.bandedHermitianSize shape


mapExtentUnchecked ::
   (Extent Size vertA horizA heightA widthA ->
    Extent Size vertB horizB heightB widthB) ->
   Omni pack property lower upper Size vertA horizA heightA widthA ->
   Omni pack property lower upper Size vertB horizB heightB widthB
mapExtentUnchecked f omni =
   case omni of
      Full shape@Layout.Full{Layout.fullExtent = ext} ->
         Full shape{Layout.fullExtent = f ext}
      Banded shape@Layout.Banded{Layout.bandedExtent = ext} ->
         Banded shape{Layout.bandedExtent = f ext}

mapHeight ::
   (Shape.C heightA, Shape.C heightB, Extent.C vert, Extent.C horiz) =>
   (heightA -> heightB) ->
   Omni pack property lower upper Size vert horiz heightA width ->
   Omni pack property lower upper Size vert horiz heightB width
mapHeight f =
   mapExtentUnchecked $ Extent.mapHeight $ Layout.mapChecked "mapHeight" f

mapWidth ::
   (Shape.C widthA, Shape.C widthB, Extent.C vert, Extent.C horiz) =>
   (widthA -> widthB) ->
   Omni pack property lower upper Size vert horiz height widthA ->
   Omni pack property lower upper Size vert horiz height widthB
mapWidth f =
   mapExtentUnchecked $ Extent.mapWidth $ Layout.mapChecked "mapWidth" f

mapSquareSize ::
   (Shape.C shA, Shape.C shB) =>
   (shA -> shB) ->
   Omni pack property lower upper Shape Small Small shA shA ->
   Omni pack property lower upper Shape Small Small shB shB
mapSquareSize f omni =
   let cf = Layout.mapChecked "mapSquareSize" f in
   case omni of
      Full shape@Layout.Full{Layout.fullExtent = ext} ->
         Full shape{Layout.fullExtent = Extent.mapSquareSize cf ext}
      UpperTriangular shape@Layout.Mosaic{Layout.mosaicSize = size} ->
         UpperTriangular shape{Layout.mosaicSize = cf size}
      LowerTriangular shape@Layout.Mosaic{Layout.mosaicSize = size} ->
         LowerTriangular shape{Layout.mosaicSize = cf size}
      Symmetric shape@Layout.Mosaic{Layout.mosaicSize = size} ->
         Symmetric shape{Layout.mosaicSize = cf size}
      Hermitian shape@Layout.Mosaic{Layout.mosaicSize = size} ->
         Hermitian shape{Layout.mosaicSize = cf size}
      Banded shape@Layout.Banded{Layout.bandedExtent = ext} ->
         Banded shape{Layout.bandedExtent = Extent.mapSquareSize cf ext}
      UnitBandedTriangular shape@Layout.Banded{Layout.bandedExtent = ext} ->
         UnitBandedTriangular
            shape{Layout.bandedExtent = Extent.mapSquareSize cf ext}
      BandedHermitian
            shape@Layout.BandedHermitian{Layout.bandedHermitianSize = size} ->
         BandedHermitian shape{Layout.bandedHermitianSize = cf size}


order ::
   Omni pack property lower upper meas vert horiz height width ->
   Layout.Order
order omni =
   case omni of
      Full shape -> Layout.fullOrder shape
      UpperTriangular shape -> Layout.mosaicOrder shape
      LowerTriangular shape -> Layout.mosaicOrder shape
      Symmetric shape -> Layout.mosaicOrder shape
      Hermitian shape -> Layout.mosaicOrder shape
      Banded shape -> Layout.bandedOrder shape
      UnitBandedTriangular shape -> Layout.bandedOrder shape
      BandedHermitian shape -> Layout.bandedHermitianOrder shape

_forceOrderDiagonal ::
   Layout.Order ->
   Omni Packed property Empty Empty meas vert horiz height width ->
   Omni Packed property Empty Empty meas vert horiz height width
_forceOrderDiagonal newOrder omni =
   case omni of
      Banded sh ->
         Banded sh{Layout.bandedOrder = newOrder}
      BandedHermitian sh ->
         BandedHermitian sh{Layout.bandedHermitianOrder = newOrder}
      UnitBandedTriangular sh ->
         UnitBandedTriangular sh{Layout.bandedOrder = newOrder}


transpose ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   Omni pack property lower upper meas vert horiz height width ->
   Omni pack property upper lower meas horiz vert width height
transpose (Full shape) =
   Full (Layout.transpose shape)
transpose (UpperTriangular shape) =
   LowerTriangular (Layout.triangularTranspose shape)
transpose (LowerTriangular shape) =
   UpperTriangular (Layout.triangularTranspose shape)
transpose (Symmetric shape) = Symmetric shape
transpose (Hermitian shape) = Hermitian shape
transpose (Banded shape) =
   Banded (Layout.bandedTranspose shape)
transpose (UnitBandedTriangular shape) =
   UnitBandedTriangular (Layout.bandedTranspose shape)
transpose (BandedHermitian shape) =
   BandedHermitian shape


instance
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Shape.C width) =>
      Shape.C
         (Omni pack property lower upper meas vert horiz height width) where

   size omni =
      case omni of
         Full shape -> Shape.size shape
         UpperTriangular shape -> Shape.size shape
         LowerTriangular shape -> Shape.size shape
         Symmetric shape -> Shape.size shape
         Hermitian shape -> Shape.size shape
         Banded shape -> Shape.size shape
         UnitBandedTriangular shape -> Shape.size shape
         BandedHermitian shape -> Shape.size shape



type family MultipliedBands bandsA bandsB
type instance MultipliedBands Filled bandsB = Filled
type instance MultipliedBands (Bands k) Filled = Filled
type instance MultipliedBands (Bands k) (Bands l) = Bands (k Unary.:+: l)

type family MultipliedStrip contA contB
type instance MultipliedStrip Filled contB = Filled
type instance MultipliedStrip Empty contB = contB

type family MultipliedProperty propA propB
type instance MultipliedProperty Arbitrary propB = Arbitrary
type instance MultipliedProperty Symmetric propB = Arbitrary
type instance MultipliedProperty (Hermitian neg zero pos) propB = Arbitrary
type instance MultipliedProperty Unit Arbitrary = Arbitrary
type instance MultipliedProperty Unit Symmetric = Arbitrary
type instance MultipliedProperty Unit (Hermitian neg zero pos) = Arbitrary
type instance MultipliedProperty Unit Unit = Unit

type family UnitIfTriangular lower upper
type instance UnitIfTriangular Empty upper = Unit
type instance UnitIfTriangular Filled Empty = Unit
type instance UnitIfTriangular Filled Filled = Arbitrary
type instance UnitIfTriangular Filled (Bands (Unary.Succ k)) = Arbitrary
type instance UnitIfTriangular (Bands (Unary.Succ k)) Empty = Unit
type instance UnitIfTriangular (Bands (Unary.Succ k)) Filled = Arbitrary
type instance UnitIfTriangular (Bands (Unary.Succ k)) (Bands (Unary.Succ l)) =
                  Arbitrary

type family MergeUnit unit0 unit1
type instance MergeUnit Unit unit1 = unit1
type instance MergeUnit Arbitrary unit1 = Arbitrary