{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE DeriveFoldable        #-}
{-# LANGUAGE DeriveTraversable     #-}
{-# LANGUAGE EmptyCase             #-}
{-# LANGUAGE EmptyDataDeriving     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeInType            #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_GHC -fno-warn-orphans  #-}

-- |
-- Module      : Data.Mutable.Instances
-- Copyright   : (c) Justin Le 2020
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Exports 'Ref' data types for various common data types, and also the
-- tools for automatic derivation of instances.  See "Data.Mutable" for
-- more information.
module Data.Mutable.Instances (
    RecRef(..)
  , HListRef(..)
  , UnitRef(..)
  , VoidRef
  -- * Generic
  , GRef(..)
  , gThawRef, gFreezeRef
  , gCopyRef, gMoveRef, gCloneRef
  , gUnsafeThawRef, gUnsafeFreezeRef
  , GMutable (GRef_)
  -- * Higher-Kinded Data Pattern
  , thawHKD, freezeHKD
  , copyHKD, moveHKD, cloneHKD
  , unsafeThawHKD, unsafeFreezeHKD
  -- * Coercible
  , CoerceRef(..)
  , thawCoerce, freezeCoerce
  , copyCoerce, moveCoerce, cloneCoerce
  , unsafeThawCoerce, unsafeFreezeCoerce
  -- * Traversable
  , TraverseRef(..)
  , thawTraverse, freezeTraverse
  , copyTraverse, moveTraverse, cloneTraverse
  , unsafeThawTraverse, unsafeFreezeTraverse
  -- * Immutable
  , ImmutableRef(..), thawImmutable, freezeImmutable, copyImmutable
  -- * Instances for Generics combinators themselves
  , GMutableRef(..)
  , MutSumF(..)
  -- * Utility
  , MapRef
  ) where

import           Control.Applicative
import           Data.Complex
import           Data.Functor.Compose
import           Data.Functor.Identity
import           Data.Functor.Product
import           Data.Functor.Sum
import           Data.Generics.Product.Internal.HList      (HList(..))
import           Data.Kind
import           Data.Mutable.Internal
import           Data.Mutable.Internal.TH
import           Data.Ord
import           Data.Primitive.Array
import           Data.Primitive.ByteArray
import           Data.Primitive.PrimArray
import           Data.Primitive.SmallArray
import           Data.Primitive.Types
import           Data.Ratio
import           Data.Vinyl                    as V hiding (HList)
import           Data.Void
import           Data.Word
import           Foreign.C.Types
import           Foreign.Storable
import           Numeric.Natural
import qualified Data.Monoid                               as M
import qualified Data.Vector                               as V
import qualified Data.Vector.Generic                       as VG
import qualified Data.Vector.Generic.Mutable               as MVG
import qualified Data.Vector.Mutable                       as MV
import qualified Data.Vector.Primitive                     as VP
import qualified Data.Vector.Primitive.Mutable             as MVP
import qualified Data.Vector.Storable                      as VS
import qualified Data.Vector.Storable.Mutable              as MVS
import qualified Data.Vector.Unboxed                       as VU
import qualified Data.Vector.Unboxed.Mutable               as MVU
import qualified Data.Vinyl.ARec                           as V
import qualified Data.Vinyl.Functor                        as V
import qualified Data.Vinyl.TypeLevel                      as V

instance Mutable s Int
instance Mutable s Integer
instance Mutable s Natural
instance Mutable s (Ratio a)
instance Mutable s Float
instance Mutable s Double
instance Mutable s (Complex a)
instance Mutable s Bool
instance Mutable s Char

instance Mutable s Word
instance Mutable s Word8
instance Mutable s Word16
instance Mutable s Word64

instance Mutable s CChar
instance Mutable s CSChar
instance Mutable s CUChar
instance Mutable s CShort
instance Mutable s CUShort
instance Mutable s CInt
instance Mutable s CUInt
instance Mutable s CLong
instance Mutable s CULong
instance Mutable s CPtrdiff
instance Mutable s CSize
instance Mutable s CWchar
instance Mutable s CSigAtomic
instance Mutable s CLLong
instance Mutable s CULLong
instance Mutable s CBool
instance Mutable s CIntPtr
instance Mutable s CUIntPtr
instance Mutable s CIntMax
instance Mutable s CUIntMax
instance Mutable s CClock
instance Mutable s CTime
instance Mutable s CUSeconds
instance Mutable s CSUSeconds
instance Mutable s CFloat
instance Mutable s CDouble

instance Mutable s a => Mutable s (Identity a) where
    type Ref s (Identity a) = CoerceRef s (Identity a) a

instance Mutable s a => Mutable s (Const a b) where
    type Ref s (Const a b) = CoerceRef s (Const a b) a

instance Mutable s a => Mutable s (V.Const a b) where
    type Ref s (V.Const a b) = CoerceRef s (V.Const a b) a

instance Mutable s a => Mutable s (M.Product a) where
    type Ref s (M.Product a) = CoerceRef s (M.Product a) a

instance Mutable s a => Mutable s (M.Sum a) where
    type Ref s (M.Sum a) = CoerceRef s (M.Sum a) a

instance Mutable s a => Mutable s (Down a) where
    type Ref s (Down a) = CoerceRef s (Down a) a

instance Mutable s a => Mutable s (M.Dual a) where
    type Ref s (M.Dual a) = CoerceRef s (M.Dual a) a

instance Mutable s a => Mutable s (Maybe a) where
    type Ref s (Maybe a) = GRef s (Maybe a)

instance (Mutable s a, Mutable s b) => Mutable s (Either a b) where
    type Ref s (Either a b) = GRef s (Either a b)

instance (Mutable s (f a), Mutable s (g a)) => Mutable s (Product f g a) where
    type Ref s (Product f g a) = GRef s (Product f g a)

instance (Mutable s (f a), Mutable s (g a)) => Mutable s (Sum f g a) where
    type Ref s (Sum f g a) = GRef s (Sum f g a)

instance (Mutable s (f (g a))) => Mutable s (Compose f g a) where
    type Ref s (Compose f g a) = CoerceRef s (Compose f g a) (f (g a))

-- | Mutable linked list with mutable references in each cell.  See
-- 'Data.Mutable.MutBranch' documentation for an example of using this as
-- a mutable linked list.l
instance Mutable s a => Mutable s [a] where
    type Ref s [a] = GRef s [a]

-- | Meant for usage with higher-kinded data pattern (See 'X.HKD')
instance Mutable s a => Mutable s (V.Identity a) where
    type Ref s (V.Identity a) = RefFor s a
    thawRef :: Identity a -> m (Ref s (Identity a))
thawRef (V.Identity x :: a
x) = Ref s a -> RefFor s a
forall s a. Ref s a -> RefFor s a
RefFor (Ref s a -> RefFor s a) -> m (Ref s a) -> m (RefFor s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Ref s a)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
thawRef a
x
    freezeRef :: Ref s (Identity a) -> m (Identity a)
freezeRef (RefFor r) = a -> Identity a
forall a. a -> Identity a
V.Identity (a -> Identity a) -> m a -> m (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref s a -> m a
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
freezeRef Ref s a
r
    copyRef :: Ref s (Identity a) -> Identity a -> m ()
copyRef (RefFor r) (V.Identity x :: a
x) = Ref s a -> a -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> a -> m ()
copyRef Ref s a
r a
x
    moveRef :: Ref s (Identity a) -> Ref s (Identity a) -> m ()
moveRef (RefFor r) (RefFor v) = Ref s a -> Ref s a -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> Ref s a -> m ()
moveRef Ref s a
r Ref s a
v
    cloneRef :: Ref s (Identity a) -> m (Ref s (Identity a))
cloneRef = (Ref s a -> RefFor s a) -> m (Ref s a) -> m (RefFor s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ref s a -> RefFor s a
forall s a. Ref s a -> RefFor s a
RefFor (m (Ref s a) -> m (RefFor s a))
-> (RefFor s a -> m (Ref s a)) -> RefFor s a -> m (RefFor s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref s a -> m (Ref s a)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m (Ref s a)
cloneRef (Ref s a -> m (Ref s a))
-> (RefFor s a -> Ref s a) -> RefFor s a -> m (Ref s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefFor s a -> Ref s a
forall s a. RefFor s a -> Ref s a
getRefFor
    unsafeThawRef :: Identity a -> m (Ref s (Identity a))
unsafeThawRef (V.Identity x :: a
x) = Ref s a -> RefFor s a
forall s a. Ref s a -> RefFor s a
RefFor (Ref s a -> RefFor s a) -> m (Ref s a) -> m (RefFor s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Ref s a)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
unsafeThawRef a
x
    unsafeFreezeRef :: Ref s (Identity a) -> m (Identity a)
unsafeFreezeRef (RefFor r) = a -> Identity a
forall a. a -> Identity a
V.Identity (a -> Identity a) -> m a -> m (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref s a -> m a
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
unsafeFreezeRef Ref s a
r

-- | Mutable reference is 'MV.MVector'.
instance Mutable s (V.Vector a) where
    type Ref s (V.Vector a) = MV.MVector s a
    thawRef :: Vector a -> m (Ref s (Vector a))
thawRef         = Vector a -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw
    freezeRef :: Ref s (Vector a) -> m (Vector a)
freezeRef       = Ref s (Vector a) -> m (Vector a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze
    copyRef :: Ref s (Vector a) -> Vector a -> m ()
copyRef         = Ref s (Vector a) -> Vector a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> v a -> m ()
VG.copy
    moveRef :: Ref s (Vector a) -> Ref s (Vector a) -> m ()
moveRef         = Ref s (Vector a) -> Ref s (Vector a) -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MVG.move
    cloneRef :: Ref s (Vector a) -> m (Ref s (Vector a))
cloneRef        = Ref s (Vector a) -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> m (v (PrimState m) a)
MVG.clone
    unsafeThawRef :: Vector a -> m (Ref s (Vector a))
unsafeThawRef   = Vector a -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.unsafeThaw
    unsafeFreezeRef :: Ref s (Vector a) -> m (Vector a)
unsafeFreezeRef = Ref s (Vector a) -> m (Vector a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze

-- | Mutable reference is 'MVS.MVector'.
instance Storable a => Mutable s (VS.Vector a) where
    type Ref s (VS.Vector a) = MVS.MVector s a
    thawRef :: Vector a -> m (Ref s (Vector a))
thawRef         = Vector a -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw
    freezeRef :: Ref s (Vector a) -> m (Vector a)
freezeRef       = Ref s (Vector a) -> m (Vector a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze
    copyRef :: Ref s (Vector a) -> Vector a -> m ()
copyRef         = Ref s (Vector a) -> Vector a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> v a -> m ()
VG.copy
    moveRef :: Ref s (Vector a) -> Ref s (Vector a) -> m ()
moveRef         = Ref s (Vector a) -> Ref s (Vector a) -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MVG.move
    cloneRef :: Ref s (Vector a) -> m (Ref s (Vector a))
cloneRef        = Ref s (Vector a) -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> m (v (PrimState m) a)
MVG.clone
    unsafeThawRef :: Vector a -> m (Ref s (Vector a))
unsafeThawRef   = Vector a -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.unsafeThaw
    unsafeFreezeRef :: Ref s (Vector a) -> m (Vector a)
unsafeFreezeRef = Ref s (Vector a) -> m (Vector a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze

-- | Mutable reference is 'MVU.MVector'.
instance VU.Unbox a => Mutable s (VU.Vector a) where
    type Ref s (VU.Vector a) = MVU.MVector s a
    thawRef :: Vector a -> m (Ref s (Vector a))
thawRef         = Vector a -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw
    freezeRef :: Ref s (Vector a) -> m (Vector a)
freezeRef       = Ref s (Vector a) -> m (Vector a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze
    copyRef :: Ref s (Vector a) -> Vector a -> m ()
copyRef         = Ref s (Vector a) -> Vector a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> v a -> m ()
VG.copy
    moveRef :: Ref s (Vector a) -> Ref s (Vector a) -> m ()
moveRef         = Ref s (Vector a) -> Ref s (Vector a) -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MVG.move
    cloneRef :: Ref s (Vector a) -> m (Ref s (Vector a))
cloneRef        = Ref s (Vector a) -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> m (v (PrimState m) a)
MVG.clone
    unsafeThawRef :: Vector a -> m (Ref s (Vector a))
unsafeThawRef   = Vector a -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.unsafeThaw
    unsafeFreezeRef :: Ref s (Vector a) -> m (Vector a)
unsafeFreezeRef = Ref s (Vector a) -> m (Vector a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze

-- | Mutable reference is 'MVP.MVector'.
instance Prim a => Mutable s (VP.Vector a) where
    type Ref s (VP.Vector a) = MVP.MVector s a
    thawRef :: Vector a -> m (Ref s (Vector a))
thawRef         = Vector a -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw
    freezeRef :: Ref s (Vector a) -> m (Vector a)
freezeRef       = Ref s (Vector a) -> m (Vector a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze
    copyRef :: Ref s (Vector a) -> Vector a -> m ()
copyRef         = Ref s (Vector a) -> Vector a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> v a -> m ()
VG.copy
    moveRef :: Ref s (Vector a) -> Ref s (Vector a) -> m ()
moveRef         = Ref s (Vector a) -> Ref s (Vector a) -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MVG.move
    cloneRef :: Ref s (Vector a) -> m (Ref s (Vector a))
cloneRef        = Ref s (Vector a) -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> m (v (PrimState m) a)
MVG.clone
    unsafeThawRef :: Vector a -> m (Ref s (Vector a))
unsafeThawRef   = Vector a -> m (Ref s (Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.unsafeThaw
    unsafeFreezeRef :: Ref s (Vector a) -> m (Vector a)
unsafeFreezeRef = Ref s (Vector a) -> m (Vector a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze

instance Mutable s (Array a) where
    type Ref s (Array a) = MutableArray s a

    thawRef :: Array a -> m (Ref s (Array a))
thawRef xs :: Array a
xs = Array a -> Int -> Int -> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
Array a -> Int -> Int -> m (MutableArray (PrimState m) a)
thawArray Array a
xs 0 (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
xs)
    freezeRef :: Ref s (Array a) -> m (Array a)
freezeRef rs :: Ref s (Array a)
rs = MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray MutableArray (PrimState m) a
Ref s (Array a)
rs 0 (MutableArray s a -> Int
forall s a. MutableArray s a -> Int
sizeofMutableArray MutableArray s a
Ref s (Array a)
rs)
    copyRef :: Ref s (Array a) -> Array a -> m ()
copyRef rs :: Ref s (Array a)
rs xs :: Array a
xs = MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray (PrimState m) a
Ref s (Array a)
rs 0 Array a
xs 0 Int
l
      where
        l :: Int
l = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
xs Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` MutableArray s a -> Int
forall s a. MutableArray s a -> Int
sizeofMutableArray MutableArray s a
Ref s (Array a)
rs
    moveRef :: Ref s (Array a) -> Ref s (Array a) -> m ()
moveRef rs :: Ref s (Array a)
rs vs :: Ref s (Array a)
vs = MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray MutableArray (PrimState m) a
Ref s (Array a)
rs 0 MutableArray (PrimState m) a
Ref s (Array a)
vs 0 Int
l
      where
        l :: Int
l = MutableArray s a -> Int
forall s a. MutableArray s a -> Int
sizeofMutableArray MutableArray s a
Ref s (Array a)
vs Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` MutableArray s a -> Int
forall s a. MutableArray s a -> Int
sizeofMutableArray MutableArray s a
Ref s (Array a)
rs
    cloneRef :: Ref s (Array a) -> m (Ref s (Array a))
cloneRef rs :: Ref s (Array a)
rs = MutableArray (PrimState m) a
-> Int -> Int -> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Int -> m (MutableArray (PrimState m) a)
cloneMutableArray MutableArray (PrimState m) a
Ref s (Array a)
rs 0 (MutableArray s a -> Int
forall s a. MutableArray s a -> Int
sizeofMutableArray MutableArray s a
Ref s (Array a)
rs)
    unsafeThawRef :: Array a -> m (Ref s (Array a))
unsafeThawRef   = Array a -> m (Ref s (Array a))
forall (m :: * -> *) a.
PrimMonad m =>
Array a -> m (MutableArray (PrimState m) a)
unsafeThawArray
    unsafeFreezeRef :: Ref s (Array a) -> m (Array a)
unsafeFreezeRef = Ref s (Array a) -> m (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray

instance Mutable s (SmallArray a) where
    type Ref s (SmallArray a) = SmallMutableArray s a

    thawRef :: SmallArray a -> m (Ref s (SmallArray a))
thawRef xs :: SmallArray a
xs = SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
thawSmallArray SmallArray a
xs 0 (SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
xs)
    freezeRef :: Ref s (SmallArray a) -> m (SmallArray a)
freezeRef rs :: Ref s (SmallArray a)
rs = SmallMutableArray (PrimState m) a -> Int -> Int -> m (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> Int -> m (SmallArray a)
freezeSmallArray SmallMutableArray (PrimState m) a
Ref s (SmallArray a)
rs 0 (SmallMutableArray s a -> Int
forall s a. SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray s a
Ref s (SmallArray a)
rs)
    copyRef :: Ref s (SmallArray a) -> SmallArray a -> m ()
copyRef rs :: Ref s (SmallArray a)
rs xs :: SmallArray a
xs = SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray (PrimState m) a
Ref s (SmallArray a)
rs 0 SmallArray a
xs 0 Int
l
      where
        l :: Int
l = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
xs Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` SmallMutableArray s a -> Int
forall s a. SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray s a
Ref s (SmallArray a)
rs
    moveRef :: Ref s (SmallArray a) -> Ref s (SmallArray a) -> m ()
moveRef rs :: Ref s (SmallArray a)
rs vs :: Ref s (SmallArray a)
vs = SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray SmallMutableArray (PrimState m) a
Ref s (SmallArray a)
rs 0 SmallMutableArray (PrimState m) a
Ref s (SmallArray a)
vs 0 Int
l
      where
        l :: Int
l = SmallMutableArray s a -> Int
forall s a. SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray s a
Ref s (SmallArray a)
vs Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` SmallMutableArray s a -> Int
forall s a. SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray s a
Ref s (SmallArray a)
rs
    cloneRef :: Ref s (SmallArray a) -> m (Ref s (SmallArray a))
cloneRef rs :: Ref s (SmallArray a)
rs = SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray SmallMutableArray (PrimState m) a
Ref s (SmallArray a)
rs 0 (SmallMutableArray s a -> Int
forall s a. SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray s a
Ref s (SmallArray a)
rs)
    unsafeThawRef :: SmallArray a -> m (Ref s (SmallArray a))
unsafeThawRef   = SmallArray a -> m (Ref s (SmallArray a))
forall (m :: * -> *) a.
PrimMonad m =>
SmallArray a -> m (SmallMutableArray (PrimState m) a)
unsafeThawSmallArray
    unsafeFreezeRef :: Ref s (SmallArray a) -> m (SmallArray a)
unsafeFreezeRef = Ref s (SmallArray a) -> m (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray

instance Mutable s ByteArray where
    type Ref s ByteArray = MutableByteArray s

    thawRef :: ByteArray -> m (Ref s ByteArray)
thawRef xs :: ByteArray
xs = do
        MutableByteArray s
rs <- Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (ByteArray -> Int
sizeofByteArray ByteArray
xs)
        MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray MutableByteArray s
MutableByteArray (PrimState m)
rs 0 ByteArray
xs 0 (ByteArray -> Int
sizeofByteArray ByteArray
xs)
        MutableByteArray s -> m (MutableByteArray s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableByteArray s
rs
    freezeRef :: Ref s ByteArray -> m ByteArray
freezeRef rs :: Ref s ByteArray
rs = do
        MutableByteArray s
xs <- Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (MutableByteArray s -> Int
forall s. MutableByteArray s -> Int
sizeofMutableByteArray MutableByteArray s
Ref s ByteArray
rs)
        MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray s
MutableByteArray (PrimState m)
xs 0 MutableByteArray (PrimState m)
Ref s ByteArray
rs 0 (MutableByteArray s -> Int
forall s. MutableByteArray s -> Int
sizeofMutableByteArray MutableByteArray s
Ref s ByteArray
rs)
        MutableByteArray (PrimState m) -> m ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState m)
xs
    copyRef :: Ref s ByteArray -> ByteArray -> m ()
copyRef rs :: Ref s ByteArray
rs xs :: ByteArray
xs = MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray MutableByteArray (PrimState m)
Ref s ByteArray
rs 0 ByteArray
xs 0 Int
l
      where
        l :: Int
l = ByteArray -> Int
sizeofByteArray ByteArray
xs Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` MutableByteArray s -> Int
forall s. MutableByteArray s -> Int
sizeofMutableByteArray MutableByteArray s
Ref s ByteArray
rs
    moveRef :: Ref s ByteArray -> Ref s ByteArray -> m ()
moveRef rs :: Ref s ByteArray
rs vs :: Ref s ByteArray
vs = MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray (PrimState m)
Ref s ByteArray
rs 0 MutableByteArray (PrimState m)
Ref s ByteArray
vs 0 Int
l
      where
        l :: Int
l = MutableByteArray s -> Int
forall s. MutableByteArray s -> Int
sizeofMutableByteArray MutableByteArray s
Ref s ByteArray
vs Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` MutableByteArray s -> Int
forall s. MutableByteArray s -> Int
sizeofMutableByteArray MutableByteArray s
Ref s ByteArray
rs
    cloneRef :: Ref s ByteArray -> m (Ref s ByteArray)
cloneRef rs :: Ref s ByteArray
rs = do
        MutableByteArray s
vs <- Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (MutableByteArray s -> Int
forall s. MutableByteArray s -> Int
sizeofMutableByteArray MutableByteArray s
Ref s ByteArray
rs)
        MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray s
MutableByteArray (PrimState m)
vs 0 MutableByteArray (PrimState m)
Ref s ByteArray
rs 0 (MutableByteArray s -> Int
forall s. MutableByteArray s -> Int
sizeofMutableByteArray MutableByteArray s
Ref s ByteArray
rs)
        MutableByteArray s -> m (MutableByteArray s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableByteArray s
vs
    unsafeThawRef :: ByteArray -> m (Ref s ByteArray)
unsafeThawRef   = ByteArray -> m (Ref s ByteArray)
forall (m :: * -> *).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
unsafeThawByteArray
    unsafeFreezeRef :: Ref s ByteArray -> m ByteArray
unsafeFreezeRef = Ref s ByteArray -> m ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray

instance Prim a => Mutable s (PrimArray a) where
    type Ref s (PrimArray a) = MutablePrimArray s a

    thawRef :: PrimArray a -> m (Ref s (PrimArray a))
thawRef xs :: PrimArray a
xs = do
        MutablePrimArray s a
rs <- Int -> m (MutablePrimArray (PrimState m) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
xs)
        MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s a
MutablePrimArray (PrimState m) a
rs 0 PrimArray a
xs 0 (PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
xs)
        MutablePrimArray s a -> m (MutablePrimArray s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutablePrimArray s a
rs
    freezeRef :: Ref s (PrimArray a) -> m (PrimArray a)
freezeRef rs :: Ref s (PrimArray a)
rs = do
        MutablePrimArray s a
xs <- Int -> m (MutablePrimArray (PrimState m) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (MutablePrimArray s a -> Int
forall s a. Prim a => MutablePrimArray s a -> Int
sizeofMutablePrimArray MutablePrimArray s a
Ref s (PrimArray a)
rs)
        MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray s a
MutablePrimArray (PrimState m) a
xs 0 MutablePrimArray (PrimState m) a
Ref s (PrimArray a)
rs 0 (MutablePrimArray s a -> Int
forall s a. Prim a => MutablePrimArray s a -> Int
sizeofMutablePrimArray MutablePrimArray s a
Ref s (PrimArray a)
rs)
        MutablePrimArray (PrimState m) a -> m (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
MutablePrimArray (PrimState m) a
xs
    copyRef :: Ref s (PrimArray a) -> PrimArray a -> m ()
copyRef rs :: Ref s (PrimArray a)
rs xs :: PrimArray a
xs = MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray (PrimState m) a
Ref s (PrimArray a)
rs 0 PrimArray a
xs 0 Int
l
      where
        l :: Int
l = PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
xs Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` MutablePrimArray s a -> Int
forall s a. Prim a => MutablePrimArray s a -> Int
sizeofMutablePrimArray MutablePrimArray s a
Ref s (PrimArray a)
rs
    moveRef :: Ref s (PrimArray a) -> Ref s (PrimArray a) -> m ()
moveRef rs :: Ref s (PrimArray a)
rs vs :: Ref s (PrimArray a)
vs = MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray (PrimState m) a
Ref s (PrimArray a)
rs 0 MutablePrimArray (PrimState m) a
Ref s (PrimArray a)
vs 0 Int
l
      where
        l :: Int
l = MutablePrimArray s a -> Int
forall s a. Prim a => MutablePrimArray s a -> Int
sizeofMutablePrimArray MutablePrimArray s a
Ref s (PrimArray a)
vs Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` MutablePrimArray s a -> Int
forall s a. Prim a => MutablePrimArray s a -> Int
sizeofMutablePrimArray MutablePrimArray s a
Ref s (PrimArray a)
rs
    cloneRef :: Ref s (PrimArray a) -> m (Ref s (PrimArray a))
cloneRef rs :: Ref s (PrimArray a)
rs = do
        MutablePrimArray s a
vs <- Int -> m (MutablePrimArray (PrimState m) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (MutablePrimArray s a -> Int
forall s a. Prim a => MutablePrimArray s a -> Int
sizeofMutablePrimArray MutablePrimArray s a
Ref s (PrimArray a)
rs)
        MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray s a
MutablePrimArray (PrimState m) a
vs 0 MutablePrimArray (PrimState m) a
Ref s (PrimArray a)
rs 0 (MutablePrimArray s a -> Int
forall s a. Prim a => MutablePrimArray s a -> Int
sizeofMutablePrimArray MutablePrimArray s a
Ref s (PrimArray a)
rs)
        MutablePrimArray s a -> m (MutablePrimArray s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutablePrimArray s a
vs
    unsafeThawRef :: PrimArray a -> m (Ref s (PrimArray a))
unsafeThawRef   = PrimArray a -> m (Ref s (PrimArray a))
forall (m :: * -> *) a.
PrimMonad m =>
PrimArray a -> m (MutablePrimArray (PrimState m) a)
unsafeThawPrimArray
    unsafeFreezeRef :: Ref s (PrimArray a) -> m (PrimArray a)
unsafeFreezeRef = Ref s (PrimArray a) -> m (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray

-- | The 'Ref' for 'Void'.
--
-- @since 0.2.0.0
data VoidRef s
  deriving (Int -> VoidRef s -> ShowS
[VoidRef s] -> ShowS
VoidRef s -> String
(Int -> VoidRef s -> ShowS)
-> (VoidRef s -> String)
-> ([VoidRef s] -> ShowS)
-> Show (VoidRef s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (s :: k). Int -> VoidRef s -> ShowS
forall k (s :: k). [VoidRef s] -> ShowS
forall k (s :: k). VoidRef s -> String
showList :: [VoidRef s] -> ShowS
$cshowList :: forall k (s :: k). [VoidRef s] -> ShowS
show :: VoidRef s -> String
$cshow :: forall k (s :: k). VoidRef s -> String
showsPrec :: Int -> VoidRef s -> ShowS
$cshowsPrec :: forall k (s :: k). Int -> VoidRef s -> ShowS
Show, ReadPrec [VoidRef s]
ReadPrec (VoidRef s)
Int -> ReadS (VoidRef s)
ReadS [VoidRef s]
(Int -> ReadS (VoidRef s))
-> ReadS [VoidRef s]
-> ReadPrec (VoidRef s)
-> ReadPrec [VoidRef s]
-> Read (VoidRef s)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k (s :: k). ReadPrec [VoidRef s]
forall k (s :: k). ReadPrec (VoidRef s)
forall k (s :: k). Int -> ReadS (VoidRef s)
forall k (s :: k). ReadS [VoidRef s]
readListPrec :: ReadPrec [VoidRef s]
$creadListPrec :: forall k (s :: k). ReadPrec [VoidRef s]
readPrec :: ReadPrec (VoidRef s)
$creadPrec :: forall k (s :: k). ReadPrec (VoidRef s)
readList :: ReadS [VoidRef s]
$creadList :: forall k (s :: k). ReadS [VoidRef s]
readsPrec :: Int -> ReadS (VoidRef s)
$creadsPrec :: forall k (s :: k). Int -> ReadS (VoidRef s)
Read, VoidRef s -> VoidRef s -> Bool
(VoidRef s -> VoidRef s -> Bool)
-> (VoidRef s -> VoidRef s -> Bool) -> Eq (VoidRef s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (s :: k). VoidRef s -> VoidRef s -> Bool
/= :: VoidRef s -> VoidRef s -> Bool
$c/= :: forall k (s :: k). VoidRef s -> VoidRef s -> Bool
== :: VoidRef s -> VoidRef s -> Bool
$c== :: forall k (s :: k). VoidRef s -> VoidRef s -> Bool
Eq, Eq (VoidRef s)
Eq (VoidRef s) =>
(VoidRef s -> VoidRef s -> Ordering)
-> (VoidRef s -> VoidRef s -> Bool)
-> (VoidRef s -> VoidRef s -> Bool)
-> (VoidRef s -> VoidRef s -> Bool)
-> (VoidRef s -> VoidRef s -> Bool)
-> (VoidRef s -> VoidRef s -> VoidRef s)
-> (VoidRef s -> VoidRef s -> VoidRef s)
-> Ord (VoidRef s)
VoidRef s -> VoidRef s -> Bool
VoidRef s -> VoidRef s -> Ordering
VoidRef s -> VoidRef s -> VoidRef s
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (s :: k). Eq (VoidRef s)
forall k (s :: k). VoidRef s -> VoidRef s -> Bool
forall k (s :: k). VoidRef s -> VoidRef s -> Ordering
forall k (s :: k). VoidRef s -> VoidRef s -> VoidRef s
min :: VoidRef s -> VoidRef s -> VoidRef s
$cmin :: forall k (s :: k). VoidRef s -> VoidRef s -> VoidRef s
max :: VoidRef s -> VoidRef s -> VoidRef s
$cmax :: forall k (s :: k). VoidRef s -> VoidRef s -> VoidRef s
>= :: VoidRef s -> VoidRef s -> Bool
$c>= :: forall k (s :: k). VoidRef s -> VoidRef s -> Bool
> :: VoidRef s -> VoidRef s -> Bool
$c> :: forall k (s :: k). VoidRef s -> VoidRef s -> Bool
<= :: VoidRef s -> VoidRef s -> Bool
$c<= :: forall k (s :: k). VoidRef s -> VoidRef s -> Bool
< :: VoidRef s -> VoidRef s -> Bool
$c< :: forall k (s :: k). VoidRef s -> VoidRef s -> Bool
compare :: VoidRef s -> VoidRef s -> Ordering
$ccompare :: forall k (s :: k). VoidRef s -> VoidRef s -> Ordering
$cp1Ord :: forall k (s :: k). Eq (VoidRef s)
Ord, (a -> b) -> VoidRef a -> VoidRef b
(forall a b. (a -> b) -> VoidRef a -> VoidRef b)
-> (forall a b. a -> VoidRef b -> VoidRef a) -> Functor VoidRef
forall a b. a -> VoidRef b -> VoidRef a
forall a b. (a -> b) -> VoidRef a -> VoidRef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> VoidRef b -> VoidRef a
$c<$ :: forall a b. a -> VoidRef b -> VoidRef a
fmap :: (a -> b) -> VoidRef a -> VoidRef b
$cfmap :: forall a b. (a -> b) -> VoidRef a -> VoidRef b
Functor, Functor VoidRef
Foldable VoidRef
(Functor VoidRef, Foldable VoidRef) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> VoidRef a -> f (VoidRef b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    VoidRef (f a) -> f (VoidRef a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> VoidRef a -> m (VoidRef b))
-> (forall (m :: * -> *) a.
    Monad m =>
    VoidRef (m a) -> m (VoidRef a))
-> Traversable VoidRef
(a -> f b) -> VoidRef a -> f (VoidRef b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => VoidRef (m a) -> m (VoidRef a)
forall (f :: * -> *) a.
Applicative f =>
VoidRef (f a) -> f (VoidRef a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> VoidRef a -> m (VoidRef b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> VoidRef a -> f (VoidRef b)
sequence :: VoidRef (m a) -> m (VoidRef a)
$csequence :: forall (m :: * -> *) a. Monad m => VoidRef (m a) -> m (VoidRef a)
mapM :: (a -> m b) -> VoidRef a -> m (VoidRef b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> VoidRef a -> m (VoidRef b)
sequenceA :: VoidRef (f a) -> f (VoidRef a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
VoidRef (f a) -> f (VoidRef a)
traverse :: (a -> f b) -> VoidRef a -> f (VoidRef b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> VoidRef a -> f (VoidRef b)
$cp2Traversable :: Foldable VoidRef
$cp1Traversable :: Functor VoidRef
Traversable, (a -> m) -> VoidRef a -> m
(forall m. Monoid m => VoidRef m -> m)
-> (forall m a. Monoid m => (a -> m) -> VoidRef a -> m)
-> (forall m a. Monoid m => (a -> m) -> VoidRef a -> m)
-> (forall a b. (a -> b -> b) -> b -> VoidRef a -> b)
-> (forall a b. (a -> b -> b) -> b -> VoidRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> VoidRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> VoidRef a -> b)
-> (forall a. (a -> a -> a) -> VoidRef a -> a)
-> (forall a. (a -> a -> a) -> VoidRef a -> a)
-> (forall a. VoidRef a -> [a])
-> (forall a. VoidRef a -> Bool)
-> (forall a. VoidRef a -> Int)
-> (forall a. Eq a => a -> VoidRef a -> Bool)
-> (forall a. Ord a => VoidRef a -> a)
-> (forall a. Ord a => VoidRef a -> a)
-> (forall a. Num a => VoidRef a -> a)
-> (forall a. Num a => VoidRef a -> a)
-> Foldable VoidRef
forall a. Eq a => a -> VoidRef a -> Bool
forall a. Num a => VoidRef a -> a
forall a. Ord a => VoidRef a -> a
forall m. Monoid m => VoidRef m -> m
forall a. VoidRef a -> Bool
forall a. VoidRef a -> Int
forall a. VoidRef a -> [a]
forall a. (a -> a -> a) -> VoidRef a -> a
forall m a. Monoid m => (a -> m) -> VoidRef a -> m
forall b a. (b -> a -> b) -> b -> VoidRef a -> b
forall a b. (a -> b -> b) -> b -> VoidRef a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: VoidRef a -> a
$cproduct :: forall a. Num a => VoidRef a -> a
sum :: VoidRef a -> a
$csum :: forall a. Num a => VoidRef a -> a
minimum :: VoidRef a -> a
$cminimum :: forall a. Ord a => VoidRef a -> a
maximum :: VoidRef a -> a
$cmaximum :: forall a. Ord a => VoidRef a -> a
elem :: a -> VoidRef a -> Bool
$celem :: forall a. Eq a => a -> VoidRef a -> Bool
length :: VoidRef a -> Int
$clength :: forall a. VoidRef a -> Int
null :: VoidRef a -> Bool
$cnull :: forall a. VoidRef a -> Bool
toList :: VoidRef a -> [a]
$ctoList :: forall a. VoidRef a -> [a]
foldl1 :: (a -> a -> a) -> VoidRef a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> VoidRef a -> a
foldr1 :: (a -> a -> a) -> VoidRef a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> VoidRef a -> a
foldl' :: (b -> a -> b) -> b -> VoidRef a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> VoidRef a -> b
foldl :: (b -> a -> b) -> b -> VoidRef a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> VoidRef a -> b
foldr' :: (a -> b -> b) -> b -> VoidRef a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> VoidRef a -> b
foldr :: (a -> b -> b) -> b -> VoidRef a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> VoidRef a -> b
foldMap' :: (a -> m) -> VoidRef a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> VoidRef a -> m
foldMap :: (a -> m) -> VoidRef a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> VoidRef a -> m
fold :: VoidRef m -> m
$cfold :: forall m. Monoid m => VoidRef m -> m
Foldable)

instance Mutable s Void where
    type Ref s Void = VoidRef s
    thawRef :: Void -> m (Ref s Void)
thawRef         = \case {}
    freezeRef :: Ref s Void -> m Void
freezeRef       = \case {}
    copyRef :: Ref s Void -> Void -> m ()
copyRef         = \case {}
    moveRef :: Ref s Void -> Ref s Void -> m ()
moveRef         = \case {}
    cloneRef :: Ref s Void -> m (Ref s Void)
cloneRef        = \case {}
    unsafeThawRef :: Void -> m (Ref s Void)
unsafeThawRef   = \case {}
    unsafeFreezeRef :: Ref s Void -> m Void
unsafeFreezeRef = \case {}

-- | The 'Ref' for @()@ (unit).  This breaks the pattern for tuple
-- instances (@type 'Ref' s (a, b) = ('Ref' s a, 'Ref' s b)@), but is
-- necessary for type inference (see documentation for 'Ref').
--
-- @since 0.2.0.0
data UnitRef s = UnitRef
  deriving (Int -> UnitRef s -> ShowS
[UnitRef s] -> ShowS
UnitRef s -> String
(Int -> UnitRef s -> ShowS)
-> (UnitRef s -> String)
-> ([UnitRef s] -> ShowS)
-> Show (UnitRef s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (s :: k). Int -> UnitRef s -> ShowS
forall k (s :: k). [UnitRef s] -> ShowS
forall k (s :: k). UnitRef s -> String
showList :: [UnitRef s] -> ShowS
$cshowList :: forall k (s :: k). [UnitRef s] -> ShowS
show :: UnitRef s -> String
$cshow :: forall k (s :: k). UnitRef s -> String
showsPrec :: Int -> UnitRef s -> ShowS
$cshowsPrec :: forall k (s :: k). Int -> UnitRef s -> ShowS
Show, ReadPrec [UnitRef s]
ReadPrec (UnitRef s)
Int -> ReadS (UnitRef s)
ReadS [UnitRef s]
(Int -> ReadS (UnitRef s))
-> ReadS [UnitRef s]
-> ReadPrec (UnitRef s)
-> ReadPrec [UnitRef s]
-> Read (UnitRef s)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k (s :: k). ReadPrec [UnitRef s]
forall k (s :: k). ReadPrec (UnitRef s)
forall k (s :: k). Int -> ReadS (UnitRef s)
forall k (s :: k). ReadS [UnitRef s]
readListPrec :: ReadPrec [UnitRef s]
$creadListPrec :: forall k (s :: k). ReadPrec [UnitRef s]
readPrec :: ReadPrec (UnitRef s)
$creadPrec :: forall k (s :: k). ReadPrec (UnitRef s)
readList :: ReadS [UnitRef s]
$creadList :: forall k (s :: k). ReadS [UnitRef s]
readsPrec :: Int -> ReadS (UnitRef s)
$creadsPrec :: forall k (s :: k). Int -> ReadS (UnitRef s)
Read, UnitRef s -> UnitRef s -> Bool
(UnitRef s -> UnitRef s -> Bool)
-> (UnitRef s -> UnitRef s -> Bool) -> Eq (UnitRef s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (s :: k). UnitRef s -> UnitRef s -> Bool
/= :: UnitRef s -> UnitRef s -> Bool
$c/= :: forall k (s :: k). UnitRef s -> UnitRef s -> Bool
== :: UnitRef s -> UnitRef s -> Bool
$c== :: forall k (s :: k). UnitRef s -> UnitRef s -> Bool
Eq, Eq (UnitRef s)
Eq (UnitRef s) =>
(UnitRef s -> UnitRef s -> Ordering)
-> (UnitRef s -> UnitRef s -> Bool)
-> (UnitRef s -> UnitRef s -> Bool)
-> (UnitRef s -> UnitRef s -> Bool)
-> (UnitRef s -> UnitRef s -> Bool)
-> (UnitRef s -> UnitRef s -> UnitRef s)
-> (UnitRef s -> UnitRef s -> UnitRef s)
-> Ord (UnitRef s)
UnitRef s -> UnitRef s -> Bool
UnitRef s -> UnitRef s -> Ordering
UnitRef s -> UnitRef s -> UnitRef s
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (s :: k). Eq (UnitRef s)
forall k (s :: k). UnitRef s -> UnitRef s -> Bool
forall k (s :: k). UnitRef s -> UnitRef s -> Ordering
forall k (s :: k). UnitRef s -> UnitRef s -> UnitRef s
min :: UnitRef s -> UnitRef s -> UnitRef s
$cmin :: forall k (s :: k). UnitRef s -> UnitRef s -> UnitRef s
max :: UnitRef s -> UnitRef s -> UnitRef s
$cmax :: forall k (s :: k). UnitRef s -> UnitRef s -> UnitRef s
>= :: UnitRef s -> UnitRef s -> Bool
$c>= :: forall k (s :: k). UnitRef s -> UnitRef s -> Bool
> :: UnitRef s -> UnitRef s -> Bool
$c> :: forall k (s :: k). UnitRef s -> UnitRef s -> Bool
<= :: UnitRef s -> UnitRef s -> Bool
$c<= :: forall k (s :: k). UnitRef s -> UnitRef s -> Bool
< :: UnitRef s -> UnitRef s -> Bool
$c< :: forall k (s :: k). UnitRef s -> UnitRef s -> Bool
compare :: UnitRef s -> UnitRef s -> Ordering
$ccompare :: forall k (s :: k). UnitRef s -> UnitRef s -> Ordering
$cp1Ord :: forall k (s :: k). Eq (UnitRef s)
Ord, (a -> b) -> UnitRef a -> UnitRef b
(forall a b. (a -> b) -> UnitRef a -> UnitRef b)
-> (forall a b. a -> UnitRef b -> UnitRef a) -> Functor UnitRef
forall a b. a -> UnitRef b -> UnitRef a
forall a b. (a -> b) -> UnitRef a -> UnitRef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> UnitRef b -> UnitRef a
$c<$ :: forall a b. a -> UnitRef b -> UnitRef a
fmap :: (a -> b) -> UnitRef a -> UnitRef b
$cfmap :: forall a b. (a -> b) -> UnitRef a -> UnitRef b
Functor, Functor UnitRef
Foldable UnitRef
(Functor UnitRef, Foldable UnitRef) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> UnitRef a -> f (UnitRef b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    UnitRef (f a) -> f (UnitRef a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> UnitRef a -> m (UnitRef b))
-> (forall (m :: * -> *) a.
    Monad m =>
    UnitRef (m a) -> m (UnitRef a))
-> Traversable UnitRef
(a -> f b) -> UnitRef a -> f (UnitRef b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => UnitRef (m a) -> m (UnitRef a)
forall (f :: * -> *) a.
Applicative f =>
UnitRef (f a) -> f (UnitRef a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnitRef a -> m (UnitRef b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnitRef a -> f (UnitRef b)
sequence :: UnitRef (m a) -> m (UnitRef a)
$csequence :: forall (m :: * -> *) a. Monad m => UnitRef (m a) -> m (UnitRef a)
mapM :: (a -> m b) -> UnitRef a -> m (UnitRef b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnitRef a -> m (UnitRef b)
sequenceA :: UnitRef (f a) -> f (UnitRef a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
UnitRef (f a) -> f (UnitRef a)
traverse :: (a -> f b) -> UnitRef a -> f (UnitRef b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnitRef a -> f (UnitRef b)
$cp2Traversable :: Foldable UnitRef
$cp1Traversable :: Functor UnitRef
Traversable, (a -> m) -> UnitRef a -> m
(forall m. Monoid m => UnitRef m -> m)
-> (forall m a. Monoid m => (a -> m) -> UnitRef a -> m)
-> (forall m a. Monoid m => (a -> m) -> UnitRef a -> m)
-> (forall a b. (a -> b -> b) -> b -> UnitRef a -> b)
-> (forall a b. (a -> b -> b) -> b -> UnitRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> UnitRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> UnitRef a -> b)
-> (forall a. (a -> a -> a) -> UnitRef a -> a)
-> (forall a. (a -> a -> a) -> UnitRef a -> a)
-> (forall a. UnitRef a -> [a])
-> (forall a. UnitRef a -> Bool)
-> (forall a. UnitRef a -> Int)
-> (forall a. Eq a => a -> UnitRef a -> Bool)
-> (forall a. Ord a => UnitRef a -> a)
-> (forall a. Ord a => UnitRef a -> a)
-> (forall a. Num a => UnitRef a -> a)
-> (forall a. Num a => UnitRef a -> a)
-> Foldable UnitRef
forall a. Eq a => a -> UnitRef a -> Bool
forall a. Num a => UnitRef a -> a
forall a. Ord a => UnitRef a -> a
forall m. Monoid m => UnitRef m -> m
forall a. UnitRef a -> Bool
forall a. UnitRef a -> Int
forall a. UnitRef a -> [a]
forall a. (a -> a -> a) -> UnitRef a -> a
forall m a. Monoid m => (a -> m) -> UnitRef a -> m
forall b a. (b -> a -> b) -> b -> UnitRef a -> b
forall a b. (a -> b -> b) -> b -> UnitRef a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: UnitRef a -> a
$cproduct :: forall a. Num a => UnitRef a -> a
sum :: UnitRef a -> a
$csum :: forall a. Num a => UnitRef a -> a
minimum :: UnitRef a -> a
$cminimum :: forall a. Ord a => UnitRef a -> a
maximum :: UnitRef a -> a
$cmaximum :: forall a. Ord a => UnitRef a -> a
elem :: a -> UnitRef a -> Bool
$celem :: forall a. Eq a => a -> UnitRef a -> Bool
length :: UnitRef a -> Int
$clength :: forall a. UnitRef a -> Int
null :: UnitRef a -> Bool
$cnull :: forall a. UnitRef a -> Bool
toList :: UnitRef a -> [a]
$ctoList :: forall a. UnitRef a -> [a]
foldl1 :: (a -> a -> a) -> UnitRef a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> UnitRef a -> a
foldr1 :: (a -> a -> a) -> UnitRef a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> UnitRef a -> a
foldl' :: (b -> a -> b) -> b -> UnitRef a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> UnitRef a -> b
foldl :: (b -> a -> b) -> b -> UnitRef a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> UnitRef a -> b
foldr' :: (a -> b -> b) -> b -> UnitRef a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> UnitRef a -> b
foldr :: (a -> b -> b) -> b -> UnitRef a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> UnitRef a -> b
foldMap' :: (a -> m) -> UnitRef a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> UnitRef a -> m
foldMap :: (a -> m) -> UnitRef a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> UnitRef a -> m
fold :: UnitRef m -> m
$cfold :: forall m. Monoid m => UnitRef m -> m
Foldable)

instance Applicative UnitRef where
    pure :: a -> UnitRef a
pure _  = UnitRef a
forall k (s :: k). UnitRef s
UnitRef
    _ <*> :: UnitRef (a -> b) -> UnitRef a -> UnitRef b
<*> _ = UnitRef b
forall k (s :: k). UnitRef s
UnitRef

instance Monad UnitRef where
    return :: a -> UnitRef a
return   = a -> UnitRef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    _ >>= :: UnitRef a -> (a -> UnitRef b) -> UnitRef b
>>= _ = UnitRef b
forall k (s :: k). UnitRef s
UnitRef

instance Mutable s () where
    type Ref s () = UnitRef s
    thawRef :: () -> m (Ref s ())
thawRef   _       = UnitRef s -> m (UnitRef s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitRef s
forall k (s :: k). UnitRef s
UnitRef
    freezeRef :: Ref s () -> m ()
freezeRef _       = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    copyRef :: Ref s () -> () -> m ()
copyRef _ _       = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    moveRef :: Ref s () -> Ref s () -> m ()
moveRef _ _       = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    cloneRef :: Ref s () -> m (Ref s ())
cloneRef _        = UnitRef s -> m (UnitRef s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitRef s
forall k (s :: k). UnitRef s
UnitRef
    unsafeThawRef :: () -> m (Ref s ())
unsafeThawRef _   = UnitRef s -> m (UnitRef s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitRef s
forall k (s :: k). UnitRef s
UnitRef
    unsafeFreezeRef :: Ref s () -> m ()
unsafeFreezeRef _ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | A 'Ref' of a tuple is a tuple of 'Ref's, for easy accessing.
--
-- @
-- Ref s (Int, 'V.Vector' Double) = ('Data.Primitive.MutVar.MutVar' s Int, 'MV.MVector' s Double)
-- @
instance (Mutable s a, Mutable s b) => Mutable s (a, b) where
    type Ref s (a, b) = (Ref s a, Ref s b)
    thawRef :: (a, b) -> m (Ref s (a, b))
thawRef   (!a
x, !b
y) = (,) (Ref s a -> Ref s b -> (Ref s a, Ref s b))
-> m (Ref s a) -> m (Ref s b -> (Ref s a, Ref s b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Ref s a)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
thawRef a
x   m (Ref s b -> (Ref s a, Ref s b))
-> m (Ref s b) -> m (Ref s a, Ref s b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> m (Ref s b)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
thawRef b
y
    freezeRef :: Ref s (a, b) -> m (a, b)
freezeRef (u , v ) = (,) (a -> b -> (a, b)) -> m a -> m (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref s a -> m a
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
freezeRef Ref s a
u m (b -> (a, b)) -> m b -> m (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ref s b -> m b
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
freezeRef Ref s b
v
    copyRef :: Ref s (a, b) -> (a, b) -> m ()
copyRef   (u , v ) (!a
x, !b
y) = Ref s a -> a -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> a -> m ()
copyRef Ref s a
u a
x m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ref s b -> b -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> a -> m ()
copyRef Ref s b
v b
y
    moveRef :: Ref s (a, b) -> Ref s (a, b) -> m ()
moveRef   (u , v ) ( x,  y) = Ref s a -> Ref s a -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> Ref s a -> m ()
moveRef Ref s a
u Ref s a
x m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ref s b -> Ref s b -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> Ref s a -> m ()
moveRef Ref s b
v Ref s b
y
    cloneRef :: Ref s (a, b) -> m (Ref s (a, b))
cloneRef  (u , v ) = (,) (Ref s a -> Ref s b -> (Ref s a, Ref s b))
-> m (Ref s a) -> m (Ref s b -> (Ref s a, Ref s b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref s a -> m (Ref s a)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m (Ref s a)
cloneRef Ref s a
u   m (Ref s b -> (Ref s a, Ref s b))
-> m (Ref s b) -> m (Ref s a, Ref s b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ref s b -> m (Ref s b)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m (Ref s a)
cloneRef Ref s b
v
    unsafeThawRef :: (a, b) -> m (Ref s (a, b))
unsafeThawRef   (!a
x, !b
y) = (,) (Ref s a -> Ref s b -> (Ref s a, Ref s b))
-> m (Ref s a) -> m (Ref s b -> (Ref s a, Ref s b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Ref s a)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
unsafeThawRef a
x   m (Ref s b -> (Ref s a, Ref s b))
-> m (Ref s b) -> m (Ref s a, Ref s b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> m (Ref s b)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
unsafeThawRef b
y
    unsafeFreezeRef :: Ref s (a, b) -> m (a, b)
unsafeFreezeRef (u , v ) = (,) (a -> b -> (a, b)) -> m a -> m (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref s a -> m a
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
unsafeFreezeRef Ref s a
u m (b -> (a, b)) -> m b -> m (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ref s b -> m b
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
unsafeFreezeRef Ref s b
v

mutableTuples [3..12]

-- | 'Ref' for components in a vinyl 'Rec'.
newtype RecRef s f a = RecRef { RecRef s f a -> Ref s (f a)
getRecRef :: Ref s (f a) }

deriving instance Eq (Ref s (f a)) => Eq (RecRef s f a)
deriving instance Ord (Ref s (f a)) => Ord (RecRef s f a)

instance Mutable s (Rec f '[]) where
    type Ref s (Rec f '[]) = Rec (RecRef s f) '[]
    thawRef :: Rec f '[] -> m (Ref s (Rec f '[]))
thawRef   _       = Rec (RecRef s f) '[] -> m (Rec (RecRef s f) '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec (RecRef s f) '[]
forall u (a :: u -> *). Rec a '[]
RNil
    freezeRef :: Ref s (Rec f '[]) -> m (Rec f '[])
freezeRef _       = Rec f '[] -> m (Rec f '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec f '[]
forall u (a :: u -> *). Rec a '[]
RNil
    copyRef :: Ref s (Rec f '[]) -> Rec f '[] -> m ()
copyRef _ _       = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    moveRef :: Ref s (Rec f '[]) -> Ref s (Rec f '[]) -> m ()
moveRef _ _       = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    cloneRef :: Ref s (Rec f '[]) -> m (Ref s (Rec f '[]))
cloneRef _        = Rec (RecRef s f) '[] -> m (Rec (RecRef s f) '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec (RecRef s f) '[]
forall u (a :: u -> *). Rec a '[]
RNil
    unsafeThawRef :: Rec f '[] -> m (Ref s (Rec f '[]))
unsafeThawRef _   = Rec (RecRef s f) '[] -> m (Rec (RecRef s f) '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec (RecRef s f) '[]
forall u (a :: u -> *). Rec a '[]
RNil
    unsafeFreezeRef :: Ref s (Rec f '[]) -> m (Rec f '[])
unsafeFreezeRef _ = Rec f '[] -> m (Rec f '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec f '[]
forall u (a :: u -> *). Rec a '[]
RNil

instance ( Mutable s (f a)
         , Mutable s (Rec f as)
         , Ref s (Rec f as) ~ Rec (RecRef s f) as
         ) => Mutable s (Rec f (a ': as)) where
    type Ref s (Rec f (a ': as)) = Rec (RecRef s f) (a ': as)
    thawRef :: Rec f (a : as) -> m (Ref s (Rec f (a : as)))
thawRef   = \case
      x :: f r
x :& xs :: Rec f rs
xs -> RecRef s f a -> Rec (RecRef s f) as -> Rec (RecRef s f) (a : as)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
(:&) (RecRef s f a -> Rec (RecRef s f) as -> Rec (RecRef s f) (a : as))
-> m (RecRef s f a)
-> m (Rec (RecRef s f) as -> Rec (RecRef s f) (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ref s (f a) -> RecRef s f a
forall k s (f :: k -> *) (a :: k). Ref s (f a) -> RecRef s f a
RecRef (Ref s (f a) -> RecRef s f a)
-> m (Ref s (f a)) -> m (RecRef s f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f r -> m (Ref s (f r))
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
thawRef f r
x) m (Rec (RecRef s f) as -> Rec (RecRef s f) (a : as))
-> m (Rec (RecRef s f) as) -> m (Rec (RecRef s f) (a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Rec f rs -> m (Ref s (Rec f rs))
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
thawRef Rec f rs
xs
    freezeRef :: Ref s (Rec f (a : as)) -> m (Rec f (a : as))
freezeRef = \case
      RecRef v :& vs -> f a -> Rec f as -> Rec f (a : as)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
(:&) (f a -> Rec f as -> Rec f (a : as))
-> m (f a) -> m (Rec f as -> Rec f (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref s (f a) -> m (f a)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
freezeRef Ref s (f a)
Ref s (f r)
v m (Rec f as -> Rec f (a : as))
-> m (Rec f as) -> m (Rec f (a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ref s (Rec f as) -> m (Rec f as)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
freezeRef Rec (RecRef s f) rs
Ref s (Rec f as)
vs
    copyRef :: Ref s (Rec f (a : as)) -> Rec f (a : as) -> m ()
copyRef = \case
      RecRef v :& vs -> \case
        x :: f r
x :& xs :: Rec f rs
xs -> Ref s (f r) -> f r -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> a -> m ()
copyRef Ref s (f r)
Ref s (f r)
v f r
x m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ref s (Rec f rs) -> Rec f rs -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> a -> m ()
copyRef Rec (RecRef s f) rs
Ref s (Rec f rs)
vs Rec f rs
xs
    moveRef :: Ref s (Rec f (a : as)) -> Ref s (Rec f (a : as)) -> m ()
moveRef = \case
      RecRef v :& vs -> \case
        RecRef r :& rs ->
          Ref s (f a) -> Ref s (f a) -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> Ref s a -> m ()
moveRef Ref s (f a)
Ref s (f r)
v Ref s (f a)
Ref s (f r)
r m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ref s (Rec f as) -> Ref s (Rec f as) -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> Ref s a -> m ()
moveRef Rec (RecRef s f) rs
Ref s (Rec f as)
vs Rec (RecRef s f) rs
Ref s (Rec f as)
rs
    cloneRef :: Ref s (Rec f (a : as)) -> m (Ref s (Rec f (a : as)))
cloneRef = \case
      RecRef v :& rs -> RecRef s f a -> Rec (RecRef s f) as -> Rec (RecRef s f) (a : as)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
(:&) (RecRef s f a -> Rec (RecRef s f) as -> Rec (RecRef s f) (a : as))
-> m (RecRef s f a)
-> m (Rec (RecRef s f) as -> Rec (RecRef s f) (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ref s (f a) -> RecRef s f a
forall k s (f :: k -> *) (a :: k). Ref s (f a) -> RecRef s f a
RecRef (Ref s (f a) -> RecRef s f a)
-> m (Ref s (f a)) -> m (RecRef s f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref s (f a) -> m (Ref s (f a))
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m (Ref s a)
cloneRef Ref s (f a)
Ref s (f r)
v) m (Rec (RecRef s f) as -> Rec (RecRef s f) (a : as))
-> m (Rec (RecRef s f) as) -> m (Rec (RecRef s f) (a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ref s (Rec f as) -> m (Ref s (Rec f as))
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m (Ref s a)
cloneRef Rec (RecRef s f) rs
Ref s (Rec f as)
rs
    unsafeThawRef :: Rec f (a : as) -> m (Ref s (Rec f (a : as)))
unsafeThawRef   = \case
      x :: f r
x :& xs :: Rec f rs
xs -> RecRef s f a -> Rec (RecRef s f) as -> Rec (RecRef s f) (a : as)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
(:&) (RecRef s f a -> Rec (RecRef s f) as -> Rec (RecRef s f) (a : as))
-> m (RecRef s f a)
-> m (Rec (RecRef s f) as -> Rec (RecRef s f) (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ref s (f a) -> RecRef s f a
forall k s (f :: k -> *) (a :: k). Ref s (f a) -> RecRef s f a
RecRef (Ref s (f a) -> RecRef s f a)
-> m (Ref s (f a)) -> m (RecRef s f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f r -> m (Ref s (f r))
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
unsafeThawRef f r
x) m (Rec (RecRef s f) as -> Rec (RecRef s f) (a : as))
-> m (Rec (RecRef s f) as) -> m (Rec (RecRef s f) (a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Rec f rs -> m (Ref s (Rec f rs))
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
unsafeThawRef Rec f rs
xs
    unsafeFreezeRef :: Ref s (Rec f (a : as)) -> m (Rec f (a : as))
unsafeFreezeRef = \case
      RecRef v :& vs -> f a -> Rec f as -> Rec f (a : as)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
(:&) (f a -> Rec f as -> Rec f (a : as))
-> m (f a) -> m (Rec f as -> Rec f (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref s (f a) -> m (f a)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
unsafeFreezeRef Ref s (f a)
Ref s (f r)
v m (Rec f as -> Rec f (a : as))
-> m (Rec f as) -> m (Rec f (a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ref s (Rec f as) -> m (Rec f as)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
unsafeFreezeRef Rec (RecRef s f) rs
Ref s (Rec f as)
vs


instance ( RecApplicative as
         , V.NatToInt (V.RLength as)
         , RPureConstrained (V.IndexableField as) as
         , Mutable s (Rec f as)
         , Ref s (Rec f as) ~ Rec (RecRef s f) as
         ) => Mutable s (ARec f as) where
    type Ref s (ARec f as) = ARec (RecRef s f) as

    thawRef :: ARec f as -> m (Ref s (ARec f as))
thawRef         = (Rec (RecRef s f) as -> ARec (RecRef s f) as)
-> m (Rec (RecRef s f) as) -> m (ARec (RecRef s f) as)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rec (RecRef s f) as -> ARec (RecRef s f) as
forall k (f :: k -> *) (ts :: [k]).
NatToInt (RLength ts) =>
Rec f ts -> ARec f ts
toARec (m (Rec (RecRef s f) as) -> m (ARec (RecRef s f) as))
-> (ARec f as -> m (Rec (RecRef s f) as))
-> ARec f as
-> m (ARec (RecRef s f) as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec f as -> m (Rec (RecRef s f) as)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
thawRef   (Rec f as -> m (Rec (RecRef s f) as))
-> (ARec f as -> Rec f as) -> ARec f as -> m (Rec (RecRef s f) as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ARec f as -> Rec f as
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec
    freezeRef :: Ref s (ARec f as) -> m (ARec f as)
freezeRef       = (Rec f as -> ARec f as) -> m (Rec f as) -> m (ARec f as)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rec f as -> ARec f as
forall k (f :: k -> *) (ts :: [k]).
NatToInt (RLength ts) =>
Rec f ts -> ARec f ts
toARec (m (Rec f as) -> m (ARec f as))
-> (ARec (RecRef s f) as -> m (Rec f as))
-> ARec (RecRef s f) as
-> m (ARec f as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (RecRef s f) as -> m (Rec f as)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
freezeRef (Rec (RecRef s f) as -> m (Rec f as))
-> (ARec (RecRef s f) as -> Rec (RecRef s f) as)
-> ARec (RecRef s f) as
-> m (Rec f as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ARec (RecRef s f) as -> Rec (RecRef s f) as
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec
    copyRef :: Ref s (ARec f as) -> ARec f as -> m ()
copyRef r :: Ref s (ARec f as)
r x :: ARec f as
x     = Ref s (Rec f as) -> Rec f as -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> a -> m ()
copyRef (ARec (RecRef s f) as -> Rec (RecRef s f) as
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec ARec (RecRef s f) as
Ref s (ARec f as)
r) (ARec f as -> Rec f as
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec ARec f as
x)
    moveRef :: Ref s (ARec f as) -> Ref s (ARec f as) -> m ()
moveRef r :: Ref s (ARec f as)
r v :: Ref s (ARec f as)
v     = Ref s (Rec f as) -> Ref s (Rec f as) -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> Ref s a -> m ()
moveRef (ARec (RecRef s f) as -> Rec (RecRef s f) as
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec ARec (RecRef s f) as
Ref s (ARec f as)
r) (ARec (RecRef s f) as -> Rec (RecRef s f) as
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec ARec (RecRef s f) as
Ref s (ARec f as)
v)
    cloneRef :: Ref s (ARec f as) -> m (Ref s (ARec f as))
cloneRef        = (Rec (RecRef s f) as -> ARec (RecRef s f) as)
-> m (Rec (RecRef s f) as) -> m (ARec (RecRef s f) as)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rec (RecRef s f) as -> ARec (RecRef s f) as
forall k (f :: k -> *) (ts :: [k]).
NatToInt (RLength ts) =>
Rec f ts -> ARec f ts
toARec (m (Rec (RecRef s f) as) -> m (ARec (RecRef s f) as))
-> (ARec (RecRef s f) as -> m (Rec (RecRef s f) as))
-> ARec (RecRef s f) as
-> m (ARec (RecRef s f) as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (RecRef s f) as -> m (Rec (RecRef s f) as)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m (Ref s a)
cloneRef (Rec (RecRef s f) as -> m (Rec (RecRef s f) as))
-> (ARec (RecRef s f) as -> Rec (RecRef s f) as)
-> ARec (RecRef s f) as
-> m (Rec (RecRef s f) as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ARec (RecRef s f) as -> Rec (RecRef s f) as
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec
    unsafeThawRef :: ARec f as -> m (Ref s (ARec f as))
unsafeThawRef   = (Rec (RecRef s f) as -> ARec (RecRef s f) as)
-> m (Rec (RecRef s f) as) -> m (ARec (RecRef s f) as)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rec (RecRef s f) as -> ARec (RecRef s f) as
forall k (f :: k -> *) (ts :: [k]).
NatToInt (RLength ts) =>
Rec f ts -> ARec f ts
toARec (m (Rec (RecRef s f) as) -> m (ARec (RecRef s f) as))
-> (ARec f as -> m (Rec (RecRef s f) as))
-> ARec f as
-> m (ARec (RecRef s f) as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec f as -> m (Rec (RecRef s f) as)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
unsafeThawRef   (Rec f as -> m (Rec (RecRef s f) as))
-> (ARec f as -> Rec f as) -> ARec f as -> m (Rec (RecRef s f) as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ARec f as -> Rec f as
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec
    unsafeFreezeRef :: Ref s (ARec f as) -> m (ARec f as)
unsafeFreezeRef = (Rec f as -> ARec f as) -> m (Rec f as) -> m (ARec f as)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rec f as -> ARec f as
forall k (f :: k -> *) (ts :: [k]).
NatToInt (RLength ts) =>
Rec f ts -> ARec f ts
toARec (m (Rec f as) -> m (ARec f as))
-> (ARec (RecRef s f) as -> m (Rec f as))
-> ARec (RecRef s f) as
-> m (ARec f as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (RecRef s f) as -> m (Rec f as)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
unsafeFreezeRef (Rec (RecRef s f) as -> m (Rec f as))
-> (ARec (RecRef s f) as -> Rec (RecRef s f) as)
-> ARec (RecRef s f) as
-> m (Rec f as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ARec (RecRef s f) as -> Rec (RecRef s f) as
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec

-- | The mutable reference of the 'HList' type from generic-lens.
data HListRef :: Type -> [Type] -> Type where
    NilRef :: HListRef s '[]
    (:!>)  :: Ref s a -> HListRef s as -> HListRef s (a ': as)
infixr 5 :!>

instance Mutable s (HList '[]) where
    type Ref s (HList '[]) = HListRef s '[]
    thawRef :: HList '[] -> m (Ref s (HList '[]))
thawRef   _       = HListRef s '[] -> m (HListRef s '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure HListRef s '[]
forall s. HListRef s '[]
NilRef
    freezeRef :: Ref s (HList '[]) -> m (HList '[])
freezeRef _       = HList '[] -> m (HList '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure HList '[]
Nil
    copyRef :: Ref s (HList '[]) -> HList '[] -> m ()
copyRef _ _       = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    moveRef :: Ref s (HList '[]) -> Ref s (HList '[]) -> m ()
moveRef _ _       = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    cloneRef :: Ref s (HList '[]) -> m (Ref s (HList '[]))
cloneRef _        = HListRef s '[] -> m (HListRef s '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure HListRef s '[]
forall s. HListRef s '[]
NilRef
    unsafeThawRef :: HList '[] -> m (Ref s (HList '[]))
unsafeThawRef _   = HListRef s '[] -> m (HListRef s '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure HListRef s '[]
forall s. HListRef s '[]
NilRef
    unsafeFreezeRef :: Ref s (HList '[]) -> m (HList '[])
unsafeFreezeRef _ = HList '[] -> m (HList '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure HList '[]
Nil

instance (Mutable s a, Mutable s (HList as), Ref s (HList as) ~ HListRef s as) => Mutable s (HList (a ': as)) where
    type Ref s (HList (a ': as)) = HListRef s (a ': as)
    thawRef :: HList (a : as) -> m (Ref s (HList (a : as)))
thawRef   = \case
      x :: a
x :> xs :: HList as1
xs -> Ref s a -> HListRef s as -> HListRef s (a : as)
forall s a (as :: [*]).
Ref s a -> HListRef s as -> HListRef s (a : as)
(:!>) (Ref s a -> HListRef s as -> HListRef s (a : as))
-> m (Ref s a) -> m (HListRef s as -> HListRef s (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Ref s a)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
thawRef a
x m (HListRef s as -> HListRef s (a : as))
-> m (HListRef s as) -> m (HListRef s (a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HList as1 -> m (Ref s (HList as1))
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
thawRef HList as1
xs
    freezeRef :: Ref s (HList (a : as)) -> m (HList (a : as))
freezeRef = \case
      v :!> vs -> a -> HList as -> HList (a : as)
forall a (as1 :: [*]). a -> HList as1 -> HList (a : as1)
(:>) (a -> HList as -> HList (a : as))
-> m a -> m (HList as -> HList (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref s a -> m a
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
freezeRef Ref s a
Ref s a
v m (HList as -> HList (a : as))
-> m (HList as) -> m (HList (a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ref s (HList as) -> m (HList as)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
freezeRef Ref s (HList as)
HListRef s as
vs
    copyRef :: Ref s (HList (a : as)) -> HList (a : as) -> m ()
copyRef = \case
      v :!> vs -> \case
        x :: a
x :> xs :: HList as1
xs -> Ref s a -> a -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> a -> m ()
copyRef Ref s a
Ref s a
v a
x m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ref s (HList as1) -> HList as1 -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> a -> m ()
copyRef Ref s (HList as1)
HListRef s as
vs HList as1
xs
    moveRef :: Ref s (HList (a : as)) -> Ref s (HList (a : as)) -> m ()
moveRef = \case
      v :!> vs -> \case
        r :!> rs ->
          Ref s a -> Ref s a -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> Ref s a -> m ()
moveRef Ref s a
Ref s a
v Ref s a
Ref s a
r m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ref s (HList as) -> Ref s (HList as) -> m ()
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> Ref s a -> m ()
moveRef Ref s (HList as)
HListRef s as
vs Ref s (HList as)
HListRef s as
rs
    cloneRef :: Ref s (HList (a : as)) -> m (Ref s (HList (a : as)))
cloneRef = \case
      v :!> rs -> Ref s a -> HListRef s as -> HListRef s (a : as)
forall s a (as :: [*]).
Ref s a -> HListRef s as -> HListRef s (a : as)
(:!>) (Ref s a -> HListRef s as -> HListRef s (a : as))
-> m (Ref s a) -> m (HListRef s as -> HListRef s (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref s a -> m (Ref s a)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m (Ref s a)
cloneRef Ref s a
Ref s a
v m (HListRef s as -> HListRef s (a : as))
-> m (HListRef s as) -> m (HListRef s (a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ref s (HList as) -> m (Ref s (HList as))
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m (Ref s a)
cloneRef Ref s (HList as)
HListRef s as
rs
    unsafeThawRef :: HList (a : as) -> m (Ref s (HList (a : as)))
unsafeThawRef   = \case
      x :: a
x :> xs :: HList as1
xs -> Ref s a -> HListRef s as -> HListRef s (a : as)
forall s a (as :: [*]).
Ref s a -> HListRef s as -> HListRef s (a : as)
(:!>) (Ref s a -> HListRef s as -> HListRef s (a : as))
-> m (Ref s a) -> m (HListRef s as -> HListRef s (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Ref s a)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
unsafeThawRef a
x m (HListRef s as -> HListRef s (a : as))
-> m (HListRef s as) -> m (HListRef s (a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HList as1 -> m (Ref s (HList as1))
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
a -> m (Ref s a)
unsafeThawRef HList as1
xs
    unsafeFreezeRef :: Ref s (HList (a : as)) -> m (HList (a : as))
unsafeFreezeRef = \case
      v :!> vs -> a -> HList as -> HList (a : as)
forall a (as1 :: [*]). a -> HList as1 -> HList (a : as1)
(:>) (a -> HList as -> HList (a : as))
-> m a -> m (HList as -> HList (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref s a -> m a
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
unsafeFreezeRef Ref s a
Ref s a
v m (HList as -> HList (a : as))
-> m (HList as) -> m (HList (a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ref s (HList as) -> m (HList as)
forall s a (m :: * -> *).
(Mutable s a, PrimMonad m, PrimState m ~ s) =>
Ref s a -> m a
unsafeFreezeRef Ref s (HList as)
HListRef s as
vs

-- ListRefTuple instances

-- this one instance is the reason why we have to define a new typeclass
-- instead of using 'ListRef' -- because of @'ListRef' s () '[]@.
instance ListRefTuple s (UnitRef s) '[] where
    tupleToListRef :: UnitRef s -> HList (MapRef s '[])
tupleToListRef _ = HList '[]
HList (MapRef s '[])
Nil
    listRefToTuple :: HList (MapRef s '[]) -> UnitRef s
listRefToTuple _ = UnitRef s
forall k (s :: k). UnitRef s
UnitRef

instance (Ref s a ~ ra) => ListRefTuple s ra '[a] where
    tupleToListRef :: ra -> HList (MapRef s '[a])
tupleToListRef x :: ra
x = ra
x ra -> HList '[] -> HList '[ra]
forall a (as1 :: [*]). a -> HList as1 -> HList (a : as1)
:> HList '[]
Nil
    listRefToTuple :: HList (MapRef s '[a]) -> ra
listRefToTuple (x :: a
x :> _) = ra
a
x

instance (Ref s a ~ ra, Ref s b ~ rb) => ListRefTuple s (ra, rb) '[a, b] where
    tupleToListRef :: (ra, rb) -> HList (MapRef s '[a, b])
tupleToListRef (x :: ra
x, y :: rb
y) = ra
x ra -> HList '[rb] -> HList '[ra, rb]
forall a (as1 :: [*]). a -> HList as1 -> HList (a : as1)
:> rb
y rb -> HList '[] -> HList '[rb]
forall a (as1 :: [*]). a -> HList as1 -> HList (a : as1)
:> HList '[]
Nil
    listRefToTuple :: HList (MapRef s '[a, b]) -> (ra, rb)
listRefToTuple (x :: a
x :> y :: a
y :> _) = (ra
a
x, rb
a
y)

listRefTuples [3..12]