module Telescope.Fits.Encoding.DataArray
  ( -- * Encoding Images
    decodeArray
  , encodeArray

    -- * Encoding as ByteStrings
  , decodeArrayData
  , encodeArrayData

    -- * Handling Axes
  , totalPix
  , AxesIndex (..)
  , getAxesVector
  , runGetThrow
  , sizeAxes

    -- * Binary Encoding
  , GetPix (..)
  , PutPix (..)
  , PutArray (..)
  , parseVector
  , fromVector

    -- * Exports from Data.Massiv.Array
  , Array
  , Ix1
  , Ix2
  , Ix3
  , Ix4
  , Ix5
  , size
  , (!>)
  , (!?>)
  , (<!)
  , (<!?)
  , (<!>)
  , Dim (..)
  ) where

import Control.Exception
import Control.Monad.Catch
import Data.Binary.Get
import Data.Binary.Put
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.Int
import Data.Massiv.Array as M hiding (isEmpty, product)
import Data.Proxy
import Data.Word (Word8)
import Telescope.Fits.Types


-- > {-# LANGUAGE TypeApplications #-}
-- > import Data.Massiv.Array
-- > import Data.Fits.Image
-- > import Data.Fits
-- >
-- > decodeExample :: BL.ByteString -> Either String Int
-- > decodeExample bs = do
-- >  hdu <- readPrimaryHDU bs
-- >  arr <- decodeImage @Ix2 $ hdu.dataArray
-- >  pure $ arr !> 1 ! 2

{- | Decode a 'DataArray' of arbitrary dimensions 'ix' and type 'a'. Inspect the DataArray's (.bitpix) and (.axes) if these are unknown.

>>> decodeArray @Ix2 @Float hdu.dataArray
Array D Seq (Sz (2 :. 3))
  [ [ 1.0, 2.0, 3.0 ]
  , [ 4.0, 5.0, 6.0 ]
  ]

This creates a delayed (D) array, which will postpone evaluation of cells until needed
-}
decodeArray :: forall ix a m. (MonadThrow m) => (Index ix, AxesIndex ix, Prim a, GetPix a) => DataArray -> m (Array D ix a)
decodeArray :: forall ix a (m :: * -> *).
(MonadThrow m, Index ix, AxesIndex ix, Prim a, GetPix a) =>
DataArray -> m (Array D ix a)
decodeArray DataArray{BitPix
bitpix :: BitPix
$sel:bitpix:DataArray :: DataArray -> BitPix
bitpix, Axes Column
axes :: Axes Column
$sel:axes:DataArray :: DataArray -> Axes Column
axes, ByteString
rawData :: ByteString
$sel:rawData:DataArray :: DataArray -> ByteString
rawData} = do
  BitPix -> Axes Column -> ByteString -> m (Array D ix a)
forall ix a (m :: * -> *).
(AxesIndex ix, Prim a, GetPix a, Index ix, MonadThrow m) =>
BitPix -> Axes Column -> ByteString -> m (Array D ix a)
decodeArrayData BitPix
bitpix Axes Column
axes ByteString
rawData


{- | Decode data into an Array of arbitrary dimensions 'ix' specifying 'BitPixFormat' and 'Axes'

>>> decodeArray @Ix2 @Float BPFloat [3, 2] input
Array P Seq (Sz (2 :. 3))
  [ [ 1.0, 2.0, 3.0 ]
  , [ 4.0, 5.0, 6.0 ]
  ]
-}
decodeArrayData
  :: forall ix a m
   . (AxesIndex ix, Prim a, GetPix a, Index ix, MonadThrow m)
  => BitPix
  -> Axes Column
  -> BS.ByteString
  -> m (Array D ix a)
decodeArrayData :: forall ix a (m :: * -> *).
(AxesIndex ix, Prim a, GetPix a, Index ix, MonadThrow m) =>
BitPix -> Axes Column -> ByteString -> m (Array D ix a)
decodeArrayData BitPix
f Axes Column
as ByteString
inp = do
  let v :: Vector D a
v = forall a. GetPix a => Comp -> BitPix -> ByteString -> Vector D a
parseVector @a Comp
Par BitPix
f ByteString
inp
  Axes Column -> Vector D a -> m (Array D ix a)
forall ix a (m :: * -> *).
(AxesIndex ix, Index ix, Prim a, MonadThrow m) =>
Axes Column -> Vector D a -> m (Array D ix a)
fromVector Axes Column
as Vector D a
v


fromVector :: forall ix a m. (AxesIndex ix, Index ix, Prim a, MonadThrow m) => Axes Column -> Vector D a -> m (Array D ix a)
fromVector :: forall ix a (m :: * -> *).
(AxesIndex ix, Index ix, Prim a, MonadThrow m) =>
Axes Column -> Vector D a -> m (Array D ix a)
fromVector Axes Column
as Vector D a
v = do
  ix
ix <- Axes Row -> m ix
forall ix (m :: * -> *).
(AxesIndex ix, MonadThrow m) =>
Axes Row -> m ix
forall (m :: * -> *). MonadThrow m => Axes Row -> m ix
axesIndex (Axes Row -> m ix) -> Axes Row -> m ix
forall a b. (a -> b) -> a -> b
$ Axes Column -> Axes Row
rowMajor Axes Column
as
  Sz ix -> Vector D a -> m (Array D ix a)
forall r ix ix' e (m :: * -> *).
(MonadThrow m, Index ix', Index ix, Size r) =>
Sz ix' -> Array r ix e -> m (Array r ix' e)
resizeM (ix -> Sz ix
forall ix. Index ix => ix -> Sz ix
Sz ix
ix) Vector D a
v


-- TODO: switch to throwable
parseVector :: forall a. (GetPix a) => Comp -> BitPix -> BS.ByteString -> Vector D a
parseVector :: forall a. GetPix a => Comp -> BitPix -> ByteString -> Vector D a
parseVector Comp
c BitPix
bp ByteString
inp =
  let v :: Vector D Word8
v = ByteString -> Vector D Word8
parseWordVector ByteString
inp
   in Comp -> Sz Int -> (Int -> a) -> Array D Int a
forall r ix e.
Load r ix e =>
Comp -> Sz ix -> (ix -> e) -> Array r ix e
makeArray Comp
c (Vector D Word8 -> Sz Int
bitPixSize Vector D Word8
v) (Vector D Word8 -> Int -> a
toBitPix Vector D Word8
v)
 where
  bitPixSize :: Vector D Word8 -> Sz Int
bitPixSize Vector D Word8
v =
    let Sz Int
s = Vector D Word8 -> Sz Int
forall r ix e. Size r => Array r ix e -> Sz ix
forall ix e. Array D ix e -> Sz ix
size Vector D Word8
v
     in Int -> Sz Int
forall ix. Index ix => ix -> Sz ix
Sz (Int -> Sz Int) -> Int -> Sz Int
forall a b. (a -> b) -> a -> b
$ Int
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
bytes

  bytes :: Int
bytes = BitPix -> Int
bitPixBits BitPix
bp Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

  toBitPix :: Vector D Word8 -> Ix1 -> a
  toBitPix :: Vector D Word8 -> Int -> a
toBitPix Vector D Word8
v Int
ix =
    let slc :: Vector D Word8
slc = Int -> Sz Int -> Vector D Word8 -> Vector D Word8
forall r e. Source r e => Int -> Sz Int -> Vector r e -> Vector r e
M.slice (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bytes) (Int -> Sz Int
forall ix. Index ix => ix -> Sz ix
Sz Int
bytes) Vector D Word8
v :: Vector D Word8
     in -- in trace (show ("toBitPix:" <> show ix, show bytes, show slc)) $
        [Word8] -> a
toPix ([Word8] -> a) -> [Word8] -> a
forall a b. (a -> b) -> a -> b
$ Vector D Word8 -> [Word8]
forall ix r e. (Index ix, Source r e) => Array r ix e -> [e]
M.toList Vector D Word8
slc

  parseWordVector :: BS.ByteString -> Vector D Word8
  parseWordVector :: ByteString -> Vector D Word8
parseWordVector = Comp -> ByteString -> Vector D Word8
forall r. Load r Int Word8 => Comp -> ByteString -> Vector r Word8
fromByteString Comp
c

  toPix :: [Word8] -> a
  toPix :: [Word8] -> a
toPix [Word8]
ws =
    -- trace (show (ws, BL.pack ws)) $
    case Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail (forall a. GetPix a => BitPix -> Get a
getPix @a BitPix
bp) ([Word8] -> ByteString
BL.pack [Word8]
ws) of
      Left (ByteString
ip, ByteOffset
byts, String
e) -> ParseError -> a
forall a e. Exception e => e -> a
throw (ParseError -> a) -> ParseError -> a
forall a b. (a -> b) -> a -> b
$ ByteOffset -> String -> ParseError
ParseError ByteOffset
byts (String
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
ip String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BitPix -> String
forall a. Show a => a -> String
show BitPix
bp)
      Right (ByteString
_, ByteOffset
_, a
a) -> a
a


-- | Decode Axes as a delayed 1d vector
getAxesVector :: Get a -> Axes Column -> Get (Vector DS a)
getAxesVector :: forall a. Get a -> Axes Column -> Get (Vector DS a)
getAxesVector Get a
get Axes Column
as = do
  Sz Int -> Get a -> Get (Vector DS a)
forall e (m :: * -> *). Monad m => Sz Int -> m e -> m (Vector DS e)
sreplicateM (Int -> Sz Int
Sz1 (Axes Column -> Int
totalPix Axes Column
as)) Get a
get


runGetThrow :: forall a m. (MonadThrow m) => Get a -> BL.ByteString -> m a
runGetThrow :: forall a (m :: * -> *). MonadThrow m => Get a -> ByteString -> m a
runGetThrow Get a
get ByteString
inp =
  case Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get a
get ByteString
inp of
    Left (ByteString
_, ByteOffset
bytes, String
e) -> ParseError -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ ByteOffset -> String -> ParseError
ParseError ByteOffset
bytes String
e
    Right (ByteString
_, ByteOffset
_, a
a) -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


----- ENCODING -----------------------------------------------------------------

{- | Encode an 'Array' to a 'DataArray'

>>> encodeImage array
DataArray:
  data: 48 bytes
  dimensions:
    format: Int64
    axes: [3,2]
-}
encodeArray
  :: forall r ix a
   . (Source r a, Stream r Ix1 a, Size r, PutArray ix, Index ix, AxesIndex ix, PutPix a, Prim a)
  => Array r ix a
  -> DataArray
encodeArray :: forall r ix a.
(Source r a, Stream r Int a, Size r, PutArray ix, Index ix,
 AxesIndex ix, PutPix a, Prim a) =>
Array r ix a -> DataArray
encodeArray Array r ix a
arr =
  let axes :: Axes Column
axes = Sz ix -> Axes Column
forall ix. (AxesIndex ix, Index ix) => Sz ix -> Axes Column
sizeAxes (Sz ix -> Axes Column) -> Sz ix -> Axes Column
forall a b. (a -> b) -> a -> b
$ Array r ix a -> Sz ix
forall r ix e. Size r => Array r ix e -> Sz ix
forall ix e. Array r ix e -> Sz ix
size Array r ix a
arr
      bitpix :: BitPix
bitpix = forall a. PutPix a => Proxy a -> BitPix
bitPixFormat @a Proxy a
forall {k} (t :: k). Proxy t
Proxy
      rawData :: ByteString
rawData = Array r ix a -> ByteString
forall r a ix.
(Source r a, Stream r Int a, PutArray ix, Index ix, PutPix a,
 Prim a) =>
Array r ix a -> ByteString
encodeArrayData Array r ix a
arr -- O(n)
   in DataArray{BitPix
$sel:bitpix:DataArray :: BitPix
bitpix :: BitPix
bitpix, Axes Column
$sel:axes:DataArray :: Axes Column
axes :: Axes Column
axes, ByteString
$sel:rawData:DataArray :: ByteString
rawData :: ByteString
rawData}


{- | Encode an Array as a Lazy ByteString based on the type of the element 'a'

>>> myArray = decodeArray @Ix2 @Float BPFloat [3, 2] input
>>> output = encodeArray myArray
-}
encodeArrayData :: (Source r a, Stream r Ix1 a, PutArray ix, Index ix, PutPix a, Prim a) => Array r ix a -> BS.ByteString
encodeArrayData :: forall r a ix.
(Source r a, Stream r Int a, PutArray ix, Index ix, PutPix a,
 Prim a) =>
Array r ix a -> ByteString
encodeArrayData = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Array r ix a -> ByteString) -> Array r ix a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString)
-> (Array r ix a -> Put) -> Array r ix a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array r ix a -> Put
forall ix r a.
(PutArray ix, Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r ix a -> Put
forall r a.
(Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r ix a -> Put
putArray


-- | The total number of pixels to read from the input ByteString
totalPix :: Axes Column -> Int
totalPix :: Axes Column -> Int
totalPix (Axes [Int]
as) = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int]
as


class AxesIndex ix where
  axesIndex :: (MonadThrow m) => Axes Row -> m ix
  indexAxes :: ix -> Axes Row


instance AxesIndex Ix1 where
  axesIndex :: forall (m :: * -> *). MonadThrow m => Axes Row -> m Int
axesIndex (Axes [Int
i]) = Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
  axesIndex Axes Row
as = ParseError -> m Int
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m Int) -> ParseError -> m Int
forall a b. (a -> b) -> a -> b
$ Axes Row -> ParseError
AxesMismatch Axes Row
as
  indexAxes :: Int -> Axes Row
