repa-convert-4.2.3.1: Packing and unpacking flat tables.

Safe HaskellNone
LanguageHaskell98

Data.Repa.Convert.Formats

Contents

Description

Pre-defined data formats.

Synopsis

Default

class FormatAscii a where Source #

Class of types that can be formatted in some default human readable ASCII way.

Minimal complete definition

formatAscii

Associated Types

type FormatAscii' a Source #

The format for values of this type.

Methods

formatAscii :: a -> FormatAscii' a Source #

Get the standard ASCII format for a value.

The element value itself is not demanded.

Instances

FormatAscii Double Source #

Doubles are formatted as base-10 decimal.

Associated Types

type FormatAscii' Double :: * Source #

FormatAscii Int Source #

Ints are formated in base-10.

Associated Types

type FormatAscii' Int :: * Source #

FormatAscii () Source #

Empty tuples produce no output.

Associated Types

type FormatAscii' () :: * Source #

Methods

formatAscii :: () -> FormatAscii' () Source #

FormatAscii String Source #

Strings are formatted with double quotes and back-slash escaping of special characters.

Associated Types

type FormatAscii' String :: * Source #

FormatAscii Date32 Source #

Dates are formatted as YYYY-MM-DD.

Associated Types

type FormatAscii' Date32 :: * Source #

Units

data UnitAsc Source #

A particular ASCII string.

Constructors

UnitAsc String 

Maybes

data MaybeChars f Source #

Maybe a raw list of characters, or something else.

Constructors

MaybeChars String f 

Instances

data MaybeBytes f Source #

Maybe a raw sequence of bytes, or something else.

Constructors

MaybeBytes ByteString f 

Instances

String Formats

for Haskell Strings

data FixChars Source #

Fixed length sequence of characters, represented as a (hated) Haskell String.

  • The runtime performance of the Haskell String is atrocious. You really shouldn't be using them for large data sets.
  • When packing, the length of the provided string must match the width of the format, else packing will fail.
  • When unpacking, the length of the result will be the width of the format.

Constructors

FixChars Int 

for Data.Text

data VarText Source #

Variable length unicode text, represented as a Data.Text thing.

Constructors

VarText 

for Data.ByteString

ASCII Atoms

ASCII integers

data IntAsc Source #

Human-readable ASCII Integer.

Constructors

IntAsc 

data IntAsc0 Source #

Human-readable ASCII integer, using leading zeros to pad the encoding out to a fixed length.

Constructors

IntAsc0 Int 

ASCII doubles

ASCII dates

Binary Atoms

8-bit binary

data Word8be Source #

Big-endian 8-bit unsigned word.

Constructors

Word8be 

data Int8be Source #

Big-endian 8-bit signed integer.

Constructors

Int8be 

16-bit binary

32-bit binary

data Int32be Source #

Big-endian 32-bit signed integer.

Constructors

Int32be 

64-bit binary

data Int64be Source #

Big-endian 64-bit signed integer.

Constructors

Int64be 

Compounds

Appended fields

data App f Source #

Append fields without separators.

Constructors

App f 

Instances

Format (App ()) Source # 

Associated Types

type Value (App ()) :: * Source #

Methods

fieldCount :: App () -> Int Source #

minSize :: App () -> Int Source #

fixedSize :: App () -> Maybe Int Source #

packedSize :: App () -> Value (App ()) -> Maybe Int Source #

(Format f1, Format (App fs), (~) * (Value (App fs)) (Value fs)) => Format (App ((:*:) f1 fs)) Source # 

Associated Types

type Value (App ((:*:) f1 fs)) :: * Source #

Methods

fieldCount :: App (f1 :*: fs) -> Int Source #

minSize :: App (f1 :*: fs) -> Int Source #

fixedSize :: App (f1 :*: fs) -> Maybe Int Source #

packedSize :: App (f1 :*: fs) -> Value (App (f1 :*: fs)) -> Maybe Int Source #

Unpackable (App ()) Source # 

Methods

unpack :: App () -> Unpacker (Value (App ())) Source #

unpacker :: App () -> Addr# -> Addr# -> (Word8 -> Bool) -> IO () -> (Addr# -> Value (App ()) -> IO ()) -> IO () Source #

