{-# LANGUAGE AllowAmbiguousTypes #-}
-- |
-- Copyright: (c) 2021 Xy Ren
-- License: BSD3
-- Maintainer: xy.r@outlook.com
-- Stability: experimental
-- Portability: non-portable (GHC only)
--
-- 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) \).
module Data.Rec.SmallArray
  ( Rec, length, empty, singleton
  , -- * Construction
    cons, pattern (:~:), type (++), concat, pattern (:++:)
  , -- * Deconstruction
    tail, KnownList, drop
  , -- * Retrieval
    head, take, Elem, index, Subset, pick
  , -- * Updating
    update, (/~/), modify, batch, (/++/)
  , -- * Mapping and Folding
    type (~>), natural, (<#>), zipWith, all, any, degenerate, extract
  , -- * Debugging
    invariant, sizeInvariant, allAccessible
  ) where

import           Control.Arrow             ((&&&))
import           Control.Monad.Primitive   (PrimMonad (PrimState))
import           Data.Functor.Const        (Const (Const, getConst))
import           Data.Kind                 (Type)
import           Data.List                 (intersperse)
import           Data.Primitive.SmallArray (SmallArray, SmallMutableArray, copySmallArray, indexSmallArray,
                                            newSmallArray, readSmallArray, runSmallArray, sizeofSmallArray,
                                            writeSmallArray)
import           GHC.Exts                  (Any)
import           GHC.TypeLits              (ErrorMessage (ShowType, Text, (:<>:)), TypeError)
import           Prelude                   hiding (all, any, concat, drop, head, length, tail, take, zipWith)
import           Text.Read                 (readPrec)
import qualified Text.Read                 as R
import qualified Text.Read.Lex             as RL
import           Unsafe.Coerce             (unsafeCoerce)

-- | 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).
type role Rec representational nominal
data Rec (f :: k -> Type) (es :: [k]) = Rec
  {-# UNPACK #-} !Int -- ^ The offset.
  {-# UNPACK #-} !Int -- ^ The length.
  {-# UNPACK #-} !(SmallArray Any) -- ^ The array content.

instance Eq (Rec f '[]) where
  Rec f '[]
_ == :: Rec f '[] -> Rec f '[] -> Bool
== Rec f '[]
_ = Bool
True

instance (Eq (Rec f xs), Eq (f x)) => Eq (Rec f (x ': xs)) where
  f x
x :~: Rec f xs
xs == :: Rec f (x : xs) -> Rec f (x : xs) -> Bool
== f x
y :~: Rec f xs
ys = f x
x f x -> f x -> Bool
forall a. Eq a => a -> a -> Bool
== f x
y Bool -> Bool -> Bool
&& Rec f xs
xs Rec f xs -> Rec f xs -> Bool
forall a. Eq a => a -> a -> Bool
== Rec f xs
ys

instance {-# OVERLAPPABLE #-} (∀ x. Eq (f x)) => Eq (Rec f xs) where
  Rec f xs
xs == :: Rec f xs -> Rec f xs -> Bool
== Rec f xs
ys = (forall (x :: k). Const Bool x -> Bool)
-> Rec (Const Bool) xs -> Bool
forall k (f :: k -> Type) (es :: [k]).
(forall (x :: k). f x -> Bool) -> Rec f es -> Bool
all (Const Bool x -> Const Bool x -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Const Bool x
forall k a (b :: k). a -> Const a b
Const Bool
True) (Rec (Const Bool) xs -> Bool) -> Rec (Const Bool) xs -> Bool
forall a b. (a -> b) -> a -> b
$ (forall (x :: k). f x -> f x -> Const Bool x)
-> Rec f xs -> Rec f xs -> Rec (Const Bool) xs
forall k (f :: k -> Type) (g :: k -> Type) (h :: k -> Type)
       (es :: [k]).
(forall (x :: k). f x -> g x -> h x)
-> Rec f es -> Rec g es -> Rec h es
zipWith (\f x
x f x
y -> Bool -> Const Bool x
forall k a (b :: k). a -> Const a b
Const (Bool -> Const Bool x) -> Bool -> Const Bool x
forall a b. (a -> b) -> a -> b
$ f x
x f x -> f x -> Bool
forall a. Eq a => a -> a -> Bool
== f x
y) Rec f xs
xs Rec f xs
ys

-- | @
-- 'show' 'empty' == "empty"
-- @
instance Show (Rec f '[]) where
  show :: Rec f '[] -> String
show Rec f '[]
_ = String
"empty"

-- | @
-- 'read' \"empty\" == 'empty'
-- @
instance Read (Rec f '[]) where
  readPrec :: ReadPrec (Rec f '[])
readPrec = ReadPrec (Rec f '[]) -> ReadPrec (Rec f '[])
forall a. ReadPrec a -> ReadPrec a
R.parens (ReadPrec (Rec f '[]) -> ReadPrec (Rec f '[]))
-> ReadPrec (Rec f '[]) -> ReadPrec (Rec f '[])
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Rec f '[]) -> ReadPrec (Rec f '[])
forall a. Int -> ReadPrec a -> ReadPrec a
R.prec Int
appPrec (ReadPrec (Rec f '[]) -> ReadPrec (Rec f '[]))
-> ReadPrec (Rec f '[]) -> ReadPrec (Rec f '[])
forall a b. (a -> b) -> a -> b
$
    Rec f '[]
forall k (f :: k -> Type). Rec f '[]
empty Rec f '[] -> ReadPrec () -> ReadPrec (Rec f '[])
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ ReadP () -> ReadPrec ()
forall a. ReadP a -> ReadPrec a
R.lift (Lexeme -> ReadP ()
RL.expect (String -> Lexeme
R.Ident String
"empty"))
    where appPrec :: Int
appPrec = Int
10

-- | @
-- 'show' ('Data.Functor.Identity.Identity' 'True' ':~:' 'Data.Functor.Identity.Identity' \"Hi\" ':~:' 'empty')
-- == "Identity True :~: Identity \\"Hi\\" :~: empty"
-- @
instance (Show (f x), Show (Rec f xs)) => Show (Rec f (x ': xs)) where
  showsPrec :: Int -> Rec f (x : xs) -> ShowS
showsPrec Int
p (f x
x :~: Rec f xs
xs) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
consPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    Int -> f x -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
consPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) f x
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" :~: " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rec f xs -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
consPrec Rec f xs
xs

-- | @
-- 'read' "Identity True :~: Identity \\"Hi\\" :~: empty"
-- == 'Data.Functor.Identity.Identity' 'True' ':~:' 'Data.Functor.Identity.Identity' \"Hi\" ':~:' 'empty'
-- @
instance (Read (f x), Read (Rec f xs)) => Read (Rec f (x ': xs)) where
  readPrec :: ReadPrec (Rec f (x : xs))
readPrec = ReadPrec (Rec f (x : xs)) -> ReadPrec (Rec f (x : xs))
forall a. ReadPrec a -> ReadPrec a
R.parens (ReadPrec (Rec f (x : xs)) -> ReadPrec (Rec f (x : xs)))
-> ReadPrec (Rec f (x : xs)) -> ReadPrec (Rec f (x : xs))
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Rec f (x : xs)) -> ReadPrec (Rec f (x : xs))
forall a. Int -> ReadPrec a -> ReadPrec a
R.prec Int
consPrec (ReadPrec (Rec f (x : xs)) -> ReadPrec (Rec f (x : xs)))
-> ReadPrec (Rec f (x : xs)) -> ReadPrec (Rec f (x : xs))
forall a b. (a -> b) -> a -> b
$
    f x -> Rec f xs -> Rec f (x : xs)
forall a (f :: a -> Type) (e :: a) (es :: [a]).
f e -> Rec f es -> Rec f (e : es)
cons (f x -> Rec f xs -> Rec f (x : xs))
-> ReadPrec (f x) -> ReadPrec (Rec f xs -> Rec f (x : xs))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec (f x) -> ReadPrec (f x)
forall a. ReadPrec a -> ReadPrec a
R.step (Read (f x) => ReadPrec (f x)
forall a. Read a => ReadPrec a
readPrec @(f x)) ReadPrec (Rec f xs -> Rec f (x : xs))
-> ReadPrec () -> ReadPrec (Rec f xs -> Rec f (x : xs))
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ReadP () -> ReadPrec ()
forall a. ReadP a -> ReadPrec a
R.lift (Lexeme -> ReadP ()
RL.expect (String -> Lexeme
R.Symbol String
":~:")) ReadPrec (Rec f xs -> Rec f (x : xs))
-> ReadPrec (Rec f xs) -> ReadPrec (Rec f (x : xs))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Read (Rec f xs) => ReadPrec (Rec f xs)
forall a. Read a => ReadPrec a
readPrec @(Rec f xs)

-- | @
-- 'show' ('Const' 'False' ':~:' 'Const' 'True' ':~:' 'empty')
-- == "Const False :~: Const True :~: empty"
-- @
instance {-# OVERLAPPABLE #-} (∀ x. Show (f x)) => Show (Rec f xs) where
  showsPrec :: Int -> Rec f xs -> ShowS
showsPrec Int
p Rec f xs
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
consPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id ([ShowS] -> ShowS) -> [ShowS] -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (String -> ShowS
showString String
" :~: ") ([ShowS] -> [ShowS]) -> [ShowS] -> [ShowS]
forall a b. (a -> b) -> a -> b
$ (forall (x :: k). f x -> ShowS) -> Rec f xs -> [ShowS]
forall k (f :: k -> Type) a (es :: [k]).
(forall (x :: k). f x -> a) -> Rec f es -> [a]
extract (Int -> f x -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
consPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Rec f xs
xs

instance Semigroup (Rec f '[]) where
  Rec f '[]
xs <> :: Rec f '[] -> Rec f '[] -> Rec f '[]
<> Rec f '[]
_ = Rec f '[]
xs

-- | One-by-one semigroup operation instead of concatenation.
--
-- @
-- (x ':~:' xs) '<>' (y ':~:' ys) == x '<>' y ':~:' xs '<>' ys
-- @
instance (Semigroup (f x), Semigroup (Rec f xs)) => Semigroup (Rec f (x ': xs)) where
  (f x
x :~: Rec f xs
xs) <> :: Rec f (x : xs) -> Rec f (x : xs) -> Rec f (x : xs)
<> (f x
y :~: Rec f xs
ys) = f x
x f x -> f x -> f x
forall a. Semigroup a => a -> a -> a
<> f x
y f x -> Rec f xs -> Rec f (x : xs)
forall a (f :: a -> Type) (e :: a) (es :: [a]).
f e -> Rec f es -> Rec f (e : es)
:~: Rec f xs
xs Rec f xs -> Rec f xs -> Rec f xs
forall a. Semigroup a => a -> a -> a
<> Rec f xs
ys

instance {-# OVERLAPPABLE #-} (∀ x. Semigroup (f x)) => Semigroup (Rec f xs) where
  Rec f xs
xs <> :: Rec f xs -> Rec f xs -> Rec f xs
<> Rec f xs
ys = (forall (x :: k). f x -> f x -> f x)
-> Rec f xs -> Rec f xs -> Rec f xs
forall k (f :: k -> Type) (g :: k -> Type) (h :: k -> Type)
       (es :: [k]).
(forall (x :: k). f x -> g x -> h x)
-> Rec f es -> Rec g es -> Rec h es
zipWith forall (x :: k). f x -> f x -> f x
forall a. Semigroup a => a -> a -> a
(<>) Rec f xs
xs Rec f xs
ys

-- | @
-- 'mempty' == 'empty'
-- @
instance Monoid (Rec f '[]) where
  mempty :: Rec f '[]
mempty = Rec f '[]
forall k (f :: k -> Type). Rec f '[]
empty

-- | The unit of a record type are the units of its element types:
--
-- @
-- 'mempty' == 'mempty' ':~:' 'mempty'
-- @
instance (Monoid (f x), Monoid (Rec f xs)) => Monoid (Rec f (x ': xs)) where
  mempty :: Rec f (x : xs)
mempty = f x
forall a. Monoid a => a
mempty f x -> Rec f xs -> Rec f (x : xs)
forall a (f :: a -> Type) (e :: a) (es :: [a]).
f e -> Rec f es -> Rec f (e : es)
:~: Rec f xs
forall a. Monoid a => a
mempty

-- | Get the length of the record.
length :: Rec f es -> Int
length :: Rec f es -> Int
length (Rec Int
_ Int
len SmallArray Any
_) = Int
len

-- | Create a new 'SmallMutableArray' with no contents.
newArr :: PrimMonad m => Int -> m (SmallMutableArray (PrimState m) a)
newArr :: Int -> m (SmallMutableArray (PrimState m) a)
newArr Int
len = Int -> a -> m (SmallMutableArray (PrimState m) a)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
len (a -> m (SmallMutableArray (PrimState m) a))
-> a -> m (SmallMutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. HasCallStack => String -> a
error
  String
"Data.Rec.SmallArray.newArr: Attempting to read an element of the underlying array of a 'Rec'. Please report this \
  \as a bug."

-- | Create an empty record. \( O(1) \).
empty :: Rec f '[]
empty :: Rec f '[]
empty = Int -> Int -> SmallArray Any -> Rec f '[]
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec Int
0 Int
0 (SmallArray Any -> Rec f '[]) -> SmallArray Any -> Rec f '[]
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray ((forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any)
-> (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a b. (a -> b) -> a -> b
$ Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newArr Int
0

-- | Create a record with one entry. \( O(1) \).
singleton :: f e -> Rec f '[e]
singleton :: f e -> Rec f '[e]
singleton f e
x = Int -> Int -> SmallArray Any -> Rec f '[e]
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec Int
0 Int
1 (SmallArray Any -> Rec f '[e]) -> SmallArray Any -> Rec f '[e]
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s Any
marr <- Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newArr Int
1
  SmallMutableArray (PrimState (ST s)) Any -> Int -> Any -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
0 (f e -> Any
forall a. a -> Any
toAny f e
x)
  SmallMutableArray s Any -> ST s (SmallMutableArray s Any)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SmallMutableArray s Any
marr

-- | Prepend one entry to the record. \( O(n) \).
cons :: f e -> Rec f es -> Rec f (e ': es)
cons :: f e -> Rec f es -> Rec f (e : es)
cons f e
x (Rec Int
off Int
len SmallArray Any
arr) = Int -> Int -> SmallArray Any -> Rec f (e : es)
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (SmallArray Any -> Rec f (e : es))
-> SmallArray Any -> Rec f (e : es)
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s Any
marr <- Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newArr (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  SmallMutableArray (PrimState (ST s)) Any -> Int -> Any -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
0 (f e -> Any
forall a. a -> Any
toAny f e
x)
  SmallMutableArray (PrimState (ST s)) Any
-> Int -> SmallArray Any -> Int -> Int -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
1 SmallArray Any
arr Int
off Int
len
  SmallMutableArray s Any -> ST s (SmallMutableArray s Any)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SmallMutableArray s Any
marr

-- | Infix version of 'cons' that also supports destructuring.
pattern (:~:) :: f e -> Rec f es -> Rec f (e ': es)
pattern x $b:~: :: f e -> Rec f es -> Rec f (e : es)
$m:~: :: forall r a (f :: a -> Type) (e :: a) (es :: [a]).
Rec f (e : es) -> (f e -> Rec f es -> r) -> (Void# -> r) -> r
:~: xs <- (head &&& tail -> (x, xs))
  where (:~:) = f e -> Rec f es -> Rec f (e : es)
forall a (f :: a -> Type) (e :: a) (es :: [a]).
f e -> Rec f es -> Rec f (e : es)
cons
infixr 5 :~:
{-# COMPLETE (:~:) #-}

-- | @infixr 5 :~:@
consPrec :: Int
consPrec :: Int
consPrec = Int
5

-- | Type level list concatenation.
type family xs ++ ys where
  '[] ++ ys = ys
  (x ': xs) ++ ys = x ': (xs ++ ys)
infixr 5 ++

-- | Concatenate two records. \( O(m+n) \).
concat :: Rec f es -> Rec f es' -> Rec f (es ++ es')
concat :: Rec f es -> Rec f es' -> Rec f (es ++ es')
concat (Rec Int
off Int
len SmallArray Any
arr) (Rec Int
off' Int
len' SmallArray Any
arr') = Int -> Int -> SmallArray Any -> Rec f (es ++ es')
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len') (SmallArray Any -> Rec f (es ++ es'))
-> SmallArray Any -> Rec f (es ++ es')
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s Any
marr <- Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newArr (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len')
  SmallMutableArray (PrimState (ST s)) Any
-> Int -> SmallArray Any -> Int -> Int -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
0 SmallArray Any
arr Int
off Int
len
  SmallMutableArray (PrimState (ST s)) Any
-> Int -> SmallArray Any -> Int -> Int -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
len SmallArray Any
arr' Int
off' Int
len'
  SmallMutableArray s Any -> ST s (SmallMutableArray s Any)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SmallMutableArray s Any
marr

-- | Infix version of 'concat' that also supports destructuring.
pattern (:++:) :: ∀ es es' f. KnownList es => Rec f es -> Rec f es' -> Rec f (es ++ es')
pattern xs $b:++: :: Rec f es -> Rec f es' -> Rec f (es ++ es')
$m:++: :: forall r a (es :: [a]) (es' :: [a]) (f :: a -> Type).
KnownList es =>
Rec f (es ++ es')
-> (Rec f es -> Rec f es' -> r) -> (Void# -> r) -> r
:++: xs' <- (take @es @es' &&& drop @es @es' -> (xs, xs'))
  where (:++:) = Rec f es -> Rec f es' -> Rec f (es ++ es')
forall a (f :: a -> Type) (es :: [a]) (es' :: [a]).
Rec f es -> Rec f es' -> Rec f (es ++ es')
concat
infixr 5 :++:
{-# COMPLETE (:++:) #-}

-- | Slice off one entry from the top of the record. \( O(1) \).
tail :: Rec f (e ': es) -> Rec f es
tail :: Rec f (e : es) -> Rec f es
tail (Rec Int
off Int
len SmallArray Any
arr) = Int -> Int -> SmallArray Any -> Rec f es
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) SmallArray Any
arr

unreifiable :: String -> String -> String -> a
unreifiable :: String -> String -> String -> a
unreifiable String
clsName String
funName String
comp = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
  String
funName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": Attempting to access " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
comp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" without a reflected value. This is perhaps because you are trying \
  \to define an instance for the '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
clsName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' typeclass, which you should not be doing whatsoever. If that or \
  \other shenanigans seem unlikely, please report this as a bug."

-- | The list @es@ list is concrete, i.e. is of the form @'[a1, a2, ..., an]@, i.e. is not a type variable.
class KnownList (es :: [k]) where
  -- | Get the length of the list.
  reifyLen :: Int
  reifyLen = String -> String -> String -> Int
forall a. String -> String -> String -> a
unreifiable String
"KnownList" String
"Data.Rec.SmallArray.reifyLen" String
"the length of a type-level list"

instance KnownList '[] where
  reifyLen :: Int
reifyLen = Int
0

instance KnownList es => KnownList (e ': es) where
  reifyLen :: Int
reifyLen = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ KnownList es => Int
forall k (es :: [k]). KnownList es => Int
reifyLen @_ @es

-- | Slice off several entries from the top of the record. \( O(1) \).
drop :: ∀ es es' f. KnownList es => Rec f (es ++ es') -> Rec f es'
drop :: Rec f (es ++ es') -> Rec f es'
drop (Rec Int
off Int
len SmallArray Any
arr) = Int -> Int -> SmallArray Any -> Rec f es'
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len') (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len') SmallArray Any
arr
  where len' :: Int
len' = KnownList es => Int
forall k (es :: [k]). KnownList es => Int
reifyLen @_ @es

-- | Get the head of the record. \( O(1) \).
head :: Rec f (e ': es) -> f e
head :: Rec f (e : es) -> f e
head (Rec Int
off Int
_ SmallArray Any
arr) = Any -> f e
forall a. Any -> a
fromAny (Any -> f e) -> Any -> f e
forall a b. (a -> b) -> a -> b
$ SmallArray Any -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Any
arr Int
off

-- | Take elements from the top of the record. \( O(m) \).
take :: ∀ es es' f. KnownList es => Rec f (es ++ es') -> Rec f es
take :: Rec f (es ++ es') -> Rec f es
take (Rec Int
off Int
_ SmallArray Any
arr) = Int -> Int -> SmallArray Any -> Rec f es
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec Int
0 Int
len (SmallArray Any -> Rec f es) -> SmallArray Any -> Rec f es
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s Any
marr <- Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newArr Int
len
  SmallMutableArray (PrimState (ST s)) Any
-> Int -> SmallArray Any -> Int -> Int -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
0 SmallArray Any
arr Int
off (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
  SmallMutableArray s Any -> ST s (SmallMutableArray s Any)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SmallMutableArray s Any
marr
  where len :: Int
len = KnownList es => Int
forall k (es :: [k]). KnownList es => Int
reifyLen @_ @es

-- | The element @e@ is present in the list @es@.
class Elem (e :: k) (es :: [k]) where
  -- | Get the index of the element.
  reifyIndex :: Int
  reifyIndex = String -> String -> String -> Int
forall a. String -> String -> String -> a
unreifiable String
"Elem" String
"Data.Rec.SmallArray.reifyIndex" String
"the index of an element of a type-level list"

instance {-# OVERLAPPING #-} Elem e (e ': es) where
  reifyIndex :: Int
reifyIndex = Int
0

instance Elem e es => Elem e (e' ': es) where
  reifyIndex :: Int
reifyIndex = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Elem e es => Int
forall k (e :: k) (es :: [k]). Elem e es => Int
reifyIndex @_ @e @es

type ElemNotFound e = 'Text "The element '" ':<>: 'ShowType e ':<>: 'Text "' is not present in the constraint"

instance TypeError (ElemNotFound e) => Elem e '[] where
  reifyIndex :: Int
reifyIndex = String -> Int
forall a. HasCallStack => String -> a
error
    String
"Data.Rec.SmallArray.reifyIndex: Attempting to refer to a nonexistent member. Please report this as a bug."

-- | Get an element in the record. Amortized \( O(1) \).
index :: ∀ e es f. Elem e es => Rec f es -> f e
index :: Rec f es -> f e
index (Rec Int
off Int
_ SmallArray Any
arr) = Any -> f e
forall a. Any -> a
fromAny (Any -> f e) -> Any -> f e
forall a b. (a -> b) -> a -> b
$ SmallArray Any -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Any
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Elem e es => Int
forall k (e :: k) (es :: [k]). Elem e es => Int
reifyIndex @_ @e @es)

-- | @es@ is a subset of @es'@.
class KnownList es => Subset (es :: [k]) (es' :: [k]) where
  -- | Get a list of indices of the elements.
  reifyIndices :: [Int]
  reifyIndices = String -> String -> String -> [Int]
forall a. String -> String -> String -> a
unreifiable
    String
"Subset" String
"Data.Rec.SmallArray.reifyIndices" String
"the index of multiple elements of a type-level list"

instance Subset '[] es where
  reifyIndices :: [Int]
reifyIndices = []

instance (Subset es es', Elem e es') => Subset (e ': es) es' where
  reifyIndices :: [Int]
reifyIndices = Elem e es' => Int
forall k (e :: k) (es :: [k]). Elem e es => Int
reifyIndex @_ @e @es' Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Subset es es' => [Int]
forall k (es :: [k]) (es' :: [k]). Subset es es' => [Int]
reifyIndices @_ @es @es'

-- | Get a subset of the record. Amortized \( O(m) \).
pick :: ∀ es es' f. Subset es es' => Rec f es' -> Rec f es
pick :: Rec f es' -> Rec f es
pick (Rec Int
off Int
_ SmallArray Any
arr) = Int -> Int -> SmallArray Any -> Rec f es
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec Int
0 (KnownList es => Int
forall k (es :: [k]). KnownList es => Int
reifyLen @_ @es) (SmallArray Any -> Rec f es) -> SmallArray Any -> Rec f es
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s Any
marr <- Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newArr (KnownList es => Int
forall k (es :: [k]). KnownList es => Int
reifyLen @_ @es)
  SmallMutableArray (PrimState (ST s)) Any -> Int -> [Int] -> ST s ()
forall (m :: Type -> Type).
PrimMonad m =>
SmallMutableArray (PrimState m) Any -> Int -> [Int] -> m ()
go SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
0 (Subset es es' => [Int]
forall k (es :: [k]) (es' :: [k]). Subset es es' => [Int]
reifyIndices @_ @es @es')
  SmallMutableArray s Any -> ST s (SmallMutableArray s Any)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SmallMutableArray s Any
marr
  where
    go :: PrimMonad m => SmallMutableArray (PrimState m) Any -> Int -> [Int] -> m ()
    go :: SmallMutableArray (PrimState m) Any -> Int -> [Int] -> m ()
go SmallMutableArray (PrimState m) Any
_ Int
_ [] = () -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
    go SmallMutableArray (PrimState m) Any
marr Int
newIx (Int
ix : [Int]
ixs) = do
      SmallMutableArray (PrimState m) Any -> Int -> Any -> m ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray (PrimState m) Any
marr Int
newIx (SmallArray Any -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Any
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix))
      SmallMutableArray (PrimState m) Any -> Int -> [Int] -> m ()
forall (m :: Type -> Type).
PrimMonad m =>
SmallMutableArray (PrimState m) Any -> Int -> [Int] -> m ()
go SmallMutableArray (PrimState m) Any
marr (Int
newIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Int]
ixs

-- | Update an entry in the record. \( O(n) \).
update :: ∀ e es f. Elem e es => f e -> Rec f es -> Rec f es
update :: f e -> Rec f es -> Rec f es
update f e
x (Rec Int
off Int
len SmallArray Any
arr) = Int -> Int -> SmallArray Any -> Rec f es
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec Int
0 Int
len (SmallArray Any -> Rec f es) -> SmallArray Any -> Rec f es
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s Any
marr <- Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newArr Int
len
  SmallMutableArray (PrimState (ST s)) Any
-> Int -> SmallArray Any -> Int -> Int -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
0 SmallArray Any
arr Int
off Int
len
  SmallMutableArray (PrimState (ST s)) Any -> Int -> Any -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr (Elem e es => Int
forall k (e :: k) (es :: [k]). Elem e es => Int
reifyIndex @_ @e @es) (f e -> Any
forall a. a -> Any
toAny f e
x)
  SmallMutableArray s Any -> ST s (SmallMutableArray s Any)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SmallMutableArray s Any
marr

-- | Infix version of 'update'.
(/~/) :: Elem e es => f e -> Rec f es -> Rec f es
/~/ :: f e -> Rec f es -> Rec f es
(/~/) = f e -> Rec f es -> Rec f es
forall k (e :: k) (es :: [k]) (f :: k -> Type).
Elem e es =>
f e -> Rec f es -> Rec f es
update
infixl 9 /~/

-- | Modify an entry in the record via a function. \( O(n) \).
modify :: ∀ e es f. Elem e es => (f e -> f e) -> Rec f es -> Rec f es
modify :: (f e -> f e) -> Rec f es -> Rec f es
modify f e -> f e
f (Rec Int
off Int
len SmallArray Any
arr) = Int -> Int -> SmallArray Any -> Rec f es
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec Int
0 Int
len (SmallArray Any -> Rec f es) -> SmallArray Any -> Rec f es
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s Any
marr <- Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newArr Int
len
  SmallMutableArray (PrimState (ST s)) Any
-> Int -> SmallArray Any -> Int -> Int -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
0 SmallArray Any
arr Int
off Int
len
  let ix :: Int
ix = Elem e es => Int
forall k (e :: k) (es :: [k]). Elem e es => Int
reifyIndex @_ @e @es
  Any
old <- SmallMutableArray (PrimState (ST s)) Any -> Int -> ST s Any
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
ix
  SmallMutableArray (PrimState (ST s)) Any -> Int -> Any -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
ix (f e -> Any
forall a. a -> Any
toAny (f e -> Any) -> f e -> Any
forall a b. (a -> b) -> a -> b
$ f e -> f e
f (f e -> f e) -> f e -> f e
forall a b. (a -> b) -> a -> b
$ Any -> f e
forall a. Any -> a
fromAny Any
old)
  SmallMutableArray s Any -> ST s (SmallMutableArray s Any)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SmallMutableArray s Any
marr

-- | Merge a subset into the original record, updating several entries at once. \( O(m+n) \).
batch :: ∀ es es' f. Subset es es' => Rec f es -> Rec f es' -> Rec f es'
batch :: Rec f es -> Rec f es' -> Rec f es'
batch (Rec Int
off Int
_ SmallArray Any
arr) (Rec Int
off' Int
len' SmallArray Any
arr') = Int -> Int -> SmallArray Any -> Rec f es'
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec Int
0 Int
len' (SmallArray Any -> Rec f es') -> SmallArray Any -> Rec f es'
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s Any
marr <- Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newArr Int
len'
  SmallMutableArray (PrimState (ST s)) Any
-> Int -> SmallArray Any -> Int -> Int -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
0 SmallArray Any
arr' Int
off' Int
len'
  SmallMutableArray (PrimState (ST s)) Any -> Int -> [Int] -> ST s ()
forall (m :: Type -> Type).
PrimMonad m =>
SmallMutableArray (PrimState m) Any -> Int -> [Int] -> m ()
go SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
0 (Subset es es' => [Int]
forall k (es :: [k]) (es' :: [k]). Subset es es' => [Int]
reifyIndices @_ @es @es')
  SmallMutableArray s Any -> ST s (SmallMutableArray s Any)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SmallMutableArray s Any
marr
  where
    go :: PrimMonad m => SmallMutableArray (PrimState m) Any -> Int -> [Int] -> m ()
    go :: SmallMutableArray (PrimState m) Any -> Int -> [Int] -> m ()
go SmallMutableArray (PrimState m) Any
_ Int
_ [] = () -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
    go SmallMutableArray (PrimState m) Any
marr Int
updIx (Int
ix : [Int]
ixs) = do
      SmallMutableArray (PrimState m) Any -> Int -> Any -> m ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray (PrimState m) Any
marr Int
ix (SmallArray Any -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Any
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
updIx))
      SmallMutableArray (PrimState m) Any -> Int -> [Int] -> m ()
forall (m :: Type -> Type).
PrimMonad m =>
SmallMutableArray (PrimState m) Any -> Int -> [Int] -> m ()
go SmallMutableArray (PrimState m) Any
marr (Int
updIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Int]
ixs

-- | Infix version of 'batch'.
(/++/) :: Subset es es' => Rec f es -> Rec f es' -> Rec f es'
/++/ :: Rec f es -> Rec f es' -> Rec f es'
(/++/) = Rec f es -> Rec f es' -> Rec f es'
forall k (es :: [k]) (es' :: [k]) (f :: k -> Type).
Subset es es' =>
Rec f es -> Rec f es' -> Rec f es'
batch
infixl 9 /++/

-- | The type of natural transformations from functor @f@ to @g@.
type f ~> g = ∀ a. f a -> g a
infixr 0 ~>

-- | Apply a natural transformation to the record. \( O(n) \).
natural :: (f ~> g) -> Rec f es -> Rec g es
natural :: (f ~> g) -> Rec f es -> Rec g es
natural f ~> g
f (Rec Int
off Int
len SmallArray Any
arr) = Int -> Int -> SmallArray Any -> Rec g es
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec Int
0 Int
len (SmallArray Any -> Rec g es) -> SmallArray Any -> Rec g es
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s Any
marr <- Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newArr Int
len
  SmallMutableArray (PrimState (ST s)) Any -> Int -> ST s ()
forall (m :: Type -> Type).
PrimMonad m =>
SmallMutableArray (PrimState m) Any -> Int -> m ()
go SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr Int
0
  SmallMutableArray s Any -> ST s (SmallMutableArray s Any)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SmallMutableArray s Any
marr
  where
    go :: PrimMonad m => SmallMutableArray (PrimState m) Any -> Int -> m ()
    go :: SmallMutableArray (PrimState m) Any -> Int -> m ()
go SmallMutableArray (PrimState m) Any
marr Int
n
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = () -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = do
        SmallMutableArray (PrimState m) Any -> Int -> Any -> m ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray (PrimState m) Any
marr Int
n (g Any -> Any
forall a. a -> Any
toAny (g Any -> Any) -> g Any -> Any
forall a b. (a -> b) -> a -> b
$ f Any -> g Any
f ~> g
f (f Any -> g Any) -> f Any -> g Any
forall a b. (a -> b) -> a -> b
$ Any -> f Any
forall a. Any -> a
fromAny (Any -> f Any) -> Any -> f Any
forall a b. (a -> b) -> a -> b
$ SmallArray Any -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Any
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n))
        SmallMutableArray (PrimState m) Any -> Int -> m ()
forall (m :: Type -> Type).
PrimMonad m =>
SmallMutableArray (PrimState m) Any -> Int -> m ()
go SmallMutableArray (PrimState m) Any
marr (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Infix version of 'natural'.
(<#>) :: (f ~> g) -> Rec f es -> Rec g es
<#> :: (f ~> g) -> Rec f es -> Rec g es
(<#>) = (f ~> g) -> Rec f es -> Rec g es
forall k (f :: k -> Type) (g :: k -> Type) (es :: [k]).
(f ~> g) -> Rec f es -> Rec g es
natural
infixl 4 <#>

-- | Zip two records with a natural transformation. \( O(n) \).
zipWith :: (∀ x. f x -> g x -> h x) -> Rec f es -> Rec g es -> Rec h es
zipWith :: (forall (x :: k). f x -> g x -> h x)
-> Rec f es -> Rec g es -> Rec h es
zipWith forall (x :: k). f x -> g x -> h x
f (Rec Int
off Int
len SmallArray Any
arr) (Rec Int
off' Int
_ SmallArray Any
arr') = Int -> Int -> SmallArray Any -> Rec h es
forall k (f :: k -> Type) (es :: [k]).
Int -> Int -> SmallArray Any -> Rec f es
Rec Int
0 Int
len (SmallArray Any -> Rec h es) -> SmallArray Any -> Rec h es
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallMutableArray s Any)) -> SmallArray Any
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s Any
marr <- Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
Int -> m (SmallMutableArray (PrimState m) a)
newArr Int
len
  SmallMutableArray (PrimState (ST s)) Any -> Int -> ST s ()
forall (m :: Type -> Type).
PrimMonad m =>
SmallMutableArray (PrimState m) Any -> Int -> m ()
go SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
marr (Int
0 :: Int)
  SmallMutableArray s Any -> ST s (SmallMutableArray s Any)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SmallMutableArray s Any
marr
  where
    go :: PrimMonad m => SmallMutableArray (PrimState m) Any -> Int -> m ()
    go :: SmallMutableArray (PrimState m) Any -> Int -> m ()
go SmallMutableArray (PrimState m) Any
marr Int
n
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = () -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = do
        SmallMutableArray (PrimState m) Any -> Int -> Any -> m ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray (PrimState m) Any
marr Int
n
          (h Any -> Any
forall a. a -> Any
toAny (h Any -> Any) -> h Any -> Any
forall a b. (a -> b) -> a -> b
$ f Any -> g Any -> h Any
forall (x :: k). f x -> g x -> h x
f (Any -> f Any
forall a. Any -> a
fromAny (Any -> f Any) -> Any -> f Any
forall a b. (a -> b) -> a -> b
$ SmallArray Any -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Any
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)) (Any -> g Any
forall a. Any -> a
fromAny (Any -> g Any) -> Any -> g Any
forall a b. (a -> b) -> a -> b
$ SmallArray Any -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Any
arr' (Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)))
        SmallMutableArray (PrimState m) Any -> Int -> m ()
forall (m :: Type -> Type).
PrimMonad m =>
SmallMutableArray (PrimState m) Any -> Int -> m ()
go SmallMutableArray (PrimState m) Any
marr (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Check if a predicate is true on all elements. \( O(n) \).
all :: (∀ x. f x -> Bool) -> Rec f es -> Bool
all :: (forall (x :: k). f x -> Bool) -> Rec f es -> Bool
all forall (x :: k). f x -> Bool
f (Rec Int
off Int
len SmallArray Any
arr) = Int -> Bool
go Int
0
  where
    go :: Int -> Bool
go Int
n
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = Bool
True
      | Bool
otherwise = f Any -> Bool
forall (x :: k). f x -> Bool
f (Any -> f Any
forall a. Any -> a
fromAny (Any -> f Any) -> Any -> f Any
forall a b. (a -> b) -> a -> b
$ SmallArray Any -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Any
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)) Bool -> Bool -> Bool
&& Int -> Bool
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Check if a predicate is true on at least one element. \( O(n) \).
any :: (∀ x. f x -> Bool) -> Rec f es -> Bool
any :: (forall (x :: k). f x -> Bool) -> Rec f es -> Bool
any forall (x :: k). f x -> Bool
f (Rec Int
off Int
len SmallArray Any
arr) = Int -> Bool
go Int
0
  where
    go :: Int -> Bool
go Int
n
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = Bool
False
      | Bool
otherwise = f Any -> Bool
forall (x :: k). f x -> Bool
f (Any -> f Any
forall a. Any -> a
fromAny (Any -> f Any) -> Any -> f Any
forall a b. (a -> b) -> a -> b
$ SmallArray Any -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Any
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)) Bool -> Bool -> Bool
|| Int -> Bool
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Convert a record that effectively contains a fixed type into a list of the fixed type. \( O(n) \).
degenerate :: Rec (Const a) es -> [a]
degenerate :: Rec (Const a) es -> [a]
degenerate (Rec Int
off Int
len SmallArray Any
arr) = Int -> [a]
go Int
0
  where
    go :: Int -> [a]
go Int
n
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = []
      | Bool
otherwise = Const a Any -> a
forall a k (b :: k). Const a b -> a
getConst (Any -> Const a Any
forall a. Any -> a
fromAny (Any -> Const a Any) -> Any -> Const a Any
forall a b. (a -> b) -> a -> b
$ SmallArray Any -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Any
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Map each element to a fixed type. \( O(n) \).
extract :: (∀ x. f x -> a) -> Rec f es -> [a]
extract :: (forall (x :: k). f x -> a) -> Rec f es -> [a]
extract forall (x :: k). f x -> a
f Rec f es
xs = Rec (Const a) es -> [a]
forall k a (es :: [k]). Rec (Const a) es -> [a]
degenerate (Rec (Const a) es -> [a]) -> Rec (Const a) es -> [a]
forall a b. (a -> b) -> a -> b
$ (f ~> Const a) -> Rec f es -> Rec (Const a) es
forall k (f :: k -> Type) (g :: k -> Type) (es :: [k]).
(f ~> g) -> Rec f es -> Rec g es
natural (a -> Const a a
forall k a (b :: k). a -> Const a b
Const (a -> Const a a) -> (f a -> a) -> f a -> Const a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> a
forall (x :: k). f x -> a
f) Rec f es
xs

-- | Test the size invariant of 'Rec'.
sizeInvariant :: Rec f es -> Rec f es
sizeInvariant :: Rec f es -> Rec f es
sizeInvariant xs :: Rec f es
xs@(Rec Int
off Int
len SmallArray Any
arr)
  | Int
tracked Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
actual = Rec f es
xs
  | Bool
otherwise = String -> Rec f es
forall a. HasCallStack => String -> a
error (String -> Rec f es) -> String -> Rec f es
forall a b. (a -> b) -> a -> b
$
    String
"Data.Rec.SmallArray.sizeInvariant: tracked size " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
tracked String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", actual size " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actual
  where
    tracked :: Int
tracked = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off
    actual :: Int
actual = SmallArray Any -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray Any
arr

-- | Test whether all fields of 'Rec' are really set.
allAccessible :: Rec f es -> Rec f es
allAccessible :: Rec f es -> Rec f es
allAccessible xs :: Rec f es
xs@(Rec Int
off Int
len SmallArray Any
arr) = Int -> Rec f es
go Int
0
  where
    go :: Int -> Rec f es
go Int
n
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = Rec f es
xs
      | Bool
otherwise = SmallArray Any -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Any
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Any -> Rec f es -> Rec f es
`seq` Int -> Rec f es
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Test all invariants.
invariant :: Rec f es -> Rec f es
invariant :: Rec f es -> Rec f es
invariant = Rec f es -> Rec f es
forall k (f :: k -> Type) (es :: [k]). Rec f es -> Rec f es
allAccessible (Rec f es -> Rec f es)
-> (Rec f es -> Rec f es) -> Rec f es -> Rec f es
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec f es -> Rec f es
forall k (f :: k -> Type) (es :: [k]). Rec f es -> Rec f es
sizeInvariant

-- Helpers

-- | Coerce any boxed value into 'Any'.
toAny :: a -> Any
toAny :: a -> Any
toAny = a -> Any
forall a b. a -> b
unsafeCoerce
{-# INLINE toAny #-}

-- | Coerce 'Any' to a boxed value. This is /generally unsafe/ and it is your responsibility to ensure that the type
-- you're coercing into is the original type that the 'Any' is coerced from.
fromAny :: Any -> a
fromAny :: Any -> a
fromAny = Any -> a
forall a b. a -> b
unsafeCoerce
{-# INLINE fromAny #-}