indexAxes Int
n = [Int] -> Axes Row
forall {k} (a :: k). [Int] -> Axes a
Axes [Int
n]


instance AxesIndex Ix2 where
  axesIndex :: forall (m :: * -> *). MonadThrow m => Axes Row -> m Ix2
axesIndex (Axes [Int
c, Int
r]) = do
    Int
ix1 <- Axes Row -> m Int
forall ix (m :: * -> *).
(AxesIndex ix, MonadThrow m) =>
Axes Row -> m ix
forall (m :: * -> *). MonadThrow m => Axes Row -> m Int
axesIndex (Axes Row -> m Int) -> Axes Row -> m Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Axes Row
forall {k} (a :: k). [Int] -> Axes a
Axes [Int
r]
    Ix2 -> m Ix2
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ix2 -> m Ix2) -> Ix2 -> m Ix2
forall a b. (a -> b) -> a -> b
$ Int
c Int -> Int -> Ix2
:. Int
ix1
  axesIndex Axes Row
as = ParseError -> m Ix2
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m Ix2) -> ParseError -> m Ix2
forall a b. (a -> b) -> a -> b
$ Axes Row -> ParseError
AxesMismatch Axes Row
as
  indexAxes :: Ix2 -> Axes Row
indexAxes (Int
c :. Int
r) = [Int] -> Axes Row
forall {k} (a :: k). [Int] -> Axes a
Axes [Int
c, Int
r]


