{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns, BangPatterns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MagicHash, UnboxedTuples #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
------------------------------------------------------------------------
-- |
-- Module      :  Data.Extensible.Struct
-- Copyright   :  (c) Fumiaki Kinoshita 2018
-- License     :  BSD3
--
-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--
-- Mutable structs
------------------------------------------------------------------------
module Data.Extensible.Struct (
  -- * Mutable struct
  Struct
  , set
  , get
  , new
  , newRepeat
  , newFor
  , newFromHList
  , WrappedPointer(..)
  , (-$>)
  -- ** Atomic operations
  , atomicModify
  , atomicModify'
  , atomicModify_
  , atomicModify'_
  -- * Immutable product
  , (:&)
  , (:*)
  , unsafeFreeze
  , newFrom
  , hlookup
  , hlength
  , type (++)
  , happend
  , hfoldrWithIndex
  , thaw
  , hfrozen
  , hmodify
  , toHList) where

import GHC.Prim
import Control.Comonad
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Primitive
import Control.Monad.ST
import Data.Constraint
import Data.Extensible.Class
import Data.Extensible.Internal.Rig
import Data.Extensible.Wrapper
import Data.Profunctor.Rep
import Data.Profunctor.Sieve
import Data.Proxy
import Data.Kind (Type)
import qualified Data.StateVar as V
import GHC.Types
import qualified Type.Membership.HList as L

-- | Mutable type-indexed struct.
data Struct s (h :: k -> Type) (xs :: [k]) = Struct (SmallMutableArray# s Any)

-- | Write a value in a 'Struct'.
set :: PrimMonad m => Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set :: Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set (Struct m :: SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# i :: Int#
i) e :: h x
e = (State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
  ((State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ())
-> (State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ()
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case (SmallMutableArray# Any Any
 -> Int# -> Any -> State# Any -> State# Any)
-> SmallMutableArray# (PrimState m) Any
-> Int#
-> h x
-> State# (PrimState m)
-> State# (PrimState m)
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> Any -> State# Any -> State# Any
forall d k1.
SmallMutableArray# d k1 -> Int# -> k1 -> State# d -> State# d
writeSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i h x
e State# (PrimState m)
s of
    s' :: State# (PrimState m)
s' -> (# State# (PrimState m)
s', () #)
{-# INLINE set #-}

-- | Read a value from a 'Struct'.
get :: PrimMonad m => Struct (PrimState m) h xs -> Membership xs x -> m (h x)
get :: Struct (PrimState m) h xs -> Membership xs x -> m (h x)
get (Struct m :: SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# i :: Int#
i) = (State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), h x #))
 -> m (h x))
-> (State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x)
forall a b. (a -> b) -> a -> b
$ (SmallMutableArray# Any Any
 -> Int# -> State# Any -> (# State# Any, Any #))
-> SmallMutableArray# (PrimState m) Any
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), h x #)
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> State# Any -> (# State# Any, Any #)
forall d k1.
SmallMutableArray# d k1 -> Int# -> State# d -> (# State# d, k1 #)
readSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i
{-# INLINE get #-}

-- | Atomically modify an element in a 'Struct'.
atomicModify :: PrimMonad m
  => Struct (PrimState m) h xs -> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify :: Struct (PrimState m) h xs
-> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify (Struct m :: SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# i :: Int#
i) f :: h x -> (h x, a)
f = (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
  ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \s0 :: State# (PrimState m)
s0 -> case SmallMutableArray# (PrimState m) Any
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), Any #)
forall d k1.
SmallMutableArray# d k1 -> Int# -> State# d -> (# State# d, k1 #)
readSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i State# (PrimState m)
s0 of
    (# s :: State# (PrimState m)
s, x :: Any
x #) -> Any -> State# (PrimState m) -> (# State# (PrimState m), a #)
retry Any
x State# (PrimState m)
s
  where
    retry :: Any -> State# (PrimState m) -> (# State# (PrimState m), a #)
retry x :: Any
x s :: State# (PrimState m)
s = let p :: (Any, a)
p = (h x -> (h x, a)) -> Any -> (Any, a)
unsafeCoerce# h x -> (h x, a)
f Any
x in
      case SmallMutableArray# (PrimState m) Any
-> Int#
-> Any
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), Int#, Any #)
forall d k1.
SmallMutableArray# d k1
-> Int# -> k1 -> k1 -> State# d -> (# State# d, Int#, k1 #)
casSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i Any
x ((Any, a) -> Any
forall a b. (a, b) -> a
fst (Any, a)
p) State# (PrimState m)
s of
        (# s' :: State# (PrimState m)
s', b :: Int#
b, y :: Any
y #) -> case Int#
b of
          0# -> (# State# (PrimState m)
s', (Any, a) -> a
forall a b. (a, b) -> b
snd (Any, a)
p #)
          _ -> Any -> State# (PrimState m) -> (# State# (PrimState m), a #)
retry Any
y State# (PrimState m)
s'
{-# INLINE atomicModify #-}

-- | Strict version of 'atomicModify'.
atomicModify' :: PrimMonad m
  => Struct (PrimState m) h xs -> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify' :: Struct (PrimState m) h xs
-> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify' s :: Struct (PrimState m) h xs
s i :: Membership xs x
i f :: h x -> (h x, a)
f = Struct (PrimState m) h xs
-> Membership xs x -> (h x -> (h x, a)) -> m a
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k) a.
PrimMonad m =>
Struct (PrimState m) h xs
-> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify Struct (PrimState m) h xs
s Membership xs x
i
  (\x :: h x
x -> let (y :: h x
y, a :: a
a) = h x -> (h x, a)
f h x
x in (h x
y, h x
y h x -> a -> a
forall k1 a. k1 -> a -> a
`seq` a
a))
  m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$!)
{-# INLINE atomicModify' #-}

-- | Apply a function to an element atomically.
atomicModify_ :: PrimMonad m
  => Struct (PrimState m) h xs -> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify_ :: Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify_ (Struct m :: SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# i :: Int#
i) f :: h x -> h x
f = (State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
  ((State# (PrimState m) -> (# State# (PrimState m), h x #))
 -> m (h x))
-> (State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x)
forall a b. (a -> b) -> a -> b
$ \s0 :: State# (PrimState m)
s0 -> case SmallMutableArray# (PrimState m) Any
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), Any #)
forall d k1.
SmallMutableArray# d k1 -> Int# -> State# d -> (# State# d, k1 #)
readSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i State# (PrimState m)
s0 of
    (# s :: State# (PrimState m)
s, x :: Any
x #) -> Any -> State# (PrimState m) -> (# State# (PrimState m), h x #)
retry Any
x State# (PrimState m)
s
  where
    retry :: Any -> State# (PrimState m) -> (# State# (PrimState m), h x #)
retry x :: Any
x s :: State# (PrimState m)
s = case SmallMutableArray# (PrimState m) Any
-> Int#
-> Any
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), Int#, Any #)
forall d k1.
SmallMutableArray# d k1
-> Int# -> k1 -> k1 -> State# d -> (# State# d, Int#, k1 #)
casSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i Any
x ((h x -> h x) -> Any -> Any
unsafeCoerce# h x -> h x
f Any
x) State# (PrimState m)
s of
      (# s' :: State# (PrimState m)
s', b :: Int#
b, y :: Any
y #) -> case Int#
b of
        0# -> (# State# (PrimState m)
s', Any -> h x
unsafeCoerce# Any
y #)
        _ -> Any -> State# (PrimState m) -> (# State# (PrimState m), h x #)
retry Any
y State# (PrimState m)
s'
{-# INLINE atomicModify_ #-}

-- | Strict version of 'atomicModify_'.
atomicModify'_ :: PrimMonad m
  => Struct (PrimState m) h xs -> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify'_ :: Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify'_ s :: Struct (PrimState m) h xs
s i :: Membership xs x
i f :: h x -> h x
f = Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify_ Struct (PrimState m) h xs
s Membership xs x
i h x -> h x
f m (h x) -> (h x -> m (h x)) -> m (h x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (h x -> m (h x)
forall (m :: * -> *) a. Monad m => a -> m a
return (h x -> m (h x)) -> h x -> m (h x)
forall a b. (a -> b) -> a -> b
$!)
{-# INLINE atomicModify'_ #-}

-- | A pointer to an element in a 'Struct'.
data WrappedPointer s h a where
  WrappedPointer :: !(Struct s h xs)
    -> !(Membership xs x)
    -> WrappedPointer s h (Repr h x)

instance (s ~ RealWorld, Wrapper h) => V.HasGetter (WrappedPointer s h a) a where
  get :: WrappedPointer s h a -> m a
get (WrappedPointer s :: Struct s h xs
s i :: Membership xs x
i) = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Optic' (->) (Const a) (h x) a -> h x -> a
forall a s. Optic' (->) (Const a) s a -> s -> a
view Optic' (->) (Const a) (h x) a
forall k (h :: k -> *) (f :: * -> *) (p :: * -> * -> *) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper (h x -> a) -> IO (h x) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Struct (PrimState IO) h xs -> Membership xs x -> IO (h x)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> m (h x)
get Struct s h xs
Struct (PrimState IO) h xs
s Membership xs x
i

instance (s ~ RealWorld, Wrapper h) => V.HasSetter (WrappedPointer s h a) a where
  WrappedPointer s :: Struct s h xs
s i :: Membership xs x
i $= :: WrappedPointer s h a -> a -> m ()
$= v :: a
v = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Struct (PrimState IO) h xs -> Membership xs x -> h x -> IO ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct s h xs
Struct (PrimState IO) h xs
s Membership xs x
i (h x -> IO ()) -> h x -> IO ()
forall a b. (a -> b) -> a -> b
$ Optic' Tagged Identity (h x) a -> a -> h x
forall s a. Optic' Tagged Identity s a -> a -> s
review Optic' Tagged Identity (h x) a
forall k (h :: k -> *) (f :: * -> *) (p :: * -> * -> *) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper a
v

instance (s ~ RealWorld, Wrapper h) => V.HasUpdate (WrappedPointer s h a) a a where
  WrappedPointer s :: Struct s h xs
s i :: Membership xs x
i $~ :: WrappedPointer s h a -> (a -> a) -> m ()
$~ f :: a -> a
f = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO (h x) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (h x) -> IO ()) -> IO (h x) -> IO ()
forall a b. (a -> b) -> a -> b
$ Struct (PrimState IO) h xs
-> Membership xs x -> (h x -> h x) -> IO (h x)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify_ Struct s h xs
Struct (PrimState IO) h xs
s Membership xs x
i ((h x -> h x) -> IO (h x)) -> (h x -> h x) -> IO (h x)
forall a b. (a -> b) -> a -> b
$ Optic (->) Identity (h x) (h x) a a -> (a -> a) -> h x -> h x
forall s t a b. Optic (->) Identity s t a b -> (a -> b) -> s -> t
over Optic (->) Identity (h x) (h x) a a
forall k (h :: k -> *) (f :: * -> *) (p :: * -> * -> *) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper a -> a
f
  WrappedPointer s :: Struct s h xs
s i :: Membership xs x
i $~! :: WrappedPointer s h a -> (a -> a) -> m ()
$~! f :: a -> a
f = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO (h x) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (h x) -> IO ()) -> IO (h x) -> IO ()
forall a b. (a -> b) -> a -> b
$ Struct (PrimState IO) h xs
-> Membership xs x -> (h x -> h x) -> IO (h x)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify'_ Struct s h xs
Struct (PrimState IO) h xs
s Membership xs x
i ((h x -> h x) -> IO (h x)) -> (h x -> h x) -> IO (h x)
forall a b. (a -> b) -> a -> b
$ Optic (->) Identity (h x) (h x) a a -> (a -> a) -> h x -> h x
forall s t a b. Optic (->) Identity s t a b -> (a -> b) -> s -> t
over Optic (->) Identity (h x) (h x) a a
forall k (h :: k -> *) (f :: * -> *) (p :: * -> * -> *) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper a -> a
f

-- | Get a 'WrappedPointer' from a name.
(-$>) :: forall k h xs v s. (Lookup xs k v) => Struct s h xs -> Proxy k -> WrappedPointer s h (Repr h (k ':> v))
s :: Struct s h xs
s -$> :: Struct s h xs -> Proxy k -> WrappedPointer s h (Repr h (k ':> v))
-$> _ = Struct s h xs
-> Membership xs (k ':> v) -> WrappedPointer s h (Repr h (k ':> v))
forall k s (h :: k -> *) (xs :: [k]) (x :: k).
Struct s h xs -> Membership xs x -> WrappedPointer s h (Repr h x)
WrappedPointer Struct s h xs
s (Membership xs (k ':> v)
forall k k1 (xs :: [Assoc k k1]) (k2 :: k) (v :: k1).
Lookup xs k2 v =>
Membership xs (k2 ':> v)
association :: Membership xs (k ':> v))
{-# INLINE (-$>) #-}

-- | Create a new 'Struct' using the supplied initializer.
new :: forall h m xs. (PrimMonad m, Generate xs)
  => (forall x. Membership xs x -> h x)
  -> m (Struct (PrimState m) h xs)
new :: (forall (x :: k). Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
new = Dict (Generate xs)
-> (forall (x :: k). Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
forall k (m :: * -> *) (xs :: [k]) (h :: k -> *).
PrimMonad m =>
Dict (Generate xs)
-> (forall (x :: k). Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newDict Dict (Generate xs)
forall (a :: Constraint). a => Dict a
Dict
{-# INLINE new #-}

newDict :: PrimMonad m
  => Dict (Generate xs)
  -> (forall x. Membership xs x -> h x)
  -> m (Struct (PrimState m) h xs)
newDict :: Dict (Generate xs)
-> (forall (x :: k). Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newDict Dict k :: forall (x :: k). Membership xs x -> h x
k = do
  Struct (PrimState m) h xs
m <- (forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
forall k (h :: k -> *) (m :: * -> *) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
newRepeat forall (x :: k). h x
forall a. HasCallStack => a
undefined
  (forall (x :: k).
 Membership xs x
 -> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs))
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs)
forall k (xs :: [k]) r.
Generate xs =>
(forall (x :: k). Membership xs x -> r -> r) -> r -> r
henumerate (\i :: Membership xs x
i cont :: m (Struct (PrimState m) h xs)
cont -> Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct (PrimState m) h xs
m Membership xs x
i (Membership xs x -> h x
forall (x :: k). Membership xs x -> h x
k Membership xs x
i) m ()
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Struct (PrimState m) h xs)
cont) (m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs))
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ Struct (PrimState m) h xs -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a. Monad m => a -> m a
return Struct (PrimState m) h xs
m
{-# NOINLINE[0] newDict #-}

-- | Create a 'Struct' full of the specified value.
newRepeat :: forall h m xs. (PrimMonad m, Generate xs)
  => (forall x. h x)
  -> m (Struct (PrimState m) h xs)
newRepeat :: (forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
newRepeat x :: forall (x :: k). h x
x = do
  let !(I# n :: Int#
n) = Proxy xs -> Int
forall k (xs :: [k]) (proxy :: [k] -> *).
Generate xs =>
proxy xs -> Int
hcount (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs)
  (State# (PrimState m)
 -> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), Struct (PrimState m) h xs #))
 -> m (Struct (PrimState m) h xs))
-> (State# (PrimState m)
    -> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case Int#
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall k1 d.
Int# -> k1 -> State# d -> (# State# d, SmallMutableArray# d k1 #)
newSmallArray# Int#
n (h Any -> Any
unsafeCoerce# h Any
forall (x :: k). h x
x) State# (PrimState m)
s of
    (# s' :: State# (PrimState m)
s', a :: SmallMutableArray# (PrimState m) Any
a #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> *) (xs :: [k]).
SmallMutableArray# s Any -> Struct s h xs
Struct SmallMutableArray# (PrimState m) Any
a #)
{-# INLINE newRepeat #-}

-- | Create a new 'Struct' using the supplied initializer with a context.
newFor :: forall proxy c h m xs. (PrimMonad m, Forall c xs)
  => proxy c
  -> (forall x. c x => Membership xs x -> h x)
  -> m (Struct (PrimState m) h xs)
newFor :: proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newFor = Dict (Forall c xs)
-> proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
forall k (proxy :: (k -> Constraint) -> *) (c :: k -> Constraint)
       (h :: k -> *) (m :: * -> *) (xs :: [k]).
PrimMonad m =>
Dict (Forall c xs)
-> proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newForDict Dict (Forall c xs)
forall (a :: Constraint). a => Dict a
Dict
{-# INLINE newFor #-}

newForDict :: forall proxy c h m xs. (PrimMonad m)
  => Dict (Forall c xs)
  -> proxy c
  -> (forall x. c x => Membership xs x -> h x)
  -> m (Struct (PrimState m) h xs)
newForDict :: Dict (Forall c xs)
-> proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newForDict Dict p :: proxy c
p k :: forall (x :: k). c x => Membership xs x -> h x
k = do
  Struct (PrimState m) h xs
m <- (forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
forall k (h :: k -> *) (m :: * -> *) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
newRepeat forall (x :: k). h x
forall a. HasCallStack => a
undefined
  proxy c
-> Proxy xs
-> (forall (x :: k).
    c x =>
    Membership xs x
    -> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs))
-> m (Struct (PrimState m) h xs)
-> m (Struct (PrimState m) h xs)
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> *) (proxy' :: [k] -> *) r.
Forall c xs =>
proxy c
-> proxy' xs
-> (forall (x :: k). c x => Membership xs x -> r -> r)
-> r
-> r
henumerateFor proxy c
p (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs) (\i :: Membership xs x
i cont :: m (Struct (PrimState m) h xs)
cont -> Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct (PrimState m) h xs
m Membership xs x
i (Membership xs x -> h x
forall (x :: k). c x => Membership xs x -> h x
k Membership xs x
i) m ()
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Struct (PrimState m) h xs)
cont) (m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs))
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ Struct (PrimState m) h xs -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a. Monad m => a -> m a
return Struct (PrimState m) h xs
m
{-# NOINLINE[0] newForDict #-}

-- | Create a new 'Struct' from an 'HList'.
newFromHList :: forall h m xs. PrimMonad m => L.HList h xs -> m (Struct (PrimState m) h xs)
newFromHList :: HList h xs -> m (Struct (PrimState m) h xs)
newFromHList l :: HList h xs
l = do
  let !(I# size :: Int#
size) = HList h xs -> Int
forall k (h :: k -> *) (xs :: [k]). HList h xs -> Int
L.hlength HList h xs
l
  Struct (PrimState m) h xs
m <- (State# (PrimState m)
 -> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), Struct (PrimState m) h xs #))
 -> m (Struct (PrimState m) h xs))
-> (State# (PrimState m)
    -> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case Int#
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall k1 d.
Int# -> k1 -> State# d -> (# State# d, SmallMutableArray# d k1 #)
newSmallArray# Int#
size Any
forall a. HasCallStack => a
undefined State# (PrimState m)
s of
    (# s' :: State# (PrimState m)
s', a :: SmallMutableArray# (PrimState m) Any
a #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> *) (xs :: [k]).
SmallMutableArray# s Any -> Struct s h xs
Struct SmallMutableArray# (PrimState m) Any
a #)

  let go :: Int -> L.HList h t -> m ()
      go :: Int -> HList h t -> m ()
go _ L.HNil = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      go i :: Int
i (L.HCons x :: h x
x xs :: HList h xs1
xs) = Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct (PrimState m) h xs
m (Int -> Membership xs x
forall k (xs :: [k]) (x :: k). Int -> Membership xs x
unsafeMembership Int
i) h x
x m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> HList h xs1 -> m ()
forall (t :: [k]). Int -> HList h t -> m ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) HList h xs1
xs

  Int -> HList h xs -> m ()
forall (t :: [k]). Int -> HList h t -> m ()
go 0 HList h xs
l
  Struct (PrimState m) h xs -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a. Monad m => a -> m a
return Struct (PrimState m) h xs
m
{-# NOINLINE newFromHList #-}

-- | The type of extensible products.
--
-- @(:&) :: [k] -> (k -> *) -> *@
--
data (s :: [k]) :& (h :: k -> *) = HProduct (SmallArray# Any)

type h :* xs = xs :& h
{-# DEPRECATED (:*) "Use :& instead" #-}

-- | Turn 'Struct' into an immutable product. The original 'Struct' may not be used.
unsafeFreeze :: PrimMonad m => Struct (PrimState m) h xs -> m (xs :& h)
unsafeFreeze :: Struct (PrimState m) h xs -> m (xs :& h)
unsafeFreeze (Struct m :: SmallMutableArray# (PrimState m) Any
m) = (State# (PrimState m) -> (# State# (PrimState m), xs :& h #))
-> m (xs :& h)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), xs :& h #))
 -> m (xs :& h))
-> (State# (PrimState m) -> (# State# (PrimState m), xs :& h #))
-> m (xs :& h)
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case SmallMutableArray# (PrimState m) Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallArray# Any #)
forall d k1.
SmallMutableArray# d k1
-> State# d -> (# State# d, SmallArray# k1 #)
unsafeFreezeSmallArray# SmallMutableArray# (PrimState m) Any
m State# (PrimState m)
s of
  (# s' :: State# (PrimState m)
s', a :: SmallArray# Any
a #) -> (# State# (PrimState m)
s', SmallArray# Any -> xs :& h
forall k (s :: [k]) (h :: k -> *). SmallArray# Any -> s :& h
HProduct SmallArray# Any
a #)
{-# INLINE unsafeFreeze #-}

-- | Create a new 'Struct' from a product.
thaw :: PrimMonad m => xs :& h -> m (Struct (PrimState m) h xs)
thaw :: (xs :& h) -> m (Struct (PrimState m) h xs)
thaw (HProduct ar :: SmallArray# Any
ar) = (State# (PrimState m)
 -> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), Struct (PrimState m) h xs #))
 -> m (Struct (PrimState m) h xs))
-> (State# (PrimState m)
    -> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case SmallArray# Any
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall k1 d.
SmallArray# k1
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d k1 #)
thawSmallArray# SmallArray# Any
ar 0# (SmallArray# Any -> Int#
forall k1. SmallArray# k1 -> Int#
sizeofSmallArray# SmallArray# Any
ar) State# (PrimState m)
s of
  (# s' :: State# (PrimState m)
s', m :: SmallMutableArray# (PrimState m) Any
m #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> *) (xs :: [k]).
SmallMutableArray# s Any -> Struct s h xs
Struct SmallMutableArray# (PrimState m) Any
m #)

-- | The size of a product.
hlength :: xs :& h -> Int
hlength :: (xs :& h) -> Int
hlength (HProduct ar :: SmallArray# Any
ar) = Int# -> Int
I# (SmallArray# Any -> Int#
forall k1. SmallArray# k1 -> Int#
sizeofSmallArray# SmallArray# Any
ar)
{-# INLINE hlength #-}

-- | Concatenate type level lists
type family (++) (xs :: [k]) (ys :: [k]) :: [k] where
  '[] ++ ys = ys
  (x ': xs) ++ ys = x ': xs ++ ys

infixr 5 ++

-- | Combine products.
happend :: xs :& h -> ys :& h -> (xs ++ ys) :& h
happend :: (xs :& h) -> (ys :& h) -> (xs ++ ys) :& h
happend (HProduct lhs :: SmallArray# Any
lhs) (HProduct rhs :: SmallArray# Any
rhs) = (forall s. ST s ((xs ++ ys) :& h)) -> (xs ++ ys) :& h
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ((xs ++ ys) :& h)) -> (xs ++ ys) :& h)
-> (forall s. ST s ((xs ++ ys) :& h)) -> (xs ++ ys) :& h
forall a b. (a -> b) -> a -> b
$ (State# (PrimState (ST s))
 -> (# State# (PrimState (ST s)), (xs ++ ys) :& h #))
-> ST s ((xs ++ ys) :& h)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState (ST s))
  -> (# State# (PrimState (ST s)), (xs ++ ys) :& h #))
 -> ST s ((xs ++ ys) :& h))
-> (State# (PrimState (ST s))
    -> (# State# (PrimState (ST s)), (xs ++ ys) :& h #))
-> ST s ((xs ++ ys) :& h)
forall a b. (a -> b) -> a -> b
$ \s0 :: State# (PrimState (ST s))
s0 ->
  let lhsSz :: Int#
lhsSz = SmallArray# Any -> Int#
forall k1. SmallArray# k1 -> Int#
sizeofSmallArray# SmallArray# Any
lhs
      rhsSz :: Int#
rhsSz = SmallArray# Any -> Int#
forall k1. SmallArray# k1 -> Int#
sizeofSmallArray# SmallArray# Any
rhs
  in  case Int# -> Any -> State# s -> (# State# s, SmallMutableArray# s Any #)
forall k1 d.
Int# -> k1 -> State# d -> (# State# d, SmallMutableArray# d k1 #)
newSmallArray# (Int#
lhsSz Int# -> Int# -> Int#
+# Int#
rhsSz) Any
forall a. HasCallStack => a
undefined State# s
State# (PrimState (ST s))
s0 of { (# s1 :: State# s
s1, a :: SmallMutableArray# s Any
a #) ->
      case SmallArray# Any
-> Int#
-> SmallMutableArray# s Any
-> Int#
-> Int#
-> State# s
-> State# s
forall k1 d.
SmallArray# k1
-> Int#
-> SmallMutableArray# d k1
-> Int#
-> Int#
-> State# d
-> State# d
copySmallArray# SmallArray# Any
lhs 0# SmallMutableArray# s Any
a 0# Int#
lhsSz State# s
s1 of { s2 :: State# s
s2 ->
      case SmallArray# Any
-> Int#
-> SmallMutableArray# s Any
-> Int#
-> Int#
-> State# s
-> State# s
forall k1 d.
SmallArray# k1
-> Int#
-> SmallMutableArray# d k1
-> Int#
-> Int#
-> State# d
-> State# d
copySmallArray# SmallArray# Any
rhs 0# SmallMutableArray# s Any
a Int#
lhsSz Int#
rhsSz State# s
s2 of { s3 :: State# s
s3 ->
      case SmallMutableArray# s Any
-> State# s -> (# State# s, SmallArray# Any #)
forall d k1.
SmallMutableArray# d k1
-> State# d -> (# State# d, SmallArray# k1 #)
unsafeFreezeSmallArray# SmallMutableArray# s Any
a State# s
s3 of { (# s4 :: State# s
s4, frz :: SmallArray# Any
frz #) ->
      (# State# s
State# (PrimState (ST s))
s4, SmallArray# Any -> (xs ++ ys) :& h
forall k (s :: [k]) (h :: k -> *). SmallArray# Any -> s :& h
HProduct SmallArray# Any
frz #) }}}}

infixr 5 `happend`

unsafeMembership :: Int -> Membership xs x
unsafeMembership :: Int -> Membership xs x
unsafeMembership = Int -> Membership xs x
unsafeCoerce#

-- | Right-associative fold of a product.
hfoldrWithIndex :: (forall x. Membership xs x -> h x -> r -> r) -> r -> xs :& h -> r
hfoldrWithIndex :: (forall (x :: k). Membership xs x -> h x -> r -> r)
-> r -> (xs :& h) -> r
hfoldrWithIndex f :: forall (x :: k). Membership xs x -> h x -> r -> r
f r :: r
r p :: xs :& h
p = (Int -> r -> r) -> r -> [Int] -> r
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
  (\i :: Int
i -> let m :: Membership xs Any
m = Int -> Membership xs Any
forall k (xs :: [k]) (x :: k). Int -> Membership xs x
unsafeMembership Int
i in Membership xs Any -> h Any -> r -> r
forall (x :: k). Membership xs x -> h x -> r -> r
f Membership xs Any
m (Membership xs Any -> (xs :& h) -> h Any
forall k (xs :: [k]) (x :: k) (h :: k -> *).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs Any
m xs :& h
p)) r
r [0..(xs :& h) -> Int
forall k (xs :: [k]) (h :: k -> *). (xs :& h) -> Int
hlength xs :& h
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
{-# INLINE hfoldrWithIndex #-}

-- | Convert a product into an 'HList'.
toHList :: forall h xs. xs :& h -> L.HList h xs
toHList :: (xs :& h) -> HList h xs
toHList p :: xs :& h
p = Int -> HList h xs
go 0 where
  go :: Int -> L.HList h xs
  go :: Int -> HList h xs
go i :: Int
i
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (xs :& h) -> Int
forall k (xs :: [k]) (h :: k -> *). (xs :& h) -> Int
hlength xs :& h
p = HList h '[] -> HList h xs
forall (ys :: [k]) (zs :: [k]). HList h ys -> HList h zs
unknownHList HList h '[]
forall k (h :: k -> *). HList h '[]
L.HNil
    | Bool
otherwise = HList h (Any : xs) -> HList h xs
forall (ys :: [k]) (zs :: [k]). HList h ys -> HList h zs
unknownHList (HList h (Any : xs) -> HList h xs)
-> HList h (Any : xs) -> HList h xs
forall a b. (a -> b) -> a -> b
$ h Any -> HList h xs -> HList h (Any : xs)
forall k (h :: k -> *) (x :: k) (xs1 :: [k]).
h x -> HList h xs1 -> HList h (x : xs1)
L.HCons (Membership xs Any -> (xs :& h) -> h Any
forall k (xs :: [k]) (x :: k) (h :: k -> *).
Membership xs x -> (xs :& h) -> h x
hlookup (Int -> Membership xs Any
forall k (xs :: [k]) (x :: k). Int -> Membership xs x
unsafeMembership Int
i) xs :& h
p) (Int -> HList h xs
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))

  unknownHList :: L.HList h ys -> L.HList h zs
  unknownHList :: HList h ys -> HList h zs
unknownHList = HList h ys -> HList h zs
unsafeCoerce#
{-# NOINLINE toHList #-}

{-# RULES "toHList/fromHList" forall x. toHList (hfrozen (newFromHList x)) = x #-}

-- | Create a new 'Struct' using the contents of a product.
newFrom :: forall g h m xs. (PrimMonad m)
  => xs :& g
  -> (forall x. Membership xs x -> g x -> h x)
  -> m (Struct (PrimState m) h xs)
newFrom :: (xs :& g)
-> (forall (x :: k). Membership xs x -> g x -> h x)
-> m (Struct (PrimState m) h xs)
newFrom hp :: xs :& g
hp@(HProduct ar :: SmallArray# Any
ar) k :: forall (x :: k). Membership xs x -> g x -> h x
k = do
  let !n :: Int#
n = SmallArray# Any -> Int#
forall k1. SmallArray# k1 -> Int#
sizeofSmallArray# SmallArray# Any
ar
  Struct (PrimState m) h xs
st <- (State# (PrimState m)
 -> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), Struct (PrimState m) h xs #))
 -> m (Struct (PrimState m) h xs))
-> (State# (PrimState m)
    -> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case Int#
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall k1 d.
Int# -> k1 -> State# d -> (# State# d, SmallMutableArray# d k1 #)
newSmallArray# Int#
n Any
forall a. HasCallStack => a
undefined State# (PrimState m)
s of
    (# s' :: State# (PrimState m)
s', a :: SmallMutableArray# (PrimState m) Any
a #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> *) (xs :: [k]).
SmallMutableArray# s Any -> Struct s h xs
Struct SmallMutableArray# (PrimState m) Any
a #)
  let go :: Int -> m (Struct (PrimState m) h xs)
go i :: Int
i
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int# -> Int
I# Int#
n = Struct (PrimState m) h xs -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a. Monad m => a -> m a
return Struct (PrimState m) h xs
st
        | Bool
otherwise = do
          let !m :: Membership xs Any
m = Int -> Membership xs Any
forall k (xs :: [k]) (x :: k). Int -> Membership xs x
unsafeMembership Int
i
          Struct (PrimState m) h xs -> Membership xs Any -> h Any -> m ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct (PrimState m) h xs
st Membership xs Any
m (h Any -> m ()) -> h Any -> m ()
forall a b. (a -> b) -> a -> b
$! Membership xs Any -> g Any -> h Any
forall (x :: k). Membership xs x -> g x -> h x
k Membership xs Any
m (Membership xs Any -> (xs :& g) -> g Any
forall k (xs :: [k]) (x :: k) (h :: k -> *).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs Any
m xs :& g
hp)
          Int -> m (Struct (PrimState m) h xs)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
  Int -> m (Struct (PrimState m) h xs)
go 0
{-# NOINLINE newFrom #-}

{-# RULES "newFrom/newFrom" forall p (f :: forall x. Membership xs x -> f x -> g x)
 (g :: forall x. Membership xs x -> g x -> h x)
  . newFrom (hfrozen (newFrom p f)) g = newFrom p (\i x -> g i (f i x)) #-}

{-# RULES "newFrom/newDict" forall d (f :: forall x. Membership xs x -> g x)
 (g :: forall x. Membership xs x -> g x -> h x)
  . newFrom (hfrozen (newDict d f)) g = newDict d (\i -> g i (f i)) #-}

{-# RULES "newFrom/newForDict" forall d p (f :: forall x. Membership xs x -> g x)
 (g :: forall x. Membership xs x -> g x -> h x)
  . newFrom (hfrozen (newForDict d p f)) g = newForDict d p (\i -> g i (f i)) #-}

-- | Get an element in a product.
hlookup :: Membership xs x -> xs :& h -> h x
hlookup :: Membership xs x -> (xs :& h) -> h x
hlookup (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# i :: Int#
i) (HProduct ar :: SmallArray# Any
ar) = case SmallArray# Any -> Int# -> (# Any #)
forall k1. SmallArray# k1 -> Int# -> (# k1 #)
indexSmallArray# SmallArray# Any
ar Int#
i of
  (# a :: Any
a #) -> Any -> h x
unsafeCoerce# Any
a
{-# INLINE hlookup #-}

-- | Create a product from an 'ST' action which returns a 'Struct'.
hfrozen :: (forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen :: (forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen m :: forall s. ST s (Struct s h xs)
m = (forall s. ST s (xs :& h)) -> xs :& h
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (xs :& h)) -> xs :& h)
-> (forall s. ST s (xs :& h)) -> xs :& h
forall a b. (a -> b) -> a -> b
$ ST s (Struct s h xs)
forall s. ST s (Struct s h xs)
m ST s (Struct s h xs)
-> (Struct s h xs -> ST s (xs :& h)) -> ST s (xs :& h)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Struct s h xs -> ST s (xs :& h)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]).
PrimMonad m =>
Struct (PrimState m) h xs -> m (xs :& h)
unsafeFreeze
{-# INLINE[0] hfrozen #-}

-- | Turn a product into a 'Struct' temporarily.
hmodify :: (forall s. Struct s h xs -> ST s ()) -> xs :& h -> xs :& h
hmodify :: (forall s. Struct s h xs -> ST s ()) -> (xs :& h) -> xs :& h
hmodify f :: forall s. Struct s h xs -> ST s ()
f m :: xs :& h
m = (forall s. ST s (xs :& h)) -> xs :& h
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (xs :& h)) -> xs :& h)
-> (forall s. ST s (xs :& h)) -> xs :& h
forall a b. (a -> b) -> a -> b
$ do
  Struct s h xs
s <- (xs :& h) -> ST s (Struct (PrimState (ST s)) h xs)
forall k (m :: * -> *) (xs :: [k]) (h :: k -> *).
PrimMonad m =>
(xs :& h) -> m (Struct (PrimState m) h xs)
thaw xs :& h
m
  Struct s h xs -> ST s ()
forall s. Struct s h xs -> ST s ()
f Struct s h xs
s
  Struct (PrimState (ST s)) h xs -> ST s (xs :& h)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]).
PrimMonad m =>
Struct (PrimState m) h xs -> m (xs :& h)
unsafeFreeze Struct s h xs
Struct (PrimState (ST s)) h xs
s
{-# INLINE[0] hmodify #-}

{-# RULES "hmodify/batch" forall
  (a :: forall s. Struct s h xs -> ST s ())
  (b :: forall s. Struct s h xs -> ST s ())
  (x :: xs :& h). hmodify b (hmodify a x) = hmodify (\s -> a s >> b s) x  #-}

instance (Corepresentable p, Comonad (Corep p), Functor f) => Extensible f p (:&) where
  -- | A lens for a value in a known position.
  pieceAt :: Membership xs x -> Optic' p f (xs :& h) (h x)
pieceAt i :: Membership xs x
i pafb :: p (h x) (f (h x))
pafb = (Corep p (xs :& h) -> f (xs :& h)) -> p (xs :& h) (f (xs :& h))
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p (xs :& h) -> f (xs :& h)) -> p (xs :& h) (f (xs :& h)))
-> (Corep p (xs :& h) -> f (xs :& h)) -> p (xs :& h) (f (xs :& h))
forall a b. (a -> b) -> a -> b
$ \ws :: Corep p (xs :& h)
ws -> (xs :& h) -> h x -> xs :& h
sbt (Corep p (xs :& h) -> xs :& h
forall (w :: * -> *) a. Comonad w => w a -> a
extract Corep p (xs :& h)
ws) (h x -> xs :& h) -> f (h x) -> f (xs :& h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p (h x) (f (h x)) -> Corep p (h x) -> f (h x)
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p (h x) (f (h x))
pafb (Membership xs x -> (xs :& h) -> h x
forall k (xs :: [k]) (x :: k) (h :: k -> *).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs x
i ((xs :& h) -> h x) -> Corep p (xs :& h) -> Corep p (h x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Corep p (xs :& h)
ws) where
    sbt :: (xs :& h) -> h x -> xs :& h
sbt xs :: xs :& h
xs !h x
x = (forall s. Struct s h xs -> ST s ()) -> (xs :& h) -> xs :& h
forall k (h :: k -> *) (xs :: [k]).
(forall s. Struct s h xs -> ST s ()) -> (xs :& h) -> xs :& h
hmodify (\s :: Struct s h xs
s -> Struct (PrimState (ST s)) h xs -> Membership xs x -> h x -> ST s ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct s h xs
Struct (PrimState (ST s)) h xs
s Membership xs x
i h x
x) xs :& h
xs
  {-# INLINE pieceAt #-}