{-# LANGUAGE GADTs #-}
--------------------------------------------------------------------------------
-- |
-- Module:    Data.IDX.Internal
-- Copyright: Christof Schramm
-- License:   GPLv3
--
-- Maintainer:  Christof Schramm <christof.schramm@campus.lmu.de>
-- Stability:   Experimental
-- Portability: Shoud work with all major haskell implementations
--
-- An internal package, the API contained here should not be used
-- and is subject to possibly breaking changes. Use these functions
-- and types at your own risk.
--
-- The safe interface is in 'Data.IDX'
--------------------------------------------------------------------------------
module Data.IDX.Internal where

import           Control.Monad (replicateM)
import           Data.Binary
import           Data.Int

import qualified Data.Vector.Unboxed as V
import           Data.Vector.Unboxed ((!))
import           Data.Functor ((<$>))

-- | A type to describe the content, according to IDX spec
data IDXContentType where
   IDXUnsignedByte :: IDXContentType
   IDXSignedByte   :: IDXContentType
   IDXShort        :: IDXContentType
   IDXInt          :: IDXContentType
   IDXFloat        :: IDXContentType
   IDXDouble       :: IDXContentType
   deriving (Int -> IDXContentType -> ShowS
[IDXContentType] -> ShowS
IDXContentType -> String
(Int -> IDXContentType -> ShowS)
-> (IDXContentType -> String)
-> ([IDXContentType] -> ShowS)
-> Show IDXContentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IDXContentType] -> ShowS
$cshowList :: [IDXContentType] -> ShowS
show :: IDXContentType -> String
$cshow :: IDXContentType -> String
showsPrec :: Int -> IDXContentType -> ShowS
$cshowsPrec :: Int -> IDXContentType -> ShowS
Show, IDXContentType -> IDXContentType -> Bool
(IDXContentType -> IDXContentType -> Bool)
-> (IDXContentType -> IDXContentType -> Bool) -> Eq IDXContentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IDXContentType -> IDXContentType -> Bool
$c/= :: IDXContentType -> IDXContentType -> Bool
== :: IDXContentType -> IDXContentType -> Bool
$c== :: IDXContentType -> IDXContentType -> Bool
Eq)

instance Binary IDXContentType where
    get :: Get IDXContentType
get = do
      Word8
w <- Get Word8
getWord8
      case Word8
w of
        Word8
0x08 -> IDXContentType -> Get IDXContentType
forall (m :: * -> *) a. Monad m => a -> m a
return IDXContentType
IDXUnsignedByte
        Word8
0x09 -> IDXContentType -> Get IDXContentType
forall (m :: * -> *) a. Monad m => a -> m a
return IDXContentType
IDXSignedByte
        Word8
0x0B -> IDXContentType -> Get IDXContentType
forall (m :: * -> *) a. Monad m => a -> m a
return IDXContentType
IDXShort
        Word8
0x0C -> IDXContentType -> Get IDXContentType
forall (m :: * -> *) a. Monad m => a -> m a
return IDXContentType
IDXInt
        Word8
0x0D -> IDXContentType -> Get IDXContentType
forall (m :: * -> *) a. Monad m => a -> m a
return IDXContentType
IDXFloat
        Word8
0x0E -> IDXContentType -> Get IDXContentType
forall (m :: * -> *) a. Monad m => a -> m a
return IDXContentType
IDXDouble
        Word8
_ -> String -> Get IDXContentType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get IDXContentType) -> String -> Get IDXContentType
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized IDX content type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word8 -> String
forall a. Show a => a -> String
show Word8
w)

    put :: IDXContentType -> Put
put IDXContentType
IDXUnsignedByte = Word8 -> Put
putWord8 Word8
0x08
    put IDXContentType
IDXSignedByte   = Word8 -> Put
putWord8 Word8
0x09
    put IDXContentType
IDXShort        = Word8 -> Put
putWord8 Word8
0x0B
    put IDXContentType
IDXInt          = Word8 -> Put
putWord8 Word8
0x0C
    put IDXContentType
IDXFloat        = Word8 -> Put
putWord8 Word8
0x0D
    put IDXContentType