instance AxesIndex Ix3 where
  axesIndex :: forall (m :: * -> *). MonadThrow m => Axes Row -> m Ix3
axesIndex = Axes Row -> m Ix3
forall (n :: Nat) (m :: * -> *).
(AxesIndex (Lower (IxN n)), MonadThrow m) =>
Axes Row -> m (IxN n)
axesIndexN
  indexAxes :: Ix3 -> Axes Row
indexAxes = Ix3 -> Axes Row
forall (n :: Nat). AxesIndex (Lower (IxN n)) => IxN n -> Axes Row
indexAxesN


instance AxesIndex Ix4 where
  axesIndex :: forall (m :: * -> *). MonadThrow m => Axes Row -> m Ix4
axesIndex = Axes Row -> m Ix4
forall (n :: Nat) (m :: * -> *).
(AxesIndex (Lower (IxN n)), MonadThrow m) =>
Axes Row -> m (IxN n)
axesIndexN
  indexAxes :: Ix4 -> Axes Row
indexAxes = Ix4 -> Axes Row
forall (n :: Nat). AxesIndex (Lower (IxN n)) => IxN n -> Axes Row
indexAxesN


instance AxesIndex Ix5 where
  axesIndex :: forall (m :: * -> *). MonadThrow m => Axes Row -> m Ix5
