| Safe Haskell | None | 
|---|---|
| Language | Haskell2010 | 
Data.Vinyl.SRec
Description
Storable records offer an efficient flat, packed representation
 in memory. In particular, field access is constant time (i.e. it
 doesn't depend on where in the record the field is) and as fast as
 possible, but updating fields may not be as efficient. The
 requirement is that all fields of a record have Storable
 instances.
The implementation leaks into the usual vinyl lens API: the
 requirement of Storable instances necessitates specialization on
 the functor argument of the record so that GHC can find all
 required instances at compile time (this is required for
 constant-time field access). What we do is allow ourselves to write
 instances of the RecElem and RecSubset classes (that provide
 the main vinyl lens API) that are restricted to particular choices
 of the record functor. This is why the SRec2 type that implements
 records here takes two functor arguments: they will usually be the
 same; we fix one when writing instances and write instance contexts
 that reference that type, and then require that the methods
 (e.g. rget) are called on records whose functor argument is equal
 to the one we picked. For usability, we provide an SRec type
 whose lens API is fixed to ElField as the functor. Other
 specializations are possible, and the work of those instances can
 always be passed along to the SRec2 functions.
Note that the lens field accessors for SRec do not support
 changing the types of the fields as they do for Rec and
 ARec.
Synopsis
- newtype SRec f ts = SRecNT {}
- toSRec :: Storable (Rec f ts) => Rec f ts -> SRec f ts
- fromSRec :: Storable (Rec f ts) => SRec f ts -> Rec f ts
- sget :: forall f t ts. FieldOffset f ts t => SRec2 f f ts -> f t
- sput :: forall (f :: u -> *) (t :: u) (ts :: [u]). (FieldOffset f ts t, Storable (Rec f ts), AllConstrained (FieldOffset f ts) ts) => f t -> SRec2 f f ts -> SRec2 f f ts
- slens :: (Functor g, FieldOffset f ts t, Storable (Rec f ts), AllConstrained (FieldOffset f ts) ts) => (f t -> g (f t)) -> SRec2 f f ts -> g (SRec2 f f ts)
- srecGetSubset :: forall (ss :: [u]) (rs :: [u]) (f :: u -> *). (RPureConstrained (FieldOffset f ss) rs, RPureConstrained (FieldOffset f rs) rs, RFoldMap rs, RMap rs, RApply rs, Storable (Rec f rs)) => SRec2 f f ss -> SRec2 f f rs
- srecSetSubset :: forall (f :: u -> *) (ss :: [u]) (rs :: [u]). (rs ⊆ ss, RPureConstrained (FieldOffset f ss) rs, RPureConstrained (FieldOffset f rs) rs, RFoldMap rs, RMap rs, RApply rs, Storable (Rec f ss)) => SRec2 f f ss -> SRec2 f f rs -> SRec2 f f ss
- toSRec2 :: forall f ts. Storable (Rec f ts) => Rec f ts -> SRec2 f f ts
- fromSRec2 :: Storable (Rec f ts) => SRec2 g f ts -> Rec f ts
- newtype SRec2 (g :: k -> *) (f :: k -> *) (ts :: [k]) = SRec2 (ForeignPtr (Rec f ts))
- class FieldOffsetAux f ts t (RIndex t ts) => FieldOffset f ts t
- class (RIndex t ts ~ i, RecAll f ts Storable) => FieldOffsetAux f ts t i where- fieldOffset :: Int -> StorableAt f t
 
- data StorableAt f a where- StorableAt :: Storable (f a) => !Int -> StorableAt f a
 
- peekField :: forall f t ts. FieldOffset f ts t => ForeignPtr (Rec f ts) -> IO (f t)
- pokeField :: forall f t ts. FieldOffset f ts t => ForeignPtr (Rec f ts) -> f t -> IO ()
Main record lens API
A simpler type for SRec2 whose RecElem and RecSubset
 instances are specialized to the ElField functor.
Instances
Lens API specialized to SRec2
sput :: forall (f :: u -> *) (t :: u) (ts :: [u]). (FieldOffset f ts t, Storable (Rec f ts), AllConstrained (FieldOffset f ts) ts) => f t -> SRec2 f f ts -> SRec2 f f ts Source #
Set a field.
slens :: (Functor g, FieldOffset f ts t, Storable (Rec f ts), AllConstrained (FieldOffset f ts) ts) => (f t -> g (f t)) -> SRec2 f f ts -> g (SRec2 f f ts) Source #
A lens for a field of an SRec2.
srecGetSubset :: forall (ss :: [u]) (rs :: [u]) (f :: u -> *). (RPureConstrained (FieldOffset f ss) rs, RPureConstrained (FieldOffset f rs) rs, RFoldMap rs, RMap rs, RApply rs, Storable (Rec f rs)) => SRec2 f f ss -> SRec2 f f rs Source #
Get a subset of a record's fields.
srecSetSubset :: forall (f :: u -> *) (ss :: [u]) (rs :: [u]). (rs ⊆ ss, RPureConstrained (FieldOffset f ss) rs, RPureConstrained (FieldOffset f rs) rs, RFoldMap rs, RMap rs, RApply rs, Storable (Rec f ss)) => SRec2 f f ss -> SRec2 f f rs -> SRec2 f f ss Source #
Set a subset of a record's fields.
Internals
newtype SRec2 (g :: k -> *) (f :: k -> *) (ts :: [k]) Source #
A Storable-backed Rec. Each field of such a value has
 statically known size, allowing for a very efficient representation
 and very fast field access. The 2 suffix is due to apparently
 taking two functor arguments, but the first type parameter is
 phantom and exists so that we can write multiple instances of
 RecElem and RecSubset for different functors. The first functor
 argument will typically be identical to the second argument. We
 currently provide instances for the ElField functor; if you wish
 to use it at a different type, consider using sget, sput, and
 slens which work with any functor given that the necessary
 Storable instances exist.
Instances
class FieldOffsetAux f ts t (RIndex t ts) => FieldOffset f ts t Source #
A more concise constraint equivalent to FieldOffsetAux.
Instances
| FieldOffsetAux f ts t (RIndex t ts) => FieldOffset (f :: k -> Type) (ts :: [k]) (t :: k) Source # | |
| Defined in Data.Vinyl.SRec | |
class (RIndex t ts ~ i, RecAll f ts Storable) => FieldOffsetAux f ts t i where Source #
Methods
fieldOffset :: Int -> StorableAt f t Source #
Get the byte offset of a field from the given origin and the
 Storable dictionary needed to work with that field.
Instances
| RecAll f (t ': ts) Storable => FieldOffsetAux (f :: a -> Type) (t ': ts :: [a]) (t :: a) Z Source # | |
| Defined in Data.Vinyl.SRec Methods fieldOffset :: Int -> StorableAt f t Source # | |
| (RIndex t (s ': ts) ~ S i, FieldOffsetAux f ts t i, RecAll f (s ': ts) Storable) => FieldOffsetAux (f :: a -> Type) (s ': ts :: [a]) (t :: a) (S i) Source # | |
| Defined in Data.Vinyl.SRec Methods fieldOffset :: Int -> StorableAt f t Source # | |
data StorableAt f a where Source #
Capture a Storable dictionary along with a byte offset from
 some origin address.
Constructors
| StorableAt :: Storable (f a) => !Int -> StorableAt f a |