{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- SPDX-License-Identifier: MPL-2.0

{- | Bounded strict file codecs, fixed-chunk raw streaming, and read-only
mapped arrays. Mappings are bracketed and protected by a lock; even an IO
closure escaping the callback reports a closed mapping rather than touching
freed memory. Callers must keep mapped files immutable (POSIX truncation can
otherwise cause SIGBUS). Windows mappings use the wide-character API.
-}
module HMath.Interchange.IO (
    readArrayFile,
    writeArrayFile,
    RawSpec (..),
    readRawChunks,
    writeRawChunks,
    MappedArray,
    withMappedArray,
    mappedValue,
    mappedShape,
    mappedReadBytes,
) where

import Control.Concurrent.MVar
import Control.Exception (IOException, bracket, catch)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Foreign
import Foreign.C.Types
import HMath.Interchange.Array
import System.IO

{- | File reading checks the declared size before allocating, then caps the
actual read too, handling concurrent growth. Files are closed before return.
-}
readArrayFile ::
    Limits ->
    (B.ByteString -> Either InterchangeError Array) ->
    FilePath ->
    IO (Either InterchangeError Array)
readArrayFile :: Limits
-> (ByteString -> Either InterchangeError Array)
-> FilePath
-> IO (Either InterchangeError Array)
readArrayFile Limits
lim ByteString -> Either InterchangeError Array
decode FilePath
path = IO (Either InterchangeError Array)
-> IO (Either InterchangeError Array)
forall a.
IO (Either InterchangeError a) -> IO (Either InterchangeError a)
ioErrors (IO (Either InterchangeError Array)
 -> IO (Either InterchangeError Array))
-> IO (Either InterchangeError Array)
-> IO (Either InterchangeError Array)
forall a b. (a -> b) -> a -> b
$ case Limits -> Either InterchangeError ()
checkLimits Limits
lim of
    Left InterchangeError
err -> Either InterchangeError Array -> IO (Either InterchangeError Array)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError Array
forall a b. a -> Either a b
Left InterchangeError
err)
    Right () -> FilePath
-> IOMode
-> (Handle -> IO (Either InterchangeError Array))
-> IO (Either InterchangeError Array)
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
path IOMode
ReadMode ((Handle -> IO (Either InterchangeError Array))
 -> IO (Either InterchangeError Array))
-> (Handle -> IO (Either InterchangeError Array))
-> IO (Either InterchangeError Array)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
        size <- Handle -> IO Integer
hFileSize Handle
h
        if size > toInteger (maxBytes lim)
            then pure (Left (LimitExceeded "file bytes"))
            else do
                bytes <- readBounded h (maxBytes lim)
                pure (bytes >>= decode)

{- | Writes to the supplied path after encoding succeeds. Applications needing
transactional replacement can write a sibling temporary and rename it.
-}
writeArrayFile ::
    Limits ->
    (Limits -> Array -> Either InterchangeError B.ByteString) ->
    FilePath ->
    Array ->
    IO (Either InterchangeError ())
writeArrayFile :: Limits
-> (Limits -> Array -> Either InterchangeError ByteString)
-> FilePath
-> Array
-> IO (Either InterchangeError ())
writeArrayFile Limits
lim Limits -> Array -> Either InterchangeError ByteString
encode FilePath
path Array
a = case Limits -> Array -> Either InterchangeError ByteString
encode Limits
lim Array
a of
    Left InterchangeError
err -> Either InterchangeError () -> IO (Either InterchangeError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError ()
forall a b. a -> Either a b
Left InterchangeError
err)
    Right ByteString
bytes -> IO (Either InterchangeError ()) -> IO (Either InterchangeError ())
forall a.
IO (Either InterchangeError a) -> IO (Either InterchangeError a)
ioErrors (FilePath -> ByteString -> IO ()
B.writeFile FilePath
path ByteString
bytes IO ()
-> IO (Either InterchangeError ())
-> IO (Either InterchangeError ())
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either InterchangeError () -> IO (Either InterchangeError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either InterchangeError ()
forall a b. b -> Either a b
Right ()))