axesIndex = Axes Row -> m Ix5
forall (n :: Nat) (m :: * -> *).
(AxesIndex (Lower (IxN n)), MonadThrow m) =>
Axes Row -> m (IxN n)
axesIndexN
  indexAxes :: Ix5 -> Axes Row
indexAxes = Ix5 -> Axes Row
forall (n :: Nat). AxesIndex (Lower (IxN n)) => IxN n -> Axes Row
indexAxesN


axesIndexN :: (AxesIndex (Lower (IxN n))) => (MonadThrow m) => Axes Row -> m (IxN n)
axesIndexN :: forall (n :: Nat) (m :: * -> *).
(AxesIndex (Lower (IxN n)), MonadThrow m) =>
Axes Row -> m (IxN n)
axesIndexN (Axes (Int
a : [Int]
as)) = do
  Ix (n - 1)
ixl <- Axes Row -> m (Ix (n - 1))
forall ix (m :: * -> *).
(AxesIndex ix, MonadThrow m) =>
Axes Row -> m ix
forall (m :: * -> *). MonadThrow m => Axes Row -> m (Ix (n - 1))
axesIndex ([Int] -> Axes Row
forall {k} (a :: k). [Int] -> Axes a
Axes [Int]
as)
  IxN n -> m (IxN n)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IxN n -> m (IxN n)) -> IxN n -> m (IxN n)