(Unpackable f1, Unpackable (App fs), (~) * (Value (App fs)) (Value fs)) => Unpackable (App ((:*:) f1 fs)) Source # 

Methods

unpack :: App (f1 :*: fs) -> Unpacker (Value (App (f1 :*: fs))) Source #

unpacker :: App (f1 :*: fs) -> Addr# -> Addr# -> (Word8 -> Bool) -> IO () -> (Addr# -> Value (App (f1 :*: fs)) -> IO ()) -> IO () Source #

Packable (App ()) Source # 

Methods

pack :: App () -> Value (App ()) -> Packer Source #

packer :: App () -> Value (App ()) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO () Source #

(Packable f1, Packable (App fs), (~) * (Value (App fs)) (Value fs)) => Packable (App ((:*:) f1 fs)) Source # 

Methods

pack :: App (f1 :*: fs) -> Value (App (f1 :*: fs)) -> Packer Source #

packer :: App (f1 :*: fs) -> Value (App (f1 :*: fs)) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO () Source #

type Value (App ()) Source # 
type Value (App ()) = ()
type Value (App ((:*:) f1 fs)) Source # 
type Value (App ((:*:) f1 fs)) = (:*:) (Value f1) (Value fs)

Separated fields

data Sep f where Source #

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.
  • The type is kept abstract as we cache some pre-computed values we use to unpack this format. Use mkSep to make one.

Constructors

SepNil :: Sep () 
SepCons :: !SepMeta -> !f -> Sep fs -> Sep (f :*: fs) 

Instances

Format (Sep ()) Source # 

Associated Types

type Value (Sep ()) :: * Source #

Methods

fieldCount :: Sep () -> Int Source #

minSize :: Sep () -> Int Source #

fixedSize :: Sep () -> Maybe Int Source #

packedSize :: Sep () -> Value (Sep ()) -> Maybe Int Source #

(Format f1, Format (Sep fs), (~) * (Value (Sep fs)) (Value fs)) => Format (Sep ((:*:) f1 fs)) Source # 

Associated Types

type Value (Sep ((:*:) f1 fs)) :: * Source #

Methods

fieldCount :: Sep (f1 :*: fs) -> Int Source #

minSize :: Sep (f1 :*: fs) -> Int Source #

fixedSize :: Sep (f1 :*: fs) -> Maybe Int Source #

packedSize :: Sep (f1 :*: fs) -> Value (Sep (f1 :*: fs)) -> Maybe Int Source #

Unpackable (Sep ()) Source # 

Methods

unpack :: Sep () -> Unpacker (Value (Sep ())) Source #

unpacker :: Sep () -> Addr# -> Addr# -> (Word8 -> Bool) -> IO () -> (Addr# -> Value (Sep ()) -> IO ()) -> IO () Source #

(Unpackable f1, Unpackable (Sep ((:*:) f2 fs)), (~) * (Value (Sep ((:*:) f2 fs))) (Value ((:*:) f2 fs)), (~) * (Value (Sep fs)) (Value fs)) => Unpackable (Sep ((:*:) f1 ((:*:) f2 fs))) Source # 

Methods

unpack :: Sep (f1 :*: (f2 :*: fs)) -> Unpacker (Value (Sep (f1 :*: (f2 :*: fs)))) Source #

unpacker :: Sep (f1 :*: (f2 :*: fs)) -> Addr# -> Addr# -> (Word8 -> Bool) -> IO () -> (Addr# -> Value (Sep (f1 :*: (f2 :*: fs))) -> IO ()) -> IO () Source #

(Unpackable f1, (~) * (Value (Sep ())) (Value ())) => Unpackable (Sep ((:*:) f1 ())) Source # 

Methods

unpack :: Sep (f1 :*: ()) -> Unpacker (Value (Sep (f1 :*: ()))) Source #

unpacker :: Sep (f1 :*: ()) -> Addr# -> Addr# -> (Word8 -> Bool) -> IO () -> (Addr# -> Value (Sep (f1 :*: ())) -> IO ()) -> IO () Source #

Packable (Sep ()) Source # 

