{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_HADDOCK not-home #-}
-- |
-- Copyright: (c) 2021 Xy Ren
-- License: BSD3
-- Maintainer: xy.r@outlook.com
-- Stability: unstable
-- 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) \).
--
-- __This is an /internal/ module and its API may change even between minor versions.__ Therefore you should be
-- extra careful if you're to depend on this module.
module Cleff.Internal.Rec
  ( Rec (Rec)
  , type (++)
    -- * Construction
  , empty
  , cons
  , concat
    -- * Deconstruction
  , KnownList
  , head
  , take
  , tail
  , drop
    -- * Retrieval and updating
  , Elem
  , Subset
  , index
  , pick
  , update
    -- * Helpers
  , newArr
  ) where

import           Cleff.Internal.Any        (Any, fromAny, toAny)
import           Control.Monad.ST          (ST)
import           Data.Kind                 (Type)
import           Data.Primitive.SmallArray (SmallArray, SmallMutableArray, cloneSmallArray, copySmallArray,
                                            indexSmallArray, newSmallArray, runSmallArray, thawSmallArray,
                                            writeSmallArray)
import           GHC.TypeLits              (ErrorMessage (ShowType, Text, (:<>:)), TypeError)
import           Prelude                   hiding (all, any, concat, drop, head, length, tail, take, zipWith)

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

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

unreifiable :: String -> String -> String -> a
unreifiable :: [Char] -> [Char] -> [Char] -> a
unreifiable [Char]
clsName [Char]
funName [Char]
comp = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$
  [Char]
funName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
": Attempting to access " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
comp [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" without a reflected value. This is perhaps because you are trying \
  \to define an instance for the '" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
clsName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"' typeclass, which you should not be doing whatsoever. If that or \
  \other shenanigans seem unlikely, 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 s Any)
forall s. Int -> ST s (SmallMutableArray s Any)
newArr Int
0

-- | 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 s Any)
forall s. Int -> ST s (SmallMutableArray s Any)
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

-- | 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 s Any)
forall s. Int -> ST s (SmallMutableArray s Any)
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

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

-- | @'KnownList' es@ means the list @es@ is concrete, i.e. is of the form @'[a1, a2, ..., an]@ instead of a type
-- variable.
class KnownList (es :: [k]) where
  -- | Get the length of the list.
  reifyLen :: Int
  reifyLen = [Char] -> [Char] -> [Char] -> Int
forall a. [Char] -> [Char] -> [Char] -> a
unreifiable [Char]
"KnownList" [Char]
"Cleff.Internal.Rec.reifyLen" [Char]
"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
$ SmallArray Any -> Int -> Int -> SmallArray Any
forall a. SmallArray a -> Int -> Int -> SmallArray a
cloneSmallArray SmallArray Any
arr Int
off Int
len
  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 = [Char] -> [Char] -> [Char] -> Int
forall a. [Char] -> [Char] -> [Char] -> a
unreifiable [Char]
"Elem" [Char]
"Cleff.Internal.Rec.reifyIndex" [Char]
"the index of an element of a type-level list"

-- | The element closer to the head takes priority.
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 = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error
    [Char]
"Cleff.Internal.Rec.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'@, i.e. all elements of @es@ are in @es'@.
class KnownList es => Subset (es :: [k]) (es' :: [k]) where
  -- | Get a list of indices of the elements.
  reifyIndices :: [Int]
  reifyIndices = [Char] -> [Char] -> [Char] -> [Int]
forall a. [Char] -> [Char] -> [Char] -> a
unreifiable
    [Char]
"Subset" [Char]
"Cleff.Internal.Rec.reifyIndices" [Char]
"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 s Any)
forall s. Int -> ST s (SmallMutableArray s Any)
newArr (KnownList es => Int
forall k (es :: [k]). KnownList es => Int
reifyLen @_ @es)
  SmallMutableArray s Any -> Int -> [Int] -> ST s ()
forall s. SmallMutableArray s Any -> Int -> [Int] -> ST s ()
go SmallMutableArray 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 :: SmallMutableArray s Any -> Int -> [Int] -> ST s ()
    go :: SmallMutableArray s Any -> Int -> [Int] -> ST s ()
go SmallMutableArray s Any
_ Int
_ [] = () -> ST s ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
    go SmallMutableArray s Any
marr Int
newIx (Int
ix : [Int]
ixs) = do
      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
newIx (Any -> ST s ()) -> Any -> ST s ()
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
ix)
      SmallMutableArray s Any -> Int -> [Int] -> ST s ()
forall s. SmallMutableArray s Any -> Int -> [Int] -> ST s ()
go SmallMutableArray s 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 <- SmallArray Any
-> Int -> Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
thawSmallArray 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