forall a b. (a -> b) -> a -> b
$ Int
a Int -> Ix (n - 1) -> IxN n
forall (n :: Nat). Int -> Ix (n - 1) -> IxN n
:> Ix (n - 1)
ixl
axesIndexN Axes Row
as = ParseError -> m (IxN n)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (IxN n)) -> ParseError -> m (IxN n)
forall a b. (a -> b) -> a -> b
$ Axes Row -> ParseError
AxesMismatch Axes Row
as


indexAxesN :: (AxesIndex (Lower (IxN n))) => IxN n -> Axes Row
indexAxesN :: forall (n :: Nat). AxesIndex (Lower (IxN n)) => IxN n -> Axes Row
indexAxesN (Int
d :> Ix (n - 1)
ix) =
  let Axes [Int]
ax = Ix (n - 1) -> Axes Row
forall ix. AxesIndex ix => ix -> Axes Row
indexAxes Ix (n - 1)
ix
   in [Int] -> Axes Row
forall {k} (a :: k). [Int] -> Axes a
Axes ([Int] -> Axes Row) -> [Int] -> Axes Row
forall a b. (a -> b) -> a -> b
$ Int
d Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
ax


sizeAxes :: (AxesIndex ix, Index ix) => Sz ix -> Axes Column
sizeAxes :: forall ix. (AxesIndex ix, Index ix) => Sz ix -> Axes Column
sizeAxes (Sz ix
ix) = Axes Row -> Axes Column
columnMajor (Axes Row -> Axes Column) -> Axes Row -> Axes Column
forall a b. (a -> b) -> a -> b
$ ix -> Axes Row
forall ix. AxesIndex ix => ix -> Axes Row
indexAxes ix
ix


data ParseError
  = ParseError !ByteOffset !String
  | AxesMismatch !(Axes Row)
  deriving (Int -> ParseError -> String -> String
[ParseError] -> String -> String
ParseError -> String
(Int -> ParseError -> String -> String)
-> (ParseError -> String)
-> ([ParseError] -> String -> String)
-> Show ParseError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ParseError -> String -> String
showsPrec :: Int -> ParseError -> String -> String
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> String -> String
showList :: [ParseError] -> String -> String
Show, Show ParseError
Typeable ParseError
Typeable ParseError
-> Show ParseError
-> (ParseError -> SomeException)
-> (SomeException -> Maybe ParseError)
-> (ParseError -> String)
-> Exception ParseError
SomeException -> Maybe ParseError
ParseError -> String
ParseError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
$ctoException :: ParseError -> SomeException
toException :: ParseError -> SomeException
$cfromException :: SomeException -> Maybe ParseError
fromException :: SomeException -> Maybe ParseError
$cdisplayException :: ParseError -> String
displayException :: ParseError -> String
Exception)