Methods

pack :: Sep () -> Value (Sep ()) -> Packer Source #

packer :: Sep () -> Value (Sep ()) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO () Source #

(Packable f1, Packable (Sep ((:*:) f2 fs)), (~) * (Value (Sep ((:*:) f2 fs))) (Value ((:*:) f2 fs)), (~) * (Value (Sep fs)) (Value fs)) => Packable (Sep ((:*:) f1 ((:*:) f2 fs))) Source # 

Methods

pack :: Sep (f1 :*: (f2 :*: fs)) -> Value (Sep (f1 :*: (f2 :*: fs))) -> Packer Source #

packer :: Sep (f1 :*: (f2 :*: fs)) -> Value (Sep (f1 :*: (f2 :*: fs))) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO () Source #

(Packable f1, (~) * (Value (Sep ())) (Value ())) => Packable (Sep ((:*:) f1 ())) Source # 

Methods

pack :: Sep (f1 :*: ()) -> Value (Sep (f1 :*: ())) -> Packer Source #

packer :: Sep (f1 :*: ()) -> Value (Sep (f1 :*: ())) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO () Source #

type Value (Sep ()) Source # 
type Value (Sep ()) = ()
type Value (Sep ((:*:) f1 fs)) Source # 
type Value (Sep ((:*:) f1 fs)) = (:*:) (Value f1) (Value fs)

class SepFormat f where Source #

Minimal complete definition

mkSep, takeSepChar

Methods

mkSep :: Char -> f -> Sep f Source #

takeSepChar :: Sep f -> Maybe Char Source #

Instances

SepFormat () Source # 

Methods

mkSep :: Char -> () -> Sep () Source #

takeSepChar :: Sep () -> Maybe Char Source #

(Format f1, SepFormat fs) => SepFormat ((:*:) f1 fs) Source # 

Methods

mkSep :: Char -> (f1 :*: fs) -> Sep (f1 :*: fs) Source #

takeSepChar :: Sep (f1 :*: fs) -> Maybe Char Source #

Object with labeled fields

data Object fields Source #

Format of a simple object format with labeled fields.

Instances

(Format (ObjectFields fs), (~) * (Value (ObjectFields fs)) (Value fs)) => Format (Object fs) Source # 

Associated Types

type Value (Object fs) :: * Source #

(Format (Object f), (~) * (Value (ObjectFields f)) (Value f), Packable (ObjectFields f)) => Packable (Object f) Source # 

Methods

pack :: Object f -> Value (Object f) -> Packer Source #

packer :: Object f -> Value (Object f) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO () Source #

type Value (Object fs) Source # 
type Value (Object fs) = Value fs

class ObjectFormat f Source #

Minimal complete definition

mkObjectFields

Instances

ObjectFormat () Source # 

Associated Types

type ObjectFormat' () :: *

Methods