ioErrors :: IO (Either InterchangeError a) -> IO (Either InterchangeError a)
ioErrors :: forall a.
IO (Either InterchangeError a) -> IO (Either InterchangeError a)
ioErrors IO (Either InterchangeError a)
action = IO (Either InterchangeError a)
action IO (Either InterchangeError a)
-> (IOException -> IO (Either InterchangeError a))
-> IO (Either InterchangeError a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
e :: IOException) -> Either InterchangeError a -> IO (Either InterchangeError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError a
forall a b. a -> Either a b
Left (FilePath -> InterchangeError
InterchangeIOError (IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
e))))
readBounded :: Handle -> Int -> IO (Either InterchangeError B.ByteString)
readBounded :: Handle -> Int -> IO (Either InterchangeError ByteString)
readBounded Handle
h Int
budget = Int -> [ByteString] -> IO (Either InterchangeError ByteString)
go Int
budget []
  where
    go :: Int -> [ByteString] -> IO (Either InterchangeError ByteString)
go Int
left [ByteString]
chunks = do
        bytes <- Handle -> Int -> IO ByteString
B.hGet Handle
h (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
65536 (if Int
left Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound then Int
left else Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        if B.length bytes > left
            then pure (Left (LimitExceeded "file grew beyond byte budget"))
            else
                if B.null bytes
                    then pure (Right (B.concat (reverse chunks)))
                    else go (left - B.length bytes) (bytes : chunks)

{- | Raw physical storage: fixed dtype/endian/order and shape, no header. The
stream has exactly the product(shape)*itemsize bytes, including empty arrays.
-}
data RawSpec = RawSpec DType Endian Order [Int] deriving (RawSpec -> RawSpec -> Bool
(RawSpec -> RawSpec -> Bool)
-> (RawSpec -> RawSpec -> Bool) -> Eq RawSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawSpec -> RawSpec -> Bool
== :: RawSpec -> RawSpec -> Bool
$c/= :: RawSpec -> RawSpec -> Bool
/= :: RawSpec -> RawSpec -> Bool
Eq, Int -> RawSpec -> ShowS
[RawSpec] -> ShowS
RawSpec -> FilePath
(Int -> RawSpec -> ShowS)
-> (RawSpec -> FilePath) -> ([RawSpec] -> ShowS) -> Show RawSpec
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawSpec -> ShowS
showsPrec :: Int -> RawSpec -> ShowS
$cshow :: RawSpec -> FilePath
show :: RawSpec -> FilePath
$cshowList :: [RawSpec] -> ShowS
showList :: [RawSpec] -> ShowS
Show)

rawSize :: Limits -> RawSpec -> Either InterchangeError Int
rawSize :: Limits -> RawSpec -> Either InterchangeError Int
rawSize Limits
lim (RawSpec DType
dt Endian
_ Order
_ [Int]
sh) = do
    n <- Limits -> [Int] -> Either InterchangeError Int
validateShape Limits
lim [Int]
sh
    boundedInt "raw stream bytes" (toInteger (maxBytes lim)) (toInteger n * toInteger (elementBytes dt))

{- | Read physical-order chunks (one-dimensional arrays); the caller retains
the original RawSpec for reconstructing dimensions. Memory is O(chunk),
excluding any data retained by the callback. False cancels successfully
without consuming the rest. Full completion requires EOF, detecting tails.
-}
readRawChunks ::
    Limits ->
    RawSpec ->
    Int ->
    Handle ->
    (Array -> IO (Either InterchangeError Bool)) ->
    IO (Either InterchangeError ())
readRawChunks :: Limits
-> RawSpec
-> Int
-> Handle
-> (Array -> IO (Either InterchangeError Bool))
-> IO (Either InterchangeError ())
readRawChunks Limits
lim spec :: RawSpec
spec@(RawSpec DType
dt Endian
en Order
_ [Int]
_) Int
chunkElements Handle
h Array -> IO (Either InterchangeError Bool)
consume = IO (Either InterchangeError ()) -> IO (Either InterchangeError ())
forall a.
IO (Either InterchangeError a) -> IO (Either InterchangeError a)
ioErrors (IO (Either InterchangeError ())
 -> IO (Either InterchangeError ()))
-> IO (Either InterchangeError ())
-> IO (Either InterchangeError ())
forall a b. (a -> b) -> a -> b
$ case Either InterchangeError Int
validate of
    Left InterchangeError
err -> Either InterchangeError () -> IO (Either InterchangeError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError ()
forall a b. a -> Either a b
Left InterchangeError
err)
    Right Int
total -> Int -> IO (Either InterchangeError ())
go Int
total
  where
    width :: Int
width = DType -> Int
elementBytes DType
dt
    validate :: Either InterchangeError Int
validate = do
        total <- Limits -> RawSpec -> Either InterchangeError Int
rawSize Limits
lim RawSpec
spec
        guardI
            (chunkElements > 0 && toInteger chunkElements * toInteger width <= toInteger (maxBytes lim))
            (InvalidData "invalid stream chunk size")
        Right total
    go :: Int -> IO (Either InterchangeError ())
go Int
0 = do
        tailByte <- Handle -> Int -> IO ByteString
B.hGet Handle
h Int
1
        pure (if B.null tailByte then Right () else Left (InvalidData "raw stream trailing bytes"))
    go Int
left = do
        let amount :: Int
amount = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
left (Int
chunkElements Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width)
        bytes <- Handle -> Int -> IO ByteString
B.hGet Handle
h Int
amount
        if B.length bytes /= amount
            then pure (Left (InvalidData "truncated raw stream"))
            else case contiguousArray lim dt en COrder [amount `div` width] bytes of
                Left InterchangeError
err -> Either InterchangeError () -> IO (Either InterchangeError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError ()
forall a b. a -> Either a b
Left InterchangeError
err)
                Right Array
a -> do
                    result <- Array -> IO (Either InterchangeError Bool)
consume Array
a
                    case result of
                        Left InterchangeError
err -> Either InterchangeError () -> IO (Either InterchangeError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError ()
forall a b. a -> Either a b
Left InterchangeError
err)
                        Right Bool
False -> Either InterchangeError () -> IO (Either InterchangeError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either InterchangeError ()
forall a b. b -> Either a b
Right ())
                        Right Bool
True -> Int -> IO (Either InterchangeError ())
go (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
amount)

{- | Write fixed-size raw chunks. The producer receives a maximum byte count,
must return whole elements, and signals EOF with Nothing. Short streams,
overlong streams, noncanonical bools and empty nonfinal chunks fail. Errors
may leave a partial output; the handle remains owned by the caller.
-}
writeRawChunks ::
    Limits ->
    RawSpec ->
    Int ->
    Handle ->
    (Int -> IO (Either InterchangeError (Maybe B.ByteString))) ->
    IO (Either InterchangeError ())
writeRawChunks :: Limits
-> RawSpec
-> Int
-> Handle
-> (Int -> IO (Either InterchangeError (Maybe ByteString)))
-> IO (Either InterchangeError ())
writeRawChunks Limits
lim spec :: RawSpec
spec@(RawSpec DType
dt Endian
en Order
_ [Int]
_) Int
chunkElements Handle
h Int -> IO (Either InterchangeError (Maybe ByteString))
produce = IO (Either InterchangeError ()) -> IO (Either InterchangeError ())
forall a.
IO (Either InterchangeError a) -> IO (Either InterchangeError a)
ioErrors (IO (Either InterchangeError ())
 -> IO (Either InterchangeError ()))
-> IO (Either InterchangeError ())
-> IO (Either InterchangeError ())
forall a b. (a -> b) -> a -> b
$ case Either InterchangeError Int
validate of
    Left InterchangeError
err -> Either InterchangeError () -> IO (Either InterchangeError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError ()
forall a b. a -> Either a b
Left InterchangeError
err)
    Right Int
total -> Int -> IO (Either InterchangeError ())
go Int
total
  where
    width :: Int
width = DType -> Int
elementBytes DType
dt
    validate :: Either InterchangeError Int
validate = do
        total <- Limits -> RawSpec -> Either InterchangeError Int
rawSize Limits
lim RawSpec
spec
        guardI
            (chunkElements > 0 && toInteger chunkElements * toInteger width <= toInteger (maxBytes lim))
            (InvalidData "invalid stream chunk size")
        Right total
    go :: Int -> IO (Either InterchangeError ())
go Int
left = do
        result <- Int -> IO (Either InterchangeError (Maybe ByteString))
produce (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
left (Int
chunkElements Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width))
        case result of
            Left InterchangeError
err -> Either InterchangeError () -> IO (Either InterchangeError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError ()
forall a b. a -> Either a b
Left InterchangeError
err)
            Right Maybe ByteString
Nothing -> Either InterchangeError () -> IO (Either InterchangeError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if Int
left Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then () -> Either InterchangeError ()
forall a b. b -> Either a b
Right () else InterchangeError -> Either InterchangeError ()
forall a b. a -> Either a b
Left (FilePath -> InterchangeError
InvalidData FilePath
"short raw producer"))
            Right (Just ByteString
bytes) -> case ByteString -> Either InterchangeError ()
valid ByteString
bytes of
                Left InterchangeError
err -> Either InterchangeError () -> IO (Either InterchangeError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError ()
forall a b. a -> Either a b
Left InterchangeError
err)
                Right () -> Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
bytes IO ()
-> IO (Either InterchangeError ())
-> IO (Either InterchangeError ())
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO (Either InterchangeError ())
go (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bytes)
      where
        valid :: ByteString -> Either InterchangeError ()
valid ByteString
bytes = do
            Bool -> InterchangeError -> Either InterchangeError ()
guardI
                ( Bool -> Bool
not (ByteString -> Bool
B.null ByteString
bytes)
                    Bool -> Bool -> Bool
&& ByteString -> Int
B.length ByteString
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
left (Int
chunkElements Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width)
                    Bool -> Bool -> Bool
&& ByteString -> Int
B.length ByteString
bytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
width Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                )
                (FilePath -> InterchangeError
InvalidData FilePath
"raw producer chunk size")
            _ <- Limits
-> DType
-> Endian
-> Order
-> [Int]
-> ByteString
-> Either InterchangeError Array
contiguousArray Limits
lim DType
dt Endian
en Order
COrder [ByteString -> Int
B.length ByteString
bytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
width] ByteString
bytes
            Right ()

foreign import ccall safe "hmath_interchange_map"
    c_map :: Ptr CChar -> Word64 -> Ptr CInt -> IO (Ptr ())
foreign import ccall unsafe "hmath_interchange_unmap" c_unmap :: Ptr () -> IO ()
foreign import ccall unsafe "hmath_interchange_map_size" c_size :: Ptr () -> IO Word64
foreign import ccall safe "hmath_interchange_map_read"
    c_read :: Ptr () -> Word64 -> CSize -> Ptr Word8 -> IO CInt

-- | Scope-bound mapping; no pointer or borrowed ByteString is exposed.
data MappedArray s = MappedArray RawSpec Int (MVar (Maybe (Ptr ())))

{- | Return dimensions of a callback-scoped read-only mapped array. The region token
prevents its raw view escaping withMappedArray.
-}
mappedShape :: MappedArray s -> [Int]
mappedShape :: forall s. MappedArray s -> [Int]
mappedShape (MappedArray (RawSpec DType
_ Endian
_ Order
_ [Int]
sh) Int
_ MVar (Maybe (Ptr ()))
_) = [Int]
sh

{- | Given limits,RawSpec,path,then rank-2 callback, map read-only raw data for that
callback's lifetime and unmap on exit. Validate exact file size/spec/budgets;
path/IO/format failures return InterchangeError. Do not retain borrowed pointers beyond
the callback.
-}
withMappedArray ::
    Limits -> RawSpec -> FilePath -> (forall s. MappedArray s -> IO a) -> IO (Either InterchangeError a)
withMappedArray :: forall a.
Limits
-> RawSpec
-> FilePath
-> (forall s. MappedArray s -> IO a)
-> IO (Either InterchangeError a)
withMappedArray Limits
lim RawSpec
spec FilePath
path forall s. MappedArray s -> IO a
action = IO (Either InterchangeError a) -> IO (Either InterchangeError a)
forall a.
IO (Either InterchangeError a) -> IO (Either InterchangeError a)
ioErrors (IO (Either InterchangeError a) -> IO (Either InterchangeError a))
-> IO (Either InterchangeError a) -> IO (Either InterchangeError a)
forall a b. (a -> b) -> a -> b
$ case Limits -> RawSpec -> Either InterchangeError Int
rawSize Limits
lim RawSpec
spec of
    Left InterchangeError
err -> Either InterchangeError a -> IO (Either InterchangeError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError a
forall a b. a -> Either a b
Left InterchangeError
err)
    Right Int
expected
        | Char
'\0' Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
path -> Either InterchangeError a -> IO (Either InterchangeError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError a
forall a b. a -> Either a b
Left (FilePath -> InterchangeError
InvalidData FilePath
"NUL in file path"))
        | Bool
otherwise -> ByteString
-> (CString -> IO (Either InterchangeError a))
-> IO (Either InterchangeError a)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString (Text -> ByteString
E.encodeUtf8 (FilePath -> Text
T.pack FilePath
path)) ((CString -> IO (Either InterchangeError a))
 -> IO (Either InterchangeError a))
-> (CString -> IO (Either InterchangeError a))
-> IO (Either InterchangeError a)
forall a b. (a -> b) -> a -> b
$ \CString
name -> (Ptr CInt -> IO (Either InterchangeError a))
-> IO (Either InterchangeError a)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Either InterchangeError a))
 -> IO (Either InterchangeError a))
