module Numeric.LAPACK.Matrix.Extent (
   Extent.C(switchTag),
   Extent.Extent,
   Map,
   Small, Big,
   Extent.height,
   Extent.width,
   Extent.squareSize,
   Extent.dimensions,
   Extent.transpose,
   Extent.fuse,

   Extent.square,

   toGeneral,
   fromSquare,
   fromSquareLiberal,
   generalizeTall,
   generalizeWide,
   Extent.GeneralTallWide,

   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.Private (C, Small, Big, Map(Map))


toGeneral :: (C vert, C horiz) => Map vert horiz Big Big height width
toGeneral :: Map vert horiz Big Big height width
toGeneral = (Extent vert horiz height width -> Extent Big Big height width)
-> Map vert horiz Big Big height width
forall vertA horizA vertB horizB height width.
(Extent vertA horizA height width
 -> Extent vertB horizB height width)
-> Map vertA horizA vertB horizB height width
Map Extent vert horiz height width -> Extent Big Big height width
forall vert horiz height width.
(C vert, C horiz) =>
Extent vert horiz height width -> General height width
Extent.toGeneral

fromSquare :: (C vert, C horiz) => Map Small Small vert horiz size size
fromSquare :: Map Small Small vert horiz size size
fromSquare = (Extent Small Small size size -> Extent vert horiz size size)
-> Map Small Small vert horiz size size
forall vertA horizA vertB horizB height width.
(Extent vertA horizA height width
 -> Extent vertB horizB height width)
-> Map vertA horizA vertB horizB height width
Map Extent Small Small size size -> Extent vert horiz size size
forall vert horiz size.
(C vert, C horiz) =>
Square size -> Extent vert horiz size size
Extent.fromSquare

fromSquareLiberal ::
   (C vert, C horiz) => Map Small Small vert horiz height width
fromSquareLiberal :: Map Small Small vert horiz height width
fromSquareLiberal = (Extent Small Small height width -> Extent vert horiz height width)
-> Map Small Small vert horiz height width
forall vertA horizA vertB horizB height width.
(Extent vertA horizA height width
 -> Extent vertB horizB height width)
-> Map vertA horizA vertB horizB height width
Map Extent Small Small height width -> Extent vert horiz height width
forall vert horiz height width.
(C vert, C horiz) =>
Extent Small Small height width -> Extent vert horiz height width
Extent.fromSquareLiberal

generalizeTall :: (C vert, C horiz) => Map vert Small vert horiz height width
generalizeTall :: Map vert Small vert horiz height width
generalizeTall = (Extent vert Small height width -> Extent vert horiz height width)
-> Map vert Small vert horiz height width
forall vertA horizA vertB horizB height width.
(Extent vertA horizA height width
 -> Extent vertB horizB height width)
-> Map vertA horizA vertB horizB height width
Map Extent vert Small height width -> Extent vert horiz height width
forall vert horiz height width.
(C vert, C horiz) =>
Extent vert Small height width -> Extent vert horiz height width
Extent.generalizeTall

generalizeWide :: (C vert, C horiz) => Map Small horiz vert horiz height width
generalizeWide :: Map Small horiz vert horiz height width
generalizeWide = (Extent Small horiz height width -> Extent vert horiz height width)
-> Map Small horiz vert horiz height width
forall vertA horizA vertB horizB height width.
(Extent vertA horizA height width
 -> Extent vertB horizB height width)
-> Map vertA horizA vertB horizB height width
Map Extent Small horiz height width -> Extent vert horiz height width
forall vert horiz height width.
(C vert, C horiz) =>
Extent Small horiz height width -> Extent vert horiz height width
Extent.generalizeWide