IDXDouble       = Word8 -> Put
putWord8 Word8
0x0E

-- | Datatype for storing IDXData. Internally data is always stored either
-- as 'Int' or 'Double' unboxed vectors. However when binary serialization
-- is used, the data is serialized according to the 'IDXContentType'.
data IDXData = IDXInts    IDXContentType (V.Vector Int) (V.Vector Int   )
             | IDXDoubles IDXContentType (V.Vector Int) (V.Vector Double)
             deriving (Int -> IDXData -> ShowS
[IDXData] -> ShowS
IDXData -> String
(Int -> IDXData -> ShowS)
-> (IDXData -> String) -> ([IDXData] -> ShowS) -> Show IDXData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IDXData] -> ShowS
$cshowList :: [IDXData] -> ShowS
show :: IDXData -> String
$cshow :: IDXData -> String
showsPrec :: Int -> IDXData -> ShowS
$cshowsPrec :: Int -> IDXData -> ShowS
Show, IDXData -> IDXData -> Bool
(IDXData -> IDXData -> Bool)
-> (IDXData -> IDXData -> Bool) -> Eq IDXData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IDXData -> IDXData -> Bool
$c/= :: IDXData -> IDXData -> Bool
== :: IDXData -> IDXData -> Bool
$c== :: IDXData -> IDXData -> Bool
Eq)


instance Binary IDXData where
    get :: Get IDXData
get = do
      -- Get header information (4 bytes total)
      Get Word8
getWord8
      Get Word8
getWord8 
      IDXContentType
idxType <- Get IDXContentType
forall t. Binary t => Get t
get :: Get IDXContentType
      Int
nDimensions <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

      -- Each dimension size is encoded as a 32 bit integer
      [Int]
dimensionSizes <- Int -> Get Int -> Get [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nDimensions (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
<$> Get Int32
getInt32)      
      let nEntries :: Int
nEntries = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int]
dimensionSizes
          dimV :: Vector Int
dimV = [Int] -> Vector Int
forall a. Unbox a => [a] -> Vector a
V.fromList [Int]
dimensionSizes

      -- Retrieve the data, depending on the type specified in the file
      -- Cast all integral types to Int and all decimal numbers tod double
      case IDXContentType
idxType of
        t :: IDXContentType
t@IDXContentType
IDXUnsignedByte -> Int -> IDXContentType -> Vector Int -> Get Word8 -> Get IDXData
forall a.
Integral a =>
Int -> IDXContentType -> Vector Int -> Get a -> Get IDXData
buildIntResult Int
nEntries IDXContentType
t Vector Int
dimV Get Word8
getWord8
        t :: IDXContentType
t@IDXContentType
IDXSignedByte   -> Int -> IDXContentType -> Vector Int -> Get Int8 -> Get IDXData
forall a.
Integral a =>
Int -> IDXContentType -> Vector Int -> Get a -> Get IDXData
buildIntResult Int
nEntries IDXContentType
t Vector Int
dimV Get Int8
getInt8
        t :: IDXContentType
t@IDXContentType
IDXShort        -> Int -> IDXContentType -> Vector Int -> Get Int16 -> Get IDXData
forall a.
Integral a =>
Int -> IDXContentType -> Vector Int -> Get a -> Get IDXData
buildIntResult Int
nEntries IDXContentType
t Vector Int
dimV Get Int16
getInt16
        t :: IDXContentType
t@IDXContentType
IDXInt          -> Int -> IDXContentType -> Vector Int -> Get Int32 -> Get IDXData
forall a.
Integral a =>
Int -> IDXContentType -> Vector Int -> Get a -> Get IDXData
buildIntResult Int
nEntries IDXContentType
t Vector Int
dimV Get Int32
getInt32

        t :: IDXContentType
t@IDXContentType
IDXFloat        -> Int -> IDXContentType -> Vector Int -> Get Float -> Get IDXData
forall a.
Real a =>
Int -> IDXContentType -> Vector Int -> Get a -> Get IDXData
buildDoubleResult Int
nEntries IDXContentType
t Vector Int
dimV Get Float
getFloat
        t :: IDXContentType
