packages feed

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 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