{-# LANGUAGE ScopedTypeVariables #-}

-- SPDX-License-Identifier: MPL-2.0

{- | Bounded ASCII numeric formats. HMath text v1 preserves dtype, shape and
endian, packing values in row order; metadata/padding/NaN payload bits are
binary-only. CSV/TSV are strict rectangular numeric tables, with optional
quoted scalar fields, no header or comments. Matrix Market follows NIST's
column-order array and one-based coordinate conventions:
<https://math.nist.gov/MatrixMarket/formats.html>.
-}
module HMath.Interchange.Text (
    encodeText,
    decodeText,
    encodeDelimited,
    decodeDelimited,
    encodeMatrixMarket,
    decodeMatrixMarket,
) where

import Control.Monad (unless)
import qualified Data.Array as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Complex (Complex ((:+)), conjugate, imagPart, realPart)
import Data.Int
import Data.List (intercalate)
import qualified Data.Map.Strict as M
import Data.Word
import GHC.Float (double2Float)
import HMath.Interchange.Array
import Text.Read (readMaybe)

ascii :: Limits -> B.ByteString -> Either InterchangeError String
ascii :: Limits -> ByteString -> Either InterchangeError [Char]
ascii Limits
lim ByteString
bytes = do
    Limits -> Either InterchangeError ()
checkLimits Limits
lim
    Bool -> InterchangeError -> Either InterchangeError ()
guardI (ByteString -> Int
B.length ByteString
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Limits -> Int
maxBytes Limits
lim) ([Char] -> InterchangeError
LimitExceeded [Char]
"text bytes")
    Bool -> InterchangeError -> Either InterchangeError ()
guardI
        ((Word8 -> Bool) -> ByteString -> Bool
B.all (\Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
9 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
32 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
126) ByteString
bytes)
        ([Char] -> InterchangeError
InvalidData [Char]
"expected ASCII numeric text")
    [Char] -> Either InterchangeError [Char]
forall a b. b -> Either a b
Right (ByteString -> [Char]
C.unpack ByteString
bytes)
output :: Limits -> String -> Either InterchangeError B.ByteString
output :: Limits -> [Char] -> Either InterchangeError ByteString
output Limits
lim [Char]
s = do
    Limits -> Either InterchangeError ()
checkLimits Limits
lim
    Bool -> InterchangeError -> Either InterchangeError ()
guardI ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Limits -> Int
maxBytes Limits
lim Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Char]
s) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Limits -> Int
maxBytes Limits
lim) ([Char] -> InterchangeError
LimitExceeded [Char]
"text output bytes")
    ByteString -> Either InterchangeError ByteString
forall a b. b -> Either a b
Right ([Char] -> ByteString
C.pack [Char]
s)
readInteger :: String -> Either InterchangeError Integer
readInteger :: [Char] -> Either InterchangeError Integer
readInteger [Char]
s = do
    Bool -> InterchangeError -> Either InterchangeError ()
guardI
        ( Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s)
            Bool -> Bool -> Bool
&& [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
130 [Char]
s) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
129
            Bool -> Bool -> Bool
&& (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9') (if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-" Bool -> Bool -> Bool
|| Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"+" then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
s else [Char]
s)
        )
        ([Char] -> InterchangeError
InvalidData [Char]
"invalid integer")
    Either InterchangeError Integer
-> (Integer -> Either InterchangeError Integer)
-> Maybe Integer
-> Either InterchangeError Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (InterchangeError -> Either InterchangeError Integer
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"invalid integer"))
        Integer -> Either InterchangeError Integer
forall a b. b -> Either a b
Right
        ([Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe (if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"+" then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
s else [Char]
s))
readBounded :: forall a. (Integral a, Bounded a) => String -> Either InterchangeError a
readBounded :: forall a.
(Integral a, Bounded a) =>
[Char] -> Either InterchangeError a
readBounded [Char]
s = do
    n <- [Char] -> Either InterchangeError Integer
readInteger [Char]
s
    guardI
        (n >= toInteger (minBound :: a) && n <= toInteger (maxBound :: a))
        (InvalidData "integer dtype overflow")
    Right (fromInteger n)
readReal :: String -> Either InterchangeError Double
readReal :: [Char] -> Either InterchangeError Double
readReal [Char]
"nan" = Double -> Either InterchangeError Double
forall a b. b -> Either a b
Right (Double
0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
readReal [Char]
"inf" = Double -> Either InterchangeError Double
forall a b. b -> Either a b
Right (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
readReal [Char]
"+inf" = Double -> Either InterchangeError Double
forall a b. b -> Either a b
Right (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
readReal [Char]
"-inf" = Double -> Either InterchangeError Double
forall a b. b -> Either a b
Right (-Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
readReal [Char]
s = do
    Bool -> InterchangeError -> Either InterchangeError ()
guardI ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
129 [Char]
s) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
128) ([Char] -> InterchangeError
LimitExceeded [Char]
"numeric token")
    let exponentPart :: [Char]
exponentPart = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'e' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'E') [Char]
s
    Bool -> Either InterchangeError () -> Either InterchangeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
exponentPart) (Either InterchangeError () -> Either InterchangeError ())
-> Either InterchangeError () -> Either InterchangeError ()
forall a b. (a -> b) -> a -> b
$ do
        e <- [Char] -> Either InterchangeError Integer
readInteger (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
exponentPart)
        guardI (abs e <= 10000) (LimitExceeded "decimal exponent")
    x <-
        Either InterchangeError Double
-> (Double -> Either InterchangeError Double)
-> Maybe Double
-> Either InterchangeError Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (InterchangeError -> Either InterchangeError Double
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"invalid floating number"))
            Double -> Either InterchangeError Double