-> (Ptr CInt -> IO (Either InterchangeError a))
-> IO (Either InterchangeError a)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
err -> do
            IO (Ptr ())
-> (Ptr () -> IO ())
-> (Ptr () -> IO (Either InterchangeError a))
-> IO (Either InterchangeError a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (CString -> Word64 -> Ptr CInt -> IO (Ptr ())
c_map CString
name (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Limits -> Int
maxBytes Limits
lim)) Ptr CInt
err) Ptr () -> IO ()
c_unmap ((Ptr () -> IO (Either InterchangeError a))
 -> IO (Either InterchangeError a))
-> (Ptr () -> IO (Either InterchangeError a))
-> IO (Either InterchangeError a)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ptr ->
                if Ptr ()
ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr
                    then do
                        code <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
err
                        pure (Left (InterchangeIOError ("mmap failed (" ++ show code ++ ")")))
                    else do
                        size <- Ptr () -> IO Word64
c_size Ptr ()
ptr
                        if size /= fromIntegral expected
                            then pure (Left (InvalidData "mapped raw file size mismatch"))
                            else do
                                lock <- newMVar (Just ptr)
                                -- Retire the capability before releasing native storage,
                                -- waiting for concurrent read copies already in progress.
                                bracket
                                    (pure (MappedArray spec expected lock))
                                    (\MappedArray (ZonkAny 0)
_ -> MVar (Maybe (Ptr ()))
-> (Maybe (Ptr ()) -> IO (Maybe (Ptr ()))) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Maybe (Ptr ()))
lock (IO (Maybe (Ptr ())) -> Maybe (Ptr ()) -> IO (Maybe (Ptr ()))
forall a b. a -> b -> a
const (Maybe (Ptr ()) -> IO (Maybe (Ptr ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr ())
forall a. Maybe a
Nothing)))
                                    (fmap Right . action)

