module Numeric.LAPACK.Matrix.Extent (
   Extent.C(switchTag), Small, Big,
   Extent.Measure(switchMeasure), Shape, Size,
   Measured(switchMeasured),
   Extent.Extent,
   Map,
   Extent.height,
   Extent.width,
   Extent.squareSize,
   Extent.dimensions,
   Extent.transpose,
   Extent.fuse,
   Extent.MultiplyMeasure,

   Extent.square,

   toGeneral,
   fromSquare,
   fromSquareLiberal,
   fromLiberalSquare,
   generalizeTall,
   generalizeWide,
   weakenTall,
   weakenWide,

   Extent.AppendMode,
   Extent.appendSame,
   Extent.appendLeft,
   Extent.appendRight,
   Extent.Append,
   Extent.appendAny,
   ) where

import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import Numeric.LAPACK.Matrix.Extent.Strict (Map(Map), Measured(..))
import Numeric.LAPACK.Matrix.Extent.Private
         (C, Measure, Small, Big, Shape, Size)


toGeneral ::
   (Measure meas, C vert, C horiz) =>
   Map meas vert horiz Size Big Big height width
toGeneral :: Map meas vert horiz Size Big Big height width
toGeneral = Map meas vert horiz Size Big Big height width
-> Map meas vert horiz Size Big Big height 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 meas vert horiz Size Big Big height width
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas vert horiz height width -> General height width
Extent.toGeneral

fromSquare ::
   (Measured meas vert, Measured meas horiz) =>
   Map Shape Small Small meas vert horiz size size
fromSquare :: Map Shape Small Small meas vert horiz size size
fromSquare = Map Shape Small Small meas vert horiz size size
-> Map Shape Small Small meas vert horiz size size
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 Shape Small Small meas vert horiz size size
forall meas vert horiz size.
(Measure meas, C vert, C horiz) =>
Square size -> Extent meas vert horiz size size
Extent.fromSquare

fromSquareLiberal ::
   (Measured meas vert, Measured meas horiz) =>
   Map Shape Small Small meas vert horiz height width
fromSquareLiberal :: Map Shape Small Small meas vert horiz height width
fromSquareLiberal = Map Shape Small Small meas vert horiz height width
-> Map Shape Small Small meas vert horiz height 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 Shape Small Small meas vert horiz height width
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent Shape Small Small height width
-> Extent meas vert horiz height width
Extent.fromSquareLiberal

fromLiberalSquare ::
   (C vert, C horiz) =>
   Map Size Small Small Size vert horiz height width
fromLiberalSquare :: Map Size Small Small Size vert horiz height width
fromLiberalSquare = Map Size Small Small Size vert horiz height width
-> Map Size Small Small Size vert horiz height 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 Size Small Small Size vert horiz height width
forall vert horiz height width.
(C vert, C horiz) =>
LiberalSquare height width -> Extent Size vert horiz height width
Extent.fromLiberalSquare

generalizeTall ::
   (Measure meas, C vert, C horiz) =>
   Map meas vert Small Size vert horiz height width
generalizeTall :: Map meas vert Small Size vert horiz height width
generalizeTall = Map meas vert Small Size vert horiz height width
-> Map meas vert Small Size vert horiz height 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 meas vert Small Size vert horiz height width
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas vert Small height width
-> Extent Size vert horiz height width
Extent.generalizeTall

generalizeWide ::
   (Measure meas, C vert, C horiz) =>
   Map meas Small horiz Size vert horiz height width
generalizeWide :: Map meas Small horiz Size vert horiz height width
generalizeWide = Map meas Small horiz Size vert horiz height width
-> Map meas Small horiz Size vert horiz height 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 meas Small horiz Size vert horiz height width
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas Small horiz height width
-> Extent Size vert horiz height width
Extent.generalizeWide

weakenTall ::
   (Measured meas horiz, C vert) =>
   Map meas vert Small meas vert horiz height width
weakenTall :: Map meas vert Small meas vert horiz height width
weakenTall = Map meas vert Small meas vert horiz height width
-> Map meas vert Small meas vert horiz height 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 meas vert Small meas vert horiz height width
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas vert Small height width
-> Extent meas vert horiz height width
Extent.weakenTall

weakenWide ::
   (Measured meas vert, C horiz) =>
   Map meas Small horiz meas vert horiz height width
weakenWide :: Map meas Small horiz meas vert horiz height width
weakenWide = Map meas Small horiz meas vert horiz height width
-> Map meas Small horiz meas vert horiz height 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 meas Small horiz meas vert horiz height width
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas Small horiz height width
-> Extent meas vert horiz height width
Extent.weakenWide