mkObjectFields :: () -> ObjectFields (ObjectFormat' ())

(Format f1, ObjectFormat fs) => ObjectFormat ((:*:) (Field f1) fs) Source # 

Associated Types

type ObjectFormat' ((:*:) (Field f1) fs) :: *

Methods

mkObjectFields :: (Field f1 :*: fs) -> ObjectFields (ObjectFormat' (Field f1 :*: fs))

data Field f Source #

A single field in an object.

Constructors

Field 

Instances

(Format f1, ObjectFormat fs) => ObjectFormat ((:*:) (Field f1) fs) Source # 

Associated Types

type ObjectFormat' ((:*:) (Field f1) fs) :: *

Methods

mkObjectFields :: (Field f1 :*: fs) -> ObjectFields (ObjectFormat' (Field f1 :*: fs))

mkObject :: ObjectFormat f => f -> Object (ObjectFormat' f) Source #

Make an object format with the given labeled fields. For example:

> let fmt =   mkObject 
          $   Field "index"   IntAsc                      Nothing
          :*: Field "message" (VarCharString '-')         Nothing 
          :*: Field "value"   (MaybeChars NULL DoubleAsc) (Just isJust)
          :*: ()

Packing this produces:

> let Just str = packToString fmt (27 :*: "foo" :*: Nothing :*: ())
> putStrLn str
> {"index":27,"message":"foo"}

Note that the encodings that this format can generate are a superset of the JavaScript Object Notation (JSON). With the Repa format, the fields of an object can directly encode dates and other values, wheras in JSON these values must be represented by strings.

Products

data a :*: b :: * -> * -> * infixr 9 #

A strict product type, written infix.

Constructors

~a :*: ~b infixr 9 

Instances

IsProdList ts => Select Z ((:*:) t1 ts) 

Associated Types

type Select' (Z :: N) ((:*:) t1 ts) :: * #

Methods

select :: Nat Z -> (t1 :*: ts) -> Select' Z (t1 :*: ts) #

IsProdList ts => Discard Z ((:*:) t1 ts) 

Associated Types

type Discard' (Z :: N) ((:*:) t1 ts) :: * #

Methods

discard :: Nat Z -> (t1 :*: ts) -> Discard' Z (t1 :*: ts) #

(Unbox a, Unbox b) => Vector Vector ((:*:) a b) 

Methods

basicUnsafeFreeze :: PrimMonad m => Mutable Vector (PrimState m) (a :*: b) -> m (Vector (a :*: b)) #

basicUnsafeThaw :: PrimMonad m => Vector (a :*: b) -> m (Mutable Vector (PrimState m) (a :*: b)) #

basicLength :: Vector (a :*: b) -> Int #

basicUnsafeSlice :: Int -> Int -> Vector (a :*: b) -> Vector (a :*: b) #

basicUnsafeIndexM :: Monad m => Vector (a :*: b) -> Int -> m (a :*: b) #

basicUnsafeCopy :: PrimMonad m => Mutable Vector (PrimState m) (a :*: b) -> Vector (a :*: b) -> m () #

elemseq :: Vector (a :*: b) -> (a :*: b) -> b -> b #

(Unbox a, Unbox b) => MVector MVector ((:*:) a b) 

Methods

basicLength :: MVector s (a :*: b) -> Int #

basicUnsafeSlice :: Int -> Int -> MVector s (a :*: b) -> MVector s (a :*: b) #

basicOverlaps :: MVector s (a :*: b) -> MVector s (a :*: b) -> Bool #

basicUnsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) (a :*: b)) #

basicUnsafeReplicate :: PrimMonad m => Int -> (a :*: b) -> m (MVector (PrimState m) (a :*: b)) #

basicUnsafeRead :: PrimMonad m => MVector (PrimState m) (a :*: b) -> Int -> m (a :*: b) #

basicUnsafeWrite :: PrimMonad m => MVector (PrimState m) (a :*: b) -> Int -> (a :*: b) -> m () #

basicClear :: PrimMonad m => MVector (PrimState m) (a :*: b) -> m () #

basicSet :: PrimMonad m => MVector (PrimState m) (a :*: b) -> (a :*: b) -> m () #

basicUnsafeCopy :: PrimMonad m => MVector (PrimState m) (a :*: b) -> MVector (PrimState m) (a :*: b) -> m () #

basicUnsafeMove :: PrimMonad m => MVector (PrimState m) (a :*: b) -> MVector (PrimState m) (a :*: b) -> m () #

basicUnsafeGrow :: PrimMonad m => MVector (PrimState m) (a :*: b) -> Int -> m (MVector (PrimState m) (a :*: b)) #

Functor ((:*:) a) 

Methods

fmap :: (a -> b) -> (a :*: a) -> a :*: b #

(<$) :: a -> (a :*: b) -> a :*: a #

(Format f1, Format (App fs), (~) * (Value (App fs)) (Value fs)) => Format (App ((:*:) f1 fs)) Source # 

Associated Types

type Value (App ((:*:) f1 fs)) :: * Source #

Methods

fieldCount :: App (f1 :*: fs) -> Int Source #

minSize :: App (f1 :*: fs) -> Int Source #

fixedSize :: App (f1 :*: fs) -> Maybe Int Source #

packedSize :: App (f1 :*: fs) -> Value (App (f1 :*: fs)) -> Maybe Int Source #

(Format f1, Format (Sep fs), (~) * (Value (Sep fs)) (Value fs)) => Format (Sep ((:*:) f1 fs)) Source # 

Associated Types

type Value (Sep ((:*:) f1 fs)) :: * Source #

Methods

fieldCount :: Sep (f1 :*: fs) -> Int Source #

minSize :: Sep (f1 :*: fs) -> Int Source #

fixedSize :: Sep (f1 :*: fs) -> Maybe Int Source #

packedSize :: Sep (f1 :*: fs) -> Value (Sep (f1 :*: fs)) -> Maybe Int Source #

(Unpackable f1, Unpackable (App fs), (~) * (Value (App fs)) (Value fs)) => Unpackable (App ((:*:) f1 fs)) Source # 

Methods

unpack :: App (f1 :*: fs) -> Unpacker (Value (App (f1 :*: fs))) Source #

unpacker :: App (f1 :*: fs) -> Addr# -> Addr# -> (Word8 -> Bool) -> IO () -> (Addr# -> Value (App (f1 :*: fs)) -> IO ()) -> IO () Source #

(Unpackable f1, Unpackable (Sep ((:*:) f2 fs)), (~) * (Value (Sep ((:*:) f2 fs))) (Value ((:*:) f2 fs)), (~) * (Value (Sep fs)) (Value fs)) => Unpackable (Sep ((:*:) f1 ((:*:) f2 fs))) Source # 

Methods

unpack :: Sep (f1 :*: (f2 :*: fs)) -> Unpacker (Value (Sep (f1 :*: (f2 :*: fs)))) Source #

unpacker :: Sep (f1 :*: (f2 :*: fs)) -> Addr# -> Addr# -> (Word8 -> Bool) -> IO () -> (Addr# -> Value (Sep (f1 :*: (f2 :*: fs))) -> IO ()) -> IO () Source #

(Unpackable f1, (~) * (Value (Sep ())) (Value ())) => Unpackable (Sep ((:*:) f1 ())) Source # 

Methods

unpack :: Sep (f1 :*: ()) -> Unpacker (Value (Sep (f1 :*: ()))) Source #

unpacker :: Sep (f1 :*: ()) -> Addr# -> Addr# -> (Word8 -> Bool) -> IO () -> (Addr# -> Value (Sep (f1 :*: ())) -> IO ()) -> IO () Source #

(Packable f1, Packable (App fs), (~) * (Value (App fs)) (Value fs)) => Packable (App ((:*:) f1 fs)) Source # 

Methods

pack :: App (f1 :*: fs) -> Value (App (f1 :*: fs)) -> Packer Source #

packer :: App (f1 :*: fs) -> Value (App (f1 :*: fs)) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO () Source #

(Packable f1, Packable (Sep ((:*:) f2 fs)), (~) * (Value (Sep ((:*:) f2 fs))) (Value ((:*:) f2 fs)), (~) * (Value (Sep fs)) (Value fs)) => Packable (Sep ((:*:) f1 ((:*:) f2 fs))) Source # 

Methods

pack :: Sep (f1 :*: (f2 :*: fs)) -> Value (Sep (f1 :*: (f2 :*: fs))) -> Packer Source #

packer :: Sep (f1 :*: (f2 :*: fs)) -> Value (Sep (f1 :*: (f2 :*: fs))) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO () Source #

(Packable f1, (~) * (Value (Sep ())) (Value ())) => Packable (Sep ((:*:) f1 ())) Source # 

Methods

pack :: Sep (f1 :*: ()) -> Value (Sep (f1 :*: ())) -> Packer Source #

packer :: Sep (f1 :*: ()) -> Value (Sep (f1 :*: ())) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO () Source #

Select n ts => Select (S n) ((:*:) t1 ts) 

Associated Types

type Select' (S n :: N) ((:*:) t1 ts) :: * #

Methods

select :: Nat (S n) -> (t1 :*: ts) -> Select' (S n) (t1 :*: ts) #

Discard n ts => Discard (S n) ((:*:) t1 ts) 

Associated Types

type Discard' (S n :: N) ((:*:) t1 ts) :: * #

Methods

discard :: Nat (S n) -> (t1 :*: ts) -> Discard' (S n) (t1 :*: ts) #

(Eq a, Eq b) => Eq ((:*:) a b) 

Methods

(==) :: (a :*: b) -> (a :*: b) -> Bool #

(/=) :: (a :*: b) -> (a :*: b) -> Bool #

(Show a, Show b) => Show ((:*:) a b) 

Methods

showsPrec :: Int -> (a :*: b) -> ShowS #

show :: (a :*: b) -> String #

showList :: [a :*: b] -> ShowS #

IsProdList fs => IsProdList ((:*:) f fs) 

Methods

isProdList :: (f :*: fs) -> Bool #

(IsKeyValues p, IsKeyValues ps, (~) * (Keys p) (Keys ps)) => IsKeyValues ((:*:) p ps) 

Associated Types

type Keys ((:*:) p ps) :: * #

type Values ((:*:) p ps) :: * #

Methods

keys :: (p :*: ps) -> [Keys (p :*: ps)] #

values :: (p :*: ps) -> Values (p :*: ps) #

(Unbox a, Unbox b) => Unbox ((:*:) a b) 
(Format f1, SepFormat fs) => SepFormat ((:*:) f1 fs) Source # 

Methods

mkSep :: Char -> (f1 :*: fs) -> Sep (f1 :*: fs) Source #

takeSepChar :: Sep (f1 :*: fs) -> Maybe Char Source #

(Format f1, ObjectFormat fs) => ObjectFormat ((:*:) (Field f1) fs) Source # 

Associated Types

type ObjectFormat' ((:*:) (Field f1) fs) :: *

Methods

mkObjectFields :: (Field f1 :*: fs) -> ObjectFields (ObjectFormat' (Field f1 :*: fs))

Mask ms ts => Mask ((:*:) Drop ms) ((:*:) t1 ts) 

Associated Types

type Mask' ((:*:) Drop ms) ((:*:) t1 ts) :: * #

Methods

mask :: (Drop :*: ms) -> (t1 :*: ts) -> Mask' (Drop :*: ms) (t1 :*: ts) #

Mask ms ts => Mask ((:*:) Keep ms) ((:*:) t1 ts) 

Associated Types

type Mask' ((:*:) Keep ms) ((:*:) t1 ts) :: * #

Methods

mask :: (Keep :*: ms) -> (t1 :*: ts) -> Mask' (Keep :*: ms) (t1 :*: ts) #

type Select' Z ((:*:) t1 ts) 
type Select' Z ((:*:) t1 ts) = t1
type Discard' Z ((:*:) t1 ts) 
type Discard' Z ((:*:) t1 ts) = ts
data MVector s ((:*:) a b) 
data MVector s ((:*:) a b) = MV_Prod ~Int ~(MVector s a) ~(MVector s b)
type Value (App ((:*:) f1 fs)) Source # 
type Value (App ((:*:) f1 fs)) = (:*:) (Value f1) (Value fs)
type Value (Sep ((:*:) f1 fs)) Source # 
type Value (Sep ((:*:) f1 fs)) = (:*:) (Value f1) (Value fs)
type Select' (S n) ((:*:) t1 ts) 
type Select' (S n) ((:*:) t1 ts) = Select' n ts
type Discard' (S n) ((:*:) t1 ts) 
type Discard' (S n) ((:*:) t1 ts) = (:*:) t1 (Discard' n ts)
type Values ((:*:) p ps) 
type Values ((:*:) p ps) = (:*:) (Values p) (Values ps)
type Keys ((:*:) p ps) 
type Keys ((:*:) p ps) = Keys p
data Vector ((:*:) a b) 
data Vector ((:*:) a b) = V_Prod ~Int ~(Vector a) ~(Vector b)
type Value ((:*:) a b) Source # 
type Value ((:*:) a b) = (:*:) (Value a) (Value b)
type Mask' ((:*:) Drop ms) ((:*:) t1 ts) 
type Mask' ((:*:) Drop ms) ((:*:) t1 ts) = Mask' ms ts
type Mask' ((:*:) Keep ms) ((:*:) t1 ts) 
type Mask' ((:*:) Keep ms) ((:*:) t1 ts) = (:*:) t1 (Mask' ms ts)