forall a b. b -> Either a b
Right
            ([Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe (if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"+" then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
s else [Char]
s))
    guardI (not (isNaN x || isInfinite x)) (InvalidData "numeric overflow; use explicit inf/nan")
    Right x
showReal :: (RealFloat a, Show a) => a -> String
showReal :: forall a. (RealFloat a, Show a) => a -> [Char]
showReal a
x | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = [Char]
"nan" | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then [Char]
"inf" else [Char]
"-inf" | Bool
otherwise = a -> [Char]
forall a. Show a => a -> [Char]
show a
x
readComplex :: String -> Either InterchangeError (Complex Double)
readComplex :: [Char] -> Either InterchangeError (Complex Double)
readComplex [Char]
s = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') [Char]
s of
    ([Char]
a, Char
',' : [Char]
b) -> Double -> Double -> Complex Double
forall a. a -> a -> Complex a
(:+) (Double -> Double -> Complex Double)
-> Either InterchangeError Double
-> Either InterchangeError (Double -> Complex Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Either InterchangeError Double
readReal [Char]
a Either InterchangeError (Double -> Complex Double)
-> Either InterchangeError Double
-> Either InterchangeError (Complex Double)
forall a b.
Either InterchangeError (a -> b)
-> Either InterchangeError a -> Either InterchangeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Either InterchangeError Double
readReal [Char]
b
    ([Char], [Char])
_ -> InterchangeError -> Either InterchangeError (Complex Double)
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"complex token must be real,imaginary")
showComplex :: (RealFloat a, Show a) => Complex a -> String
showComplex :: forall a. (RealFloat a, Show a) => Complex a -> [Char]
showComplex (a
a :+ a
b) = a -> [Char]
forall a. (RealFloat a, Show a) => a -> [Char]
showReal a
a [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. (RealFloat a, Show a) => a -> [Char]
showReal a
b
valueTokens :: Array -> Either InterchangeError [String]
valueTokens :: Array -> Either InterchangeError [[Char]]
valueTokens Array
a = case Array -> DType
arrayDType Array
a of
    DType
Bool8 -> (Bool -> [Char]) -> [Bool] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Bool
x -> if Bool
x then [Char]
"1" else [Char]
"0") ([Bool] -> [[Char]])
-> Either InterchangeError [Bool]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Bool]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Bool])
    DType
I8 -> (Int8 -> [Char]) -> [Int8] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Int8 -> [Char]
forall a. Show a => a -> [Char]
show ([Int8] -> [[Char]])
-> Either InterchangeError [Int8]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Int8]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Int8])
    DType
U8 -> (Word8 -> [Char]) -> [Word8] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> [Char]
forall a. Show a => a -> [Char]
show ([Word8] -> [[Char]])
-> Either InterchangeError [Word8]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Word8]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Word8])
    DType
I16 -> (Int16 -> [Char]) -> [Int16] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Int16 -> [Char]
forall a. Show a => a -> [Char]
show ([Int16] -> [[Char]])
-> Either InterchangeError [Int16]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Int16]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Int16])
    DType
U16 -> (Word16 -> [Char]) -> [Word16] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Word16 -> [Char]
forall a. Show a => a -> [Char]
show ([Word16] -> [[Char]])
-> Either InterchangeError [Word16]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Word16]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Word16])
    DType
I32 -> (Int32 -> [Char]) -> [Int32] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> [Char]
forall a. Show a => a -> [Char]
show ([Int32] -> [[Char]])
-> Either InterchangeError [Int32]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Int32]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Int32])
    DType
U32 -> (Word32 -> [Char]) -> [Word32] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> [Char]
forall a. Show a => a -> [Char]
show ([Word32] -> [[Char]])
-> Either InterchangeError [Word32]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Word32]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Word32])
    DType
I64 -> (Int64 -> [Char]) -> [Int64] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Int64 -> [Char]
forall a. Show a => a -> [Char]
show ([Int64] -> [[Char]])
-> Either InterchangeError [Int64]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Int64]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Int64])
    DType
U64 -> (Word64 -> [Char]) -> [Word64] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> [Char]
forall a. Show a => a -> [Char]
show ([Word64] -> [[Char]])
-> Either InterchangeError [Word64]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Word64]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Word64])
    DType
F32 -> (Float -> [Char]) -> [Float] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Float -> [Char]
forall a. (RealFloat a, Show a) => a -> [Char]
showReal ([Float] -> [[Char]])
-> Either InterchangeError [Float]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Float]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Float])
    DType
F64 -> (Double -> [Char]) -> [Double] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Double -> [Char]
forall a. (RealFloat a, Show a) => a -> [Char]
showReal ([Double] -> [[Char]])
-> Either InterchangeError [Double]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Double]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Double])
    DType
C64 -> (Complex Float -> [Char]) -> [Complex Float] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Complex Float -> [Char]
forall a. (RealFloat a, Show a) => Complex a -> [Char]
showComplex ([Complex Float] -> [[Char]])
-> Either InterchangeError [Complex Float]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Complex Float]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Complex Float])
    DType
C128 -> (Complex Double -> [Char]) -> [Complex Double] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Complex Double -> [Char]
forall a. (RealFloat a, Show a) => Complex a -> [Char]
showComplex ([Complex Double] -> [[Char]])
-> Either InterchangeError [Complex Double]
-> Either InterchangeError [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Array -> Either InterchangeError [Complex Double]
forall a. Element a => Array -> Either InterchangeError [a]
toValues Array
a :: Either InterchangeError [Complex Double])
parseValues :: Limits -> DType -> Endian -> [Int] -> [String] -> Either InterchangeError Array
parseValues :: Limits
-> DType
-> Endian
-> [Int]
-> [[Char]]
-> Either InterchangeError Array
parseValues Limits
lim DType
dt Endian
en [Int]
sh [[Char]]
ss = do
    n <- Limits -> [Int] -> Either InterchangeError Int