class GetPix a where
  getPix :: BitPix -> Get a


instance GetPix Int8 where
  getPix :: BitPix -> Get Int8
getPix BitPix
BPInt8 = Get Int8
getInt8
  getPix BitPix
f = String -> Get Int8
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Int8) -> String -> Get Int8
forall a b. (a -> b) -> a -> b
$ String
"Expected Int8, but format is " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BitPix -> String
forall a. Show a => a -> String
show BitPix
f


instance GetPix Int16 where
  getPix :: BitPix -> Get Int16
getPix BitPix
BPInt16 = Get Int16
getInt16be
  getPix BitPix
f = String -> Get Int16
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Int16) -> String -> Get Int16
forall a b. (a -> b) -> a -> b
$ String
"Expected Int16, but format is " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BitPix -> String
forall a. Show a => a -> String
show BitPix
f


instance GetPix Int32 where
  getPix :: BitPix -> Get Int32
getPix BitPix
BPInt32 = Get Int32
getInt32be
  getPix BitPix
f = String -> Get Int32
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Int32) -> String -> Get Int32
forall a b. (a -> b) -> a -> b
$ String
"Expected Int32, but format is " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BitPix -> String
forall a. Show a => a -> String
show BitPix
f


instance GetPix Int64 where
  getPix :: BitPix -> Get ByteOffset
getPix BitPix
BPInt64 = Get ByteOffset
getInt64be
  getPix BitPix
f = String -> Get ByteOffset
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ByteOffset) -> String -> Get ByteOffset
forall a b. (a -> b) -> a -> b
$ String
"Expected Int64, but format is " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BitPix -> String
forall a. Show a => a -> String
show BitPix
f


instance GetPix Int where
  getPix :: BitPix -> Get Int
getPix BitPix
BPInt8 = Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int) -> Get Int8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. GetPix a => BitPix -> Get a
getPix @Int8 BitPix
BPInt8
  getPix BitPix
BPInt16 = Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. GetPix a => BitPix -> Get a
getPix @Int16 BitPix
BPInt16
  getPix BitPix
BPInt32 = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. GetPix a => BitPix -> Get a
getPix @Int32 BitPix
BPInt32
  getPix BitPix
BPInt64 = ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Int) -> Get ByteOffset -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. GetPix a => BitPix -> Get a
getPix @Int64 BitPix
BPInt64
  getPix BitPix
f = String -> Get Int
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Int) -> String -> Get Int
forall a b. (a -> b) -> a -> b
$ String
"Expected Int, but format is " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BitPix -> String
forall a. Show a => a -> String
show BitPix
f


instance GetPix Float where
  getPix :: BitPix -> Get Float
getPix BitPix
BPFloat = Get Float
getFloatbe
  getPix BitPix
f = String -> Get Float
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Float) -> String -> Get Float
forall a b. (a -> b) -> a -> b
$ String
"Expected Float, but format is " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BitPix -> String
forall a. Show a => a -> String
show BitPix
f


instance GetPix Double where
  getPix :: BitPix -> Get Double
getPix BitPix
BPDouble = Get Double
getDoublebe
  getPix BitPix
f = String -> Get Double
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Double) -> String -> Get Double
forall a b. (a -> b) -> a -> b
$ String
"Expected Double, but format is " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BitPix -> String
forall a. Show a => a -> String
show BitPix
f


-- | How to encode an element type. Note that there is no instance for 'Int', since the size is system dependent. Use Int64 or Int32 instead
class PutPix a where
  bitPixFormat :: Proxy a -> BitPix
  putPix :: a -> Put


instance PutPix Int8 where
  bitPixFormat :: Proxy Int8 -> BitPix
bitPixFormat Proxy Int8
_ = BitPix
BPInt8
  putPix :: Int8 -> Put
putPix = Int8 -> Put
putInt8
instance PutPix Int16 where
  bitPixFormat :: Proxy Int16 -> BitPix