t@IDXContentType
IDXDouble       -> Int -> IDXContentType -> Vector Int -> Get Double -> Get IDXData
forall a.
Real a =>
Int -> IDXContentType -> Vector Int -> Get a -> Get IDXData
buildDoubleResult Int
nEntries IDXContentType
t Vector Int
dimV Get Double
getDouble
        
    put :: IDXData -> Put
put IDXData
d = do
      -- First four bytes are meta information
      Word8 -> Put
putWord8 Word8
0
      Word8 -> Put
putWord8 Word8
0
      -- Third byte is content type
      IDXContentType -> Put
forall t. Binary t => t -> Put
put (IDXContentType -> Put) -> IDXContentType -> Put
forall a b. (a -> b) -> a -> b
$ IDXData -> IDXContentType
idxType IDXData
d
      
      -- Fourth byte is number of dimensions
      let dimensions :: Vector Int
dimensions = IDXData -> Vector Int
idxDimensions IDXData
d
      Word8 -> Put
forall t. Binary t => t -> Put
put (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector Int
dimensions :: Word8)

      -- Put size of each dimension as an Int32
      Vector Int -> (Int -> Put) -> Put
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
V.forM_ Vector Int
dimensions ((Int -> Put) -> Put) -> (Int -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ (\Int
x -> Int32 -> Put
forall t. Binary t => t -> Put
put (Int32 -> Put) -> Int32 -> Put
forall a b. (a -> b) -> a -> b
$! (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x :: Int32))

      -- Put the individual values
      case IDXData
d of
        IDXDoubles IDXContentType
t Vector Int
_ Vector Double
content -> Vector Double -> (Double -> Put) -> Put
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
V.forM_ Vector Double
content ((Double -> Put) -> Put) -> (Double -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ IDXContentType -> Double -> Put
putReal     IDXContentType
t
        IDXInts    IDXContentType
t Vector Int
_ Vector Int
content -> Vector Int -> (Int -> Put) -> Put
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
V.forM_ Vector Int
content ((Int -> Put) -> Put) -> (Int -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ IDXContentType -> Int -> Put
putIntegral IDXContentType
t

-- | A data type that holds 'Int' labels for a set of 'IDXData'
newtype IDXLabels = IDXLabels (V.Vector Int)

instance Binary IDXLabels where
  get :: Get IDXLabels
get = do
    Get Int32
getInt32
    Int
nItems <- 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
<$> Get Int32
getInt32
    let readEntries :: Int -> Get (Vector a)
readEntries Int
n = Int -> Get a -> Get (Vector a)
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> m a -> m (Vector a)
V.replicateM Int
n (Get a -> Get (Vector a)) -> Get a -> Get (Vector a)
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Get Word8 -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get a -> (a -> Get a) -> Get a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$!)
    Vector Int
v <- (Int -> Get (Vector Int)) -> Int -> Int -> Get (Vector Int)
forall a.
Unbox a =>
(Int -> Get (Vector a)) -> Int -> Int -> Get (Vector a)
readContent Int -> Get (Vector Int)
forall a. (Unbox a, Num a) => Int -> Get (Vector a)
readEntries Int
500 Int
nItems
    IDXLabels -> Get IDXLabels
forall (m :: * -> *) a. Monad m => a -> m a
return (IDXLabels -> Get IDXLabels) -> IDXLabels -> Get IDXLabels
forall a b. (a -> b) -> a -> b
$ Vector Int -> IDXLabels
IDXLabels Vector Int
v

  put :: IDXLabels -> Put
put (IDXLabels Vector Int
v) = do
    Int32 -> Put
forall t. Binary t => t -> Put
put (Int32
0 :: Int32)
    let len :: Int
len = Vector Int -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector Int
v
    Int32 -> Put
forall t. Binary t => t -> Put
put (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len :: Int32)
    Vector Int -> (Int -> Put) -> Put
forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
V.forM_ Vector Int
v (\Int
x -> Word8 -> Put
forall t. Binary t => t -> Put
put (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$! (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x :: Word8))


-- | Return the what type the data is stored in
idxType :: IDXData -> IDXContentType
idxType :: IDXData -> IDXContentType
idxType (IDXInts    IDXContentType
t Vector Int
_ Vector Int
_) = IDXContentType
t
idxType (IDXDoubles IDXContentType
t Vector Int
_ Vector Double
_) = IDXContentType
t

-- | Return an unboxed Vector of Int dimensions
idxDimensions :: IDXData -> V.Vector Int
idxDimensions :: IDXData -> Vector Int
idxDimensions (IDXInts    IDXContentType
_ Vector Int
ds Vector Int
_) = Vector Int
ds
idxDimensions (IDXDoubles IDXContentType
_ Vector Int
ds Vector Double
_) = Vector Int
ds

-- | Return wether the data in this IDXData value is
-- stored as integral values
isIDXIntegral :: IDXData -> Bool
isIDXIntegral :: IDXData -> Bool
isIDXIntegral (IDXInts IDXContentType
_ Vector Int
_ Vector Int
_) = Bool
True
isIDXIntegral (IDXData
_            ) = Bool
False

-- | Return wether the data in this IDXData value is
-- stored as double values
isIDXReal :: IDXData -> Bool
isIDXReal :: IDXData -> Bool
isIDXReal (IDXDoubles IDXContentType
_ Vector Int
_ Vector Double
_) = Bool
True
isIDXReal (IDXData
_               ) = Bool
False

-- | Return contained ints, if no ints are contained,
-- convert content to ints by using 'round'. Data is stored like
-- in a C-array, i.e. the last index changes first.
idxIntContent :: IDXData -> V.Vector Int
idxIntContent :: IDXData -> Vector Int
idxIntContent (IDXInts    IDXContentType
_ Vector Int
_ Vector Int
v) = Vector Int
v
idxIntContent (IDXDoubles IDXContentType
_ Vector Int
_ Vector Double
v) =
  [Int] -> Vector Int
forall a. Unbox a => [a] -> Vector a
V.fromList ([Int] -> Vector Int) -> [Int] -> Vector Int
forall a b. (a -> b) -> a -> b
$ [Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Double
v Vector Double -> Int -> Double
forall a. Unbox a => Vector a -> Int -> a
! Int
i) | Int
i <- [Int
0.. ((Vector Double -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector Double
v)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]]

-- | Return contained doubles, if no doubles are contained
-- convert the content to double by using 'fromIntegral'. Data is stored like
-- in a C-array, i.e. the last index changes first.
idxDoubleContent :: IDXData -> V.Vector Double
idxDoubleContent :: IDXData -> Vector Double
idxDoubleContent (IDXDoubles IDXContentType
_ Vector Int
_ Vector Double
v) = Vector Double
v
idxDoubleContent (IDXInts    IDXContentType
_ Vector Int
_ Vector Int
v) =
  [Double] -> Vector Double
forall a. Unbox a => [a] -> Vector a
V.fromList ([Double] -> Vector Double) -> [Double] -> Vector Double
forall a b. (a -> b) -> a -> b
$ [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ (Vector Int
v Vector Int -> Int -> Int
forall a. Unbox a => Vector a -> Int -> a
! Int
i) | Int
i <- [Int
0.. ((Vector Int -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector Int
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]]

-- | Helper function to read a (possibly big) vector of binary
-- values as chunks. Strictly evaluates each chunk and then
-- concatenates the chunks, does not leak space.
readContent :: (V.Unbox a)
            => (Int -> Get (V.Vector a)) -- ^ To Get a chunk of size n
            -> Int                       -- ^ Chunk size
            -> Int                       -- ^ Expected input
            -> Get (V.Vector a) 
readContent :: (Int -> Get (Vector a)) -> Int -> Int -> Get (Vector a)
readContent Int -> Get (Vector a)
readEntries Int
chunkSize Int
n =
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
chunkSize
  then do
    Vector a
headChunk <- Int -> Get (Vector a)
readEntries (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
chunkSize)
    let nChunks :: Int
nChunks = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
chunkSize
    [Vector a]
chunkList <- Int -> Get (Vector a) -> Get [Vector a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nChunks ((Int -> Get (Vector a)) -> Int -> Int -> Get (Vector a)
forall a.
Unbox a =>
(Int -> Get (Vector a)) -> Int -> Int -> Get (Vector a)
readContent Int -> Get (Vector a)
readEntries Int
chunkSize Int
chunkSize)
    Vector a -> Get (Vector a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector a -> Get (Vector a)) -> Vector a -> Get (Vector a)
forall a b. (a -> b) -> a -> b
$! [Vector a] -> Vector a
forall a. Unbox a => [Vector a] -> Vector a
V.concat ([Vector a] -> Vector a) -> [Vector a] -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a
headChunkVector a -> [Vector a] -> [Vector a]
forall a. a -> [a] -> [a]
:[Vector a]
chunkList
  else do
    Vector a
rest <- Int -> Get (Vector a)
readEntries Int
n
    Vector a -> Get (Vector a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector a -> Get (Vector a)) -> Vector a -> Get (Vector a)
forall a b. (a -> b) -> a -> b
$! Vector a
rest

-- Haskell's Data.Binary uses big-endian format
getInt8 :: Get Int8
getInt8 :: Get Int8
getInt8 = Get Int8
forall t. Binary t => Get t
get

getInt16 :: Get Int16
getInt16 :: Get Int16
getInt16 = Get Int16
forall t. Binary t => Get t
get

getInt32 :: Get Int32
getInt32 :: Get Int32
getInt32 = Get Int32
forall t. Binary t => Get t
get

getFloat :: Get Float
getFloat :: Get Float
getFloat = Get Float
forall t. Binary t => Get t
get

getDouble :: Get Double
getDouble :: Get Double
getDouble = Get Double
forall t. Binary t => Get t
get

-- | Helper function for parsing integer data from the
-- IDX content. Returns a full IDX result.
buildIntResult :: Integral a
                  => Int                -- ^ Expected number of entries
                      -> IDXContentType -- ^ Description of content
                      -> V.Vector Int   -- ^ Dimension sizes
                      -> Get a          -- ^ Monadic action to get content element
                      -> Get IDXData
buildIntResult :: Int -> IDXContentType -> Vector Int -> Get a -> Get IDXData
buildIntResult Int
nEntries IDXContentType
typ Vector Int
dimV Get a
getContent = do
  Vector Int
content <- (Int -> Get (Vector Int)) -> Int -> Int -> Get (Vector Int)
forall a.
Unbox a =>
(Int -> Get (Vector a)) -> Int -> Int -> Get (Vector a)
readContent Int -> Get (Vector Int)
readEntries Int
500 Int
nEntries
  IDXData -> Get IDXData
forall (m :: * -> *) a. Monad m => a -> m a
return (IDXData -> Get IDXData) -> IDXData -> Get IDXData
forall a b. (a -> b) -> a -> b
$ IDXContentType -> Vector Int -> Vector Int -> IDXData
IDXInts IDXContentType
typ Vector Int
dimV Vector Int
content
  where
    readEntries :: Int -> Get (Vector Int)
readEntries Int
n = Int -> Get Int -> Get (Vector Int)
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> m a -> m (Vector a)
V.replicateM Int
n (Get Int -> Get (Vector Int)) -> Get Int -> Get (Vector Int)
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int) -> Get a -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
getContent Get Int -> (Int -> Get Int) -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Get Int) -> Int -> Get Int
forall a b. (a -> b) -> a -> b
$!)

-- | Helper function for parsing real number data from
-- the IDX content.
buildDoubleResult :: Real a
                  => Int                -- ^ Expected number of entries
                      -> IDXContentType -- ^ Description of content
                      -> V.Vector Int   -- ^ Dimension sizes
                      -> Get a          -- ^ Monadic action to get content element
                      -> Get IDXData
buildDoubleResult :: Int -> IDXContentType -> Vector Int -> Get a -> Get IDXData
buildDoubleResult Int
nEntries IDXContentType
typ Vector Int
dimV Get a
getContent = do
  Vector Double
content <- (Int -> Get (Vector Double)) -> Int -> Int -> Get (Vector Double)
forall a.
Unbox a =>
(Int -> Get (Vector a)) -> Int -> Int -> Get (Vector a)
readContent Int -> Get (Vector Double)
readEntries Int
500 Int
nEntries
  IDXData -> Get IDXData
forall (m :: * -> *) a. Monad m => a -> m a
return (IDXData -> Get IDXData) -> IDXData -> Get IDXData
forall a b. (a -> b) -> a -> b
$ IDXContentType -> Vector Int -> Vector Double -> IDXData
IDXDoubles IDXContentType
typ Vector Int
dimV Vector Double
content
  where
    readEntries :: Int -> Get (Vector Double)
readEntries Int
n = Int -> Get Double -> Get (Vector Double)
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> m a -> m (Vector a)
V.replicateM Int
n (Get Double -> Get (Vector Double))
-> Get Double -> Get (Vector Double)
forall a b. (a -> b) -> a -> b
$ a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (a -> Double) -> Get a -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
getContent Get Double -> (Double -> Get Double) -> Get Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Double -> Get Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Get Double) -> Double -> Get Double
forall a b. (a -> b) -> a -> b
$!)

-- | Put values that are saved as Int
putIntegral :: IDXContentType -> Int -> Put
putIntegral :: IDXContentType -> Int -> Put
putIntegral IDXContentType
IDXUnsignedByte Int
n = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$! (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Word8)
putIntegral IDXContentType
IDXSignedByte   Int
n = Int8 -> Put
forall t. Binary t => t -> Put
put (Int8 -> Put) -> Int8 -> Put
forall a b. (a -> b) -> a -> b
$! (Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Int8 )
putIntegral IDXContentType
IDXShort        Int
n = Int16 -> Put
forall t. Binary t => t -> Put
put (Int16 -> Put) -> Int16 -> Put
forall a b. (a -> b) -> a -> b
$! (Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Int16)
putIntegral IDXContentType
IDXInt          Int
n = Int32 -> Put
forall t. Binary t => t -> Put
put (Int32 -> Put) -> Int32 -> Put
forall a b. (a -> b) -> a -> b
$! (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Int32)
putIntegral IDXContentType
t               Int
_ = String -> Put
forall a. HasCallStack => String -> a
error (String -> Put) -> String -> Put
forall a b. (a -> b) -> a -> b
$ String
"IDX.putIntegral " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IDXContentType -> String
forall a. Show a => a -> String
show IDXContentType
t 

-- | Put real values that are saved as Double
putReal :: IDXContentType -> Double -> Put
putReal :: IDXContentType -> Double -> Put
putReal IDXContentType
IDXDouble Double
n = Double -> Put
forall t. Binary t => t -> Put
put Double
n
putReal IDXContentType
IDXFloat  Double
n = Float -> Put
forall t. Binary t => t -> Put
put (Float -> Put) -> Float -> Put
forall a b. (a -> b) -> a -> b
$! (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n :: Float )

-- | Split data by the first dimension of the C-Array. This would e.g. split a
-- data-set of images into a list of data representing an individual image
partitionedData :: V.Unbox a => (IDXData -> V.Vector a) -> IDXData -> [V.Vector a]
partitionedData :: (IDXData -> Vector a) -> IDXData -> [Vector a]
partitionedData IDXData -> Vector a
getContent IDXData
idxData = do
  Int
i <- [Int
0 .. Int
dim0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  Vector a -> [Vector a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector a -> [Vector a]) -> Vector a -> [Vector a]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Vector a -> Vector a
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
V.slice (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
entrySize) Int
entrySize Vector a
content)
 where
   dim0 :: Int
dim0 = Vector Int -> Int
forall a. Unbox a => Vector a -> a
V.head (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ IDXData -> Vector Int
idxDimensions IDXData
idxData
   content :: Vector a
content = IDXData -> Vector a
getContent IDXData
idxData
   entrySize :: Int
entrySize = (Vector Int -> Int
forall a. (Unbox a, Num a) => Vector a -> a
V.product (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ IDXData -> Vector Int
idxDimensions IDXData
idxData) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
dim0