validateShape Limits
lim [Int]
sh
    guardI (length (take (n + 1) ss) == n) (InvalidData "numeric value count mismatch")
    case dt of
        DType
Bool8 ->
            ([Char] -> Either InterchangeError Bool)
-> [[Char]] -> Either InterchangeError [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
                ( \[Char]
s -> case [Char]
s of
                    [Char]
"0" -> Bool -> Either InterchangeError Bool
forall a b. b -> Either a b
Right Bool
False
                    [Char]
"1" -> Bool -> Either InterchangeError Bool
forall a b. b -> Either a b
Right Bool
True
                    [Char]
_ -> InterchangeError -> Either InterchangeError Bool
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"invalid bool")
                )
                [[Char]]
ss
                Either InterchangeError [Bool]
-> ([Bool] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian -> [Int] -> [Bool] -> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
I8 -> (([Char] -> Either InterchangeError Int8)
-> [[Char]] -> Either InterchangeError [Int8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Either InterchangeError Int8
forall a.
(Integral a, Bounded a) =>
[Char] -> Either InterchangeError a
readBounded [[Char]]
ss :: Either InterchangeError [Int8]) Either InterchangeError [Int8]
-> ([Int8] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian -> [Int] -> [Int8] -> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
U8 -> (([Char] -> Either InterchangeError Word8)
-> [[Char]] -> Either InterchangeError [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Either InterchangeError Word8
forall a.
(Integral a, Bounded a) =>
[Char] -> Either InterchangeError a
readBounded [[Char]]
ss :: Either InterchangeError [Word8]) Either InterchangeError [Word8]
-> ([Word8] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian -> [Int] -> [Word8] -> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
I16 -> (([Char] -> Either InterchangeError Int16)
-> [[Char]] -> Either InterchangeError [Int16]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Either InterchangeError Int16
forall a.
(Integral a, Bounded a) =>
[Char] -> Either InterchangeError a
readBounded [[Char]]
ss :: Either InterchangeError [Int16]) Either InterchangeError [Int16]
-> ([Int16] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian -> [Int] -> [Int16] -> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
U16 -> (([Char] -> Either InterchangeError Word16)
-> [[Char]] -> Either InterchangeError [Word16]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Either InterchangeError Word16
forall a.
(Integral a, Bounded a) =>
[Char] -> Either InterchangeError a
readBounded [[Char]]
ss :: Either InterchangeError [Word16]) Either InterchangeError [Word16]
-> ([Word16] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian -> [Int] -> [Word16] -> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
I32 -> (([Char] -> Either InterchangeError Int32)
-> [[Char]] -> Either InterchangeError [Int32]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Either InterchangeError Int32
forall a.
(Integral a, Bounded a) =>
[Char] -> Either InterchangeError a
readBounded [[Char]]
ss :: Either InterchangeError [Int32]) Either InterchangeError [Int32]
-> ([Int32] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian -> [Int] -> [Int32] -> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
U32 -> (([Char] -> Either InterchangeError Word32)
-> [[Char]] -> Either InterchangeError [Word32]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Either InterchangeError Word32
forall a.
(Integral a, Bounded a) =>
[Char] -> Either InterchangeError a
readBounded [[Char]]
ss :: Either InterchangeError [Word32]) Either InterchangeError [Word32]
-> ([Word32] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian -> [Int] -> [Word32] -> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
I64 -> (([Char] -> Either InterchangeError Int64)
-> [[Char]] -> Either InterchangeError [Int64]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Either InterchangeError Int64
forall a.
(Integral a, Bounded a) =>
[Char] -> Either InterchangeError a
readBounded [[Char]]
ss :: Either InterchangeError [Int64]) Either InterchangeError [Int64]
-> ([Int64] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian -> [Int] -> [Int64] -> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
U64 -> (([Char] -> Either InterchangeError Word64)
-> [[Char]] -> Either InterchangeError [Word64]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Either InterchangeError Word64
forall a.
(Integral a, Bounded a) =>
[Char] -> Either InterchangeError a
readBounded [[Char]]
ss :: Either InterchangeError [Word64]) Either InterchangeError [Word64]
-> ([Word64] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian -> [Int] -> [Word64] -> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
F32 -> ([Char] -> Either InterchangeError Float)
-> [[Char]] -> Either InterchangeError [Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char] -> Either InterchangeError Double
readReal ([Char] -> Either InterchangeError Double)
-> (Double -> Either InterchangeError Float)
-> [Char]
-> Either InterchangeError Float
forall {m :: * -> *} {t} {a} {b}.
Monad m =>
(t -> m a) -> (a -> m b) -> t -> m b
>=> Double -> Either InterchangeError Float
floatChecked) [[Char]]
ss Either InterchangeError [Float]
-> ([Float] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian -> [Int] -> [Float] -> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
F64 -> ([Char] -> Either InterchangeError Double)
-> [[Char]] -> Either InterchangeError [Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Either InterchangeError Double
readReal [[Char]]
ss Either InterchangeError [Double]
-> ([Double] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian -> [Int] -> [Double] -> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
C64 -> ([Char] -> Either InterchangeError (Complex Float))
-> [[Char]] -> Either InterchangeError [Complex Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char] -> Either InterchangeError (Complex Double)
readComplex ([Char] -> Either InterchangeError (Complex Double))
-> (Complex Double -> Either InterchangeError (Complex Float))
-> [Char]
-> Either InterchangeError (Complex Float)
forall {m :: * -> *} {t} {a} {b}.
Monad m =>
(t -> m a) -> (a -> m b) -> t -> m b
>=> Complex Double -> Either InterchangeError (Complex Float)
complexChecked) [[Char]]
ss Either InterchangeError [Complex Float]
-> ([Complex Float] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian
-> [Int]
-> [Complex Float]
-> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
        DType
C128 -> ([Char] -> Either InterchangeError (Complex Double))
-> [[Char]] -> Either InterchangeError [Complex Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Either InterchangeError (Complex Double)
readComplex [[Char]]
ss Either InterchangeError [Complex Double]
-> ([Complex Double] -> Either InterchangeError Array)
-> Either InterchangeError Array
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limits
-> Endian
-> [Int]
-> [Complex Double]
-> Either InterchangeError Array
forall a.
Element a =>
Limits -> Endian -> [Int] -> [a] -> Either InterchangeError Array
fromValues Limits
lim Endian
en [Int]
sh
  where
    >=> :: (t -> m a) -> (a -> m b) -> t -> m b
(>=>) t -> m a
f a -> m b
g t
x = t -> m a
f t
x m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
g
    floatChecked :: Double -> Either InterchangeError Float
floatChecked Double
x =
        -- realToFrac falls back to a rational conversion without optimization,
        -- which loses signed zero and does not preserve NaN or infinity.
        let y :: Float
y = Double -> Float
double2Float Double
x
         in if Bool -> Bool
not (Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
x Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x) Bool -> Bool -> Bool
&& Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
y
                then InterchangeError -> Either InterchangeError Float
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"float32 overflow")
                else Float -> Either InterchangeError Float
forall a b. b -> Either a b
Right Float
y
    complexChecked :: Complex Double -> Either InterchangeError (Complex Float)
complexChecked (Double
a :+ Double
b) = Float -> Float -> Complex Float
forall a. a -> a -> Complex a
(:+) (Float -> Float -> Complex Float)
-> Either InterchangeError Float
-> Either InterchangeError (Float -> Complex Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Either InterchangeError Float
floatChecked Double
a Either InterchangeError (Float -> Complex Float)
-> Either InterchangeError Float
-> Either InterchangeError (Complex Float)
forall a b.
Either InterchangeError (a -> b)
-> Either InterchangeError a -> Either InterchangeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Double -> Either InterchangeError Float
floatChecked Double
b

{- | Given limits then Array, encode self-describing HMath text with dtype/shape and scalar
tokens. Invalid/unsupported values or output exceeding limits returns InterchangeError.
-}
encodeText :: Limits -> Array -> Either InterchangeError B.ByteString
encodeText :: Limits -> Array -> Either InterchangeError ByteString
encodeText Limits
lim Array
a = do
    values <- Array -> Either InterchangeError [[Char]]
valueTokens Array
a
    let sh = Array -> [Int]
arrayShape Array
a
    output
        lim
        ( unwords
            ( [ "HMATH-TEXT"
              , "1"
              , show (arrayDType a)
              , if arrayEndian a == LittleEndian then "little" else "big"
              , show (length sh)
              ]
                ++ map show sh
            )
            ++ "\n"
            ++ unlines values
        )

{- | Given limits then HMath text bytes, parse dtype/shape/tokens and return a checked
Array. Invalid ASCII/header/value counts or exceeded budgets fail.
-}
decodeText :: Limits -> B.ByteString -> Either InterchangeError Array
decodeText :: Limits -> ByteString -> Either InterchangeError Array
decodeText Limits
lim ByteString
bs = do
    s <- Limits -> ByteString -> Either InterchangeError [Char]
ascii Limits
lim ByteString
bs
    case lines s of
        [Char]
header : [[Char]]
rest -> case [Char] -> [[Char]]
words [Char]
header of
            [Char]
"HMATH-TEXT" : [Char]
"1" : [Char]
dt : [Char]
en : [Char]
r : [[Char]]
ds -> do
                typ <-
                    Either InterchangeError DType
-> (DType -> Either InterchangeError DType)
-> Maybe DType
-> Either InterchangeError DType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                        (InterchangeError -> Either InterchangeError DType
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
Unsupported [Char]
"text dtype"))
                        DType -> Either InterchangeError DType
forall a b. b -> Either a b
Right
                        ([Char] -> [([Char], DType)] -> Maybe DType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
dt [(DType -> [Char]
forall a. Show a => a -> [Char]
show DType
t, DType
t) | DType
t <- [DType
forall a. Bounded a => a
minBound .. DType
forall a. Bounded a => a
maxBound]])
                endian <- case en of
                    [Char]
"little" -> Endian -> Either InterchangeError Endian
forall a b. b -> Either a b
Right Endian
LittleEndian
                    [Char]
"big" -> Endian -> Either InterchangeError Endian
forall a b. b -> Either a b
Right Endian
BigEndian
                    [Char]
_ -> InterchangeError -> Either InterchangeError Endian
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"text endian")
                rank <- readInteger r >>= boundedInt "text rank" (toInteger (maxRank lim))
                guardI (length ds == rank) (InvalidData "shape rank mismatch")
                sh <- mapM (readInteger >=> boundedInt "dimension" (toInteger (maxBound :: Int))) ds
                parseValues lim typ endian sh (words (unlines rest))
            [[Char]]
_ -> InterchangeError -> Either InterchangeError Array
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
Unsupported [Char]
"text header/version")
        [[Char]]
_ -> InterchangeError -> Either InterchangeError Array
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"empty text")
  where
    >=> :: (t -> m a) -> (a -> m b) -> t -> m b
(>=>) t -> m a
f a -> m b
g t
x = t -> m a
f t
x m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
g

{- | Given limits,comma or tab separator,then rank-two noncomplex Array, encode CSV/TSV
numeric cells. No shape/dtype metadata is embedded; unsupported input/separator or
output bounds fail.
-}
encodeDelimited :: Limits -> Char -> Array -> Either InterchangeError B.ByteString
encodeDelimited :: Limits -> Char -> Array -> Either InterchangeError ByteString
encodeDelimited Limits
lim Char
separator Array
a = do
    Bool -> InterchangeError -> Either InterchangeError ()
guardI (Char
separator Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
separator Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t') ([Char] -> InterchangeError
InvalidData [Char]
"separator must be comma or tab")
    Bool -> InterchangeError -> Either InterchangeError ()
guardI
        (Array -> DType
arrayDType Array
a DType -> DType -> Bool
forall a. Eq a => a -> a -> Bool
/= DType
C64 Bool -> Bool -> Bool
&& Array -> DType
arrayDType Array
a DType -> DType -> Bool
forall a. Eq a => a -> a -> Bool
/= DType
C128)
        ([Char] -> InterchangeError
Unsupported [Char]
"complex CSV requires an explicit column schema")
    case Array -> [Int]
arrayShape Array
a of
        [Int
r, Int
c] -> do
            Bool -> InterchangeError -> Either InterchangeError ()
guardI
                ((Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Bool -> Bool -> Bool
|| (Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0))
                ([Char] -> InterchangeError
Unsupported [Char]
"CSV cannot preserve a single zero dimension")
            values <- Array -> Either InterchangeError [[Char]]
valueTokens Array
a
            let rows [] = []
                rows [a]
xs = let ([a]
row, [a]
rest) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
c [a]
xs in [a]
row [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
rows [a]
rest
            output lim (concatMap ((++ "\n") . intercalate [separator]) (rows values))
        [Int]
_ -> InterchangeError -> Either InterchangeError ByteString
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"CSV requires rank two")

{- | Given limits,comma/tab separator,target DType,then CSV/TSV bytes, parse rectangular
real numeric cells to a rank-two Array. Complex dtype, malformed rows/tokens or
exceeded budgets fail.
-}
decodeDelimited :: Limits -> Char -> DType -> B.ByteString -> Either InterchangeError Array
decodeDelimited :: Limits
-> Char -> DType -> ByteString -> Either InterchangeError Array
decodeDelimited Limits
lim Char
separator DType
dt ByteString
bs = do
    Bool -> InterchangeError -> Either InterchangeError ()
guardI (Char
separator Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
separator Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t') ([Char] -> InterchangeError
InvalidData [Char]
"separator must be comma or tab")
    Bool -> InterchangeError -> Either InterchangeError ()
guardI (DType
dt DType -> DType -> Bool
forall a. Eq a => a -> a -> Bool
/= DType
C64 Bool -> Bool -> Bool
&& DType
dt DType -> DType -> Bool
forall a. Eq a => a -> a -> Bool
/= DType
C128) ([Char] -> InterchangeError
Unsupported [Char]
"complex CSV")
    s <- Limits -> ByteString -> Either InterchangeError [Char]
ascii Limits
lim ByteString
bs
    let rows = ([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> [Char] -> [[Char]]
forall {t}. Eq t => t -> [t] -> [[t]]
split Char
separator ([Char] -> [[Char]]) -> ([Char] -> [Char]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')) ([Char] -> [[Char]]
lines [Char]
s)
        cols = case [[[Char]]]
rows of
            [] -> Int
0
            [[Char]]
row : [[[Char]]]
_ -> [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
row
    guardI
        (all ((== cols) . length) rows && all (all (not . null)) rows)
        (InvalidData "ragged/empty CSV field")
    tokens <- mapM quoted (concat rows)
    parseValues lim dt LittleEndian [length rows, cols] tokens
  where
    split :: t -> [t] -> [[t]]
split t
c [t]
s = case (t -> Bool) -> [t] -> ([t], [t])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
c) [t]
s of
        ([t]
a, []) -> [[t]
a]
        ([t]
a, t
_ : [t]
rest) -> [t]
a [t] -> [[t]] -> [[t]]
forall a. a -> [a] -> [a]
: t -> [t] -> [[t]]
split t
c [t]
rest
    trim :: [Char] -> [Char]
trim = [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
    quoted :: [Char] -> Either InterchangeError [Char]
quoted [Char]
field =
        let t :: [Char]
t = [Char] -> [Char]
trim [Char]
field
         in case [Char]
t of
                Char
'"' : [Char]
xs | Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
xs) Bool -> Bool -> Bool
&& [Char] -> Char
forall a. HasCallStack => [a] -> a
last [Char]
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
&& Char
'"' Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init [Char]
xs -> [Char] -> Either InterchangeError [Char]
forall a b. b -> Either a b
Right ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init [Char]
xs)
                [Char]
_ | Char
'"' Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
t -> [Char] -> Either InterchangeError [Char]
forall a b. b -> Either a b
Right [Char]
t
                [Char]
_ -> InterchangeError -> Either InterchangeError [Char]
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"invalid quoted numeric CSV field")

-- | Dense general Matrix Market; exact Int64, Float64, or Complex128.
encodeMatrixMarket :: Limits -> Array -> Either InterchangeError B.ByteString
encodeMatrixMarket :: Limits -> Array -> Either InterchangeError ByteString
encodeMatrixMarket Limits
lim Array
a = do
    field <- case Array -> DType
arrayDType Array
a of
        DType
I64 -> [Char] -> Either InterchangeError [Char]
forall a b. b -> Either a b
Right [Char]
"integer"
        DType
F64 -> [Char] -> Either InterchangeError [Char]
forall a b. b -> Either a b
Right [Char]
"real"
        DType
C128 -> [Char] -> Either InterchangeError [Char]
forall a b. b -> Either a b
Right [Char]
"complex"
        DType
_ -> InterchangeError -> Either InterchangeError [Char]
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
Unsupported [Char]
"Matrix Market output dtype")
    case arrayShape a of
        [Int
r, Int
c] -> do
            vals <- Array -> Either InterchangeError [[Char]]
valueTokens Array
a
            guardI
                (all (all (`notElem` ["nan", "inf", "-inf"]) . splitComplex) vals)
                (InvalidData "nonfinite Matrix Market output")
            let table = (Int, Int) -> [[Char]] -> Array Int [Char]
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (Int
0, [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
vals Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [[Char]]
vals
            output
                lim
                ( "%%MatrixMarket matrix array "
                    ++ field
                    ++ " general\n"
                    ++ show r
                    ++ " "
                    ++ show c
                    ++ "\n"
                    ++ unlines
                        [ map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' then Char
' ' else Char
x) (table A.! (i * c + j))
                        | (i, j) <- columnIndices r c
                        ]
                )
        [Int]
_ -> InterchangeError -> Either InterchangeError ByteString
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"Matrix Market requires rank two")
  where
    splitComplex :: [Char] -> [[Char]]
splitComplex [Char]
s = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') [Char]
s of
        ([Char]
x, []) -> [[Char]
x]
        ([Char]
x, Char
_ : [Char]
y) -> [[Char]
x, [Char]
y]

{- | Array and coordinate input, real/integer/complex/pattern fields and
general/symmetric/skew-symmetric/Hermitian storage. Coordinate duplicates
are added exactly for integers and checked for finite overflow for floats.
Dense output is bounded by maxElements even for sparse input.
-}
decodeMatrixMarket :: Limits -> B.ByteString -> Either InterchangeError Array
decodeMatrixMarket :: Limits -> ByteString -> Either InterchangeError Array
decodeMatrixMarket Limits
lim ByteString
bs = do
    s <- Limits -> ByteString -> Either InterchangeError [Char]
ascii Limits
lim ByteString
bs
    case lines s of
        [Char]
header : [[Char]]
rest -> case [Char] -> [[Char]]
words [Char]
header of
            [[Char]
"%%MatrixMarket", [Char]
"matrix", [Char]
storage, [Char]
field, [Char]
sym] -> do
                Bool -> InterchangeError -> Either InterchangeError ()
guardI
                    ( [Char]
storage [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"array", [Char]
"coordinate"]
                        Bool -> Bool -> Bool
&& [Char]
field [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"real", [Char]
"integer", [Char]
"complex", [Char]
"pattern"]
                        Bool -> Bool -> Bool
&& [Char]
sym [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"general", [Char]
"symmetric", [Char]
"skew-symmetric", [Char]
"hermitian"]
                    )
                    ([Char] -> InterchangeError
Unsupported [Char]
"Matrix Market schema")
                Bool -> InterchangeError -> Either InterchangeError ()
guardI ([Char]
storage [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"coordinate" Bool -> Bool -> Bool
|| [Char]
field [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"pattern") ([Char] -> InterchangeError
InvalidData [Char]
"array pattern is invalid")
                let meaningful :: [[[Char]]]
meaningful = [[Char] -> [[Char]]
words [Char]
l | [Char]
l <- [[Char]]
rest, Bool -> Bool
not ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> [[Char]]
words [Char]
l)), Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') [Char]
l) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"%"]
                case [[[Char]]]
meaningful of
                    [[Char]]
dims : [[[Char]]]
entries -> do
                        sizes <- ([Char] -> Either InterchangeError Int)
-> [[Char]] -> Either InterchangeError [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char] -> Either InterchangeError Integer
readInteger ([Char] -> Either InterchangeError Integer)
-> (Integer -> Either InterchangeError Int)
-> [Char]
-> Either InterchangeError Int
forall {m :: * -> *} {t} {a} {b}.
Monad m =>
(t -> m a) -> (a -> m b) -> t -> m b
>=> [Char] -> Integer -> Integer -> Either InterchangeError Int
boundedInt [Char]
"Matrix Market size" (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int))) [[Char]]
dims
                        (r, c, n) <- case (storage, sizes) of
                            ([Char]
"array", [Int
r, Int
c]) -> (Int, Int, Int) -> Either InterchangeError (Int, Int, Int)
forall a b. b -> Either a b
Right (Int
r, Int
c, [[[Char]]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[Char]]]
entries)
                            ([Char]
"coordinate", [Int
r, Int
c, Int
n]) -> (Int, Int, Int) -> Either InterchangeError (Int, Int, Int)
forall a b. b -> Either a b
Right (Int
r, Int
c, Int
n)
                            ([Char], [Int])
_ -> InterchangeError -> Either InterchangeError (Int, Int, Int)
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"Matrix Market dimensions")
                        _ <- validateShape lim [r, c]
                        guardI (sym == "general" || r == c) (InvalidData "symmetric matrix must be square")
                        guardI
                            (n <= maxElements lim && length (take (n + 1) entries) == n)
                            (InvalidData "Matrix Market entry count")
                        let positions =
                                [ (Int
i, Int
j)
                                | (Int
i, Int
j) <- Int -> Int -> [(Int, Int)]
columnIndices Int
r Int
c
                                , [Char]
sym [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"general" Bool -> Bool -> Bool
|| if [Char]
sym [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"skew-symmetric" then Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
j else Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
j
                                ]
                        coords <-
                            if storage == "array"
                                then do
                                    guardI (length (take (n + 1) positions) == n) (InvalidData "Matrix Market array count")
                                    Right (zip positions entries)
                                else mapM (coordinate r c) entries
                        if field == "integer" then decodeInts r c sym coords else decodeFloats r c field sym coords
                    [[[Char]]]
_ -> InterchangeError -> Either InterchangeError Array
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"missing Matrix Market dimensions")
            [[Char]]
_ -> InterchangeError -> Either InterchangeError Array
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"Matrix Market header")
        [[Char]]
_ -> InterchangeError -> Either InterchangeError Array
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"empty Matrix Market")
  where
    >=> :: (t -> m a) -> (a -> m b) -> t -> m b
(>=>) t -> m a
f a -> m b
g t
x = t -> m a
f t
x m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
g
    coordinate :: a -> a -> [[Char]] -> Either InterchangeError ((a, b), [[Char]])
coordinate a
r a
c ([Char]
i : [Char]
j : [[Char]]
xs) = do
        row <- [Char] -> Either InterchangeError Integer
readInteger [Char]
i
        col <- readInteger j
        guardI
            (row >= 1 && row <= toInteger r && col >= 1 && col <= toInteger c)
            (InvalidData "coordinate out of range")
        Right ((fromInteger row - 1, fromInteger col - 1), xs)
    coordinate a
_ a
_ [[Char]]
_ = InterchangeError -> Either InterchangeError ((a, b), [[Char]])
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"coordinate record")
    expand :: [Char] -> ((b, b), b) -> [((b, b), b)]
expand [Char]
sym ((b
i, b
j), b
x)
        | [Char]
sym [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"general" Bool -> Bool -> Bool
|| b
i b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
j = [((b
i, b
j), b
x)]
        | [Char]
sym [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"skew-symmetric" = [((b
i, b
j), b
x), ((b
j, b
i), b -> b
forall a. Num a => a -> a
negate b
x)]
        | Bool
otherwise = [((b
i, b
j), b
x), ((b
j, b
i), b
x)]
    lower :: [Char] -> ((a, a), b) -> Either InterchangeError ()
lower [Char]
sym ((a
i, a
j), b
_) = Bool -> InterchangeError -> Either InterchangeError ()
guardI ([Char]
sym [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"general" Bool -> Bool -> Bool
|| a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
j) ([Char] -> InterchangeError
InvalidData [Char]
"symmetric entries must be lower triangular")
    one :: [b] -> Either InterchangeError b
one [b
s] = b -> Either InterchangeError b
forall a b. b -> Either a b
Right b
s
    one [b]
_ = InterchangeError -> Either InterchangeError b
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"scalar record arity")
    decodeInts :: Int
-> Int
-> [Char]
-> t ((Int, Int), [[Char]])
-> Either InterchangeError Array
decodeInts Int
r Int
c [Char]
sym t ((Int, Int), [[Char]])
coords = do
        (((Int, Int), [[Char]]) -> Either InterchangeError ())
-> t ((Int, Int), [[Char]]) -> Either InterchangeError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> ((Int, Int), [[Char]]) -> Either InterchangeError ()
forall {a} {b}.
Ord a =>
[Char] -> ((a, a), b) -> Either InterchangeError ()
lower [Char]
sym) t ((Int, Int), [[Char]])
coords
        parsed <-
            (((Int, Int), [[Char]])
 -> Either InterchangeError ((Int, Int), Integer))
-> t ((Int, Int), [[Char]])
-> Either InterchangeError (t ((Int, Int), Integer))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM
                ( \((Int, Int)
ij, [[Char]]
xs) -> do
                    token <- [[Char]] -> Either InterchangeError [Char]
forall {b}. [b] -> Either InterchangeError b
one [[Char]]
xs
                    x <- readInteger token
                    Right (ij, x)
                )
                t ((Int, Int), [[Char]])
coords
        guardI
            (sym /= "skew-symmetric" || all (\((Int
i, Int
j), Integer
x) -> Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
j Bool -> Bool -> Bool
|| Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) parsed)
            (InvalidData "skew diagonal must be zero")
        let table = (Integer -> Integer -> Integer)
-> [((Int, Int), Integer)] -> Map (Int, Int) Integer
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) ((((Int, Int), Integer) -> [((Int, Int), Integer)])
-> t ((Int, Int), Integer) -> [((Int, Int), Integer)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> ((Int, Int), Integer) -> [((Int, Int), Integer)]
forall {b} {b}.
(Eq b, Num b) =>
[Char] -> ((b, b), b) -> [((b, b), b)]
expand [Char]
sym) t ((Int, Int), Integer)
parsed)
        xs <-
            mapM
                (\(Int, Int)
ij -> [Char] -> Either InterchangeError Int64
forall a.
(Integral a, Bounded a) =>
[Char] -> Either InterchangeError a
readBounded (Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> (Int, Int) -> Map (Int, Int) Integer -> Integer
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Integer
0 (Int, Int)
ij Map (Int, Int) Integer
table)))
                (rowIndices r c)
        fromValues lim LittleEndian [r, c] (xs :: [Int64])
    decodeFloats :: Int
-> Int
-> [Char]
-> [Char]
-> t ((Int, Int), [[Char]])
-> Either InterchangeError Array
decodeFloats Int
r Int
c [Char]
field [Char]
sym t ((Int, Int), [[Char]])
coords = do
        (((Int, Int), [[Char]]) -> Either InterchangeError ())
-> t ((Int, Int), [[Char]]) -> Either InterchangeError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> ((Int, Int), [[Char]]) -> Either InterchangeError ()
forall {a} {b}.
Ord a =>
[Char] -> ((a, a), b) -> Either InterchangeError ()
lower [Char]
sym) t ((Int, Int), [[Char]])
coords
        parsed <-
            (((Int, Int), [[Char]])
 -> Either InterchangeError ((Int, Int), Complex Double))
-> t ((Int, Int), [[Char]])
-> Either InterchangeError (t ((Int, Int), Complex Double))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM
                ( \((Int, Int)
ij, [[Char]]
xs) -> do
                    x <- case ([Char]
field, [[Char]]
xs) of
                        ([Char]
"pattern", []) -> Complex Double -> Either InterchangeError (Complex Double)
forall a b. b -> Either a b
Right (Double
1 Double -> Double -> Complex Double
forall a. a -> a -> Complex a
:+ Double
0)
                        ([Char]
"complex", [[Char]
a, [Char]
b]) -> Double -> Double -> Complex Double
forall a. a -> a -> Complex a
(:+) (Double -> Double -> Complex Double)
-> Either InterchangeError Double
-> Either InterchangeError (Double -> Complex Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Either InterchangeError Double
readReal [Char]
a Either InterchangeError (Double -> Complex Double)
-> Either InterchangeError Double
-> Either InterchangeError (Complex Double)
forall a b.
Either InterchangeError (a -> b)
-> Either InterchangeError a -> Either InterchangeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Either InterchangeError Double
readReal [Char]
b
                        ([Char]
_, [[Char]
_]) -> (Double -> Double -> Complex Double
forall a. a -> a -> Complex a
:+ Double
0) (Double -> Complex Double)
-> Either InterchangeError Double
-> Either InterchangeError (Complex Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Char]] -> Either InterchangeError [Char]
forall {b}. [b] -> Either InterchangeError b
one [[Char]]
xs Either InterchangeError [Char]
-> ([Char] -> Either InterchangeError Double)
-> Either InterchangeError Double
forall a b.
Either InterchangeError a
-> (a -> Either InterchangeError b) -> Either InterchangeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Either InterchangeError Double
readReal)
                        ([Char], [[Char]])
_ -> InterchangeError -> Either InterchangeError (Complex Double)
forall a b. a -> Either a b
Left ([Char] -> InterchangeError
InvalidData [Char]
"numeric record arity")
                    guardI
                        (not (any (\Double
z -> Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
z Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
z) [realPart x, imagPart x]))
                        (InvalidData "nonfinite Matrix Market value")
                    Right (ij, x)
                )
                t ((Int, Int), [[Char]])
