rec-smallarray-0.1.0.0: SmallArray-based extensible records for small-scale fast reads
Copyright(c) 2021 Xy Ren
LicenseBSD3
Maintainerxy.r@outlook.com
Stabilityexperimental
Portabilitynon-portable (GHC only)
Safe HaskellNone
LanguageHaskell2010

Data.Rec.SmallArray

Description

This module defines an immutable extensible record type, similar to vinyl and data-diverse. However this implementation focuses on fast reads, hence has very different performance characteristics from other libraries:

  • Lookup: Amortized \( O(1) \).
  • Update: \( O(n) \).
  • Shrink: \( O(1) \).
  • Append: \( O(n) \).
Synopsis

Documentation

data Rec (f :: k -> Type) (es :: [k]) Source #

Extensible record type supporting efficient \( O(1) \) reads. The underlying implementation is SmallArray slices, therefore suits small numbers of entries (i.e. less than 128).

Instances

Instances details
(forall (x :: k). Eq (f x)) => Eq (Rec f xs) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

(==) :: Rec f xs -> Rec f xs -> Bool #

(/=) :: Rec f xs -> Rec f xs -> Bool #

(Eq (Rec f xs), Eq (f x)) => Eq (Rec f (x ': xs)) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

(==) :: Rec f (x ': xs) -> Rec f (x ': xs) -> Bool #

(/=) :: Rec f (x ': xs) -> Rec f (x ': xs) -> Bool #

Eq (Rec f ('[] :: [k])) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

(==) :: Rec f '[] -> Rec f '[] -> Bool #

(/=) :: Rec f '[] -> Rec f '[] -> Bool #

(Read (f x), Read (Rec f xs)) => Read (Rec f (x ': xs)) Source #
read "Identity True :~: Identity \"Hi\" :~: empty"
== Identity True :~: Identity "Hi" :~: empty
Instance details

Defined in Data.Rec.SmallArray

Methods

readsPrec :: Int -> ReadS (Rec f (x ': xs)) #

readList :: ReadS [Rec f (x ': xs)] #

readPrec :: ReadPrec (Rec f (x ': xs)) #

readListPrec :: ReadPrec [Rec f (x ': xs)] #

Read (Rec f ('[] :: [k])) Source #
read "empty" == empty
Instance details

Defined in Data.Rec.SmallArray

Methods

readsPrec :: Int -> ReadS (Rec f '[]) #

readList :: ReadS [Rec f '[]] #

readPrec :: ReadPrec (Rec f '[]) #

readListPrec :: ReadPrec [Rec f '[]] #

(forall (x :: k). Show (f x)) => Show (Rec f xs) Source #
show (Const False :~: Const True :~: empty)
== "Const False :~: Const True :~: empty"
Instance details

Defined in Data.Rec.SmallArray

Methods

showsPrec :: Int -> Rec f xs -> ShowS #

show :: Rec f xs -> String #

showList :: [Rec f xs] -> ShowS #

(Show (f x), Show (Rec f xs)) => Show (Rec f (x ': xs)) Source #
show (Identity True :~: Identity "Hi" :~: empty)
== "Identity True :~: Identity \"Hi\" :~: empty"
Instance details

Defined in Data.Rec.SmallArray

Methods

showsPrec :: Int -> Rec f (x ': xs) -> ShowS #

show :: Rec f (x ': xs) -> String #

showList :: [Rec f (x ': xs)] -> ShowS #

Show (Rec f ('[] :: [k])) Source #
show empty == "empty"
Instance details

Defined in Data.Rec.SmallArray

Methods

showsPrec :: Int -> Rec f '[] -> ShowS #

show :: Rec f '[] -> String #

showList :: [Rec f '[]] -> ShowS #

(forall (x :: k). Semigroup (f x)) => Semigroup (Rec f xs) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

(<>) :: Rec f xs -> Rec f xs -> Rec f xs #

sconcat :: NonEmpty (Rec f xs) -> Rec f xs #

stimes :: Integral b => b -> Rec f xs -> Rec f xs #

(Semigroup (f x), Semigroup (Rec f xs)) => Semigroup (Rec f (x ': xs)) Source #

One-by-one semigroup operation instead of concatenation.

(x :~: xs) <> (y :~: ys) == x <> y :~: xs <> ys
Instance details

Defined in Data.Rec.SmallArray

Methods

(<>) :: Rec f (x ': xs) -> Rec f (x ': xs) -> Rec f (x ': xs) #

sconcat :: NonEmpty (Rec f (x ': xs)) -> Rec f (x ': xs) #

stimes :: Integral b => b -> Rec f (x ': xs) -> Rec f (x ': xs) #

Semigroup (Rec f ('[] :: [k])) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

(<>) :: Rec f '[] -> Rec f '[] -> Rec f '[] #

sconcat :: NonEmpty (Rec f '[]) -> Rec f '[] #

stimes :: Integral b => b -> Rec f '[] -> Rec f '[] #

(Monoid (f x), Monoid (Rec f xs)) => Monoid (Rec f (x ': xs)) Source #

The unit of a record type are the units of its element types:

mempty == mempty :~: mempty
Instance details

Defined in Data.Rec.SmallArray

Methods

mempty :: Rec f (x ': xs) #

mappend :: Rec f (x ': xs) -> Rec f (x ': xs) -> Rec f (x ': xs) #

mconcat :: [Rec f (x ': xs)] -> Rec f (x ': xs) #

Monoid (Rec f ('[] :: [k])) Source #
mempty == empty
Instance details

Defined in Data.Rec.SmallArray

Methods

mempty :: Rec f '[] #

mappend :: Rec f '[] -> Rec f '[] -> Rec f '[] #

mconcat :: [Rec f '[]] -> Rec f '[] #

length :: Rec f es -> Int Source #

Get the length of the record.

empty :: Rec f '[] Source #

Create an empty record. \( O(1) \).

singleton :: f e -> Rec f '[e] Source #

Create a record with one entry. \( O(1) \).

Construction

cons :: f e -> Rec f es -> Rec f (e ': es) Source #

Prepend one entry to the record. \( O(n) \).

pattern (:~:) :: f e -> Rec f es -> Rec f (e ': es) infixr 5 Source #

Infix version of cons that also supports destructuring.

type family xs ++ ys where ... infixr 5 Source #

Type level list concatenation.

Equations

'[] ++ ys = ys 
(x ': xs) ++ ys = x ': (xs ++ ys) 

concat :: Rec f es -> Rec f es' -> Rec f (es ++ es') Source #

Concatenate two records. \( O(m+n) \).

pattern (:++:) :: forall es es' f. KnownList es => Rec f es -> Rec f es' -> Rec f (es ++ es') infixr 5 Source #

Infix version of concat that also supports destructuring.

Deconstruction

tail :: Rec f (e ': es) -> Rec f es Source #

Slice off one entry from the top of the record. \( O(1) \).

class KnownList (es :: [k]) Source #

The list es list is concrete, i.e. is of the form '[a1, a2, ..., an], i.e. is not a type variable.

Instances

Instances details
KnownList ('[] :: [k]) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

reifyLen :: Int

KnownList es => KnownList (e ': es :: [k]) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

reifyLen :: Int

drop :: forall es es' f. KnownList es => Rec f (es ++ es') -> Rec f es' Source #

Slice off several entries from the top of the record. \( O(1) \).

Retrieval

head :: Rec f (e ': es) -> f e Source #

Get the head of the record. \( O(1) \).

take :: forall es es' f. KnownList es => Rec f (es ++ es') -> Rec f es Source #

Take elements from the top of the record. \( O(m) \).

class Elem (e :: k) (es :: [k]) Source #

The element e is present in the list es.

Instances

Instances details
(TypeError (ElemNotFound e) :: Constraint) => Elem (e :: k) ('[] :: [k]) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

reifyIndex :: Int

Elem e es => Elem (e :: a) (e' ': es :: [a]) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

reifyIndex :: Int

Elem (e :: a) (e ': es :: [a]) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

reifyIndex :: Int

index :: forall e es f. Elem e es => Rec f es -> f e Source #

Get an element in the record. Amortized \( O(1) \).

class KnownList es => Subset (es :: [k]) (es' :: [k]) Source #

es is a subset of es'.

Instances

Instances details
Subset ('[] :: [k]) (es :: [k]) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

reifyIndices :: [Int]

(Subset es es', Elem e es') => Subset (e ': es :: [k]) (es' :: [k]) Source # 
Instance details

Defined in Data.Rec.SmallArray

Methods

reifyIndices :: [Int]

pick :: forall es es' f. Subset es es' => Rec f es' -> Rec f es Source #

Get a subset of the record. Amortized \( O(m) \).

Updating

update :: forall e es f. Elem e es => f e -> Rec f es -> Rec f es Source #

Update an entry in the record. \( O(n) \).

(/~/) :: Elem e es => f e -> Rec f es -> Rec f es infixl 9 Source #

Infix version of update.

modify :: forall e es f. Elem e es => (f e -> f e) -> Rec f es -> Rec f es Source #

Modify an entry in the record via a function. \( O(n) \).

batch :: forall es es' f. Subset es es' => Rec f es -> Rec f es' -> Rec f es' Source #

Merge a subset into the original record, updating several entries at once. \( O(m+n) \).

(/++/) :: Subset es es' => Rec f es -> Rec f es' -> Rec f es' infixl 9 Source #

Infix version of batch.

Mapping and Folding

type (~>) f g = forall a. f a -> g a infixr 0 Source #

The type of natural transformations from functor f to g.

natural :: (f ~> g) -> Rec f es -> Rec g es Source #

Apply a natural transformation to the record. \( O(n) \).

(<#>) :: (f ~> g) -> Rec f es -> Rec g es infixl 4 Source #

Infix version of natural.

zipWith :: (forall x. f x -> g x -> h x) -> Rec f es -> Rec g es -> Rec h es Source #

Zip two records with a natural transformation. \( O(n) \).

all :: (forall x. f x -> Bool) -> Rec f es -> Bool Source #

Check if a predicate is true on all elements. \( O(n) \).

any :: (forall x. f x -> Bool) -> Rec f es -> Bool Source #

Check if a predicate is true on at least one element. \( O(n) \).

degenerate :: Rec (Const a) es -> [a] Source #

Convert a record that effectively contains a fixed type into a list of the fixed type. \( O(n) \).

extract :: (forall x. f x -> a) -> Rec f es -> [a] Source #

Map each element to a fixed type. \( O(n) \).

Debugging

invariant :: Rec f es -> Rec f es Source #

Test all invariants.

sizeInvariant :: Rec f es -> Rec f es Source #

Test the size invariant of Rec.

allAccessible :: Rec f es -> Rec f es Source #

Test whether all fields of Rec are really set.