-- | Copy a bounded byte range. Copies may safely survive mapping closure.
mappedReadBytes :: MappedArray s -> Int -> Int -> IO (Either InterchangeError B.ByteString)
mappedReadBytes :: forall s.
MappedArray s
-> Int -> Int -> IO (Either InterchangeError ByteString)
mappedReadBytes (MappedArray RawSpec
_ Int
size MVar (Maybe (Ptr ()))
lock) Int
offset Int
count
    | Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
size Bool -> Bool -> Bool
|| Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset =
        Either InterchangeError ByteString
-> IO (Either InterchangeError ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError ByteString
forall a b. a -> Either a b
Left (FilePath -> InterchangeError
InvalidData FilePath
"mapped byte range"))
    | Bool
otherwise = MVar (Maybe (Ptr ()))
-> (Maybe (Ptr ()) -> IO (Either InterchangeError ByteString))
-> IO (Either InterchangeError ByteString)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar (Maybe (Ptr ()))
lock ((Maybe (Ptr ()) -> IO (Either InterchangeError ByteString))
 -> IO (Either InterchangeError ByteString))
-> (Maybe (Ptr ()) -> IO (Either InterchangeError ByteString))
-> IO (Either InterchangeError ByteString)
forall a b. (a -> b) -> a -> b
$ \Maybe (Ptr ())
current -> case Maybe (Ptr ())
current of
        Maybe (Ptr ())
