repa-convert 4.1.0.1 → 4.2.0.1
raw patch · 15 files changed
+1497/−571 lines, 15 filesdep +bytestringdep +double-conversiondep +repa-scalardep ~basedep ~primitivePVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring, double-conversion, repa-scalar
Dependency ranges changed: base, primitive
API changes (from Hackage documentation)
- Data.Repa.Convert.Format: (:*:) :: !a -> !b -> (:*:) a b
- Data.Repa.Convert.Format: ASCII :: ASCII
- Data.Repa.Convert.Format: FixList :: f -> Int -> FixList f
- Data.Repa.Convert.Format: FixString :: t -> Int -> FixString t
- Data.Repa.Convert.Format: Float32be :: Float32be
- Data.Repa.Convert.Format: Float64be :: Float64be
- Data.Repa.Convert.Format: Int16be :: Int16be
- Data.Repa.Convert.Format: Int32be :: Int32be
- Data.Repa.Convert.Format: Int64be :: Int64be
- Data.Repa.Convert.Format: Int8be :: Int8be
- Data.Repa.Convert.Format: VarList :: f -> VarList f
- Data.Repa.Convert.Format: VarString :: t -> VarString t
- Data.Repa.Convert.Format: Word16be :: Word16be
- Data.Repa.Convert.Format: Word32be :: Word32be
- Data.Repa.Convert.Format: Word64be :: Word64be
- Data.Repa.Convert.Format: Word8be :: Word8be
- Data.Repa.Convert.Format: data (:*:) a b
- Data.Repa.Convert.Format: data ASCII
- Data.Repa.Convert.Format: data FixList f
- Data.Repa.Convert.Format: data FixString t
- Data.Repa.Convert.Format: data Float32be
- Data.Repa.Convert.Format: data Float64be
- Data.Repa.Convert.Format: data Int16be
- Data.Repa.Convert.Format: data Int32be
- Data.Repa.Convert.Format: data Int64be
- Data.Repa.Convert.Format: data Int8be
- Data.Repa.Convert.Format: data VarList f
- Data.Repa.Convert.Format: data VarString t
- Data.Repa.Convert.Format: data Word16be
- Data.Repa.Convert.Format: data Word32be
- Data.Repa.Convert.Format: data Word64be
- Data.Repa.Convert.Format: data Word8be
- Data.Repa.Convert.Format: forFormat :: format -> Value format -> Value format
- Data.Repa.Convert.Format: listFormat :: format -> [Value format] -> [Value format]
- Data.Repa.Convert.Format: packToList :: Packable format => format -> Value format -> Maybe [Word8]
- Data.Repa.Convert.Format: unpackFromList :: Packable format => format -> [Word8] -> Maybe (Value format)
- Data.Repa.Product: (:*:) :: !a -> !b -> (:*:) a b
- Data.Repa.Product: data (:*:) a b
- Data.Repa.Product: instance (Eq a, Eq b) => Eq (a :*: b)
- Data.Repa.Product: instance (Show a, Show b) => Show (a :*: b)
- Data.Repa.Product: instance (Unbox a, Unbox b) => MVector MVector (a :*: b)
- Data.Repa.Product: instance (Unbox a, Unbox b) => Unbox (a :*: b)
- Data.Repa.Product: instance (Unbox a, Unbox b) => Vector Vector (a :*: b)
+ Data.Repa.Convert: Packer :: (Ptr Word8 -> (Ptr Word8 -> IO (Maybe (Ptr Word8))) -> IO (Maybe (Ptr Word8))) -> Packer
+ Data.Repa.Convert: Unpacker :: (forall b. Ptr Word8 -> Ptr Word8 -> (Word8 -> Bool) -> IO b -> (Ptr Word8 -> a -> IO b) -> IO b) -> Unpacker a
+ Data.Repa.Convert: [fromPacker] :: Packer -> Ptr Word8 -> (Ptr Word8 -> IO (Maybe (Ptr Word8))) -> IO (Maybe (Ptr Word8))
+ Data.Repa.Convert: [fromUnpacker] :: Unpacker a -> forall b. Ptr Word8 -> Ptr Word8 -> (Word8 -> Bool) -> IO b -> (Ptr Word8 -> a -> IO b) -> IO b
+ Data.Repa.Convert: class Format f where type family Value f
+ Data.Repa.Convert: class Format format => Packable format
+ Data.Repa.Convert: data Packer
+ Data.Repa.Convert: data Unpacker a
+ Data.Repa.Convert: fieldCount :: Format f => f -> Int
+ Data.Repa.Convert: fixedSize :: Format f => f -> Maybe Int
+ Data.Repa.Convert: forFormat :: format -> Value format -> Value format
+ Data.Repa.Convert: listFormat :: format -> [Value format] -> [Value format]
+ Data.Repa.Convert: minSize :: Format f => f -> Int
+ Data.Repa.Convert: pack :: Packable format => format -> Value format -> Packer
+ Data.Repa.Convert: packToAscii :: (FormatAscii a, Value (FormatAscii' a) ~ a, Packable (FormatAscii' a)) => a -> Maybe String
+ Data.Repa.Convert: packToList8 :: Packable format => format -> Value format -> Maybe [Word8]
+ Data.Repa.Convert: packToString :: Packable format => format -> Value format -> Maybe String
+ Data.Repa.Convert: packedSize :: Format f => f -> Value f -> Maybe Int
+ Data.Repa.Convert: unpack :: Packable format => format -> Unpacker (Value format)
+ Data.Repa.Convert: unpackFromList8 :: Packable format => format -> [Word8] -> Maybe (Value format)
+ Data.Repa.Convert: unpackFromString :: Packable format => format -> String -> Maybe (Value format)
+ Data.Repa.Convert: unsafeRunPacker :: Packer -> Ptr Word8 -> IO (Maybe (Ptr Word8))
+ Data.Repa.Convert: unsafeRunUnpacker :: Unpacker a -> Ptr Word8 -> Int -> (Word8 -> Bool) -> IO (Maybe (a, Ptr Word8))
+ Data.Repa.Convert.Format: Packer :: (Ptr Word8 -> (Ptr Word8 -> IO (Maybe (Ptr Word8))) -> IO (Maybe (Ptr Word8))) -> Packer
+ Data.Repa.Convert.Format: Unpacker :: (forall b. Ptr Word8 -> Ptr Word8 -> (Word8 -> Bool) -> IO b -> (Ptr Word8 -> a -> IO b) -> IO b) -> Unpacker a
+ Data.Repa.Convert.Format: [fromPacker] :: Packer -> Ptr Word8 -> (Ptr Word8 -> IO (Maybe (Ptr Word8))) -> IO (Maybe (Ptr Word8))
+ Data.Repa.Convert.Format: [fromUnpacker] :: Unpacker a -> forall b. Ptr Word8 -> Ptr Word8 -> (Word8 -> Bool) -> IO b -> (Ptr Word8 -> a -> IO b) -> IO b
+ Data.Repa.Convert.Format: data Packer
+ Data.Repa.Convert.Format: data Unpacker a
+ Data.Repa.Convert.Format: fieldCount :: Format f => f -> Int
+ Data.Repa.Convert.Format: minSize :: Format f => f -> Int
+ Data.Repa.Convert.Format: unsafeRunPacker :: Packer -> Ptr Word8 -> IO (Maybe (Ptr Word8))
+ Data.Repa.Convert.Format: unsafeRunUnpacker :: Unpacker a -> Ptr Word8 -> Int -> (Word8 -> Bool) -> IO (Maybe (a, Ptr Word8))
+ Data.Repa.Convert.Formats: (:*:) :: SrictNotUnpackeda -> SrictNotUnpackedb -> (:*:) a b
+ Data.Repa.Convert.Formats: App :: f -> App f
+ Data.Repa.Convert.Formats: DDsMMsYYYY :: Char -> DDsMMsYYYY
+ Data.Repa.Convert.Formats: DoubleAsc :: DoubleAsc
+ Data.Repa.Convert.Formats: FixAsc :: Int -> FixAsc
+ Data.Repa.Convert.Formats: Float32be :: Float32be
+ Data.Repa.Convert.Formats: Float64be :: Float64be
+ Data.Repa.Convert.Formats: Int16be :: Int16be
+ Data.Repa.Convert.Formats: Int32be :: Int32be
+ Data.Repa.Convert.Formats: Int64be :: Int64be
+ Data.Repa.Convert.Formats: Int8be :: Int8be
+ Data.Repa.Convert.Formats: IntAsc :: IntAsc
+ Data.Repa.Convert.Formats: IntAsc0 :: Int -> IntAsc0
+ Data.Repa.Convert.Formats: Sep :: Char -> f -> Sep f
+ Data.Repa.Convert.Formats: Tup :: f -> Tup f
+ Data.Repa.Convert.Formats: VarAsc :: VarAsc
+ Data.Repa.Convert.Formats: VarString :: VarString
+ Data.Repa.Convert.Formats: Word16be :: Word16be
+ Data.Repa.Convert.Formats: Word32be :: Word32be
+ Data.Repa.Convert.Formats: Word64be :: Word64be
+ Data.Repa.Convert.Formats: Word8be :: Word8be
+ Data.Repa.Convert.Formats: YYYYsMMsDD :: Char -> YYYYsMMsDD
+ Data.Repa.Convert.Formats: class FormatAscii a where type family FormatAscii' a
+ Data.Repa.Convert.Formats: data (:*:) a b :: * -> * -> *
+ Data.Repa.Convert.Formats: data App f
+ Data.Repa.Convert.Formats: data DDsMMsYYYY
+ Data.Repa.Convert.Formats: data DoubleAsc
+ Data.Repa.Convert.Formats: data FixAsc
+ Data.Repa.Convert.Formats: data Float32be
+ Data.Repa.Convert.Formats: data Float64be
+ Data.Repa.Convert.Formats: data Int16be
+ Data.Repa.Convert.Formats: data Int32be
+ Data.Repa.Convert.Formats: data Int64be
+ Data.Repa.Convert.Formats: data Int8be
+ Data.Repa.Convert.Formats: data IntAsc
+ Data.Repa.Convert.Formats: data IntAsc0
+ Data.Repa.Convert.Formats: data Sep f
+ Data.Repa.Convert.Formats: data Tup f
+ Data.Repa.Convert.Formats: data VarAsc
+ Data.Repa.Convert.Formats: data VarString
+ Data.Repa.Convert.Formats: data Word16be
+ Data.Repa.Convert.Formats: data Word32be
+ Data.Repa.Convert.Formats: data Word64be
+ Data.Repa.Convert.Formats: data Word8be
+ Data.Repa.Convert.Formats: data YYYYsMMsDD
+ Data.Repa.Convert.Formats: formatAscii :: FormatAscii a => a -> FormatAscii' a
- Data.Repa.Convert.Format: pack :: Packable format => Ptr Word8 -> format -> Value format -> (Int -> IO (Maybe a)) -> IO (Maybe a)
+ Data.Repa.Convert.Format: pack :: Packable format => format -> Value format -> Packer
- Data.Repa.Convert.Format: unpack :: Packable format => Ptr Word8 -> format -> ((Value format, Int) -> IO (Maybe a)) -> IO (Maybe a)
+ Data.Repa.Convert.Format: unpack :: Packable format => format -> Unpacker (Value format)
Files
- Data/Repa/Convert.hs +164/−0
- Data/Repa/Convert/Format.hs +11/−60
- Data/Repa/Convert/Format/App.hs +75/−0
- Data/Repa/Convert/Format/Ascii.hs +99/−0
- Data/Repa/Convert/Format/Base.hs +143/−229
- Data/Repa/Convert/Format/Binary.hs +189/−126
- Data/Repa/Convert/Format/Date32.hs +103/−0
- Data/Repa/Convert/Format/Fields.hs +53/−0
- Data/Repa/Convert/Format/Lists.hs +218/−0
- Data/Repa/Convert/Format/Numeric.hs +130/−0
- Data/Repa/Convert/Format/Sep.hs +125/−0
- Data/Repa/Convert/Format/Tup.hs +97/−0
- Data/Repa/Convert/Formats.hs +58/−0
- Data/Repa/Product.hs +0/−141
- repa-convert.cabal +32/−15
+ Data/Repa/Convert.hs view
@@ -0,0 +1,164 @@++-- | Convert tuples of Haskell values to and from ASCII or packed binary+-- representations.+--+-- This package is intended for cheap and cheerful serialisation and+-- deserialisation of flat tables, where each row has a fixed format.+-- If you have a table consisting of a couple hundred megs of+-- Pipe-Separated-Variables issued by some filthy enterprise system,+-- then this package is for you.+--+-- If you want to parse context-free, or context-sensitive+-- languages then try the @parsec@ or @attoparsec@ packages.+-- If you have binary data that does not have a fixed format then+-- try the @binary@ or @cereal@ packages.+--+-- For testing purposes, use `packToString` which takes a format,+-- a record, and returns a list of bytes.+--+-- @+-- > import Data.Repa.Convert+--+-- > let format = Sep '|' (VarAsc :*: IntAsc :*: DoubleAsc :*: ())+-- > let Just str = packToString format ("foo" :*: 66 :*: 93.42 :*: ())+-- > str+-- "foo|66|93.42"+-- @+--+-- We can then unpack the raw bytes back to Haskell values with `unpackFromString`.+--+-- @+-- > unpackFromString format str +-- Just ("foo" :*: (66 :*: (93.42 :*: ())))+-- @+--+-- In production code use `unsafeRunPacker` and `unsafeRunUnpacker` to work directly+-- with a buffer in foreign memory.+--+-- * NOTE that in the current version the separating character is un-escapable. +-- * The above means that the format @(Sep ',')@ does NOT parse a CSV+-- file according to the CSV specification: http://tools.ietf.org/html/rfc4180.+--+module Data.Repa.Convert+ ( -- | The @Formats@ module contains the pre-defined data formats.+ module Data.Repa.Convert.Formats++ -- * Data formats + , Format (..)++ -- * Type constraints+ , forFormat+ , listFormat++ -- * Packing data+ , Packable (..)++ -- ** Packer monoid+ , Packer (..)+ , unsafeRunPacker++ -- ** Unpacker monad+ , Unpacker (..)+ , unsafeRunUnpacker++ -- * Interfaces+ -- ** Default Ascii+ , packToAscii++ -- ** List Interface+ , packToList8, unpackFromList8++ -- ** String Interface+ , packToString, unpackFromString)+where+import Data.Repa.Convert.Format+import Data.Repa.Convert.Formats+import Data.Char+import Data.Word+import Control.Monad+import System.IO.Unsafe+import qualified Foreign.Storable as S+import qualified Foreign.Marshal.Alloc as S+import qualified GHC.Ptr as S+++---------------------------------------------------------------------------------------------------+-- | Pack a value to a list of `Word8` using the default Ascii format.+packToAscii+ :: ( FormatAscii a+ , Value (FormatAscii' a) ~ a+ , Packable (FormatAscii' a))+ => a -> Maybe String+packToAscii a+ = packToString (formatAscii a) a+++---------------------------------------------------------------------------------------------------+-- | Pack a value to a list of `Word8`.+packToList8 + :: Packable format+ => format -> Value format -> Maybe [Word8]+packToList8 f x+ | Just lenMax <- packedSize f x+ = unsafePerformIO+ $ do buf <- S.mallocBytes lenMax+ mResult <- unsafeRunPacker (pack f x) buf+ case mResult of+ Nothing -> return Nothing+ Just buf' + -> do let lenUsed = S.minusPtr buf' buf+ xs <- mapM (S.peekByteOff buf) [0 .. lenUsed - 1]+ S.free buf+ return $ Just xs++ | otherwise = Nothing+++-- | Unpack a value from a list of `Word8`.+unpackFromList8+ :: Packable format+ => format -> [Word8] -> Maybe (Value format)++unpackFromList8 format xs+ = unsafePerformIO+ $ do let len = length xs+ buf <- S.mallocBytes len+ mapM_ (\(o, x) -> S.pokeByteOff buf o x)+ $ zip [0 .. len - 1] xs+ r <- unsafeRunUnpacker (unpack format) buf len (const False)+ return $ fmap fst r+++-- | Pack a value to a String.+packToString+ :: Packable format+ => format -> Value format -> Maybe String+packToString f v+ = liftM (map (chr . fromIntegral)) $ packToList8 f v+++-- | Unpack a value from a String.+unpackFromString + :: Packable format+ => format -> String -> Maybe (Value format)+unpackFromString f s+ = unpackFromList8 f $ map (fromIntegral . ord) s+++---------------------------------------------------------------------------------------------------+-- | Constrain the type of a value to match the given format.+-- +-- The value itself is not used.+--+forFormat :: format -> Value format -> Value format+forFormat _ v = v+{-# INLINE forFormat #-}+++-- | Constrain the type of some values to match the given format.+--+-- The value itself is not used.+--+listFormat :: format -> [Value format] -> [Value format]+listFormat _ v = v+{-# INLINE listFormat #-}
Data/Repa/Convert/Format.hs view
@@ -1,68 +1,19 @@ --- | Convert Haskell values to and from a compact binary representation.--- --- For testing purposes, use `packToList` which takes a format, a record, and returns a list of bytes.------ @--- > import Data.Repa.Convert.Format------ > let Just bytes = packToList (FixString ASCII 10 :*: Word16be :*: Float64be) ("foo" :*: 66 :*: 93.42)--- > bytes--- [102,111,111,0,0,0,0,0,0,0,0,66,64,87,90,225,71,174,20,123]--- @------ We can then unpack the raw bytes back to Haskell values with `unpackFromList`.------ @--- > unpackFromList (FixString ASCII 10 :*: Word16be :*: Float64be) bytes --- Just ("foo" :*: (66 :*: 93.42))--- @------ In production code use `pack` and `unpack` to work directly with a buffer in foreign memory.---+-- | This module provides the `Format` class definition,+-- without exporting the pre-defined formats. module Data.Repa.Convert.Format- ( -- * Data formats+ ( -- * Packing single fields Format (..) - -- * Packing records- , Packable (..)- , packToList- , unpackFromList-- -- * Constraints- , forFormat- , listFormat-- -- * Products- , (:*:)(..)-- -- * Lists- , FixList(..)- , VarList(..)-- -- * Strings- , FixString (..)- , VarString (..)- , ASCII (..)-- -- * Atomic values- -- ** 8-bit- , Word8be (..), Int8be (..)-- -- ** 16-bit- , Word16be (..), Int16be (..)-- -- ** 32-bit- , Word32be (..), Int32be (..)- , Float32be (..)+ -- * Packable+ , Packable (..) - -- ** 64-bit- , Word64be (..), Int64be (..)- , Float64be (..))+ -- ** Packer+ , Packer (..)+ , unsafeRunPacker + -- ** Unpacker+ , Unpacker (..)+ , unsafeRunUnpacker) where-import Data.Repa.Product import Data.Repa.Convert.Format.Base-import Data.Repa.Convert.Format.Binary--
+ Data/Repa/Convert/Format/App.hs view
@@ -0,0 +1,75 @@++module Data.Repa.Convert.Format.App+ (App (..))+where+import Data.Repa.Convert.Format.Base+import Data.Repa.Scalar.Product+import Data.Monoid+++-- | Append fields without separators.+data App f+ = App f + deriving Show+++instance Format (App ()) where+ type Value (App ()) = ()+ fieldCount (App ()) = 0+ minSize (App ()) = 0+ fixedSize (App ()) = return 0+ packedSize (App ()) () = return 0+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance ( Format f1, Format (App fs)+ , Value (App fs) ~ Value fs)+ => Format (App (f1 :*: fs)) where+ type Value (App (f1 :*: fs)) + = Value f1 :*: Value fs++ minSize (App (f1 :*: fs))+ = minSize f1 + minSize (App fs)++ fieldCount (App (_f1 :*: fs))+ = 1 + fieldCount (App fs)++ fixedSize (App (f1 :*: fs))+ = do s1 <- fixedSize f1+ ss <- fixedSize (App fs)+ return $ s1 + ss++ packedSize (App (f1 :*: fs)) (x1 :*: xs)+ = do s1 <- packedSize f1 x1+ ss <- packedSize (App fs) xs+ return $ s1 + ss+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable (App ()) where+ pack _fmt _val = mempty+ unpack _fmt = return ()+ {-# INLINE pack #-}+ {-# INLINE unpack #-}+++instance ( Packable f1, Packable (App fs)+ , Value (App fs) ~ Value fs)+ => Packable (App (f1 :*: fs)) where++ pack (App (f1 :*: fs)) (x1 :*: xs)+ = pack f1 x1 <> pack (App fs) xs++ unpack (App (f1 :*: fs))+ = do x1 <- unpack f1+ xs <- unpack (App fs)+ return (x1 :*: xs)+ {-# INLINE pack #-}+ {-# INLINE unpack #-}+
+ Data/Repa/Convert/Format/Ascii.hs view
@@ -0,0 +1,99 @@++module Data.Repa.Convert.Format.Ascii+ (FormatAscii (..))+where+import Data.Repa.Convert.Format.Numeric+import Data.Repa.Convert.Format.Lists+import Data.Repa.Convert.Format.Date32+import Data.Repa.Convert.Format.Tup+import Data.Repa.Scalar.Date32 (Date32)+import Data.Repa.Scalar.Product+++-- | Class of types that can be formatted in some default human readable+-- ASCII way.+class FormatAscii a where+ -- | The format for values of this type.+ type FormatAscii' a ++ -- | Get the standard ASCII format for a value.+ --+ -- The element value itself is not demanded.+ --+ formatAscii :: a -> FormatAscii' a++data Plain a + = Plain a+++-- | Empty tuples produce no output.+instance FormatAscii () where+ type FormatAscii' () = ()+ formatAscii _ = ()+ {-# INLINE formatAscii #-}+++-- | Tuples are displayed with round parens and commas to separate+-- the fields.+instance ( FormatAscii t1+ , FormatAscii (Plain ts))+ => FormatAscii (t1 :*: ts) where++ type FormatAscii' (t1 :*: ts) + = Tup (FormatAscii' t1 :*: FormatAscii' (Plain ts))++ formatAscii _ + = let -- The values of these type proxies should never be demanded.+ (x1_proxy :: t1) = error "repa-convert: formatAscii proxy"+ (xs_proxy :: ts) = error "repa-convert: formatAscii proxy"+ in Tup (formatAscii x1_proxy :*: formatAscii (Plain xs_proxy))+ {-# INLINE formatAscii #-}+++instance FormatAscii (Plain ()) where+ type FormatAscii' (Plain ()) = ()+ formatAscii (Plain _) = ()+ {-# INLINE formatAscii #-}+++instance (FormatAscii t1, FormatAscii (Plain ts))+ => FormatAscii (Plain (t1 :*: ts)) where+ type FormatAscii' (Plain (t1 :*: ts)) + = FormatAscii' t1 :*: FormatAscii' (Plain ts)++ formatAscii _+ = let -- The values of these type proxies should never be demanded.+ (x1_proxy :: t1) = error "repa-convert: formatAscii proxy"+ (xs_proxy :: ts) = error "repa-convert: formatAscii proxy"+ in formatAscii x1_proxy :*: formatAscii (Plain xs_proxy)+ {-# INLINE formatAscii #-}+ + +-- | Ints are formated in base-10.+instance FormatAscii Int where+ type FormatAscii' Int = IntAsc+ formatAscii _ = IntAsc+ {-# INLINE formatAscii #-}+++-- | Doubles are formatted as base-10 decimal.+instance FormatAscii Double where+ type FormatAscii' Double = DoubleAsc+ formatAscii _ = DoubleAsc+ {-# INLINE formatAscii #-}+++-- | Strings are formatted with double quotes and back-slash escaping+-- of special characters.+instance FormatAscii String where+ type FormatAscii' String = VarString+ formatAscii _ = VarString+ {-# INLINE formatAscii #-}+++-- | Dates are formatted as YYYY-MM-DD.+instance FormatAscii Date32 where+ type FormatAscii' Date32 = YYYYsMMsDD+ formatAscii _ = YYYYsMMsDD '-'+ {-# INLINE formatAscii #-}+
Data/Repa/Convert/Format/Base.hs view
@@ -2,34 +2,19 @@ module Data.Repa.Convert.Format.Base ( Format (..) , Packable (..)- , packToList- , unpackFromList - -- * Constraints- , forFormat- , listFormat-- -- * Strict products- , (:*:)(..)-- -- * Lists- , FixList(..)- , VarList(..)-- -- * ASCII Strings- , FixString (..)- , VarString (..)- , ASCII (..))+ -- * Packer+ , Packer (..)+ , unsafeRunPacker + -- * Unpacker+ , Unpacker (..)+ , unsafeRunUnpacker) where-import Data.Repa.Product import Data.Word-import Data.Char-import System.IO.Unsafe-import qualified Foreign.Storable as S-import qualified Foreign.Marshal.Alloc as S+import Data.IORef import qualified Foreign.Ptr as S-+import Prelude hiding (fail) --------------------------------------------------------------------------------------------------- -- | Relates a storage format to the Haskell type of the value@@ -39,254 +24,183 @@ -- | Get the type of a value with this format. type Value f - -- | For fixed size storage formats, yield their size (length) in bytes.+ -- | Yield the number of separate fields in this format.+ fieldCount :: f -> Int+++ -- | Yield the minumum number of bytes that a value of this+ -- format will take up. + -- + -- Packing a value into this format+ -- is guaranteed to use at least this many bytes.+ -- This is exact for fixed-size formats.+ minSize :: f -> Int+++ -- | For fixed size formats, yield their size (length) in bytes. -- -- Yields `Nothing` if this is not a fixed size format. -- fixedSize :: f -> Maybe Int + -- | Yield the size of a value in the given format. -- -- Yields `Nothing` when a collection of values is to be packed into a -- fixed length format, but the size of the collection does not match -- the format. --- packedSize :: f -> Value f -> Maybe Int--------------------------------------------------------------------------------------------------------- | Class of storage formats that can have values packed and unpacked--- from foreign bufferes. --- --- The methods are written using continuations to make it easier for--- GHC to optimise its core code when packing/unpacking many fields.----class Format format - => Packable format where-- -- | Pack a value into a buffer using the given format.- -- - -- If the format contains fixed width fields and the corresponding- -- value has too many elements, then this function returns `False`, - -- otherwise `True`.- --- pack :: S.Ptr Word8 -- ^ Target Buffer.- -> format -- ^ Storage format.- -> Value format -- ^ Value to pack.- -> (Int -> IO (Maybe a)) -- ^ Continue, given the number of bytes written.- -> IO (Maybe a)-- -- | Unpack a value from a buffer using the given format.+ -- If `fixedSize` returns a size then `packedSize` returns the same size. --- -- This is the inverse of `pack` above.- unpack :: S.Ptr Word8 -- ^ Source buffer.- -> format -- ^ Format of buffer.- -> ((Value format, Int) -> IO (Maybe a)) - -- ^ Continue, given the unpacked value and the - -- number of bytes read. - -> IO (Maybe a)+ packedSize :: f -> Value f -> Maybe Int ------------------------------------------------------------------------------------------------------ | Pack a value into a list of `Word8`.-packToList - :: Packable format- => format -> Value format -> Maybe [Word8]-packToList f x- | Just size <- packedSize f x- = unsafePerformIO- $ do buf <- S.mallocBytes size- mResult <- pack buf f x (\_ -> return (Just ()))- case mResult of- Nothing -> return Nothing- Just _ -> do- xs <- mapM (S.peekByteOff buf) [0..size - 1]- S.free buf- return $ Just xs-- | otherwise- = Nothing-+-- | Packer wraps a function that can write to a buffer.+data Packer+ = Packer+ { -- | Takes start of buffer, packs data into it, and calls the + -- continuation with a pointer to the byte just after the + -- last one that was written.+ fromPacker+ :: S.Ptr Word8 + -> (S.Ptr Word8 -> IO (Maybe (S.Ptr Word8)))+ -> IO (Maybe (S.Ptr Word8))+ } --- | Unpack a value from a list of `Word8`.-unpackFromList- :: Packable format- => format -> [Word8] -> Maybe (Value format)+instance Monoid Packer where+ mempty + = Packer $ \buf k -> k buf+ {-# INLINE mempty #-} -unpackFromList f xs- = unsafePerformIO- $ do let len = length xs- buf <- S.mallocBytes len- mapM_ (\(o, x) -> S.pokeByteOff buf o x)- $ zip [0 .. len - 1] xs- unpack buf f $ \(v, _) -> return (Just v)+ mappend (Packer fa) (Packer fb)+ = Packer $ \buf0 k -> fa buf0 (\buf1 -> fb buf1 k)+ {-# INLINE mappend #-} ------------------------------------------------------------------------------------------------------- | Constrain the type of a value to match the given format.--- --- The value itself is not used.+-- | Pack data into the given buffer.+-- +-- PRECONDITION: The buffer needs to be big enough to hold the packed data,+-- otherwise you'll corrupt the heap (bad). Use `packedSize` to work out+-- how big it needs to be. ---forFormat :: format -> Value format -> Value format-forFormat _ v = v-{-# INLINE forFormat #-}-+unsafeRunPacker + :: Packer -- ^ Packer to run.+ -> S.Ptr Word8 -- ^ Start of buffer.+ -> IO (Maybe (S.Ptr Word8))+ -- ^ Pointer to the byte after the last one written. --- | Constrain the type of some values to match the given format.------ The value itself is not used.----listFormat :: format -> [Value format] -> [Value format]-listFormat _ v = v-{-# INLINE listFormat #-}+unsafeRunPacker (Packer make) buf+ = make buf (\buf' -> return (Just buf'))+{-# INLINE unsafeRunPacker #-} ----------------------------------------------------------------------------------------------------instance (Format a, Format b) - => Format (a :*: b) where- type Value (a :*: b) = Value a :*: Value b+data Unpacker a+ = Unpacker + { -- | Takes pointers to the first byte in the buffer, the first byte+ -- after the buffer, and a special field terminating character. + -- The field terminating character is used by variable length + -- encodings where the length of the encoded data cannot be + -- determined from the encoding itself.+ --+ -- If a value can be successfully unpacked from the buffer then+ -- it is passed to the continuation, along with a pointer to the+ -- byte after the last one that was read. If not, then the fail+ -- action is invoked.+ --+ fromUnpacker+ :: forall b+ . S.Ptr Word8 -- Start of buffer.+ -> S.Ptr Word8 -- Pointer to first byte after end of buffer.+ -> (Word8 -> Bool) -- Detect a field terminator.+ -> IO b -- Signal failure.+ -> (S.Ptr Word8 -> a -> IO b) -- Eat an unpacked value.+ -> IO b+ } - fixedSize (xa :*: xb)- = do sa <- fixedSize xa- sb <- fixedSize xb- return $ sa + sb- {-# INLINE fixedSize #-} - packedSize (fa :*: fb) (xa :*: xb)- = do sa <- packedSize fa xa- sb <- packedSize fb xb- return $ sa + sb- {-# INLINE packedSize #-}+instance Functor Unpacker where+ fmap f (Unpacker fx)+ = Unpacker $ \start end stop fail eat+ -> fx start end stop fail $ \start_x x + -> eat start_x (f x)+ {-# INLINE fmap #-} -instance (Packable fa, Packable fb) - => Packable (fa :*: fb) where-- pack buf (fa :*: fb) (xa :*: xb) k- = pack buf fa xa $ \oa - -> pack (S.plusPtr buf oa) fb xb $ \ob- -> k (oa + ob)- {-# INLINE pack #-}+instance Applicative Unpacker where+ pure x+ = Unpacker $ \start _end _fail _stop eat+ -> eat start x+ {-# INLINE pure #-} - unpack buf (fa :*: fb) k- = unpack buf fa $ \(xa, oa)- -> unpack (S.plusPtr buf oa) fb $ \(xb, ob)- -> k (xa :*: xb, oa + ob)- {-# INLINE unpack #-}+ (<*>) (Unpacker ff) (Unpacker fx)+ = Unpacker $ \start end stop fail eat+ -> ff start end stop fail $ \start_f f+ -> fx start_f end stop fail $ \start_x x+ -> eat start_x (f x)+ {-# INLINE (<*>) #-} ------------------------------------------------------------------------------------------------------- | Fixed length list.----data FixList f = FixList f Int deriving (Eq, Show)-instance Format f => Format (FixList f) where- type Value (FixList f) = [Value f]-- fixedSize (FixList f len) - = do lenElem <- fixedSize f- return $ lenElem * len-- packedSize (FixList _ 0) _- = return 0-- packedSize (FixList f len) xs- | length xs == len- = do lenElems <- mapM (packedSize f) xs- return $ sum lenElems+instance Monad Unpacker where+ return = pure+ {-# INLINE return #-} - | otherwise - = Nothing+ (>>=) (Unpacker fa) mkfb+ = Unpacker $ \start end stop fail eat+ -> fa start end stop fail $ \start_x x+ -> case mkfb x of+ Unpacker fb+ -> fb start_x end stop fail eat+ {-# INLINE (>>=) #-} --- | Variable length list.-data VarList f = VarList f deriving (Eq, Show)-instance Format f => Format (VarList f) where- type Value (VarList f) = [Value f]-- fixedSize (VarList _) = Nothing-- packedSize (VarList f) xs@(x : _)- = do lenElem <- packedSize f x- return $ lenElem * length xs+-- | Unpack data from the given buffer.+--+-- PRECONDITION: The buffer must be at least the minimum size of the +-- format (minSize). This allows us to avoid repeatedly checking for +-- buffer overrun when unpacking fixed size format. If the buffer+-- is not long enough then you'll get an indeterminate result (bad).+--+unsafeRunUnpacker+ :: Unpacker a -- ^ Unpacker to run.+ -> S.Ptr Word8 -- ^ Source buffer.+ -> Int -- ^ Length of source buffer.+ -> (Word8 -> Bool) -- ^ Detect a field terminator.+ -> IO (Maybe (a, S.Ptr Word8)) + -- ^ Unpacked result, and pointer to the byte after the last+ -- one read. - packedSize _ []- = return 0+unsafeRunUnpacker (Unpacker f) start len stop+ = do ref <- newIORef Nothing+ f start + (S.plusPtr start len)+ stop+ (return ())+ (\ptr x -> writeIORef ref (Just (x, ptr)))+ readIORef ref+{-# INLINE unsafeRunUnpacker #-} ------------------------------------------------------------------------------------------------------ | Fixed length string.--- --- * When packing, if the provided string is shorter than the fixed length--- then the extra bytes are zero-filled. +-- | Class of storage formats that can have values packed and unpacked+-- from foreign bufferes. +-- +-- The methods are written using continuations to make it easier for+-- GHC to optimise its core code when packing/unpacking many fields. ---data FixString t = FixString t Int deriving (Eq, Show)-instance Format (FixString ASCII) where- type Value (FixString ASCII) = String- fixedSize (FixString ASCII len) = Just len- packedSize (FixString ASCII len) _ = Just len---instance Packable (FixString ASCII) where- - pack buf (FixString ASCII lenField) xs k- = do let !lenChars = length xs- let !lenPad = lenField - lenChars-- if lenChars > lenField- then return Nothing- else do- mapM_ (\(o, x) -> S.pokeByteOff buf o (w8 $ ord x)) - $ zip [0 .. lenChars - 1] xs-- mapM_ (\o -> S.pokeByteOff buf (lenChars + o) (0 :: Word8))- $ [0 .. lenPad - 1]-- k lenField- {-# NOINLINE pack #-}-- unpack buf (FixString ASCII lenField) k- = do - let load_unpackChar o- = do x :: Word8 <- S.peekByteOff buf o- return $ chr $ fromIntegral x- {-# INLINE load_unpackChar #-}-- xs <- mapM load_unpackChar [0 .. lenField - 1]- let (pre, _) = break (== '\0') xs- k (pre, lenField)- {-# NOINLINE unpack #-}----- | Variable length string.-data VarString t = VarString t deriving (Eq, Show)-instance Format (VarString ASCII) where- type Value (VarString ASCII) = String- fixedSize (VarString ASCII) = Nothing- packedSize (VarString ASCII) xs = Just $ length xs+class Format format + => Packable format where -instance Packable (VarString ASCII) where-- pack buf (VarString ASCII) xs k- = do let !lenChars = length xs-- mapM_ (\(o, x) -> S.pokeByteOff buf o (w8 $ ord x))- $ zip [0 .. lenChars - 1] xs-- k lenChars- {-# NOINLINE pack #-}-- unpack _ (VarString ASCII) _- = return Nothing- {-# NOINLINE unpack #-}+ -- | Pack a value into a buffer using the given format.+ pack :: format -- ^ Storage format.+ -> Value format -- ^ Value to pack.+ -> Packer -- ^ Packer that can write the value. --- | String is encoded as 8-bit ASCII characters.-data ASCII = ASCII deriving (Eq, Show)-+ -- | Unpack a value from a buffer using the given format.+ unpack :: format -- ^ Storage format.+ -> Unpacker (Value format) -- ^ Unpacker for that format. -----------------------------------------------------------------------------------------------------w8 :: Integral a => a -> Word8-w8 = fromIntegral-{-# INLINE w8 #-}
Data/Repa/Convert/Format/Binary.hs view
@@ -21,45 +21,32 @@ import qualified Control.Monad.Primitive as Prim -------------------------------------------------------------------------------------------- Int8be--- | Big-endian 8-bit signed integer.-data Int8be = Int8be deriving (Eq, Show)-instance Format Int8be where- type Value Int8be = V.Int8- fixedSize _ = Just 1- packedSize _ _ = Just 1---i8 :: Integral a => a -> Int8-i8 = fromIntegral-{-# INLINE i8 #-}-- ------------------------------------------------------------------------------------------- Word8be -- | Big-endian 8-bit unsigned word. data Word8be = Word8be deriving (Eq, Show) instance Format Word8be where- type Value Word8be = V.Word8+ type Value Word8be = Word8+ fieldCount _ = 1+ minSize _ = 1 fixedSize _ = Just 1 packedSize _ _ = Just 1+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-} instance Packable Word8be where- pack buf Word8be x k- = do S.poke buf (fromIntegral x)- k 1+ pack Word8be x + = Packer $ \buf k+ -> do S.poke buf (fromIntegral x)+ k (S.plusPtr buf 1) {-# INLINE pack #-} - unpack buf Word8be k- = do x <- S.peek buf- k (fromIntegral x, 1)- {-# INLINE unpack #-}---instance Packable Int8be where- pack buf Int8be x k = pack buf Word8be (w8 x) k- unpack buf Int8be k = unpack buf Word8be (\(x, o) -> k (i8 x, o))- {-# INLINE pack #-}+ unpack Word8be + = Unpacker $ \start _end _stop _fail eat+ -> do x <- S.peek start+ eat (S.plusPtr start 1) (fromIntegral x) {-# INLINE unpack #-} @@ -68,49 +55,62 @@ {-# INLINE w8 #-} -------------------------------------------------------------------------------------------- Int16be---- | Big-endian 16-bit signed integer.-data Int16be = Int16be deriving (Eq, Show)-instance Format Int16be where- type Value Int16be = V.Int16- fixedSize _ = Just 2- packedSize _ _ = Just 2+------------------------------------------------------------------------------------------- Int8be+-- | Big-endian 8-bit signed integer.+data Int8be = Int8be deriving (Eq, Show)+instance Format Int8be where+ type Value Int8be = V.Int8+ fieldCount _ = 1+ minSize _ = 1+ fixedSize _ = Just 1+ packedSize _ _ = Just 1+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-} +instance Packable Int8be where+ pack Int8be x = pack Word8be (w8 x)+ unpack Int8be = fmap i8 (unpack Word8be)+ {-# INLINE pack #-}+ {-# INLINE unpack #-} -i16 :: Integral a => a -> Int16-i16 = fromIntegral-{-# INLINE i16 #-} +i8 :: Integral a => a -> Int8+i8 = fromIntegral+{-# INLINE i8 #-} + ------------------------------------------------------------------------------------------ Word16be -- | Big-endian 32-bit unsigned word. data Word16be = Word16be deriving (Eq, Show) instance Format Word16be where type Value Word16be = V.Word16- fixedSize _ = Just 2+ fieldCount _ = 1+ minSize _ = 2+ fixedSize _ = Just 2 packedSize _ _ = Just 2+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-} instance Packable Word16be where- pack buf Word16be x k- = do S.poke buf (w8 ((w16 x .&. 0x0ff00) `shiftR` 8))+ pack Word16be x + = Packer $ \buf k+ -> do S.poke buf (w8 ((w16 x .&. 0x0ff00) `shiftR` 8)) S.pokeByteOff buf 1 (w8 ((w16 x .&. 0x000ff)))- k 2+ k (S.plusPtr buf 2) {-# INLINE pack #-} - unpack buf Word16be k- = do x0 :: Word8 <- S.peek buf - x1 :: Word8 <- S.peekByteOff buf 1- let !x = w16 ((w16 x0 `shiftL` 8) .|. w16 x1)- k (x, 2)- {-# INLINE unpack #-}---instance Packable Int16be where- pack buf Int16be x k = pack buf Word16be (w16 x) k- unpack buf Int16be k = unpack buf Word16be (\(x, o) -> k (i16 x, o))- {-# INLINE pack #-}+ unpack Word16be + = Unpacker $ \start _end _stop _fail eat+ -> do x0 :: Word8 <- S.peek start + x1 :: Word8 <- S.peekByteOff start 1+ eat (S.plusPtr start 2)+ (w16 ((w16 x0 `shiftL` 8) .|. w16 x1)) {-# INLINE unpack #-} @@ -119,25 +119,31 @@ {-# INLINE w16 #-} -------------------------------------------------------------------------------------------- Int32be--- | Big-endian 32-bit signed integer.-data Int32be = Int32be deriving (Eq, Show)-instance Format Int32be where- type Value Int32be = V.Int32- fixedSize _ = Just 4- packedSize _ _ = Just 4+------------------------------------------------------------------------------------------- Int16be+--- | Big-endian 16-bit signed integer.+data Int16be = Int16be deriving (Eq, Show)+instance Format Int16be where+ type Value Int16be = V.Int16+ fieldCount _ = 1+ minSize _ = 2+ fixedSize _ = Just 2+ packedSize _ _ = Just 2+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-} -instance Packable Int32be where- pack buf Int32be x k = pack buf Word32be (w32 x) k- unpack buf Int32be k = unpack buf Word32be (\(x, o) -> k (i32 x, o))+instance Packable Int16be where+ pack Int16be x = pack Word16be (w16 x)+ unpack Int16be = fmap i16 (unpack Word16be) {-# INLINE pack #-} {-# INLINE unpack #-} -i32 :: Integral a => a -> Int32-i32 = fromIntegral-{-# INLINE i32 #-}+i16 :: Integral a => a -> Int16+i16 = fromIntegral+{-# INLINE i16 #-} ------------------------------------------------------------------------------------------ Word32be@@ -145,29 +151,37 @@ data Word32be = Word32be deriving (Eq, Show) instance Format Word32be where type Value Word32be = V.Word32- fixedSize _ = Just 4+ fieldCount _ = 1+ minSize _ = 4+ fixedSize _ = Just 4 packedSize _ _ = Just 4+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-} instance Packable Word32be where- pack buf Word32be x k- = do S.poke buf (w8 ((w32 x .&. 0x0ff000000) `shiftR` 24))+ pack Word32be x + = Packer $ \buf k+ -> do S.poke buf (w8 ((w32 x .&. 0x0ff000000) `shiftR` 24)) S.pokeByteOff buf 1 (w8 ((w32 x .&. 0x000ff0000) `shiftR` 16)) S.pokeByteOff buf 2 (w8 ((w32 x .&. 0x00000ff00) `shiftR` 8)) S.pokeByteOff buf 3 (w8 ((w32 x .&. 0x0000000ff)))- k 4+ k (S.plusPtr buf 4) {-# INLINE pack #-} - unpack buf Word32be k- = do x0 :: Word8 <- S.peek buf - x1 :: Word8 <- S.peekByteOff buf 1- x2 :: Word8 <- S.peekByteOff buf 2- x3 :: Word8 <- S.peekByteOff buf 3- let !x = w32 ( (w32 x0 `shiftL` 24) - .|. (w32 x1 `shiftL` 16)- .|. (w32 x2 `shiftL` 8)- .|. (w32 x3))- k (x, 4)+ unpack Word32be + = Unpacker $ \start _end _fail _stop eat+ -> do x0 :: Word8 <- S.peek start + x1 :: Word8 <- S.peekByteOff start 1+ x2 :: Word8 <- S.peekByteOff start 2+ x3 :: Word8 <- S.peekByteOff start 3+ eat (S.plusPtr start 4)+ (w32 ( (w32 x0 `shiftL` 24) + .|. (w32 x1 `shiftL` 16)+ .|. (w32 x2 `shiftL` 8)+ .|. (w32 x3))) {-# INLINE unpack #-} @@ -175,25 +189,33 @@ w32 = fromIntegral {-# INLINE w32 #-} -------------------------------------------------------------------------------------------- Int64be--- | Big-endian 64-bit signed integer.-data Int64be = Int64be deriving (Eq, Show)-instance Format Int64be where- type Value Int64be = V.Int64- fixedSize _ = Just 8- packedSize _ _ = Just 8 -instance Packable Int64be where- pack buf Int64be x k = pack buf Word64be (w64 x) k- unpack buf Int64be k = unpack buf Word64be (\(x, o) -> k (i64 x, o))+------------------------------------------------------------------------------------------- Int32be+-- | Big-endian 32-bit signed integer.+data Int32be = Int32be deriving (Eq, Show)+instance Format Int32be where+ type Value Int32be = V.Int32+ fieldCount _ = 1+ minSize _ = 4+ fixedSize _ = Just 4+ packedSize _ _ = Just 4+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable Int32be where+ pack Int32be x = pack Word32be (w32 x)+ unpack Int32be = fmap i32 (unpack Word32be) {-# INLINE pack #-} {-# INLINE unpack #-} -i64 :: Integral a => a -> Int64-i64 = fromIntegral-{-# INLINE i64 #-}+i32 :: Integral a => a -> Int32+i32 = fromIntegral+{-# INLINE i32 #-} ------------------------------------------------------------------------------------------ Word64be@@ -201,13 +223,20 @@ data Word64be = Word64be deriving (Eq, Show) instance Format Word64be where type Value Word64be = V.Word64- fixedSize _ = Just 8+ fieldCount _ = 1+ minSize _ = 8+ fixedSize _ = Just 8 packedSize _ _ = Just 8+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-} instance Packable Word64be where- pack buf Word64be x k- = do S.poke buf (w8 ((w64 x .&. 0x0ff00000000000000) `shiftR` 56))+ pack Word64be x + = Packer $ \buf k+ -> do S.poke buf (w8 ((w64 x .&. 0x0ff00000000000000) `shiftR` 56)) S.pokeByteOff buf 1 (w8 ((w64 x .&. 0x000ff000000000000) `shiftR` 48)) S.pokeByteOff buf 2 (w8 ((w64 x .&. 0x00000ff0000000000) `shiftR` 40)) S.pokeByteOff buf 3 (w8 ((w64 x .&. 0x0000000ff00000000) `shiftR` 32))@@ -215,27 +244,28 @@ S.pokeByteOff buf 5 (w8 ((w64 x .&. 0x00000000000ff0000) `shiftR` 16)) S.pokeByteOff buf 6 (w8 ((w64 x .&. 0x0000000000000ff00) `shiftR` 8)) S.pokeByteOff buf 7 (w8 ((w64 x .&. 0x000000000000000ff) ))- k 8+ k (S.plusPtr buf 8) {-# INLINE pack #-} - unpack buf Word64be k- = do x0 :: Word8 <- S.peek buf - x1 :: Word8 <- S.peekByteOff buf 1- x2 :: Word8 <- S.peekByteOff buf 2- x3 :: Word8 <- S.peekByteOff buf 3- x4 :: Word8 <- S.peekByteOff buf 4- x5 :: Word8 <- S.peekByteOff buf 5- x6 :: Word8 <- S.peekByteOff buf 6- x7 :: Word8 <- S.peekByteOff buf 7- let !x = w64 ( (w64 x0 `shiftL` 56) - .|. (w64 x1 `shiftL` 48)- .|. (w64 x2 `shiftL` 40)- .|. (w64 x3 `shiftL` 32) - .|. (w64 x4 `shiftL` 24) - .|. (w64 x5 `shiftL` 16)- .|. (w64 x6 `shiftL` 8)- .|. (w64 x7 ))- k (x, 8)+ unpack Word64be + = Unpacker $ \start _end _fail _stop eat+ -> do x0 :: Word8 <- S.peek start + x1 :: Word8 <- S.peekByteOff start 1+ x2 :: Word8 <- S.peekByteOff start 2+ x3 :: Word8 <- S.peekByteOff start 3+ x4 :: Word8 <- S.peekByteOff start 4+ x5 :: Word8 <- S.peekByteOff start 5+ x6 :: Word8 <- S.peekByteOff start 6+ x7 :: Word8 <- S.peekByteOff start 7+ eat (S.plusPtr start 8)+ (w64 ( (w64 x0 `shiftL` 56) + .|. (w64 x1 `shiftL` 48)+ .|. (w64 x2 `shiftL` 40)+ .|. (w64 x3 `shiftL` 32) + .|. (w64 x4 `shiftL` 24) + .|. (w64 x5 `shiftL` 16)+ .|. (w64 x6 `shiftL` 8)+ .|. (w64 x7 ))) {-# INLINE unpack #-} @@ -244,22 +274,52 @@ {-# INLINE w64 #-} +------------------------------------------------------------------------------------------- Int64be+-- | Big-endian 64-bit signed integer.+data Int64be = Int64be deriving (Eq, Show)+instance Format Int64be where+ type Value Int64be = V.Int64+ fieldCount _ = 1+ minSize _ = 8+ fixedSize _ = Just 8+ packedSize _ _ = Just 8+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable Int64be where+ pack Int64be x = pack Word64be (w64 x)+ unpack Int64be = fmap i64 (unpack Word64be)+ {-# INLINE pack #-}+ {-# INLINE unpack #-}+++i64 :: Integral a => a -> Int64+i64 = fromIntegral+{-# INLINE i64 #-}++ ----------------------------------------------------------------------------------------- Float32be -- | Big-endian 32-bit IEEE 754 float. data Float32be = Float32be deriving (Eq, Show) instance Format Float32be where type Value Float32be = Float+ fieldCount _ = 1+ minSize _ = 4 fixedSize _ = Just 4 packedSize _ _ = Just 4+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-} instance Packable Float32be where- pack buf Float32be x k- = pack buf Word32be (floatToWord32 x) k+ pack Float32be x = pack Word32be (floatToWord32 x)+ unpack Float32be = fmap word32ToFloat (unpack Word32be) {-# INLINE pack #-}-- unpack buf Float32be k- = unpack buf Word32be (\(v, i) -> k (word32ToFloat v, i)) {-# INLINE unpack #-} @@ -291,17 +351,20 @@ data Float64be = Float64be deriving (Eq, Show) instance Format Float64be where type Value Float64be = Double+ fieldCount _ = 1+ minSize _ = 8 fixedSize _ = Just 8 packedSize _ _ = Just 8+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-} instance Packable Float64be where- pack buf Float64be x k- = pack buf Word64be (doubleToWord64 x) k+ pack Float64be x = pack Word64be (doubleToWord64 x)+ unpack Float64be = fmap word64ToDouble (unpack Word64be) {-# INLINE pack #-}-- unpack buf Float64be k- = unpack buf Word64be (\(v, i) -> k (word64ToDouble v, i)) {-# INLINE unpack #-}
+ Data/Repa/Convert/Format/Date32.hs view
@@ -0,0 +1,103 @@++module Data.Repa.Convert.Format.Date32+ ( YYYYsMMsDD (..)+ , DDsMMsYYYY (..))+where+import Data.Repa.Convert.Format.Base+import Data.Repa.Convert.Format.Numeric+import Data.Repa.Convert.Format.Binary+import Data.Monoid+import Data.Char+import Data.Word+import Data.Repa.Scalar.Date32 (Date32)+import qualified Data.Repa.Scalar.Date32 as Date32+import qualified Foreign.Ptr as F+import Prelude hiding (fail)+++---------------------------------------------------------------------------------------- YYYYsMMsDD+-- | Date32 in ASCII YYYYsMMsDD format.+data YYYYsMMsDD = YYYYsMMsDD Char deriving (Eq, Show)+instance Format YYYYsMMsDD where+ type Value YYYYsMMsDD = Date32+ fieldCount _ = 1+ minSize _ = 10+ fixedSize _ = Just 10+ packedSize _ _ = Just 10+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable YYYYsMMsDD where++ pack (YYYYsMMsDD s) v + | (yy', mm', dd') <- Date32.unpack v+ , yy <- fromIntegral yy'+ , mm <- fromIntegral mm'+ , dd <- fromIntegral dd'+ = pack (IntAsc0 4) yy+ <> pack Word8be (cw8 s)+ <> pack (IntAsc0 2) mm+ <> pack Word8be (cw8 s)+ <> pack (IntAsc0 2) dd+ {-# INLINE pack #-}++ unpack (YYYYsMMsDD s)+ = Unpacker $ \start end _stop fail eat+ -> do+ let !len = F.minusPtr end start+ r <- Date32.loadYYYYsMMsDD (fromIntegral $ ord s) start len+ case r of+ Just (d, o) -> eat (F.plusPtr start o) d+ Nothing -> fail+ {-# INLINE unpack #-}+++---------------------------------------------------------------------------------------- DDsMMsYYYY+-- | Date32 in ASCII DDsMMsYYYY format.+data DDsMMsYYYY = DDsMMsYYYY Char deriving (Eq, Show)+instance Format DDsMMsYYYY where+ type Value DDsMMsYYYY = Date32+ fieldCount _ = 1+ minSize _ = 10+ fixedSize _ = Just 10+ packedSize _ _ = Just 10+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable DDsMMsYYYY where++ pack (DDsMMsYYYY s) v+ | (yy', mm', dd') <- Date32.unpack v+ , yy <- fromIntegral yy'+ , mm <- fromIntegral mm'+ , dd <- fromIntegral dd'+ = pack (IntAsc0 2) dd+ <> pack Word8be (cw8 s)+ <> pack (IntAsc0 2) mm+ <> pack Word8be (cw8 s)+ <> pack (IntAsc0 4) yy+ {-# INLINE pack #-}++ unpack (DDsMMsYYYY s)+ = Unpacker $ \start end _stop fail eat+ -> do+ let !len = F.minusPtr end start+ r <- Date32.loadDDsMMsYYYY (fromIntegral $ ord s) start len+ case r of+ Just (d, o) -> eat (F.plusPtr start o) d+ Nothing -> fail+ {-# INLINE unpack #-}+++---------------------------------------------------------------------------------------------------+cw8 :: Char -> Word8+cw8 c = fromIntegral $ ord c+{-# INLINE cw8 #-}++
+ Data/Repa/Convert/Format/Fields.hs view
@@ -0,0 +1,53 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Repa.Convert.Format.Fields where+import Data.Repa.Convert.Format.Base+import Data.Repa.Scalar.Product+++instance Format () where+ type Value () = ()+ fieldCount _ = 0+ minSize _ = 0+ fixedSize _ = return 0+ packedSize _ _ = return 0+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable () where+ pack _ = mempty+ unpack _ = return ()+ {-# INLINE pack #-} + {-# INLINE unpack #-}+++-- | Formatting fields.+instance (Format a, Format b) + => Format (a :*: b) where++ type Value (a :*: b)+ = Value a :*: Value b++ fieldCount (fa :*: fb)+ = fieldCount fa + fieldCount fb++ minSize (fa :*: fb)+ = minSize fa + minSize fb++ fixedSize (fa :*: fb)+ = do sa <- fixedSize fa+ sb <- fixedSize fb+ return $ sa + sb++ packedSize (fa :*: fb) (xa :*: xb)+ = do sa <- packedSize fa xa+ sb <- packedSize fb xb+ return $ sa + sb++ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+
+ Data/Repa/Convert/Format/Lists.hs view
@@ -0,0 +1,218 @@++module Data.Repa.Convert.Format.Lists + ( -- * ASCII Strings+ FixAsc (..)+ , VarAsc (..)+ , VarString (..))+where+import Data.Repa.Convert.Format.Binary+import Data.Repa.Convert.Format.Base+import Data.Monoid+import Data.Word+import Data.Char+import qualified Foreign.Storable as S+import qualified Foreign.Ptr as S+import Prelude hiding (fail)+++---------------------------------------------------------------------------------------------------+-- | Fixed length string.+-- +-- * When packing, the length of the provided string must match+-- the field width, else packing will fail.+--+-- * When unpacking, the length of the result will be as set+-- by the field width.+--+data FixAsc = FixAsc Int deriving (Eq, Show)+instance Format FixAsc where+ type Value (FixAsc) = String+ fieldCount _ = 1+ minSize (FixAsc len) = len+ fixedSize (FixAsc len) = Just len+ packedSize (FixAsc len) _ = Just len+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable FixAsc where+ + pack (FixAsc len) xs + | length xs == len+ = Packer $ \buf k+ -> do mapM_ (\(o, x) -> S.pokeByteOff buf o (w8 $ ord x)) + $ zip [0 .. len - 1] xs+ k (S.plusPtr buf len)++ | otherwise+ = Packer $ \_ _ -> return Nothing+ {-# NOINLINE pack #-}++ unpack (FixAsc len)+ = Unpacker $ \start end _stop fail eat+ -> do + let lenBuf = S.minusPtr end start+ if lenBuf < len+ then fail+ else + do let load_unpackChar o+ = do x :: Word8 <- S.peekByteOff start o+ return $ chr $ fromIntegral x+ {-# INLINE load_unpackChar #-}++ xs <- mapM load_unpackChar [0 .. len - 1]+ eat (S.plusPtr start len) xs+ {-# NOINLINE unpack #-}+++---------------------------------------------------------------------------------------------------+-- | Variable length raw string (with no quotes).+data VarAsc = VarAsc deriving (Eq, Show)+instance Format (VarAsc) where+ type Value VarAsc = String+ fieldCount _ = 1+ minSize _ = 0+ fixedSize VarAsc = Nothing+ packedSize VarAsc xs = Just $ length xs+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable VarAsc where++ pack VarAsc xx+ = case xx of+ [] -> mempty+ (x : xs) -> pack Word8be (w8 $ ord x) <> pack VarAsc xs+ {-# NOINLINE pack #-}++ unpack VarAsc + = Unpacker $ \start end stop _fail eat+ -> do (ptr, str) <- unpackAsc start end stop+ eat ptr str+ {-# INLINE unpack #-}+++-- | Unpack a ascii text from the given buffer.+unpackAsc+ :: S.Ptr Word8 -- ^ First byte in buffer.+ -> S.Ptr Word8 -- ^ First byte after buffer.+ -> (Word8 -> Bool) -- ^ Detect field deliminator.+ -> IO (S.Ptr Word8, [Char])++unpackAsc start end stop+ = go start []+ where go !ptr !acc+ | ptr >= end+ = return (ptr, reverse acc)++ | otherwise+ = do w :: Word8 <- S.peek ptr+ if stop w + then do+ return (ptr, reverse acc)+ else do+ let !ptr' = S.plusPtr ptr 1+ go ptr' ((chr $ fromIntegral w) : acc)+{-# INLINE unpackAsc #-}+++---------------------------------------------------------------------------------------------------+-- | Variable length string in double quotes, +-- and standard backslash encoding of special characters.+data VarString = VarString deriving (Eq, Show)+instance Format VarString where+ type Value VarString = String+ fieldCount _ = 1+ minSize _ = 2+ fixedSize _ = Nothing+ packedSize VarString xs + = Just $ length $ show xs + {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable VarString where++ -- ISSUE #43: Avoid intermediate lists when packing Ints and Strings.+ pack VarString xx+ = pack VarAsc (show xx)+ {-# INLINE pack #-}++ unpack VarString+ = Unpacker $ \start end _stop fail eat+ -> do r <- unpackString start end+ case r of+ Nothing -> fail+ Just (start', str) -> eat start' str+ {-# INLINE unpack #-}+++-- | Unpack a string from the given buffer.+unpackString + :: S.Ptr Word8 -- ^ First byte in buffer.+ -> S.Ptr Word8 -- ^ First byte after buffer.+ -> IO (Maybe (S.Ptr Word8, [Char]))++unpackString start end+ = open start+ where+ -- Accept the open quotes.+ open !ptr+ | ptr >= end+ = return $ Nothing++ | otherwise+ = do w :: Word8 <- S.peek ptr+ let !ptr' = S.plusPtr ptr 1 + case chr $ fromIntegral w of+ '"' -> go_body ptr' []+ _ -> return Nothing++ -- Handle the next character in the string.+ go_body !ptr !acc+ | ptr >= end + = return $ Just (ptr, reverse acc)++ | otherwise+ = do w :: Word8 <- S.peek ptr+ let !ptr' = S.plusPtr ptr 1+ case chr $ fromIntegral w of+ '"' -> return $ Just (ptr', reverse acc)+ '\\' -> go_escape ptr' acc+ c -> go_body ptr' (c : acc)++ -- Handle escaped character.+ -- The previous character was a '\\'+ go_escape !ptr !acc+ | ptr >= end+ = return Nothing++ | otherwise+ = do w :: Word8 <- S.peek ptr+ let ptr' = S.plusPtr ptr 1+ case chr $ fromIntegral w of+ 'a' -> go_body ptr' ('\a' : acc)+ 'b' -> go_body ptr' ('\b' : acc)+ 'f' -> go_body ptr' ('\f' : acc)+ 'n' -> go_body ptr' ('\n' : acc)+ 'r' -> go_body ptr' ('\r' : acc)+ 't' -> go_body ptr' ('\t' : acc)+ 'v' -> go_body ptr' ('\v' : acc)+ '\\' -> go_body ptr' ('\\' : acc)+ '"' -> go_body ptr' ('"' : acc)+ _ -> return Nothing+{-# NOINLINE unpackString #-}+++---------------------------------------------------------------------------------------------------+w8 :: Integral a => a -> Word8+w8 = fromIntegral+{-# INLINE w8 #-}+
+ Data/Repa/Convert/Format/Numeric.hs view
@@ -0,0 +1,130 @@++module Data.Repa.Convert.Format.Numeric+ ( IntAsc (..)+ , IntAsc0 (..)+ , DoubleAsc (..))+where+import Data.Repa.Convert.Format.Base+import Data.Repa.Convert.Format.Lists+import qualified Data.Repa.Scalar.Int as S+import qualified Data.Repa.Scalar.Double as S+import qualified Foreign.ForeignPtr as F+import qualified Foreign.Marshal.Utils as F+import qualified Foreign.Ptr as F+import Prelude hiding (fail)+++------------------------------------------------------------------------------------------- IntAsc+-- | Human-readable ASCII Integer.+data IntAsc = IntAsc deriving (Eq, Show)+instance Format IntAsc where+ type Value IntAsc = Int+ fieldCount _ = 1+ minSize _ = 1+ fixedSize _ = Nothing++ -- Max length of a pretty printed 64-bit Int is 20 bytes including sign.+ packedSize _ _ = Just 20 + {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable IntAsc where++ -- ISSUE #43: Avoid intermediate lists when packing Ints and Strings.+ pack IntAsc v+ = pack VarAsc (show v)+ {-# INLINE pack #-}++ unpack IntAsc + = Unpacker $ \start end _stop fail eat+ -> let !len = F.minusPtr end start in + if len > 0+ then do+ r <- S.loadInt start len+ case r of+ Just (n, o) -> eat (F.plusPtr start o) n+ Nothing -> fail+ else fail+ {-# INLINE unpack #-}+++------------------------------------------------------------------------------------------- IntAsc+-- | Human-readable ASCII integer, with leading zeros.+data IntAsc0 = IntAsc0 Int deriving (Eq, Show)+instance Format IntAsc0 where+ type Value IntAsc0 = Int+ fieldCount _ = 1+ minSize _ = 1+ fixedSize _ = Nothing++ -- Max length of a pretty printed 64-bit Int is 20 bytes including sign.+ packedSize (IntAsc0 n) _ = Just (n + 20)+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable IntAsc0 where++ -- ISSUE #43: Avoid intermediate lists when packing Ints and Strings.+ pack (IntAsc0 n) v + = let s = show v+ s' = replicate (n - length s) '0' ++ s+ in pack VarAsc s'+ {-# INLINE pack #-}++ unpack (IntAsc0 _)+ = Unpacker $ \start end _stop fail eat+ -> let !len = F.minusPtr end start in+ if len > 0+ then do+ r <- S.loadInt start len+ case r of+ Just (n, o) -> eat (F.plusPtr start o) n+ Nothing -> fail+ else fail+ {-# INLINE unpack #-}+++----------------------------------------------------------------------------------------- DoubleAsc+-- | Human-readable ASCII Double.+data DoubleAsc = DoubleAsc deriving (Eq, Show)+instance Format DoubleAsc where+ type Value DoubleAsc = Double+ fieldCount _ = 1+ minSize _ = 1+ fixedSize _ = Nothing++ -- Max length of a pretty-printed 64-bit double is 64 bytes.+ packedSize _ _ = Just 24+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable DoubleAsc where++ pack DoubleAsc v + = Packer $ \buf k+ -> do (fptr, len) <- S.storeDoubleShortest v+ F.withForeignPtr fptr $ \ptr+ -> F.copyBytes buf ptr len+ k (F.plusPtr buf len)+ {-# INLINE pack #-}++ unpack DoubleAsc + = Unpacker $ \start end _stop fail eat+ -> let !len = F.minusPtr end start in+ if len > 0+ then do+ (v, o) <- S.loadDouble start len+ eat (F.plusPtr start o) v+ else fail+ {-# INLINE unpack #-}++
+ Data/Repa/Convert/Format/Sep.hs view
@@ -0,0 +1,125 @@++module Data.Repa.Convert.Format.Sep+ (Sep (..))+where+import Data.Repa.Convert.Format.Binary+import Data.Repa.Convert.Format.Base+import Data.Repa.Scalar.Product+import Data.Monoid+import Data.Word+import Data.Char+import qualified Foreign.Storable as F+import qualified Foreign.Ptr as F+import Prelude hiding (fail)+++-- | Separate fields with the given character.+-- +-- * The separating character is un-escapable. +-- * The format @(Sep ',')@ does NOT parse a CSV+-- file according to the CSV specification: http://tools.ietf.org/html/rfc4180.+--+data Sep f+ = Sep Char f+ deriving Show+++---------------------------------------------------------------------------------------------------+instance Format (Sep ()) where+ type Value (Sep ()) = ()+ fieldCount (Sep _ _) = 0+ minSize (Sep _ _) = 0+ fixedSize (Sep _ _) = return 0+ packedSize (Sep _ _) () = return 0+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable (Sep ()) where+ pack _fmt _val = mempty+ unpack _fmt = return ()+ {-# INLINE pack #-}+ {-# INLINE unpack #-}+++---------------------------------------------------------------------------------------------------+instance ( Format f1, Format (Sep fs)+ , Value (Sep fs) ~ Value fs)+ => Format (Sep (f1 :*: fs)) where++ type Value (Sep (f1 :*: fs)) + = Value f1 :*: Value fs++ fieldCount (Sep c (_ :*: fs))+ = 1 + fieldCount (Sep c fs)++ minSize (Sep c (f1 :*: fs))+ = let !n = fieldCount (Sep c fs)+ in minSize f1+ + (if n == 0 then 0 else 1) + + minSize (Sep c fs)++ fixedSize (Sep c (f1 :*: fs))+ = do s1 <- fixedSize f1+ ss <- fixedSize (Sep c fs)+ let sSep = if fieldCount (Sep c fs) == 0 then 0 else 1+ return $ s1 + sSep + ss++ packedSize (Sep c (f1 :*: fs)) (x1 :*: xs)+ = do s1 <- packedSize f1 x1+ ss <- packedSize (Sep c fs) xs+ let sSep = if fieldCount (Sep c fs) == 0 then 0 else 1+ return $ s1 + sSep + ss + {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance ( Packable f1, Packable (Sep fs)+ , Value (Sep fs) ~ Value fs)+ => Packable (Sep (f1 :*: fs)) where++ pack (Sep c (f1 :*: fs)) (x1 :*: xs) + | fieldCount (Sep c fs) >= 1+ = pack f1 x1 <> pack Word8be (w8 $ ord c) <> pack (Sep c fs) xs++ | otherwise+ = pack f1 x1+ {-# INLINE pack #-}+++ unpack (Sep c (f1 :*: fs)) + | fieldCount (Sep c fs) >= 1+ = Unpacker $ \start end stop fail eat+ -> let !len = F.minusPtr end start + !s1 = minSize f1+ !ss = minSize (Sep c fs)++ stop' x = w8 (ord c) == x || stop x+ {-# INLINE stop' #-}++ in if (s1 + 1 + ss <= len)+ then (fromUnpacker $ unpack f1) start end stop' fail $ \start_x1 x1+ -> let start_x1' = F.plusPtr start_x1 1 + in (fromUnpacker $ unpack (Sep c fs)) start_x1' end stop' fail $ \start_xs xs+ -> eat start_xs (x1 :*: xs)+ else fail++ | otherwise+ = Unpacker $ \start end stop fail eat+ -> let stop' x = w8 (ord c) == x || stop x+ {-# INLINE stop' #-}+ in (fromUnpacker $ unpack f1) start end stop' fail $ \start_x x+ -> (fromUnpacker $ unpack (Sep c fs)) start_x end stop' fail $ \start_xs xs+ -> eat start_xs (x :*: xs)+ {-# INLINE unpack #-}+++---------------------------------------------------------------------------------------------------+w8 :: Integral a => a -> Word8+w8 = fromIntegral+{-# INLINE w8 #-}+
+ Data/Repa/Convert/Format/Tup.hs view
@@ -0,0 +1,97 @@++module Data.Repa.Convert.Format.Tup+ (Tup (..))+where+import Data.Repa.Convert.Format.Sep+import Data.Repa.Convert.Format.Binary+import Data.Repa.Convert.Format.Base+import Data.Repa.Scalar.Product+import Data.Monoid+import Data.Word+import Data.Char+++-- | Display fields as a tuple, like @(x,y,z)@.+data Tup f+ = Tup f+ deriving Show+++---------------------------------------------------------------------------------------------------+instance Format (Tup ()) where+ type Value (Tup ()) = ()+ fieldCount (Tup _) = 0+ minSize (Tup _) = 0+ fixedSize (Tup _) = return 0+ packedSize (Tup _) () = return 0+ {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance Packable (Tup ()) where+ pack _fmt _val = mempty+ unpack _fmt = return ()+ {-# INLINE pack #-}+ {-# INLINE unpack #-}+++---------------------------------------------------------------------------------------------------+instance ( Format f1+ , Format (Tup fs)+ , Format (Sep fs)+ , Value (Sep fs) ~ Value fs)+ => Format (Tup (f1 :*: fs)) where++ type Value (Tup (f1 :*: fs)) + = Value f1 :*: Value fs++ fieldCount (Tup (_ :*: fs))+ = 1 + fieldCount (Tup fs)++ minSize (Tup (f1 :*: fs))+ = let !n = fieldCount (Tup fs)+ in 2 + minSize f1+ + (if n == 0 then 0 else 1) + + minSize (Sep ',' fs)++ fixedSize (Tup (f1 :*: fs))+ = do s1 <- fixedSize f1+ ss <- fixedSize (Sep ',' fs)+ let sSep = if fieldCount (Sep ',' fs) == 0 then 0 else 1+ return $ 2 + s1 + sSep + ss++ packedSize (Tup (f1 :*: fs)) (x1 :*: xs)+ = do s1 <- packedSize f1 x1+ ss <- packedSize (Sep ',' fs) xs+ let sSep = if fieldCount (Sep ',' fs) == 0 then 0 else 1+ return $ 2 + s1 + sSep + ss + {-# INLINE minSize #-}+ {-# INLINE fieldCount #-}+ {-# INLINE fixedSize #-}+ {-# INLINE packedSize #-}+++instance ( Packable f1+ , Packable (Sep fs)+ , Format (Tup fs)+ , Value (Sep fs) ~ Value fs)+ => Packable (Tup (f1 :*: fs)) where++ pack (Tup fs) xs+ = pack Word8be (cw8 '(')+ <> pack (Sep ',' fs) xs+ <> pack Word8be (cw8 ')')+ {-# INLINE pack #-}++ -- TODO: finish tuple decoding.+ unpack = error "repa-convert.row unpack finish me"+ {-# INLINE unpack #-}+++---------------------------------------------------------------------------------------------------+cw8 :: Char -> Word8+cw8 c = fromIntegral $ ord c+{-# INLINE cw8 #-}+
+ Data/Repa/Convert/Formats.hs view
@@ -0,0 +1,58 @@++-- | Pre-defined data formats.+module Data.Repa.Convert.Formats+ ( -- * Default Ascii Format+ FormatAscii(..)++ -- * Field Products+ , (:*:)(..)++ -- * Field Separators+ , App (..)+ , Sep (..)+ , Tup (..)++ -- * Strings+ , FixAsc (..)+ , VarAsc (..)+ , VarString (..)++ -- * Atomic values+ -- ** ASCII numeric+ , IntAsc (..)+ , IntAsc0 (..)+ , DoubleAsc (..)++ -- ** ASCII dates+ , YYYYsMMsDD (..)+ , DDsMMsYYYY (..)++ -- ** 8-bit binary+ , Word8be (..)+ , Int8be (..)++ -- ** 16-bit binary+ , Word16be (..)+ , Int16be (..)++ -- ** 32-bit binary+ , Word32be (..)+ , Int32be (..)+ , Float32be (..)++ -- ** 64-bit binary+ , Word64be (..)+ , Int64be (..)+ , Float64be (..))+where+import Data.Repa.Convert.Format.Ascii+import Data.Repa.Convert.Format.App+import Data.Repa.Convert.Format.Binary+import Data.Repa.Convert.Format.Date32+import Data.Repa.Convert.Format.Fields ()+import Data.Repa.Convert.Format.Lists+import Data.Repa.Convert.Format.Numeric+import Data.Repa.Convert.Format.Tup+import Data.Repa.Convert.Format.Sep+import Data.Repa.Scalar.Product+
− Data/Repa/Product.hs
@@ -1,141 +0,0 @@--module Data.Repa.Product- ((:*:)(..))-where-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Generic as G-import qualified Data.Vector.Generic.Mutable as M---- | Strict product type, written infix.-data a :*: b - = !a :*: !b - deriving (Eq, Show)--infixr :*:---- Unboxed ------------------------------------------------------------------------------------------- Unboxed instance adapted from:--- http://code.haskell.org/vector/internal/unbox-tuple-instances----data instance U.Vector (a :*: b)- = V_Prod - {-# UNPACK #-} !Int - !(U.Vector a)- !(U.Vector b)---instance (U.Unbox a, U.Unbox b) - => U.Unbox (a :*: b)---data instance U.MVector s (a :*: b)- = MV_Prod {-# UNPACK #-} !Int - !(U.MVector s a)- !(U.MVector s b)---instance (U.Unbox a, U.Unbox b) - => M.MVector U.MVector (a :*: b) where-- basicLength (MV_Prod n_ _as _bs) = n_- {-# INLINE basicLength #-}-- basicUnsafeSlice i_ m_ (MV_Prod _n_ as bs)- = MV_Prod m_ (M.basicUnsafeSlice i_ m_ as)- (M.basicUnsafeSlice i_ m_ bs)- {-# INLINE basicUnsafeSlice #-}-- basicOverlaps (MV_Prod _n_1 as1 bs1) (MV_Prod _n_2 as2 bs2)- = M.basicOverlaps as1 as2- || M.basicOverlaps bs1 bs2- {-# INLINE basicOverlaps #-}-- basicUnsafeNew n_- = do as <- M.basicUnsafeNew n_- bs <- M.basicUnsafeNew n_- return $ MV_Prod n_ as bs- {-# INLINE basicUnsafeNew #-}-- basicUnsafeReplicate n_ (a :*: b)- = do as <- M.basicUnsafeReplicate n_ a- bs <- M.basicUnsafeReplicate n_ b- return $ MV_Prod n_ as bs- {-# INLINE basicUnsafeReplicate #-}-- basicUnsafeRead (MV_Prod _n_ as bs) i_- = do a <- M.basicUnsafeRead as i_- b <- M.basicUnsafeRead bs i_- return (a :*: b)- {-# INLINE basicUnsafeRead #-}-- basicUnsafeWrite (MV_Prod _n_ as bs) i_ (a :*: b)- = do M.basicUnsafeWrite as i_ a- M.basicUnsafeWrite bs i_ b- {-# INLINE basicUnsafeWrite #-}-- basicClear (MV_Prod _n_ as bs)- = do M.basicClear as- M.basicClear bs- {-# INLINE basicClear #-}-- basicSet (MV_Prod _n_ as bs) (a :*: b)- = do M.basicSet as a- M.basicSet bs b- {-# INLINE basicSet #-}-- basicUnsafeCopy (MV_Prod _n_1 as1 bs1) (MV_Prod _n_2 as2 bs2)- = do M.basicUnsafeCopy as1 as2- M.basicUnsafeCopy bs1 bs2- {-# INLINE basicUnsafeCopy #-}-- basicUnsafeMove (MV_Prod _n_1 as1 bs1) (MV_Prod _n_2 as2 bs2)- = do M.basicUnsafeMove as1 as2- M.basicUnsafeMove bs1 bs2- {-# INLINE basicUnsafeMove #-}-- basicUnsafeGrow (MV_Prod n_ as bs) m_- = do as' <- M.basicUnsafeGrow as m_- bs' <- M.basicUnsafeGrow bs m_- return $ MV_Prod (m_ + n_) as' bs'- {-# INLINE basicUnsafeGrow #-}---instance (U.Unbox a, U.Unbox b) - => G.Vector U.Vector (a :*: b) where- basicUnsafeFreeze (MV_Prod n_ as bs)- = do as' <- G.basicUnsafeFreeze as- bs' <- G.basicUnsafeFreeze bs- return $ V_Prod n_ as' bs'- {-# INLINE basicUnsafeFreeze #-}-- basicUnsafeThaw (V_Prod n_ as bs)- = do as' <- G.basicUnsafeThaw as- bs' <- G.basicUnsafeThaw bs- return $ MV_Prod n_ as' bs'- {-# INLINE basicUnsafeThaw #-}-- basicLength (V_Prod n_ _as _bs) - = n_- {-# INLINE basicLength #-}-- basicUnsafeSlice i_ m_ (V_Prod _n_ as bs)- = V_Prod m_ (G.basicUnsafeSlice i_ m_ as)- (G.basicUnsafeSlice i_ m_ bs)- {-# INLINE basicUnsafeSlice #-}-- basicUnsafeIndexM (V_Prod _n_ as bs) i_- = do a <- G.basicUnsafeIndexM as i_- b <- G.basicUnsafeIndexM bs i_- return (a :*: b)- {-# INLINE basicUnsafeIndexM #-}-- basicUnsafeCopy (MV_Prod _n_1 as1 bs1) (V_Prod _n_2 as2 bs2)- = do G.basicUnsafeCopy as1 as2- G.basicUnsafeCopy bs1 bs2- {-# INLINE basicUnsafeCopy #-}-- elemseq _ (a :*: b)- = G.elemseq (undefined :: U.Vector a) a- . G.elemseq (undefined :: U.Vector b) b- {-# INLINE elemseq #-}-
repa-convert.cabal view
@@ -1,5 +1,5 @@ Name: repa-convert-Version: 4.1.0.1+Version: 4.2.0.1 License: BSD3 License-file: LICENSE Author: The Repa Development Team@@ -10,8 +10,8 @@ Category: Data Structures Homepage: http://repa.ouroborus.net Bug-reports: repa@ouroborus.net-Description: Packing and unpacking binary data.-Synopsis: Packing and unpacking binary data.+Description: Packing and unpacking flat tables.+Synopsis: Packing and unpacking flat tables. source-repository head type: git@@ -19,17 +19,29 @@ Library build-Depends: - base == 4.7.*,- primitive == 0.5.4.*,- vector == 0.10.*+ base == 4.8.*,+ primitive == 0.6.*,+ vector == 0.10.*,+ bytestring == 0.10.*,+ double-conversion == 2.0.*,+ repa-scalar == 4.2.0.* exposed-modules:- Data.Repa.Product Data.Repa.Convert.Format+ Data.Repa.Convert.Formats+ Data.Repa.Convert other-modules:+ Data.Repa.Convert.Format.Ascii+ Data.Repa.Convert.Format.App Data.Repa.Convert.Format.Base Data.Repa.Convert.Format.Binary+ Data.Repa.Convert.Format.Date32+ Data.Repa.Convert.Format.Fields+ Data.Repa.Convert.Format.Lists+ Data.Repa.Convert.Format.Numeric+ Data.Repa.Convert.Format.Sep+ Data.Repa.Convert.Format.Tup ghc-options: -Wall -fno-warn-missing-signatures@@ -37,16 +49,21 @@ extensions: CPP- NoMonomorphismRestriction- ExistentialQuantification- BangPatterns- FlexibleContexts- FlexibleInstances- PatternGuards+ GADTs+ MagicHash+ DataKinds+ RankNTypes MultiWayIf+ BangPatterns TypeFamilies+ PatternGuards TypeOperators+ UnboxedTuples+ FlexibleContexts+ FlexibleInstances+ StandaloneDeriving ScopedTypeVariables MultiParamTypeClasses--+ ForeignFunctionInterface+ ExistentialQuantification+ NoMonomorphismRestriction