{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
-- |
-- Module      : Data.Massiv.Core.Index.Internal
-- Copyright   : (c) Alexey Kuleshevich 2018-2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Massiv.Core.Index.Internal
  ( Sz(SafeSz)
  , pattern Sz
  , pattern Sz1
  , type Sz1
  , unSz
  , zeroSz
  , oneSz
  , liftSz
  , liftSz2
  , consSz
  , unconsSz
  , snocSz
  , unsnocSz
  , setSzM
  , insertSzM
  , pullOutSzM
  , Dim(..)
  , Dimension(DimN)
  , pattern Dim1
  , pattern Dim2
  , pattern Dim3
  , pattern Dim4
  , pattern Dim5
  , IsIndexDimension
  , IsDimValid
  , ReportInvalidDim
  , Lower
  , Index(..)
  , Ix0(..)
  , type Ix1
  , pattern Ix1
  , IndexException(..)
  , SizeException(..)
  , ShapeException(..)
  , showsPrecWrapped
  ) where

import Control.DeepSeq
import Control.Exception (Exception(..), throw)
import Control.Monad.Catch (MonadThrow(..))
import Data.Coerce
import Data.Massiv.Core.Iterator
import Data.Typeable
import GHC.TypeLits

-- | `Sz` provides type safety guarantees preventing mixup with index, which is used for looking into
-- array cells, from the size, that describes total number of elements along each dimension in the
-- array. Moreover the @Sz@ constructor will prevent creation of invalid sizes with negative numbers.
--
-- @since 0.3.0
newtype Sz ix =
  SafeSz ix
  -- ^ Safe size constructor. It is unsafe to use it without making sure that it does not contain
  -- negative components. Use `Data.Massiv.Core.Index.Sz` pattern instead.
  --
  -- @since 0.3.0
  deriving (Sz ix -> Sz ix -> Bool
(Sz ix -> Sz ix -> Bool) -> (Sz ix -> Sz ix -> Bool) -> Eq (Sz ix)
forall ix. Eq ix => Sz ix -> Sz ix -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sz ix -> Sz ix -> Bool
$c/= :: forall ix. Eq ix => Sz ix -> Sz ix -> Bool
== :: Sz ix -> Sz ix -> Bool
$c== :: forall ix. Eq ix => Sz ix -> Sz ix -> Bool
Eq, Eq (Sz ix)
Eq (Sz ix)
-> (Sz ix -> Sz ix -> Ordering)
-> (Sz ix -> Sz ix -> Bool)
-> (Sz ix -> Sz ix -> Bool)
-> (Sz ix -> Sz ix -> Bool)
-> (Sz ix -> Sz ix -> Bool)
-> (Sz ix -> Sz ix -> Sz ix)
-> (Sz ix -> Sz ix -> Sz ix)
-> Ord (Sz ix)
Sz ix -> Sz ix -> Bool
Sz ix -> Sz ix -> Ordering
Sz ix -> Sz ix -> Sz ix
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall ix. Ord ix => Eq (Sz ix)
forall ix. Ord ix => Sz ix -> Sz ix -> Bool
forall ix. Ord ix => Sz ix -> Sz ix -> Ordering
forall ix. Ord ix => Sz ix -> Sz ix -> Sz ix
min :: Sz ix -> Sz ix -> Sz ix
$cmin :: forall ix. Ord ix => Sz ix -> Sz ix -> Sz ix
max :: Sz ix -> Sz ix -> Sz ix
$cmax :: forall ix. Ord ix => Sz ix -> Sz ix -> Sz ix
>= :: Sz ix -> Sz ix -> Bool
$c>= :: forall ix. Ord ix => Sz ix -> Sz ix -> Bool
> :: Sz ix -> Sz ix -> Bool
$c> :: forall ix. Ord ix => Sz ix -> Sz ix -> Bool
<= :: Sz ix -> Sz ix -> Bool
$c<= :: forall ix. Ord ix => Sz ix -> Sz ix -> Bool
< :: Sz ix -> Sz ix -> Bool
$c< :: forall ix. Ord ix => Sz ix -> Sz ix -> Bool
compare :: Sz ix -> Sz ix -> Ordering
$ccompare :: forall ix. Ord ix => Sz ix -> Sz ix -> Ordering
$cp1Ord :: forall ix. Ord ix => Eq (Sz ix)
Ord, Sz ix -> ()
(Sz ix -> ()) -> NFData (Sz ix)
forall ix. NFData ix => Sz ix -> ()
forall a. (a -> ()) -> NFData a
rnf :: Sz ix -> ()
$crnf :: forall ix. NFData ix => Sz ix -> ()
NFData)

-- | A safe bidirectional pattern synonym for `Sz` construction that will make sure that none of
-- the size elements are negative.
--
-- @since 0.3.0
pattern Sz :: Index ix => ix -> Sz ix
pattern $bSz :: ix -> Sz ix
$mSz :: forall r ix. Index ix => Sz ix -> (ix -> r) -> (Void# -> r) -> r
Sz ix <- SafeSz ix where
        Sz ix
ix = ix -> Sz ix
forall ix. ix -> Sz ix
SafeSz ((Int -> Int) -> ix -> ix
forall ix. Index ix => (Int -> Int) -> ix -> ix
liftIndex (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0) ix
ix)
{-# COMPLETE Sz #-}

-- | 1-dimensional type synonym for size.
--
-- @since 0.3.0
type Sz1 = Sz Ix1

-- | 1-dimensional size constructor. Especially useful with literals: @(Sz1 5) == Sz (5 :: Int)@.
--
-- @since 0.3.0
pattern Sz1 :: Ix1 -> Sz1
pattern $bSz1 :: Int -> Sz1
$mSz1 :: forall r. Sz1 -> (Int -> r) -> (Void# -> r) -> r
Sz1 ix  <- SafeSz ix where
        Sz1 Int
ix = Int -> Sz1
forall ix. ix -> Sz ix
SafeSz (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
ix)
{-# COMPLETE Sz1 #-}


instance Index ix => Show (Sz ix) where
  showsPrec :: Int -> Sz ix -> ShowS
showsPrec Int
n sz :: Sz ix
sz@(SafeSz ix
usz) = Int -> ShowS -> ShowS
showsPrecWrapped Int
n (String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++)
    where
      str :: String
str =
        String
"Sz" String -> ShowS
forall a. [a] -> [a] -> [a]
++
        case Dim -> Int
unDim (Sz ix -> Dim
forall ix (proxy :: * -> *). Index ix => proxy ix -> Dim
dimensions Sz ix
sz) of
          Int
1 -> String
"1 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ix -> String
forall a. Show a => a -> String
show ix
usz
          Int
_ -> String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ix -> ShowS
forall a. Show a => a -> ShowS
shows ix
usz String
")"

instance (Num ix, Index ix) => Num (Sz ix) where
  + :: Sz ix -> Sz ix -> Sz ix
(+) Sz ix
x Sz ix
y = ix -> Sz ix
forall ix. Index ix => ix -> Sz ix
Sz (Sz ix -> ix
coerce Sz ix
x ix -> ix -> ix
forall a. Num a => a -> a -> a
+ Sz ix -> ix
coerce Sz ix
y)
  {-# INLINE (+) #-}
  (-) Sz ix
x Sz ix
y = ix -> Sz ix
forall ix. Index ix => ix -> Sz ix
Sz (Sz ix -> ix
coerce Sz ix
x ix -> ix -> ix
forall a. Num a => a -> a -> a
- Sz ix -> ix
coerce Sz ix
y)
  {-# INLINE (-) #-}
  * :: Sz ix -> Sz ix -> Sz ix
(*) Sz ix
x Sz ix
y = ix -> Sz ix
forall ix. ix -> Sz ix
SafeSz (Sz ix -> ix
coerce Sz ix
x ix -> ix -> ix
forall a. Num a => a -> a -> a
* Sz ix -> ix
coerce Sz ix
y)
  {-# INLINE (*) #-}
  abs :: Sz ix -> Sz ix
abs !Sz ix
x = Sz ix
x
  {-# INLINE abs #-}
  negate :: Sz ix -> Sz ix
negate !Sz ix
_x = Sz ix
0
  {-# INLINE negate #-}
  signum :: Sz ix -> Sz ix
signum Sz ix
x = ix -> Sz ix
forall ix. ix -> Sz ix
SafeSz (ix -> ix
forall a. Num a => a -> a
signum (Sz ix -> ix
coerce Sz ix
x))
  {-# INLINE signum #-}
  fromInteger :: Integer -> Sz ix
fromInteger = ix -> Sz ix
forall ix. Index ix => ix -> Sz ix
Sz (ix -> Sz ix) -> (Integer -> ix) -> Integer -> Sz ix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ix
forall a. Num a => Integer -> a
fromInteger
  {-# INLINE fromInteger #-}


-- | Function for unwrapping `Sz`.
--
-- ==== __Example__
--
-- >>> import Data.Massiv.Core.Index
-- >>> unSz $ Sz3 1 2 3
-- 1 :> 2 :. 3
--
-- @since 0.3.0
unSz :: Sz ix -> ix
unSz :: Sz ix -> ix
unSz (SafeSz ix
ix) = ix
ix
{-# INLINE unSz #-}

-- | An empty size with all elements in size equal to @0@.
--
-- ==== __Example__
--
-- >>> import Data.Massiv.Core.Index
-- >>> zeroSz :: Sz5
-- Sz (0 :> 0 :> 0 :> 0 :. 0)
--
-- @since 0.3.0
zeroSz :: Index ix => Sz ix
zeroSz :: Sz ix
zeroSz = ix -> Sz ix
forall ix. ix -> Sz ix
SafeSz (Int -> ix
forall ix. Index ix => Int -> ix
pureIndex Int
0)
{-# INLINE zeroSz #-}

-- | A singleton size with all elements in size equal to @1@.
--
-- ==== __Example__
--
-- >>> import Data.Massiv.Core.Index
-- >>> oneSz :: Sz3
-- Sz (1 :> 1 :. 1)
--
-- @since 0.3.0
oneSz :: Index ix => Sz ix
oneSz :: Sz ix
oneSz = ix -> Sz ix
forall ix. ix -> Sz ix
SafeSz (Int -> ix
forall ix. Index ix => Int -> ix
pureIndex Int
1)
{-# INLINE oneSz #-}


-- | Same as `liftIndex`, but for `Sz`
--
-- ==== __Example__
--
-- >>> import Data.Massiv.Core.Index
-- >>> liftSz succ (Sz2 2 3)
-- Sz (3 :. 4)
--
-- @since 0.4.0
liftSz :: Index ix => (Int -> Int) -> Sz ix -> Sz ix
liftSz :: (Int -> Int) -> Sz ix -> Sz ix
liftSz Int -> Int
f (SafeSz ix
ix) = ix -> Sz ix
forall ix. Index ix => ix -> Sz ix
Sz ((Int -> Int) -> ix -> ix
forall ix. Index ix => (Int -> Int) -> ix -> ix
liftIndex Int -> Int
f ix
ix)
{-# INLINE liftSz #-}

-- | Same as `liftIndex2`, but for `Sz`
--
-- ==== __Example__
--
-- >>> import Data.Massiv.Core.Index
-- >>> liftSz2 (-) (Sz2 2 3) (Sz2 3 1)
-- Sz (0 :. 2)
--
-- @since 0.4.3
liftSz2 :: Index ix => (Int -> Int -> Int) -> Sz ix -> Sz ix -> Sz ix
liftSz2 :: (Int -> Int -> Int) -> Sz ix -> Sz ix -> Sz ix
liftSz2 Int -> Int -> Int
f Sz ix
sz1 Sz ix
sz2 = ix -> Sz ix
forall ix. Index ix => ix -> Sz ix
Sz ((Int -> Int -> Int) -> ix -> ix -> ix
forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 Int -> Int -> Int
f (Sz ix -> ix
coerce Sz ix
sz1) (Sz ix -> ix
coerce Sz ix
sz2))
{-# INLINE liftSz2 #-}


-- | Same as `consDim`, but for `Sz`
--
-- ==== __Example__
--
-- >>> import Data.Massiv.Core.Index
-- >>> consSz (Sz1 1) (Sz2 2 3) :: Sz3
-- Sz (1 :> 2 :. 3)
--
-- @since 0.3.0
consSz :: Index ix => Sz1 -> Sz (Lower ix) -> Sz ix
consSz :: Sz1 -> Sz (Lower ix) -> Sz ix
consSz (SafeSz Int
i) (SafeSz Lower ix
ix) = ix -> Sz ix
forall ix. ix -> Sz ix
SafeSz (Int -> Lower ix -> ix
forall ix. Index ix => Int -> Lower ix -> ix
consDim Int
i Lower ix
ix)
{-# INLINE consSz #-}


-- | Same as `snocDim`, but for `Sz`
--
-- ==== __Example__
--
-- >>> import Data.Massiv.Core.Index
-- >>> snocSz (Sz2 2 3) (Sz1 1) :: Sz3
-- Sz (2 :> 3 :. 1)
--
-- @since 0.3.0
snocSz :: Index ix => Sz (Lower ix) -> Sz1 -> Sz ix
snocSz :: Sz (Lower ix) -> Sz1 -> Sz ix
snocSz (SafeSz Lower ix
i) (SafeSz Int
ix) = ix -> Sz ix
forall ix. ix -> Sz ix
SafeSz (Lower ix -> Int -> ix
forall ix. Index ix => Lower ix -> Int -> ix
snocDim Lower ix
i Int
ix)
{-# INLINE snocSz #-}

-- | Same as `setDimM`, but for `Sz`
--
-- ==== __Example__
--
-- >>> import Data.Massiv.Core.Index
-- >>> setSzM (Sz2 2 3) 2 (Sz1 1) :: IO Sz2
-- Sz (1 :. 3)
-- >>> setSzM (Sz2 2 3) 3 (Sz1 1) :: IO Sz2
-- *** Exception: IndexDimensionException: (Dim 3) for (2 :. 3)
--
-- @since 0.3.0
setSzM :: (MonadThrow m, Index ix) => Sz ix -> Dim -> Sz Int -> m (Sz ix)
setSzM :: Sz ix -> Dim -> Sz1 -> m (Sz ix)
setSzM (SafeSz ix
sz) Dim
dim (SafeSz Int
sz1) = ix -> Sz ix
forall ix. ix -> Sz ix
SafeSz (ix -> Sz ix) -> m ix -> m (Sz ix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ix -> Dim -> Int -> m ix
forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM ix
sz Dim
dim Int
sz1
{-# INLINE setSzM #-}

-- | Same as `insertDimM`, but for `Sz`
--
-- ==== __Example__
--
-- >>> import Data.Massiv.Core.Index
-- >>> insertSzM (Sz2 2 3) 3 (Sz1 1) :: IO Sz3
-- Sz (1 :> 2 :. 3)
-- >>> insertSzM (Sz2 2 3) 4 (Sz1 1) :: IO Sz3
-- *** Exception: IndexDimensionException: (Dim 4) for (2 :. 3)
--
-- @since 0.3.0
insertSzM :: (MonadThrow m, Index ix) => Sz (Lower ix) -> Dim -> Sz Int -> m (Sz ix)
insertSzM :: Sz (Lower ix) -> Dim -> Sz1 -> m (Sz ix)
insertSzM (SafeSz Lower ix
sz) Dim
dim (SafeSz Int
sz1) = ix -> Sz ix
forall ix. ix -> Sz ix
SafeSz (ix -> Sz ix) -> m ix -> m (Sz ix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lower ix -> Dim -> Int -> m ix
forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
Lower ix -> Dim -> Int -> m ix
insertDimM Lower ix
sz Dim
dim Int
sz1
{-# INLINE insertSzM #-}

-- | Same as `unconsDim`, but for `Sz`
--
-- ==== __Example__
--
-- >>> import Data.Massiv.Core.Index
-- >>> unconsSz $ Sz3 1 2 3
-- (Sz1 1,Sz (2 :. 3))
--
-- @since 0.3.0
unconsSz :: Index ix => Sz ix -> (Sz1, Sz (Lower ix))
unconsSz :: Sz ix -> (Sz1, Sz (Lower ix))
unconsSz (SafeSz ix
sz) = (Int, Lower ix) -> (Sz1, Sz (Lower ix))
coerce (ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
sz)
{-# INLINE unconsSz #-}

-- | Same as `unsnocDim`, but for `Sz`
--
-- ==== __Example__
--
-- >>> import Data.Massiv.Core.Index
-- >>> unsnocSz $ Sz3 1 2 3
-- (Sz (1 :. 2),Sz1 3)
--
-- @since 0.3.0
unsnocSz :: Index ix => Sz ix -> (Sz (Lower ix), Sz1)
unsnocSz :: Sz ix -> (Sz (Lower ix), Sz1)
unsnocSz (SafeSz ix
sz) = (Lower ix, Int) -> (Sz (Lower ix), Sz1)
coerce (ix -> (Lower ix, Int)
forall ix. Index ix => ix -> (Lower ix, Int)
unsnocDim ix
sz)
{-# INLINE unsnocSz #-}

-- | Same as `pullOutDim`, but for `Sz`
--
-- >>> import Data.Massiv.Core.Index
-- >>> pullOutSzM (Sz3 1 2 3) 3
-- (Sz1 1,Sz (2 :. 3))
-- >>> pullOutSzM (Sz3 1 2 3) 0
-- *** Exception: IndexDimensionException: (Dim 0) for (1 :> 2 :. 3)
--
-- @since 0.3.0
pullOutSzM :: (MonadThrow m, Index ix) => Sz ix -> Dim -> m (Sz Ix1, Sz (Lower ix))
pullOutSzM :: Sz ix -> Dim -> m (Sz1, Sz (Lower ix))
pullOutSzM (SafeSz ix
sz) = ((Int, Lower ix) -> (Sz1, Sz (Lower ix)))
-> m (Int, Lower ix) -> m (Sz1, Sz (Lower ix))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Lower ix) -> (Sz1, Sz (Lower ix))
coerce (m (Int, Lower ix) -> m (Sz1, Sz (Lower ix)))
-> (Dim -> m (Int, Lower ix)) -> Dim -> m (Sz1, Sz (Lower ix))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix -> Dim -> m (Int, Lower ix)
forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> m (Int, Lower ix)
pullOutDimM ix
sz
{-# INLINE pullOutSzM #-}


-- | A way to select Array dimension at a value level.
--
-- @since 0.1.0
newtype Dim = Dim { Dim -> Int
unDim :: Int } deriving (Dim -> Dim -> Bool
(Dim -> Dim -> Bool) -> (Dim -> Dim -> Bool) -> Eq Dim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dim -> Dim -> Bool
$c/= :: Dim -> Dim -> Bool
== :: Dim -> Dim -> Bool
$c== :: Dim -> Dim -> Bool
Eq, Eq Dim
Eq Dim
-> (Dim -> Dim -> Ordering)
-> (Dim -> Dim -> Bool)
-> (Dim -> Dim -> Bool)
-> (Dim -> Dim -> Bool)
-> (Dim -> Dim -> Bool)
-> (Dim -> Dim -> Dim)
-> (Dim -> Dim -> Dim)
-> Ord Dim
Dim -> Dim -> Bool
Dim -> Dim -> Ordering
Dim -> Dim -> Dim
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dim -> Dim -> Dim
$cmin :: Dim -> Dim -> Dim
max :: Dim -> Dim -> Dim
$cmax :: Dim -> Dim -> Dim
>= :: Dim -> Dim -> Bool
$c>= :: Dim -> Dim -> Bool
> :: Dim -> Dim -> Bool
$c> :: Dim -> Dim -> Bool
<= :: Dim -> Dim -> Bool
$c<= :: Dim -> Dim -> Bool
< :: Dim -> Dim -> Bool
$c< :: Dim -> Dim -> Bool
compare :: Dim -> Dim -> Ordering
$ccompare :: Dim -> Dim -> Ordering
$cp1Ord :: Eq Dim
Ord, Integer -> Dim
Dim -> Dim
Dim -> Dim -> Dim
(Dim -> Dim -> Dim)
-> (Dim -> Dim -> Dim)
-> (Dim -> Dim -> Dim)
-> (Dim -> Dim)
-> (Dim -> Dim)
-> (Dim -> Dim)
-> (Integer -> Dim)
-> Num Dim
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Dim
$cfromInteger :: Integer -> Dim
signum :: Dim -> Dim
$csignum :: Dim -> Dim
abs :: Dim -> Dim
$cabs :: Dim -> Dim
negate :: Dim -> Dim
$cnegate :: Dim -> Dim
* :: Dim -> Dim -> Dim
$c* :: Dim -> Dim -> Dim
- :: Dim -> Dim -> Dim
$c- :: Dim -> Dim -> Dim
+ :: Dim -> Dim -> Dim
$c+ :: Dim -> Dim -> Dim
Num, Num Dim
Ord Dim
Num Dim -> Ord Dim -> (Dim -> Rational) -> Real Dim
Dim -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Dim -> Rational
$ctoRational :: Dim -> Rational
$cp2Real :: Ord Dim
$cp1Real :: Num Dim
Real, Enum Dim
Real Dim
Real Dim
-> Enum Dim
-> (Dim -> Dim -> Dim)
-> (Dim -> Dim -> Dim)
-> (Dim -> Dim -> Dim)
-> (Dim -> Dim -> Dim)
-> (Dim -> Dim -> (Dim, Dim))
-> (Dim -> Dim -> (Dim, Dim))
-> (Dim -> Integer)
-> Integral Dim
Dim -> Integer
Dim -> Dim -> (Dim, Dim)
Dim -> Dim -> Dim
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Dim -> Integer
$ctoInteger :: Dim -> Integer
divMod :: Dim -> Dim -> (Dim, Dim)
$cdivMod :: Dim -> Dim -> (Dim, Dim)
quotRem :: Dim -> Dim -> (Dim, Dim)
$cquotRem :: Dim -> Dim -> (Dim, Dim)
mod :: Dim -> Dim -> Dim
$cmod :: Dim -> Dim -> Dim
div :: Dim -> Dim -> Dim
$cdiv :: Dim -> Dim -> Dim
rem :: Dim -> Dim -> Dim
$crem :: Dim -> Dim -> Dim
quot :: Dim -> Dim -> Dim
$cquot :: Dim -> Dim -> Dim
$cp2Integral :: Enum Dim
$cp1Integral :: Real Dim
Integral, Int -> Dim
Dim -> Int
Dim -> [Dim]
Dim -> Dim
Dim -> Dim -> [Dim]
Dim -> Dim -> Dim -> [Dim]
(Dim -> Dim)
-> (Dim -> Dim)
-> (Int -> Dim)
-> (Dim -> Int)
-> (Dim -> [Dim])
-> (Dim -> Dim -> [Dim])
-> (Dim -> Dim -> [Dim])
-> (Dim -> Dim -> Dim -> [Dim])
-> Enum Dim
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Dim -> Dim -> Dim -> [Dim]
$cenumFromThenTo :: Dim -> Dim -> Dim -> [Dim]
enumFromTo :: Dim -> Dim -> [Dim]
$cenumFromTo :: Dim -> Dim -> [Dim]
enumFromThen :: Dim -> Dim -> [Dim]
$cenumFromThen :: Dim -> Dim -> [Dim]
enumFrom :: Dim -> [Dim]
$cenumFrom :: Dim -> [Dim]
fromEnum :: Dim -> Int
$cfromEnum :: Dim -> Int
toEnum :: Int -> Dim
$ctoEnum :: Int -> Dim
pred :: Dim -> Dim
$cpred :: Dim -> Dim
succ :: Dim -> Dim
$csucc :: Dim -> Dim
Enum, Dim -> ()
(Dim -> ()) -> NFData Dim
forall a. (a -> ()) -> NFData a
rnf :: Dim -> ()
$crnf :: Dim -> ()
NFData)

instance Show Dim where
  show :: Dim -> String
show (Dim Int
d) = String
"(Dim " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- | A way to select Array dimension at a type level.
--
-- @since 0.2.4
data Dimension (n :: Nat) where
  DimN :: (1 <= n, KnownNat n) => Dimension n

-- | Construct 1st dimension
--
-- @since 0.2.4
pattern Dim1 :: Dimension 1
pattern $bDim1 :: Dimension 1
$mDim1 :: forall r. Dimension 1 -> (Void# -> r) -> (Void# -> r) -> r
Dim1 = DimN

-- | Construct 2nd dimension
--
-- @since 0.2.4
pattern Dim2 :: Dimension 2
pattern $bDim2 :: Dimension 2
$mDim2 :: forall r. Dimension 2 -> (Void# -> r) -> (Void# -> r) -> r
Dim2 = DimN

-- | Construct 3rd dimension
--
-- @since 0.2.4
pattern Dim3 :: Dimension 3
pattern $bDim3 :: Dimension 3
$mDim3 :: forall r. Dimension 3 -> (Void# -> r) -> (Void# -> r) -> r
Dim3 = DimN

-- | Construct 4th dimension
--
-- @since 0.2.4
pattern Dim4 :: Dimension 4
pattern $bDim4 :: Dimension 4
$mDim4 :: forall r. Dimension 4 -> (Void# -> r) -> (Void# -> r) -> r
Dim4 = DimN

-- | Construct 5th dimension
--
-- @since 0.2.4
pattern Dim5 :: Dimension 5
pattern $bDim5 :: Dimension 5
$mDim5 :: forall r. Dimension 5 -> (Void# -> r) -> (Void# -> r) -> r
Dim5 = DimN


-- | A type level constraint that ensures index is indeed valid and that supplied dimension can be
-- safely used with it.
--
-- @since 0.2.4
type IsIndexDimension ix n = (1 <= n, n <= Dimensions ix, Index ix, KnownNat n)


-- | This type family will always point to a type for a dimension that is one lower than the type
-- argument.
--
-- @since 0.1.0
type family Lower ix :: *


type family ReportInvalidDim (dims :: Nat) (n :: Nat) isNotZero isLess :: Bool where
  ReportInvalidDim dims n True True = True
  ReportInvalidDim dims n True False =
    TypeError (Text "Dimension " :<>: ShowType n :<>: Text " is higher than " :<>:
                Text "the maximum expected " :<>: ShowType dims)
  ReportInvalidDim dims n False isLess =
    TypeError (Text "Zero dimensional indices are not supported")

type family IsDimValid ix n :: Bool where
  IsDimValid ix n = ReportInvalidDim (Dimensions ix) n (1 <=? n) (n <=? Dimensions ix)

-- | This is bread and butter of multi-dimensional array indexing. It is unlikely that any of the
-- functions in this class will be useful to a regular user, unless general algorithms are being
-- implemented that do span multiple dimensions.
class ( Eq ix
      , Ord ix
      , Show ix
      , NFData ix
      , Eq (Lower ix)
      , Ord (Lower ix)
      , Show (Lower ix)
      , NFData (Lower ix)
      , KnownNat (Dimensions ix)
      ) =>
      Index ix
  where
  -- | Type level information on how many dimensions this index has.
  --
  -- @since 0.2.0
  type Dimensions ix :: Nat

  -- | What is the dimensionality of this index.
  --
  -- @since 0.2.0
  dimensions :: proxy ix -> Dim

  -- | Total number of elements in an array of this size.
  --
  -- @since 0.1.0
  totalElem :: Sz ix -> Int

  -- | Prepend a dimension to the index
  --
  -- @since 0.1.0
  consDim :: Int -> Lower ix -> ix

  -- | Take a dimension from the index from the outside
  --
  -- @since 0.1.0
  unconsDim :: ix -> (Int, Lower ix)

  -- | Apppend a dimension to the index
  --
  -- @since 0.1.0
  snocDim :: Lower ix -> Int -> ix

  -- | Take a dimension from the index from the inside
  --
  -- @since 0.1.0
  unsnocDim :: ix -> (Lower ix, Int)

  -- | Pull out value at specified dimension from the index, thus also lowering it dimensionality.
  --
  -- @since 0.2.5
  pullOutDimM :: MonadThrow m => ix -> Dim -> m (Int, Lower ix)

  -- | Insert a dimension into the index
  insertDimM :: MonadThrow m => Lower ix -> Dim -> Int -> m ix

  -- | Extract the value index has at specified dimension.
  --
  -- @since 0.3.0
  getDimM :: MonadThrow m => ix -> Dim -> m Int
  getDimM ix
ix Dim
dim = (Int, ix) -> Int
forall a b. (a, b) -> a
fst ((Int, ix) -> Int) -> m (Int, ix) -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ix -> Dim -> (Int -> Int) -> m (Int, ix)
forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> (Int -> Int) -> m (Int, ix)
modifyDimM ix
ix Dim
dim Int -> Int
forall a. a -> a
id
  {-# INLINE [1] getDimM #-}

  -- | Set the value for an index at specified dimension.
  --
  -- @since 0.3.0
  setDimM :: MonadThrow m => ix -> Dim -> Int -> m ix
  setDimM ix
ix Dim
dim Int
i = (Int, ix) -> ix
forall a b. (a, b) -> b
snd ((Int, ix) -> ix) -> m (Int, ix) -> m ix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ix -> Dim -> (Int -> Int) -> m (Int, ix)
forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> (Int -> Int) -> m (Int, ix)
modifyDimM ix
ix Dim
dim (Int -> Int -> Int
forall a b. a -> b -> a
const Int
i)
  {-# INLINE [1] setDimM #-}

  -- | Update the value for an index at specified dimension and return the old value as
  -- well as the updated index.
  --
  -- @since 0.4.1
  modifyDimM :: MonadThrow m => ix -> Dim -> (Int -> Int) -> m (Int, ix)
  modifyDimM ix
ix Dim
dim Int -> Int
f = do
    Int
i <- ix -> Dim -> m Int
forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> m Int
getDimM ix
ix Dim
dim
    ix
ix' <- ix -> Dim -> Int -> m ix
forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM ix
ix Dim
dim (Int -> Int
f Int
i)
    (Int, ix) -> m (Int, ix)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, ix
ix')
  {-# INLINE [1] modifyDimM #-}

  -- | Lift an `Int` to any index by replicating the value as many times as there are dimensions.
  --
  -- @since 0.1.0
  pureIndex :: Int -> ix

  -- | Zip together two indices with a function
  --
  -- @since 0.1.0
  liftIndex2 :: (Int -> Int -> Int) -> ix -> ix -> ix

  -- | Map a function over an index
  --
  -- @since 0.1.0
  liftIndex :: (Int -> Int) -> ix -> ix
  liftIndex Int -> Int
f = (Int -> Int -> Int) -> ix -> ix -> ix
forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 (\Int
_ Int
i -> Int -> Int
f Int
i) (Int -> ix
forall ix. Index ix => Int -> ix
pureIndex Int
0)
  {-# INLINE [1] liftIndex #-}

  -- | Perform a left fold over the index
  foldlIndex :: (a -> Int -> a) -> a -> ix -> a
  default foldlIndex :: Index (Lower ix) =>
    (a -> Int -> a) -> a -> ix -> a
  foldlIndex a -> Int -> a
f !a
acc !ix
ix = (a -> Int -> a) -> a -> Lower ix -> a
forall ix a. Index ix => (a -> Int -> a) -> a -> ix -> a
foldlIndex a -> Int -> a
f (a -> Int -> a
f a
acc Int
i0) Lower ix
ixL
    where
      !(Int
i0, Lower ix
ixL) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
ix
  {-# INLINE [1] foldlIndex #-}

  -- TODO: implement in terms of foldlIndex and pull out of the class
  -- | Check whether index is positive and is within the size.
  --
  -- @since 0.1.0
  isSafeIndex ::
       Sz ix -- ^ Size
    -> ix -- ^ Index
    -> Bool
  default isSafeIndex :: Index (Lower ix) =>
    Sz ix -> ix -> Bool
  isSafeIndex Sz ix
sz !ix
ix = Sz1 -> Int -> Bool
forall ix. Index ix => Sz ix -> ix -> Bool
isSafeIndex Sz1
n0 Int
i0 Bool -> Bool -> Bool
&& Sz (Lower ix) -> Lower ix -> Bool
forall ix. Index ix => Sz ix -> ix -> Bool
isSafeIndex Sz (Lower ix)
szL Lower ix
ixL
    where
      !(Sz1
n0, Sz (Lower ix)
szL) = Sz ix -> (Sz1, Sz (Lower ix))
forall ix. Index ix => Sz ix -> (Sz1, Sz (Lower ix))
unconsSz Sz ix
sz
      !(Int
i0, Lower ix
ixL) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
ix
  {-# INLINE [1] isSafeIndex #-}

  -- | Convert linear index from size and index
  --
  -- @since 0.1.0
  toLinearIndex ::
       Sz ix -- ^ Size
    -> ix -- ^ Index
    -> Ix1
  default toLinearIndex :: Index (Lower ix) => Sz ix -> ix -> Ix1
  toLinearIndex (SafeSz ix
sz) !ix
ix = Sz (Lower ix) -> Lower ix -> Int
forall ix. Index ix => Sz ix -> ix -> Int
toLinearIndex (Lower ix -> Sz (Lower ix)
forall ix. ix -> Sz ix
SafeSz Lower ix
szL) Lower ix
ixL Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
    where
      !(Lower ix
szL, Int
n) = ix -> (Lower ix, Int)
forall ix. Index ix => ix -> (Lower ix, Int)
unsnocDim ix
sz
      !(Lower ix
ixL, Int
i) = ix -> (Lower ix, Int)
forall ix. Index ix => ix -> (Lower ix, Int)
unsnocDim ix
ix
  {-# INLINE [1] toLinearIndex #-}

  -- | Convert linear index from size and index with an accumulator. Currently is useless and will
  -- likley be removed in future versions.
  --
  -- @since 0.1.0
  toLinearIndexAcc :: Ix1 -> ix -> ix -> Ix1
  default toLinearIndexAcc :: Index (Lower ix) => Ix1 -> ix -> ix -> Ix1
  toLinearIndexAcc !Int
acc !ix
sz !ix
ix = Int -> Lower ix -> Lower ix -> Int
forall ix. Index ix => Int -> ix -> ix -> Int
toLinearIndexAcc (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Lower ix
szL Lower ix
ixL
    where
      !(Int
n, Lower ix
szL) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
sz
      !(Int
i, Lower ix
ixL) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
ix
  {-# INLINE [1] toLinearIndexAcc #-}

  -- | Compute an index from size and linear index
  --
  -- @since 0.1.0
  fromLinearIndex :: Sz ix -> Ix1 -> ix
  default fromLinearIndex :: Index (Lower ix) => Sz ix -> Ix1 -> ix
  fromLinearIndex (SafeSz ix
sz) Int
k = Int -> Lower ix -> ix
forall ix. Index ix => Int -> Lower ix -> ix
consDim Int
q Lower ix
ixL
    where
      !(Int
q, Lower ix
ixL) = Lower ix -> Int -> (Int, Lower ix)
forall ix. Index ix => ix -> Int -> (Int, ix)
fromLinearIndexAcc ((Int, Lower ix) -> Lower ix
forall a b. (a, b) -> b
snd (ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
sz)) Int
k
  {-# INLINE [1] fromLinearIndex #-}

  -- | Compute an index from size and linear index using an accumulator, thus trying to optimize for
  -- tail recursion while getting the index computed.
  --
  -- @since 0.1.0
  fromLinearIndexAcc :: ix -> Ix1 -> (Int, ix)
  default fromLinearIndexAcc :: Index (Lower ix) => ix -> Ix1 -> (Ix1, ix)
  fromLinearIndexAcc ix
ix' !Int
k = (Int
q, Int -> Lower ix -> ix
forall ix. Index ix => Int -> Lower ix -> ix
consDim Int
r Lower ix
ixL)
    where
      !(Int
m, Lower ix
ix) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
ix'
      !(Int
kL, Lower ix
ixL) = Lower ix -> Int -> (Int, Lower ix)
forall ix. Index ix => ix -> Int -> (Int, ix)
fromLinearIndexAcc Lower ix
ix Int
k
      !(Int
q, Int
r) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
kL Int
m
  {-# INLINE [1] fromLinearIndexAcc #-}

  -- | A way to make sure index is withing the bounds for the supplied size. Takes two functions
  -- that will be invoked whenever index (2nd arg) is outsize the supplied size (1st arg)
  --
  -- @since 0.1.0
  repairIndex ::
       Sz ix -- ^ Size
    -> ix -- ^ Index
    -> (Sz Int -> Int -> Int) -- ^ Repair when below zero
    -> (Sz Int -> Int -> Int) -- ^ Repair when higher than size
    -> ix
  default repairIndex :: Index (Lower ix) =>
    Sz ix -> ix -> (Sz Int -> Int -> Int) -> (Sz Int -> Int -> Int) -> ix
  repairIndex Sz ix
sz !ix
ix Sz1 -> Int -> Int
rBelow Sz1 -> Int -> Int
rOver =
    Int -> Lower ix -> ix
forall ix. Index ix => Int -> Lower ix -> ix
consDim (Sz1 -> Int -> (Sz1 -> Int -> Int) -> (Sz1 -> Int -> Int) -> Int
forall ix.
Index ix =>
Sz ix -> ix -> (Sz1 -> Int -> Int) -> (Sz1 -> Int -> Int) -> ix
repairIndex Sz1
n Int
i Sz1 -> Int -> Int
rBelow Sz1 -> Int -> Int
rOver) (Sz (Lower ix)
-> Lower ix
-> (Sz1 -> Int -> Int)
-> (Sz1 -> Int -> Int)
-> Lower ix
forall ix.
Index ix =>
Sz ix -> ix -> (Sz1 -> Int -> Int) -> (Sz1 -> Int -> Int) -> ix
repairIndex Sz (Lower ix)
szL Lower ix
ixL Sz1 -> Int -> Int
rBelow Sz1 -> Int -> Int
rOver)
    where
      !(Sz1
n, Sz (Lower ix)
szL) = Sz ix -> (Sz1, Sz (Lower ix))
forall ix. Index ix => Sz ix -> (Sz1, Sz (Lower ix))
unconsSz Sz ix
sz
      !(Int
i, Lower ix
ixL) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
ix
  {-# INLINE [1] repairIndex #-}

  -- | This function is what makes it possible to iterate over an array of any dimension.
  --
  -- @since 0.1.0
  iterM ::
       Monad m
    => ix -- ^ Start index
    -> ix -- ^ End index
    -> ix -- ^ Increment
    -> (Int -> Int -> Bool) -- ^ Continue iterating while predicate is True (eg. until end of row)
    -> a -- ^ Initial value for an accumulator
    -> (ix -> a -> m a) -- ^ Accumulator function
    -> m a
  default iterM :: (Index (Lower ix), Monad m) =>
    ix -> ix -> ix -> (Int -> Int -> Bool) -> a -> (ix -> a -> m a) -> m a
  iterM !ix
sIx ix
eIx !ix
incIx Int -> Int -> Bool
cond !a
acc ix -> a -> m a
f =
    Int
-> (Int -> Bool) -> (Int -> Int) -> a -> (Int -> a -> m a) -> m a
forall (m :: * -> *) a.
Monad m =>
Int
-> (Int -> Bool) -> (Int -> Int) -> a -> (Int -> a -> m a) -> m a
loopM Int
s (Int -> Int -> Bool
`cond` Int
e) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inc) a
acc ((Int -> a -> m a) -> m a) -> (Int -> a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ !Int
i !a
acc0 ->
      Lower ix
-> Lower ix
-> Lower ix
-> (Int -> Int -> Bool)
-> a
-> (Lower ix -> a -> m a)
-> m a
forall ix (m :: * -> *) a.
(Index ix, Monad m) =>
ix
-> ix -> ix -> (Int -> Int -> Bool) -> a -> (ix -> a -> m a) -> m a
iterM Lower ix
sIxL Lower ix
eIxL Lower ix
incIxL Int -> Int -> Bool
cond a
acc0 ((Lower ix -> a -> m a) -> m a) -> (Lower ix -> a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ !Lower ix
ix -> ix -> a -> m a
f (Int -> Lower ix -> ix
forall ix. Index ix => Int -> Lower ix -> ix
consDim Int
i Lower ix
ix)
    where
      !(Int
s, Lower ix
sIxL) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
sIx
      !(Int
e, Lower ix
eIxL) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
eIx
      !(Int
inc, Lower ix
incIxL) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
incIx
  {-# INLINE iterM #-}

  -- TODO: Implement in terms of iterM, benchmark it and remove from `Index`
  -- | Same as `iterM`, but don't bother with accumulator and return value.
  --
  -- @since 0.1.0
  iterM_ :: Monad m => ix -> ix -> ix -> (Int -> Int -> Bool) -> (ix -> m a) -> m ()
  default iterM_ :: (Index (Lower ix), Monad m) =>
    ix -> ix -> ix -> (Int -> Int -> Bool) -> (ix -> m a) -> m ()
  iterM_ !ix
sIx ix
eIx !ix
incIx Int -> Int -> Bool
cond ix -> m a
f =
    Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m a) -> m ()
loopM_ Int
s (Int -> Int -> Bool
`cond` Int
e) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inc) ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ !Int
i -> Lower ix
-> Lower ix
-> Lower ix
-> (Int -> Int -> Bool)
-> (Lower ix -> m a)
-> m ()
forall ix (m :: * -> *) a.
(Index ix, Monad m) =>
ix -> ix -> ix -> (Int -> Int -> Bool) -> (ix -> m a) -> m ()
iterM_ Lower ix
sIxL Lower ix
eIxL Lower ix
incIxL Int -> Int -> Bool
cond ((Lower ix -> m a) -> m ()) -> (Lower ix -> m a) -> m ()
forall a b. (a -> b) -> a -> b
$ \ !Lower ix
ix -> ix -> m a
f (Int -> Lower ix -> ix
forall ix. Index ix => Int -> Lower ix -> ix
consDim Int
i Lower ix
ix)
    where
      !(Int
s, Lower ix
sIxL) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
sIx
      !(Int
e, Lower ix
eIxL) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
eIx
      !(Int
inc, Lower ix
incIxL) = ix -> (Int, Lower ix)
forall ix. Index ix => ix -> (Int, Lower ix)
unconsDim ix
incIx
  {-# INLINE iterM_ #-}

-- | Zero-dimension, i.e. a scalar. Can't really be used directly as there is no instance of
-- `Index` for it, and is included for completeness.
data Ix0 = Ix0 deriving (Ix0 -> Ix0 -> Bool
(Ix0 -> Ix0 -> Bool) -> (Ix0 -> Ix0 -> Bool) -> Eq Ix0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ix0 -> Ix0 -> Bool
$c/= :: Ix0 -> Ix0 -> Bool
== :: Ix0 -> Ix0 -> Bool
$c== :: Ix0 -> Ix0 -> Bool
Eq, Eq Ix0
Eq Ix0
-> (Ix0 -> Ix0 -> Ordering)
-> (Ix0 -> Ix0 -> Bool)
-> (Ix0 -> Ix0 -> Bool)
-> (Ix0 -> Ix0 -> Bool)
-> (Ix0 -> Ix0 -> Bool)
-> (Ix0 -> Ix0 -> Ix0)
-> (Ix0 -> Ix0 -> Ix0)
-> Ord Ix0
Ix0 -> Ix0 -> Bool
Ix0 -> Ix0 -> Ordering
Ix0 -> Ix0 -> Ix0
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ix0 -> Ix0 -> Ix0
$cmin :: Ix0 -> Ix0 -> Ix0
max :: Ix0 -> Ix0 -> Ix0
$cmax :: Ix0 -> Ix0 -> Ix0
>= :: Ix0 -> Ix0 -> Bool
$c>= :: Ix0 -> Ix0 -> Bool
> :: Ix0 -> Ix0 -> Bool
$c> :: Ix0 -> Ix0 -> Bool
<= :: Ix0 -> Ix0 -> Bool
$c<= :: Ix0 -> Ix0 -> Bool
< :: Ix0 -> Ix0 -> Bool
$c< :: Ix0 -> Ix0 -> Bool
compare :: Ix0 -> Ix0 -> Ordering
$ccompare :: Ix0 -> Ix0 -> Ordering
$cp1Ord :: Eq Ix0
Ord, Int -> Ix0 -> ShowS
[Ix0] -> ShowS
Ix0 -> String
(Int -> Ix0 -> ShowS)
-> (Ix0 -> String) -> ([Ix0] -> ShowS) -> Show Ix0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ix0] -> ShowS
$cshowList :: [Ix0] -> ShowS
show :: Ix0 -> String
$cshow :: Ix0 -> String
showsPrec :: Int -> Ix0 -> ShowS
$cshowsPrec :: Int -> Ix0 -> ShowS
Show)

instance NFData Ix0 where
  rnf :: Ix0 -> ()
rnf Ix0
Ix0 = ()

-- | A type synonym for 1-dimensional index, i.e. `Int`.
--
-- >>> 5 :: Ix1
-- 5
--
-- @since 0.1.0
type Ix1 = Int

-- | This is a very handy pattern synonym to indicate that any arbitrary `Integral` literal is an
-- `Int`, e.g. a 1-dimensional index: @(Ix1 5) == (5 :: Int)@
--
-- >>> Ix1 5
-- 5
-- >>> :t Ix1 5
-- Ix1 5 :: Ix1
--
-- @since 0.1.0
pattern Ix1 :: Int -> Ix1
pattern $bIx1 :: Int -> Int
$mIx1 :: forall r. Int -> (Int -> r) -> (Void# -> r) -> r
Ix1 i = i
{-# COMPLETE Ix1 #-}

type instance Lower Int = Ix0


instance Index Ix1 where
  type Dimensions Ix1 = 1
  dimensions :: proxy Int -> Dim
dimensions proxy Int
_ = Dim
1
  {-# INLINE [1] dimensions #-}
  totalElem :: Sz1 -> Int
totalElem = Sz1 -> Int
forall ix. Sz ix -> ix
unSz
  {-# INLINE [1] totalElem #-}
  isSafeIndex :: Sz1 -> Int -> Bool
isSafeIndex (SafeSz Int
k) !Int
i = Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
k
  {-# INLINE [1] isSafeIndex #-}
  toLinearIndex :: Sz1 -> Int -> Int
toLinearIndex Sz1
_ = Int -> Int
forall a. a -> a
id
  {-# INLINE [1] toLinearIndex #-}
  toLinearIndexAcc :: Int -> Int -> Int -> Int
toLinearIndexAcc !Int
acc Int
m Int
i  = Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
  {-# INLINE [1] toLinearIndexAcc #-}
  fromLinearIndex :: Sz1 -> Int -> Int
fromLinearIndex Sz1
_ = Int -> Int
forall a. a -> a
id
  {-# INLINE [1] fromLinearIndex #-}
  fromLinearIndexAcc :: Int -> Int -> (Int, Int)
fromLinearIndexAcc Int
n Int
k = Int
k Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
n
  {-# INLINE [1] fromLinearIndexAcc #-}
  repairIndex :: Sz1 -> Int -> (Sz1 -> Int -> Int) -> (Sz1 -> Int -> Int) -> Int
repairIndex k :: Sz1
k@(SafeSz Int
ksz) !Int
i Sz1 -> Int -> Int
rBelow Sz1 -> Int -> Int
rOver
    | Int
ksz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = IndexException -> Int
forall a e. Exception e => e -> a
throw (IndexException -> Int) -> IndexException -> Int
forall a b. (a -> b) -> a -> b
$ Int -> IndexException
forall ix. Index ix => ix -> IndexException
IndexZeroException Int
ksz
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Sz1 -> Int -> Int
rBelow Sz1
k Int
i
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ksz = Sz1 -> Int -> Int
rOver Sz1
k Int
i
    | Bool
otherwise = Int
i
  {-# INLINE [1] repairIndex #-}
  consDim :: Int -> Lower Int -> Int
consDim Int
i Lower Int
_ = Int
i
  {-# INLINE [1] consDim #-}
  unconsDim :: Int -> (Int, Lower Int)
unconsDim Int
i = (Int
i, Ix0
Lower Int
Ix0)
  {-# INLINE [1] unconsDim #-}
  snocDim :: Lower Int -> Int -> Int
snocDim Lower Int
_ Int
i = Int
i
  {-# INLINE [1] snocDim #-}
  unsnocDim :: Int -> (Lower Int, Int)
unsnocDim Int
i = (Ix0
Lower Int
Ix0, Int
i)
  {-# INLINE [1] unsnocDim #-}
  getDimM :: Int -> Dim -> m Int
getDimM Int
ix Dim
1 = Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
ix
  getDimM Int
ix Dim
d = IndexException -> m Int
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IndexException -> m Int) -> IndexException -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> Dim -> IndexException
forall ix.
(NFData ix, Show ix, Typeable ix) =>
ix -> Dim -> IndexException
IndexDimensionException Int
ix Dim
d
  {-# INLINE [1] getDimM #-}
  setDimM :: Int -> Dim -> Int -> m Int
setDimM Int
_  Dim
1 Int
ix = Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
ix
  setDimM Int
ix Dim
d Int
_  = IndexException -> m Int
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IndexException -> m Int) -> IndexException -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> Dim -> IndexException
forall ix.
(NFData ix, Show ix, Typeable ix) =>
ix -> Dim -> IndexException
IndexDimensionException Int
ix Dim
d
  {-# INLINE [1] setDimM #-}
  modifyDimM :: Int -> Dim -> (Int -> Int) -> m (Int, Int)
modifyDimM Int
ix Dim
1 Int -> Int
f = (Int, Int) -> m (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
ix, Int -> Int
f Int
ix)
  modifyDimM Int
ix Dim
d Int -> Int
_ = IndexException -> m (Int, Int)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IndexException -> m (Int, Int)) -> IndexException -> m (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Dim -> IndexException
forall ix.
(NFData ix, Show ix, Typeable ix) =>
ix -> Dim -> IndexException
IndexDimensionException Int
ix Dim
d
  {-# INLINE [1] modifyDimM #-}
  pullOutDimM :: Int -> Dim -> m (Int, Lower Int)
pullOutDimM Int
ix Dim
1 = (Int, Ix0) -> m (Int, Ix0)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
ix, Ix0
Ix0)
  pullOutDimM Int
ix Dim
d = IndexException -> m (Int, Ix0)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IndexException -> m (Int, Ix0)) -> IndexException -> m (Int, Ix0)
forall a b. (a -> b) -> a -> b
$ Int -> Dim -> IndexException
forall ix.
(NFData ix, Show ix, Typeable ix) =>
ix -> Dim -> IndexException
IndexDimensionException Int
ix Dim
d
  {-# INLINE [1] pullOutDimM #-}
  insertDimM :: Lower Int -> Dim -> Int -> m Int
insertDimM Lower Int
Ix0 Dim
1 Int
i = Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
  insertDimM Lower Int
ix  Dim
d Int
_ = IndexException -> m Int
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IndexException -> m Int) -> IndexException -> m Int
forall a b. (a -> b) -> a -> b
$ Ix0 -> Dim -> IndexException
forall ix.
(NFData ix, Show ix, Typeable ix) =>
ix -> Dim -> IndexException
IndexDimensionException Ix0
Lower Int
ix Dim
d
  {-# INLINE [1] insertDimM #-}
  pureIndex :: Int -> Int
pureIndex Int
i = Int
i
  {-# INLINE [1] pureIndex #-}
  liftIndex :: (Int -> Int) -> Int -> Int
liftIndex Int -> Int
f = Int -> Int
f
  {-# INLINE [1] liftIndex #-}
  liftIndex2 :: (Int -> Int -> Int) -> Int -> Int -> Int
liftIndex2 Int -> Int -> Int
f = Int -> Int -> Int
f
  {-# INLINE [1] liftIndex2 #-}
  foldlIndex :: (a -> Int -> a) -> a -> Int -> a
foldlIndex a -> Int -> a
f = a -> Int -> a
f
  {-# INLINE [1] foldlIndex #-}
  iterM :: Int
-> Int
-> Int
-> (Int -> Int -> Bool)
-> a
-> (Int -> a -> m a)
-> m a
iterM Int
k0 Int
k1 Int
inc Int -> Int -> Bool
cond = Int
-> (Int -> Bool) -> (Int -> Int) -> a -> (Int -> a -> m a) -> m a
forall (m :: * -> *) a.
Monad m =>
Int
-> (Int -> Bool) -> (Int -> Int) -> a -> (Int -> a -> m a) -> m a
loopM Int
k0 (Int -> Int -> Bool
`cond` Int
k1) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
inc)
  {-# INLINE iterM #-}
  iterM_ :: Int -> Int -> Int -> (Int -> Int -> Bool) -> (Int -> m a) -> m ()
iterM_ Int
k0 Int
k1 Int
inc Int -> Int -> Bool
cond = Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m a) -> m ()
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m a) -> m ()
loopM_ Int
k0 (Int -> Int -> Bool
`cond` Int
k1) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
inc)
  {-# INLINE iterM_ #-}


-- | Exceptions that get thrown when there is a problem with an index, size or dimension.
--
-- @since 0.3.0
data IndexException where
  -- | Index contains a zero value along one of the dimensions.
  IndexZeroException :: Index ix => !ix -> IndexException
  -- | Dimension is out of reach.
  IndexDimensionException :: (NFData ix, Show ix, Typeable ix) => !ix -> !Dim -> IndexException
  -- | Index is out of bounds.
  IndexOutOfBoundsException :: Index ix => !(Sz ix) -> !ix -> IndexException

instance Show IndexException where
  show :: IndexException -> String
show (IndexZeroException ix
ix) = String
"IndexZeroException: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ix -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 ix
ix String
""
  show (IndexDimensionException ix
ix Dim
dim) =
    String
"IndexDimensionException: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Dim -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 Dim
dim String
" for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ix -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 ix
ix String
""
  show (IndexOutOfBoundsException Sz ix
sz ix
ix) =
    String
"IndexOutOfBoundsException: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ix -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 ix
ix String
" is not safe for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Sz ix -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 Sz ix
sz String
""
  showsPrec :: Int -> IndexException -> ShowS
showsPrec Int
n IndexException
exc = Int -> ShowS -> ShowS
showsPrecWrapped Int
n (IndexException -> String
forall a. Show a => a -> String
show IndexException
exc String -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance Eq IndexException where
  IndexException
e1 == :: IndexException -> IndexException -> Bool
== IndexException
e2 =
    case (IndexException
e1, IndexException
e2) of
      (IndexZeroException ix
i1, IndexZeroException ix
i2) -> ix -> String
forall a. Show a => a -> String
show ix
i1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ix -> String
forall a. Show a => a -> String
show ix
i2
      (IndexDimensionException ix
i1 Dim
d1, IndexDimensionException ix
i2 Dim
d2) ->
        ix -> String
forall a. Show a => a -> String
show ix
i1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ix -> String
forall a. Show a => a -> String
show ix
i2 Bool -> Bool -> Bool
&& Dim
d1 Dim -> Dim -> Bool
forall a. Eq a => a -> a -> Bool
== Dim
d2
      (IndexOutOfBoundsException Sz ix
sz1 ix
i1, IndexOutOfBoundsException Sz ix
sz2 ix
i2) ->
        Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz2 Bool -> Bool -> Bool
&& ix -> String
forall a. Show a => a -> String
show ix
i1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ix -> String
forall a. Show a => a -> String
show ix
i2
      (IndexException, IndexException)
_ -> Bool
False

instance NFData IndexException where
  rnf :: IndexException -> ()
rnf =
    \case
      IndexZeroException ix
i -> ix -> ()
forall a. NFData a => a -> ()
rnf ix
i
      IndexDimensionException ix
i Dim
d -> ix
i ix -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Dim -> ()
forall a. NFData a => a -> ()
rnf Dim
d
      IndexOutOfBoundsException Sz ix
sz ix
i -> Sz ix
sz Sz ix -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ix -> ()
forall a. NFData a => a -> ()
rnf ix
i

instance Exception IndexException

-- | Exception that indicates an issue with an array size.
--
-- @since 0.3.0
data SizeException where
  -- | Two sizes are expected to be equal along some or all dimensions, but they are not.
  SizeMismatchException :: Index ix => !(Sz ix) -> !(Sz ix) -> SizeException
  -- | Total number of elements does not match between the two sizes.
  SizeElementsMismatchException :: (Index ix, Index ix') => !(Sz ix) -> !(Sz ix') -> SizeException
  -- | Described subregion is too big for the specified size.
  SizeSubregionException :: Index ix => !(Sz ix) -> !ix -> !(Sz ix) -> SizeException
  -- | An array with the size cannot contain any elements.
  SizeEmptyException :: Index ix => !(Sz ix) -> SizeException

instance Eq SizeException where
  SizeException
e1 == :: SizeException -> SizeException -> Bool
== SizeException
e2 =
    case (SizeException
e1, SizeException
e2) of
      (SizeMismatchException Sz ix
sz1 Sz ix
sz1', SizeMismatchException Sz ix
sz2 Sz ix
sz2') ->
        Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz2 Bool -> Bool -> Bool
&& Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz1' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz2'
      (SizeElementsMismatchException Sz ix
sz1 Sz ix'
sz1', SizeElementsMismatchException Sz ix
sz2 Sz ix'
sz2') ->
        Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz2 Bool -> Bool -> Bool
&& Sz ix' -> String
forall a. Show a => a -> String
show Sz ix'
sz1' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Sz ix' -> String
forall a. Show a => a -> String
show Sz ix'
sz2'
      (SizeSubregionException Sz ix
sz1 ix
i1 Sz ix
sz1', SizeSubregionException Sz ix
sz2 ix
i2 Sz ix
sz2') ->
        Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz2 Bool -> Bool -> Bool
&& ix -> String
forall a. Show a => a -> String
show ix
i1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ix -> String
forall a. Show a => a -> String
show ix
i2 Bool -> Bool -> Bool
&& Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz1' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz2'
      (SizeEmptyException Sz ix
sz1, SizeEmptyException Sz ix
sz2) -> Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz2
      (SizeException, SizeException)
_ -> Bool
False

instance NFData SizeException where
  rnf :: SizeException -> ()
rnf =
    \case
      SizeMismatchException Sz ix
sz Sz ix
sz' -> Sz ix
sz Sz ix -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Sz ix -> ()
forall a. NFData a => a -> ()
rnf Sz ix
sz'
      SizeElementsMismatchException Sz ix
sz Sz ix'
sz' -> Sz ix
sz Sz ix -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Sz ix' -> ()
forall a. NFData a => a -> ()
rnf Sz ix'
sz'
      SizeSubregionException Sz ix
sz ix
i Sz ix
sz' -> Sz ix
sz Sz ix -> ix -> ix
forall a b. NFData a => a -> b -> b
`deepseq` ix
i ix -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Sz ix -> ()
forall a. NFData a => a -> ()
rnf Sz ix
sz'
      SizeEmptyException Sz ix
sz -> Sz ix -> ()
forall a. NFData a => a -> ()
rnf Sz ix
sz

instance Exception SizeException


instance Show SizeException where
  show :: SizeException -> String
show (SizeMismatchException Sz ix
sz Sz ix
sz') =
    String
"SizeMismatchException: (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") vs (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (SizeElementsMismatchException Sz ix
sz Sz ix'
sz') =
    String
"SizeElementsMismatchException: (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") vs (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Sz ix' -> String
forall a. Show a => a -> String
show Sz ix'
sz' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (SizeSubregionException Sz ix
sz' ix
ix Sz ix
sz) =
    String
"SizeSubregionException: (" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") is to small for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ix -> String
forall a. Show a => a -> String
show ix
ix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (SizeEmptyException Sz ix
sz) =
    String
"SizeEmptyException: (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Sz ix -> String
forall a. Show a => a -> String
show Sz ix
sz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") corresponds to an empty array"
  showsPrec :: Int -> SizeException -> ShowS
showsPrec Int
n SizeException
exc = Int -> ShowS -> ShowS
showsPrecWrapped Int
n (SizeException -> String
forall a. Show a => a -> String
show SizeException
exc String -> ShowS
forall a. [a] -> [a] -> [a]
++)

-- | Exception that can happen upon conversion of a ragged type array into the rectangular kind. Which
-- means conversion from lists is susceptible to this exception.
--
-- @since 0.3.0
data ShapeException
  = DimTooShortException !Sz1 !Sz1
  | DimTooLongException
  deriving ShapeException -> ShapeException -> Bool
(ShapeException -> ShapeException -> Bool)
-> (ShapeException -> ShapeException -> Bool) -> Eq ShapeException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShapeException -> ShapeException -> Bool
$c/= :: ShapeException -> ShapeException -> Bool
== :: ShapeException -> ShapeException -> Bool
$c== :: ShapeException -> ShapeException -> Bool
Eq

instance Show ShapeException where
  showsPrec :: Int -> ShapeException -> ShowS
showsPrec Int
_ ShapeException
DimTooLongException = (String
"DimTooLongException" String -> ShowS
forall a. [a] -> [a] -> [a]
++)
  showsPrec Int
n (DimTooShortException Sz1
sz Sz1
sz') =
    Int -> ShowS -> ShowS
showsPrecWrapped
      Int
n
      ((String
"DimTooShortException: expected (" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sz1 -> ShowS
forall a. Show a => a -> ShowS
shows Sz1
sz ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"), got (" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sz1 -> ShowS
forall a. Show a => a -> ShowS
shows Sz1
sz' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++))

instance Exception ShapeException


showsPrecWrapped :: Int -> ShowS -> ShowS
showsPrecWrapped :: Int -> ShowS -> ShowS
showsPrecWrapped Int
n ShowS
inner
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = ShowS
inner
  | Bool
otherwise = (Char
'('Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
inner ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++)