coords
        guardI
            ( all
                ( \((Int
i, Int
j), Complex Double
x) -> Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
j Bool -> Bool -> Bool
|| if [Char]
sym [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"skew-symmetric" then Complex Double
x Complex Double -> Complex Double -> Bool
forall a. Eq a => a -> a -> Bool
== Complex Double
0 else [Char]
sym [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"hermitian" Bool -> Bool -> Bool
|| Complex Double -> Double
forall a. Complex a -> a
imagPart Complex Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
                )
                parsed
            )
            (InvalidData "invalid symmetry diagonal")
        let expanded =
                if [Char]
sym [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"hermitian"
                    then
                        (((Int, Int), Complex Double) -> [((Int, Int), Complex Double)])
-> t ((Int, Int), Complex Double) -> [((Int, Int), Complex Double)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                            (\((Int
i, Int
j), Complex Double
x) -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then [((Int
i, Int
j), Complex Double
x)] else [((Int
i, Int
j), Complex Double
x), ((Int
j, Int
i), Complex Double -> Complex Double
forall a. Num a => Complex a -> Complex a
conjugate Complex Double
x)])
                            t ((Int, Int), Complex Double)
parsed
                    else (((Int, Int), Complex Double) -> [((Int, Int), Complex Double)])
-> t ((Int, Int), Complex Double) -> [((Int, Int), Complex Double)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char]
-> ((Int, Int), Complex Double) -> [((Int, Int), Complex Double)]
forall {b} {b}.
(Eq b, Num b) =>
[Char] -> ((b, b), b) -> [((b, b), b)]
expand [Char]
sym) t ((Int, Int), Complex Double)
parsed
            table = (Complex Double -> Complex Double -> Complex Double)
-> [((Int, Int), Complex Double)]
-> Map (Int, Int) (Complex Double)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Complex Double -> Complex Double -> Complex Double
forall a. Num a => a -> a -> a
(+) [((Int, Int), Complex Double)]
expanded
            values = [Complex Double
-> (Int, Int) -> Map (Int, Int) (Complex Double) -> Complex Double
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Complex Double
0 (Int, Int)
ij Map (Int, Int) (Complex Double)
table | (Int, Int)
ij <- Int -> Int -> [(Int, Int)]
rowIndices Int
r Int
c]
        guardI
            (all (\Complex Double
x -> (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Double
z -> Bool -> Bool
not (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
z Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
z)) [Complex Double -> Double
forall a. Complex a -> a
realPart Complex Double
x, Complex Double -> Double
forall a. Complex a -> a
imagPart Complex Double
x]) values)
            (InvalidData "duplicate accumulation overflow")
        if field == "complex"
            then fromValues lim LittleEndian [r, c] values
            else fromValues lim LittleEndian [r, c] (map realPart values)

-- Empty rectangular matrices must not enumerate a huge outer axis just to
-- discover an empty inner axis. Dimensions are already validated above.
rowIndices :: Int -> Int -> [(Int, Int)]
rowIndices :: Int -> Int -> [(Int, Int)]
rowIndices Int
r Int
c
    | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = []
    | Bool
otherwise = [(Int
i, Int
j) | Int
i <- [Int
0 .. Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Int
j <- [Int
0 .. Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

columnIndices :: Int -> Int -> [(Int, Int)]
columnIndices :: Int -> Int -> [(Int, Int)]
columnIndices Int
r Int
c = [(Int
i, Int
j) | (Int
j, Int
i) <- Int -> Int -> [(Int, Int)]
rowIndices Int
c Int
r]