Nothing -> Either InterchangeError ByteString
-> IO (Either InterchangeError ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError ByteString
forall a b. a -> Either a b
Left (FilePath -> InterchangeError
InvalidData FilePath
"mapping is closed"))
        Just Ptr ()
ptr -> do
            (bytes, result) <- Int -> (Ptr Word8 -> IO (Int, Int, CInt)) -> IO (ByteString, CInt)
forall a.
Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
BI.createAndTrim' Int
count ((Ptr Word8 -> IO (Int, Int, CInt)) -> IO (ByteString, CInt))
-> (Ptr Word8 -> IO (Int, Int, CInt)) -> IO (ByteString, CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dest -> do
                status <- Ptr () -> Word64 -> CSize -> Ptr Word8 -> IO CInt
c_read Ptr ()
ptr (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count) Ptr Word8
dest
                pure (0, if status == 0 then count else 0, status)
            pure (if result == 0 then Right bytes else Left (InvalidData "mapped native range"))

{- | Read one typed scalar using checked multidimensional indexing. Physical
endian conversion happens through the same Element decoder as normal arrays.
-}
mappedValue :: (Element a) => MappedArray s -> [Int] -> IO (Either InterchangeError a)
mappedValue :: forall a s.
Element a =>
MappedArray s -> [Int] -> IO (Either InterchangeError a)
mappedValue mapped :: MappedArray s
mapped@(MappedArray (RawSpec DType
dt Endian
en Order
order [Int]
sh) Int
_ MVar (Maybe (Ptr ()))
_) [Int]
ix
    | [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
sh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Int]
ix) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
sh Bool -> Bool -> Bool
|| Bool -> Bool
not ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Int
d -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
d) [Int]
ix [Int]
sh)) =
        Either InterchangeError a -> IO (Either InterchangeError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterchangeError -> Either InterchangeError a
forall a b. a -> Either a b
Left (FilePath -> InterchangeError
InvalidData FilePath
"mapped index out of range"))
    | Bool
otherwise = do
        let offset :: Int
offset = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) [Int]
ix (Order -> Int -> [Int] -> [Int]
denseStrides Order
order (DType -> Int
elementBytes DType
dt) [Int]
sh))
        bytes <- MappedArray s
-> Int -> Int -> IO (Either InterchangeError ByteString)
forall s.
MappedArray s
-> Int -> Int -> IO (Either InterchangeError ByteString)
mappedReadBytes MappedArray s
mapped Int
offset (DType -> Int
elementBytes DType
dt)
        pure $ do
            b <- bytes
            a <- contiguousArray defaultLimits dt en COrder [] b
            xs <- toValues a
            case xs of
                [a
x] -> a -> Either InterchangeError a
forall a b. b -> Either a b
Right a
x
                [a]
_ -> InterchangeError -> Either InterchangeError a
forall a b. a -> Either a b
Left (FilePath -> InterchangeError
InvalidData FilePath
"mapped scalar")