module Data.Repa.Array.Auto.Format ( module Data.Repa.Convert.Format , module Data.Repa.Convert.Formats -- * Packing , packFormat , packsFormat , packsFormatLn -- * Unpacking , unpackFormat , unpacksFormatLn , UnpackableRow , A.Unpackables) where import Data.Repa.Array.Auto.Base as A import Data.Repa.Array.Generic.Convert as A import qualified Data.Repa.Array.Generic as AG import qualified Data.Repa.Array.Material.Auto as A import qualified Data.Repa.Array.Material.Auto.Operator.Lines as A import qualified Data.Repa.Array.Material.Auto.Operator.Unpackables as A import qualified Data.Repa.Array.Material.Foreign as AF import qualified Data.Repa.Array.Internals.Target as A import qualified Data.Repa.Array.Internals.Layout as A import qualified Data.Repa.Array.Internals.Bulk as A import qualified Data.Repa.Convert.Format as C import Data.Repa.Convert.Format import Data.Repa.Convert.Formats import Foreign.ForeignPtr as F import Foreign.Ptr as F import System.IO.Unsafe import Data.Word import Data.Char import qualified Data.Vector.Storable.Mutable as SM #include "repa-array.h" --------------------------------------------------------------------------------------------------- -- | Pack a value into a buffer using the given format. packFormat :: C.Packable format => format -- ^ Format for the value. -> Value format -- ^ Source value. -> Maybe (Array Word8) -- ^ Packed binary data. packFormat !format !v | Just lenBytes <- packedSize format v = unsafePerformIO $ do -- The 'lenBytes' we get above is an upper bound on the -- number of used by the serialised data. buf@(AF.FBuffer mvec) :: A.Buffer AF.F Word8 <- A.unsafeNewBuffer (AF.Foreign lenBytes) let (fptr, oStart, _) = SM.unsafeToForeignPtr mvec -- When we pack the data into the buffer we get the number -- of bytes actually used, then slice the original buffer -- down to this size. withForeignPtr fptr $ \ptr -> do Just ptr' <- C.unsafeRunPacker (C.pack format v) (plusPtr ptr oStart) let len = minusPtr ptr' ptr buf' <- A.unsafeSliceBuffer 0 len buf arr <- A.unsafeFreezeBuffer buf' return $ Just $ A.convert arr | otherwise = Nothing {-# INLINE_ARRAY packFormat #-} -- | Pack an array of values into a buffer using the given format. -- -- * The bytes representing each value are concatenated together with no delimitor. -- packsFormat :: (C.Packable format, Show format, A.Bulk A.A (Value format)) => format -- ^ Format for each value -> Array (Value format) -- ^ Source values. -> Maybe (Array Word8) -- ^ Packed binary data. packsFormat !format !arr = let packRow v = case packFormat format v of Nothing -> error $ unlines [ "repa-array.packsFormat: conversion failed"] Just arr8 -> arr8 {-# INLINE packRow #-} in Just $ AG.concat A.A $ AG.mapS A.N packRow arr {-# INLINE_ARRAY packsFormat #-} -- | Like `packsFormat`, but append a newline character after -- every packed element. -- -- * If a value cannot be converted then this function just returns `error`. -- packsFormatLn :: (C.Packable format, A.Bulk A.A (Value format)) => format -- ^ Format for each value -> Array (Value format) -- ^ Source values. -> Maybe (Array Word8) -- ^ Packed binary data. packsFormatLn !format !arr = let !arrNL = A.fromList A.A [fromIntegral $ ord '\n'] -- TODO: kill lists packRow v = case packFormat format v of Nothing -> error $ unlines [ "repa-array.packsFormat: conversion failed"] Just arr8 -> AG.concat A.A $ A.fromList A.A [ arr8, arrNL ] {-# INLINE packRow #-} in Just $ AG.concat A.A $ AG.mapS A.N packRow arr {-# INLINE_ARRAY packsFormatLn #-} --------------------------------------------------------------------------------------------------- -- | Unpack a value from a buffer using the given format. unpackFormat :: C.Unpackable format => format -- ^ Format for the value. -> Array Word8 -- ^ Packed binary data. -> Maybe (C.Value format) -- ^ Unpacked value. unpackFormat !format !arrBytes | lenBytes <- A.length arrBytes = unsafePerformIO $ let (oStart, _, fptr :: ForeignPtr Word8) = AF.toForeignPtr $ A.convert arrBytes in withForeignPtr fptr $ \ptr_ -> do r <- C.unsafeRunUnpacker (C.unpack format) (plusPtr ptr_ oStart) lenBytes (const False) case r of Just (v, _) -> return $ Just v _ -> return Nothing | otherwise = Nothing {-# INLINE_ARRAY unpackFormat #-} -- | Unpack an encoded table of values from an array of bytes. unpacksFormatLn :: UnpackableRow format => Sep format -- ^ Format of each row. -> Array Word8 -- ^ Source data. -> Array (Value (Sep format)) -- ^ Array of rows. unpacksFormatLn format arrSrc@(A.AArray_Word8 arrSrcF) = unsafePerformIO $ do -- Rows are separated by newline characters. let !wSepRow = fromIntegral $ ord '\n' -- Determine the field separator character. -- If the format is just () then we're only counting the -- number of lines in the table, so it doesn't matter -- what we use for the field separator. let !wSepField = case takeSepChar format of Nothing -> fromIntegral $ ord ' ' Just c -> fromIntegral $ ord c -- Scan through the input data to determine where the lines begin -- and end. let (ixsStarts, ixsEnds) = A.findRowsStartEnd wSepRow arrSrc -- Allocate a buffer for the output data. let len = A.extent $ A.bufferLayout ixsStarts buf <- A.unsafeNewBuffer (A.Auto len) -- Unpack all the rows into the buffer. mErr <- A.unpacksToBuffer format wSepField arrSrcF ixsStarts ixsEnds buf case mErr of Nothing -> A.unsafeFreezeBuffer buf -- TODO: return error. Just err -> error $ "unsafeFormatLn: parse error " ++ show err {-# INLINE unpacksFormatLn #-} -- | Dictionaries needed to unpack a row of the given format. type UnpackableRow format = ( SepFormat format , A.Unpackables (Sep format) , A.Target A.A (Value (Sep format)))