{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Rank2Types #-}
module Numeric.LAPACK.Matrix.Extent.Strict where

import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import Numeric.LAPACK.Matrix.Extent.Private
         (C, Extent, Measure, switchTag,
          Shape, Size, Small, Big, errorTagTriple)

import qualified Data.Array.Comfort.Shape as Shape


newtype Map measA vertA horizA measB vertB horizB height width =
   Map {forall measA vertA horizA measB vertB horizB height width.
Map measA vertA horizA measB vertB horizB height width
-> Map measA vertA horizA measB vertB horizB height width
apply :: Extent.Map measA vertA horizA measB vertB horizB height width}

transpose ::
   (Measure measA, C vertA, C horizA) =>
   (Measure measB, C vertB, C horizB) =>
   Map measA vertA horizA measB vertB horizB height width ->
   Map measA horizA vertA measB horizB vertB width height
transpose :: forall measA vertA horizA measB vertB horizB height width.
(Measure measA, C vertA, C horizA, Measure measB, C vertB,
 C horizB) =>
Map measA vertA horizA measB vertB horizB height width
-> Map measA horizA vertA measB horizB vertB width height
transpose (Map Map measA vertA horizA measB vertB horizB height width
m) = Map measA horizA vertA measB horizB vertB width height
-> Map measA horizA vertA measB horizB vertB width height
forall measA vertA horizA measB vertB horizB height width.
Map measA vertA horizA measB vertB horizB height width
-> Map measA vertA horizA measB vertB horizB height width
Map (Extent measB vertB horizB height width
-> Extent measB horizB vertB width height
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas vert horiz height width
-> Extent meas horiz vert width height
Extent.transpose (Extent measB vertB horizB height width
 -> Extent measB horizB vertB width height)
-> (Extent measA horizA vertA width height
    -> Extent measB vertB horizB height width)
-> Map measA horizA vertA measB horizB vertB width height
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map measA vertA horizA measB vertB horizB height width
m Map measA vertA horizA measB vertB horizB height width
-> (Extent measA horizA vertA width height
    -> Extent measA vertA horizA height width)
-> Extent measA horizA vertA width height
-> Extent measB vertB horizB height width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extent measA horizA vertA width height
-> Extent measA vertA horizA height width
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas vert horiz height width
-> Extent meas horiz vert width height
Extent.transpose)


{- |
Admissible tag combinations are:

> meas  vert  horiz
> Shape Small Small - Square
> Size  Small Small - LiberalSquare
> Size  Big   Small - Tall
> Size  Small Big   - Wide
> Size  Big   Big   - General

We can enforce this set with the constraints

> (Extent.Measured meas vert, Extent.Measured meas horiz)

However, in some cases it leads to constraints
like @Measured meas Small@ or @Measured meas Big@.
The former one is morally equivalent to @Measure meas@
and the latter one is morally equivalent to @meas ~ Size@.
However, in order to convince the compiler
you would have to go through 'switchMeasured'.

In order to circumvent this trouble
we use internal functions with weaker constraints:

> (Extent.Measure meas, Extent.C vert, Extent.C horiz)

This is typesafe whenever the input
is based on one of the five admissible extent types.
We only need the strict constraints
when constructing matrices of arbitrary extent type,
i.e. this almost only concerns 'Numeric.LAPACK.Matrix.Extent.fromSquare'.
-}
class (Measure meas, C tag) => Measured meas tag where
   switchMeasured :: f Shape Small -> f Size Small -> f Size Big -> f meas tag
instance (tag ~ Small) => Measured Shape tag where
   switchMeasured :: forall (f :: * -> * -> *).
f Shape Small -> f Size Small -> f Size Big -> f Shape tag
switchMeasured f Shape Small
f f Size Small
_ f Size Big
_ = f Shape tag
f Shape Small
f
instance (C tag) => Measured Size tag where
   switchMeasured :: forall (f :: * -> * -> *).
f Shape Small -> f Size Small -> f Size Big -> f Size tag
switchMeasured f Shape Small
_ = f Size Small -> f Size Big -> f Size tag
forall tag (f :: * -> *). C tag => f Small -> f Big -> f tag
forall (f :: * -> *). f Small -> f Big -> f tag
switchTag

{-
Alternative set of instances:

instance (Measure meas) => Measured meas Small where
instance (meas ~ Size) => Measured meas Big where
-}


newtype RotRight3 f c a b = RotRight3 {forall (f :: * -> * -> * -> *) c a b. RotRight3 f c a b -> f a b c
getRotRight3 :: f a b c}

switchTagTriple ::
   (Measured meas vert, Measured meas horiz) =>
   f Shape Small Small -> f Size Small Small -> f Size Small Big ->
   f Size Big Small -> f Size Big Big -> f meas vert horiz
switchTagTriple :: forall meas vert horiz (f :: * -> * -> * -> *).
(Measured meas vert, Measured meas horiz) =>
f Shape Small Small
-> f Size Small Small
-> f Size Small Big
-> f Size Big Small
-> f Size Big Big
-> f meas vert horiz
switchTagTriple f Shape Small Small
fSquare f Size Small Small
fLiberalSquare f Size Small Big
fWide f Size Big Small
fTall f Size Big Big
fGeneral =
   RotRight3 f horiz meas vert -> f meas vert horiz
forall (f :: * -> * -> * -> *) c a b. RotRight3 f c a b -> f a b c
getRotRight3 (RotRight3 f horiz meas vert -> f meas vert horiz)
-> RotRight3 f horiz meas vert -> f meas vert horiz
forall a b. (a -> b) -> a -> b
$
   RotRight3 f horiz Shape Small
-> RotRight3 f horiz Size Small
-> RotRight3 f horiz Size Big
-> RotRight3 f horiz meas vert
forall meas tag (f :: * -> * -> *).
Measured meas tag =>
f Shape Small -> f Size Small -> f Size Big -> f meas tag
forall (f :: * -> * -> *).
f Shape Small -> f Size Small -> f Size Big -> f meas vert
switchMeasured
      (f Shape Small horiz -> RotRight3 f horiz Shape Small
forall (f :: * -> * -> * -> *) c a b. f a b c -> RotRight3 f c a b
RotRight3 (f Shape Small horiz -> RotRight3 f horiz Shape Small)
-> f Shape Small horiz -> RotRight3 f horiz Shape Small
forall a b. (a -> b) -> a -> b
$ f Shape Small Small -> f Shape Small Big -> f Shape Small horiz
forall tag (f :: * -> *). C tag => f Small -> f Big -> f tag
forall (f :: * -> *). f Small -> f Big -> f horiz
switchTag f Shape Small Small
fSquare f Shape Small Big
forall meas vert horiz (f :: * -> * -> * -> *).
(Measure meas, C vert, C horiz) =>
f meas vert horiz
errorTagTriple)
      (f Size Small horiz -> RotRight3 f horiz Size Small
forall (f :: * -> * -> * -> *) c a b. f a b c -> RotRight3 f c a b
RotRight3 (f Size Small horiz -> RotRight3 f horiz Size Small)
-> f Size Small horiz -> RotRight3 f horiz Size Small
forall a b. (a -> b) -> a -> b
$ f Size Small Small -> f Size Small Big -> f Size Small horiz
forall tag (f :: * -> *). C tag => f Small -> f Big -> f tag
forall (f :: * -> *). f Small -> f Big -> f horiz
switchTag f Size Small Small
fLiberalSquare f Size Small Big
fWide)
      (f Size Big horiz -> RotRight3 f horiz Size Big
forall (f :: * -> * -> * -> *) c a b. f a b c -> RotRight3 f c a b
RotRight3 (f Size Big horiz -> RotRight3 f horiz Size Big)
-> f Size Big horiz -> RotRight3 f horiz Size Big
forall a b. (a -> b) -> a -> b
$ f Size Big Small -> f Size Big Big -> f Size Big horiz
forall tag (f :: * -> *). C tag => f Small -> f Big -> f tag
forall (f :: * -> *). f Small -> f Big -> f horiz
switchTag f Size Big Small
fTall f Size Big Big
fGeneral)


type family MeasureTarget meas sh
type instance MeasureTarget Shape sh = sh
type instance MeasureTarget Size sh = Int

type family Dimension meas height width
type instance Dimension Shape height width = height
type instance Dimension Size height width = (height, width)


data Cons_ height width meas vert horiz =
   Cons {
      forall height width meas vert horiz.
Cons_ height width meas vert horiz
-> (MeasureTarget meas height ~ MeasureTarget meas width) =>
   Dimension meas height width -> Extent meas vert horiz height width
getCons ::
         (MeasureTarget meas height ~ MeasureTarget meas width) =>
         Dimension meas height width -> Extent meas vert horiz height width
   }

consChecked ::
   (Measured meas vert, Measured meas horiz) =>
   (Shape.C height, Shape.C width) =>
   (MeasureTarget meas height ~ MeasureTarget meas width) =>
   Dimension meas height width ->
   Extent meas vert horiz height width
consChecked :: forall meas vert horiz height width.
(Measured meas vert, Measured meas horiz, C height, C width,
 MeasureTarget meas height ~ MeasureTarget meas width) =>
Dimension meas height width -> Extent meas vert horiz height width
consChecked =
   Cons_ height width meas vert horiz
-> (MeasureTarget meas height ~ MeasureTarget meas width) =>
   Dimension meas height width -> Extent meas vert horiz height width
forall height width meas vert horiz.
Cons_ height width meas vert horiz
-> (MeasureTarget meas height ~ MeasureTarget meas width) =>
   Dimension meas height width -> Extent meas vert horiz height width
getCons (Cons_ height width meas vert horiz
 -> (MeasureTarget meas height ~ MeasureTarget meas width) =>
    Dimension meas height width -> Extent meas vert horiz height width)
-> Cons_ height width meas vert horiz
-> (MeasureTarget meas height ~ MeasureTarget meas width) =>
   Dimension meas height width -> Extent meas vert horiz height width
forall a b. (a -> b) -> a -> b
$
   Cons_ height width Shape Small Small
-> Cons_ height width Size Small Small
-> Cons_ height width Size Small Big
-> Cons_ height width Size Big Small
-> Cons_ height width Size Big Big
-> Cons_ height width meas vert horiz
forall meas vert horiz (f :: * -> * -> * -> *).
(Measured meas vert, Measured meas horiz) =>
f Shape Small Small
-> f Size Small Small
-> f Size Small Big
-> f Size Big Small
-> f Size Big Big
-> f meas vert horiz
switchTagTriple
      (((MeasureTarget Shape height ~ MeasureTarget Shape width) =>
 Dimension Shape height width
 -> Extent Shape Small Small height width)
-> Cons_ height width Shape Small Small
forall height width meas vert horiz.
((MeasureTarget meas height ~ MeasureTarget meas width) =>
 Dimension meas height width -> Extent meas vert horiz height width)
-> Cons_ height width meas vert horiz
Cons height -> Extent Shape Small Small height height
(MeasureTarget Shape height ~ MeasureTarget Shape width) =>
Dimension Shape height width
-> Extent Shape Small Small height width
Dimension Shape height width
-> Extent Shape Small Small height width
forall height. height -> Extent Shape Small Small height height
Extent.Square)
      (((MeasureTarget Size height ~ MeasureTarget Size width) =>
 Dimension Size height width
 -> Extent Size Small Small height width)
-> Cons_ height width Size Small Small
forall height width meas vert horiz.
((MeasureTarget meas height ~ MeasureTarget meas width) =>
 Dimension meas height width -> Extent meas vert horiz height width)
-> Cons_ height width meas vert horiz
Cons (((MeasureTarget Size height ~ MeasureTarget Size width) =>
  Dimension Size height width
  -> Extent Size Small Small height width)
 -> Cons_ height width Size Small Small)
-> ((MeasureTarget Size height ~ MeasureTarget Size width) =>
    Dimension Size height width
    -> Extent Size Small Small height width)
-> Cons_ height width Size Small Small
forall a b. (a -> b) -> a -> b
$ \(height
height, width
width) ->
         if height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== width -> Int
forall sh. C sh => sh -> Int
Shape.size width
width
            then height -> width -> Extent Size Small Small height width
forall height width. height -> width -> LiberalSquare height width
Extent.liberalSquare height
height width
width
            else [Char] -> Extent Size Small Small height width
forall a. HasCallStack => [Char] -> a
error [Char]
"Extent.liberalSquare: height and width size differ")
      (((MeasureTarget Size height ~ MeasureTarget Size width) =>
 Dimension Size height width -> Extent Size Small Big height width)
-> Cons_ height width Size Small Big
forall height width meas vert horiz.
((MeasureTarget meas height ~ MeasureTarget meas width) =>
 Dimension meas height width -> Extent meas vert horiz height width)
-> Cons_ height width meas vert horiz
Cons (((MeasureTarget Size height ~ MeasureTarget Size width) =>
  Dimension Size height width -> Extent Size Small Big height width)
 -> Cons_ height width Size Small Big)
-> ((MeasureTarget Size height ~ MeasureTarget Size width) =>
    Dimension Size height width -> Extent Size Small Big height width)
-> Cons_ height width Size Small Big
forall a b. (a -> b) -> a -> b
$ \(height
height, width
width) ->
         if height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= width -> Int
forall sh. C sh => sh -> Int
Shape.size width
width
            then height -> width -> Extent Size Small Big height width
forall height width. height -> width -> Wide height width
Extent.wide height
height width
width
            else [Char] -> Extent Size Small Big height width
forall a. HasCallStack => [Char] -> a
error [Char]
"Extent.wide: width smaller than height")
      (((MeasureTarget Size height ~ MeasureTarget Size width) =>
 Dimension Size height width -> Extent Size Big Small height width)
-> Cons_ height width Size Big Small
forall height width meas vert horiz.
((MeasureTarget meas height ~ MeasureTarget meas width) =>
 Dimension meas height width -> Extent meas vert horiz height width)
-> Cons_ height width meas vert horiz
Cons (((MeasureTarget Size height ~ MeasureTarget Size width) =>
  Dimension Size height width -> Extent Size Big Small height width)
 -> Cons_ height width Size Big Small)
-> ((MeasureTarget Size height ~ MeasureTarget Size width) =>
    Dimension Size height width -> Extent Size Big Small height width)
-> Cons_ height width Size Big Small
forall a b. (a -> b) -> a -> b
$ \(height
height, width
width) ->
         if height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= width -> Int
forall sh. C sh => sh -> Int
Shape.size width
width
            then height -> width -> Extent Size Big Small height width
forall height width. height -> width -> Tall height width
Extent.tall height
height width
width
            else [Char] -> Extent Size Big Small height width
forall a. HasCallStack => [Char] -> a
error [Char]
"Extent.tall: height smaller than width")
      (((MeasureTarget Size height ~ MeasureTarget Size width) =>
 Dimension Size height width -> Extent Size Big Big height width)
-> Cons_ height width Size Big Big
forall height width meas vert horiz.
((MeasureTarget meas height ~ MeasureTarget meas width) =>
 Dimension meas height width -> Extent meas vert horiz height width)
-> Cons_ height width meas vert horiz
Cons (((MeasureTarget Size height ~ MeasureTarget Size width) =>
  Dimension Size height width -> Extent Size Big Big height width)
 -> Cons_ height width Size Big Big)
-> ((MeasureTarget Size height ~ MeasureTarget Size width) =>
    Dimension Size height width -> Extent Size Big Big height width)
-> Cons_ height width Size Big Big
forall a b. (a -> b) -> a -> b
$ (height -> width -> Extent Size Big Big height width)
-> (height, width) -> Extent Size Big Big height width
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry height -> width -> Extent Size Big Big height width
forall height width. height -> width -> General height width
Extent.general)


unifiers ::
   (Extent.Measure measA, Extent.C vertA, Extent.C horizA,
    Extent.Measure measB, Extent.C vertB, Extent.C horizB) =>
   (Extent.MultiplyMeasure measA measB ~ measC) =>
   (Extent.Multiply vertA vertB ~ vertC) =>
   (Extent.Multiply horizA horizB ~ horizC) =>
   Extent measA vertA horizA height fuse ->
   Extent measB vertB horizB fuse width ->
   ((Extent.MeasureFact measC, Extent.TagFact vertC, Extent.TagFact horizC),
    (Map measA vertA horizA measC vertC horizC height fuse,
     Map measB vertB horizB measC vertC horizC fuse width))
unifiers :: forall measA vertA horizA measB vertB horizB measC vertC horizC
       height fuse width.
(Measure measA, C vertA, C horizA, Measure measB, C vertB,
 C horizB, MultiplyMeasure measA measB ~ measC,
 Multiply vertA vertB ~ vertC, Multiply horizA horizB ~ horizC) =>
Extent measA vertA horizA height fuse
-> Extent measB vertB horizB fuse width
-> ((MeasureFact measC, TagFact vertC, TagFact horizC),
    (Map measA vertA horizA measC vertC horizC height fuse,
     Map measB vertB horizB measC vertC horizC fuse width))
unifiers Extent measA vertA horizA height fuse
a Extent measB vertB horizB fuse width
b =
   ((MeasureFact measA
-> MeasureFact measB -> MeasureFact (MultiplyMeasure measA measB)
forall a b.
MeasureFact a -> MeasureFact b -> MeasureFact (MultiplyMeasure a b)
Extent.multiplyMeasureLaw (Extent measA vertA horizA height fuse -> MeasureFact measA
forall meas vert horiz height width.
Measure meas =>
Extent meas vert horiz height width -> MeasureFact meas
Extent.measureFact Extent measA vertA horizA height fuse
a) (Extent measB vertB horizB fuse width -> MeasureFact measB
forall meas vert horiz height width.
Measure meas =>
Extent meas vert horiz height width -> MeasureFact meas
Extent.measureFact Extent measB vertB horizB fuse width
b),
     TagFact vertA -> TagFact vertB -> TagFact (Multiply vertA vertB)
forall a b. TagFact a -> TagFact b -> TagFact (Multiply a b)
Extent.multiplyTagLaw (Extent measA vertA horizA height fuse -> TagFact vertA
forall vert meas horiz height width.
C vert =>
Extent meas vert horiz height width -> TagFact vert
Extent.heightFact Extent measA vertA horizA height fuse
a) (Extent measB vertB horizB fuse width -> TagFact vertB
forall vert meas horiz height width.
C vert =>
Extent meas vert horiz height width -> TagFact vert
Extent.heightFact Extent measB vertB horizB fuse width
b),
     TagFact horizA
-> TagFact horizB -> TagFact (Multiply horizA horizB)
forall a b. TagFact a -> TagFact b -> TagFact (Multiply a b)
Extent.multiplyTagLaw (Extent measA vertA horizA height fuse -> TagFact horizA
forall horiz meas vert height width.
C horiz =>
Extent meas vert horiz height width -> TagFact horiz
Extent.widthFact Extent measA vertA horizA height fuse
a) (Extent measB vertB horizB fuse width -> TagFact horizB
forall horiz meas vert height width.
C horiz =>
Extent meas vert horiz height width -> TagFact horiz
Extent.widthFact Extent measB vertB horizB fuse width
b)),
    (Map measA vertA horizA measC vertC horizC height fuse
-> Map measA vertA horizA measC vertC horizC height fuse
forall measA vertA horizA measB vertB horizB height width.
Map measA vertA horizA measB vertB horizB height width
-> Map measA vertA horizA measB vertB horizB height width
Map (Map measA vertA horizA measC vertC horizC height fuse
 -> Map measA vertA horizA measC vertC horizC height fuse)
-> Map measA vertA horizA measC vertC horizC height fuse
-> Map measA vertA horizA measC vertC horizC height fuse
forall a b. (a -> b) -> a -> b
$ (Extent measA vertA horizA height fuse
 -> Extent measB vertB horizB fuse width
 -> Extent measC vertC horizC height fuse)
-> Extent measB vertB horizB fuse width
-> Map measA vertA horizA measC vertC horizC height fuse
forall a b c. (a -> b -> c) -> b -> a -> c
flip Extent measA vertA horizA height fuse
-> Extent measB vertB horizB fuse width
-> Extent measC vertC horizC height fuse
Extent measA vertA horizA height fuse
-> Extent measB vertB horizB fuse width
-> Extent
     (MultiplyMeasure measA measB)
     (Multiply vertA vertB)
     (Multiply horizA horizB)
     height
     fuse
forall measA measB vertA horizA vertB horizB height fuse width.
(Measure measA, Measure measB, C vertA, C horizA, C vertB,
 C horizB) =>
Extent measA vertA horizA height fuse
-> Extent measB vertB horizB fuse width
-> Extent
     (MultiplyMeasure measA measB)
     (Multiply vertA vertB)
     (Multiply horizA horizB)
     height
     fuse
Extent.unifyLeft Extent measB vertB horizB fuse width
b, Map measB vertB horizB measC vertC horizC fuse width
-> Map measB vertB horizB measC vertC horizC fuse width
forall measA vertA horizA measB vertB horizB height width.
Map measA vertA horizA measB vertB horizB height width
-> Map measA vertA horizA measB vertB horizB height width
Map (Map measB vertB horizB measC vertC horizC fuse width
 -> Map measB vertB horizB measC vertC horizC fuse width)
-> Map measB vertB horizB measC vertC horizC fuse width
-> Map measB vertB horizB measC vertC horizC fuse width
forall a b. (a -> b) -> a -> b
$ Extent measA vertA horizA height fuse
-> Extent measB vertB horizB fuse width
-> Extent
     (MultiplyMeasure measA measB)
     (Multiply vertA vertB)
     (Multiply horizA horizB)
     fuse
     width
forall measA measB vertA horizA vertB horizB height fuse width.
(Measure measA, Measure measB, C vertA, C horizA, C vertB,
 C horizB) =>
Extent measA vertA horizA height fuse
-> Extent measB vertB horizB fuse width
-> Extent
     (MultiplyMeasure measA measB)
     (Multiply vertA vertB)
     (Multiply horizA horizB)
     fuse
     width
Extent.unifyRight Extent measA vertA horizA height fuse
a))