bitPixFormat Proxy Int16
_ = BitPix
BPInt16
  putPix :: Int16 -> Put
putPix = Int16 -> Put
putInt16be
instance PutPix Int32 where
  bitPixFormat :: Proxy Int32 -> BitPix
bitPixFormat Proxy Int32
_ = BitPix
BPInt32
  putPix :: Int32 -> Put
putPix = Int32 -> Put
putInt32be
instance PutPix Int64 where
  bitPixFormat :: Proxy ByteOffset -> BitPix
bitPixFormat Proxy ByteOffset
_ = BitPix
BPInt64
  putPix :: ByteOffset -> Put
putPix = ByteOffset -> Put
putInt64be
instance PutPix Float where
  bitPixFormat :: Proxy Float -> BitPix
bitPixFormat Proxy Float
_ = BitPix
BPFloat
  putPix :: Float -> Put
putPix = Float -> Put
putFloatbe
instance PutPix Double where
  bitPixFormat :: Proxy Double -> BitPix
bitPixFormat Proxy Double
_ = BitPix
BPDouble
  putPix :: Double -> Put
putPix = Double -> Put
putDoublebe


class PutArray ix where
  putArray :: (Source r a, Stream r Ix1 a, PutPix a, Prim a) => Array r ix a -> Put


instance PutArray Ix1 where
  putArray :: forall r a.
(Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r Int a -> Put
putArray = (Put -> a -> Put) -> Put -> Array r Int a -> Put
forall r ix e a.
Stream r ix e =>
(a -> e -> a) -> a -> Array r ix e -> a
sfoldl (\Put
b a
a -> Put
b Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> a -> Put
forall a. PutPix a => a -> Put
putPix a
a) Put
forall a. Monoid a => a
mempty


instance PutArray Ix2 where
  putArray :: forall r a.
(Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r Ix2 a -> Put
putArray = (Array r (Lower Ix2) a -> Put) -> Array r Ix2 a -> Put
forall ix r e m.
(Index ix, Index (Lower ix), Source r e, Monoid m) =>
(Array r (Lower ix) e -> m) -> Array r ix e -> m
foldOuterSlice Array r Int a -> Put
Array r (Lower Ix2) a -> Put
forall ix r a.
(PutArray ix, Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r ix a -> Put
forall r a.
(Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r Int a -> Put
putArray


instance PutArray Ix3 where
  putArray :: forall r a.
(Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r Ix3 a -> Put
putArray = (Array r (Lower Ix3) a -> Put) -> Array r Ix3 a -> Put
forall ix r e m.
(Index ix, Index (Lower ix), Source r e, Monoid m) =>
(Array r (Lower ix) e -> m) -> Array r ix e -> m
foldOuterSlice Array r (Lower Ix3) a -> Put
Array r Ix2 a -> Put
forall ix r a.
(PutArray ix, Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r ix a -> Put
forall r a.
(Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r Ix2 a -> Put
putArray


instance PutArray Ix4 where
  putArray :: forall r a.
(Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r Ix4 a -> Put
putArray = (Array r (Lower Ix4) a -> Put) -> Array r Ix4 a -> Put
forall ix r e m.
(Index ix, Index (Lower ix), Source r e, Monoid m) =>
(Array r (Lower ix) e -> m) -> Array r ix e -> m
foldOuterSlice Array r (Lower Ix4) a -> Put
Array r Ix3 a -> Put
forall ix r a.
(PutArray ix, Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r ix a -> Put
forall r a.
(Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r Ix3 a -> Put
putArray


instance PutArray Ix5 where
  putArray :: forall r a.
(Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r Ix5 a -> Put
putArray = (Array r (Lower Ix5) a -> Put) -> Array r Ix5 a -> Put
forall ix r e m.
(Index ix, Index (Lower ix), Source r e, Monoid m) =>
(Array r (Lower ix) e -> m) -> Array r ix e -> m
foldOuterSlice Array r (Lower Ix5) a -> Put
Array r Ix4 a -> Put
forall ix r a.
(PutArray ix, Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r ix a -> Put
forall r a.
(Source r a, Stream r Int a, PutPix a, Prim a) =>
Array r Ix4 a -> Put
putArray