{-
 - Copyright (C) 2019  Koz Ross <koz.ross@retro-freedom.nz>
 -
 - This program is free software: you can redistribute it and/or modify
 - it under the terms of the GNU General Public License as published by
 - the Free Software Foundation, either version 3 of the License, or
 - (at your option) any later version.
 -
 - This program is distributed in the hope that it will be useful,
 - but WITHOUT ANY WARRANTY; without even the implied warranty of
 - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 - GNU General Public License for more details.
 -
 - You should have received a copy of the GNU General Public License
 - along with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}

{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}

-- |

-- Module:        Data.Finitary.PackInto

-- Description:   Scheme for packing @Finitary@ types into other @Finitary@

--                types.

-- Copyright:     (C) Koz Ross 2019

-- License:       GPL version 3.0 or later

-- Stability:     Experimental

-- Portability:   GHC only

--

-- This allows us to \'borrow\' implementations of certain type classes from

-- \'larger\' finitary types for \'smaller\' finitary types. Essentially, for

-- any types @a@ and @b@, if both @a@ and @b@ are 'Finitary' and @Cardinality a

-- <= Cardinality b@, the set of indexes for @a@ is a subset (strictly speaking,

-- a prefix) of the set of indexes for @b@. Therefore, we have an injective

-- mapping from @a@ to @b@, whose

-- [preimage](https://en.wikipedia.org/wiki/Preimage)

-- is also injective, witnessed by the function @fromFinite . toFinite@ in both

-- directions. When combined with the monotonicity of @toFinite@ and

-- @fromFinite@, we can operate on inhabitants of @b@ in certain ways while

-- always being able to recover the \'equivalent\' inhabitant of @a@.

--

-- On this basis, we can \'borrow\' both 'VU.Unbox' and 'Storable' instances

-- from @b@. This is done by way of the @PackInto a b@ type; here, @a@ is the

-- type to which instances are being \'lent\' and @b@ is the type from which

-- instances are being \'borrowed\'. @PackInto a b@ does not store any values of

-- type @a@ - construction and deconstruction of @PackInto@ performs a

-- conversion as described above.

--

-- If an existing 'Finitary' type exists with desired instances, this encoding

-- is the most flexible and efficient. Unless you have good reasons to consider

-- something else (such as space use), use this encoding. However, its

-- usefulness is conditional on a suitable \'packing\' type existing of

-- appropriate cardinality. Additionally, if @Cardinality a < Cardinality b@,

-- any @PackInto a b@ will waste some space, with larger cardinality differences

-- creating proportionately more waste.

module Data.Finitary.PackInto 
(
  PackInto, pattern Packed
) where

import GHC.TypeNats
import Data.Vector.Instances ()
import Data.Kind (Type)
import CoercibleUtils (op, over, over2)
import Data.Hashable (Hashable(..))
import Control.DeepSeq (NFData(..))
import Foreign.Storable (Storable(..))
import Foreign.Ptr (castPtr)
import Data.Finitary (Finitary(..))
import Data.Finite (weakenN, strengthenN)
import Data.Maybe (fromJust)
import Data.Ord (comparing)

import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM

-- | An opaque wrapper, representing values of type @a@ as \'corresponding\'

-- values of type @b@.

newtype PackInto (a :: Type) (b :: Type) = PackInto b
  deriving (PackInto a b -> PackInto a b -> Bool
(PackInto a b -> PackInto a b -> Bool)
-> (PackInto a b -> PackInto a b -> Bool) -> Eq (PackInto a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. Eq b => PackInto a b -> PackInto a b -> Bool
/= :: PackInto a b -> PackInto a b -> Bool
$c/= :: forall a b. Eq b => PackInto a b -> PackInto a b -> Bool
== :: PackInto a b -> PackInto a b -> Bool
$c== :: forall a b. Eq b => PackInto a b -> PackInto a b -> Bool
Eq, Int -> PackInto a b -> ShowS
[PackInto a b] -> ShowS
PackInto a b -> String
(Int -> PackInto a b -> ShowS)
-> (PackInto a b -> String)
-> ([PackInto a b] -> ShowS)
-> Show (PackInto a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. Show b => Int -> PackInto a b -> ShowS
forall a b. Show b => [PackInto a b] -> ShowS
forall a b. Show b => PackInto a b -> String
showList :: [PackInto a b] -> ShowS
$cshowList :: forall a b. Show b => [PackInto a b] -> ShowS
show :: PackInto a b -> String
$cshow :: forall a b. Show b => PackInto a b -> String
showsPrec :: Int -> PackInto a b -> ShowS
$cshowsPrec :: forall a b. Show b => Int -> PackInto a b -> ShowS
Show)

type role PackInto nominal nominal

-- | To provide (something that resembles a) data constructor for 'PackInto', we

-- provide the following pattern. It can be used like any other data

-- constructor:

--

-- > import Data.Finitary.PackInt

-- >

-- > anInt :: PackInto Int Word

-- > anInt = Packed 10

-- >

-- > isPackedEven :: PackInto Int Word -> Bool

-- > isPackedEven (Packed x) = even x

--

-- __Every__ pattern match, and data constructor call, performs a re-encoding by

-- way of @fromFinite . toFinite@ on @b@ and @a@ respectively. Use with this in

-- mind.

{-# COMPLETE Packed #-}
pattern Packed :: forall (b :: Type) (a :: Type) . 
  (Finitary a, Finitary b, Cardinality a <= Cardinality b) =>
  a -> PackInto a b
pattern $bPacked :: a -> PackInto a b
$mPacked :: forall r b a.
(Finitary a, Finitary b, Cardinality a <= Cardinality b) =>
PackInto a b -> (a -> r) -> (Void# -> r) -> r
Packed x <- (unpackOutOf -> x)
  where Packed a
x = a -> PackInto a b
forall b a.
(Finitary a, Finitary b, Cardinality a <= Cardinality b) =>
a -> PackInto a b
packInto a
x

instance (Ord a, Finitary a, Finitary b, Cardinality a <= Cardinality b) => Ord (PackInto a b) where
  {-# INLINE compare #-}
  compare :: PackInto a b -> PackInto a b -> Ordering
compare = (PackInto a b -> a) -> PackInto a b -> PackInto a b -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing @a (Finite (Cardinality a) -> a
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite (Finite (Cardinality a) -> a)
-> (PackInto a b -> Finite (Cardinality a)) -> PackInto a b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackInto a b -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite)

instance (Hashable b) => Hashable (PackInto a b) where
  {-# INLINE hashWithSalt #-}
  hashWithSalt :: Int -> PackInto a b -> Int
hashWithSalt Int
salt = (b -> PackInto a b) -> (b -> Int) -> PackInto a b -> Int
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over b -> PackInto a b
forall a b. b -> PackInto a b
PackInto (Int -> b -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt)

instance (NFData b) => NFData (PackInto a b) where
  {-# INLINE rnf #-}
  rnf :: PackInto a b -> ()
rnf = (b -> PackInto a b) -> (b -> ()) -> PackInto a b -> ()
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over b -> PackInto a b
forall a b. b -> PackInto a b
PackInto b -> ()
forall a. NFData a => a -> ()
rnf

instance (Storable b) => Storable (PackInto a b) where
  {-# INLINE sizeOf #-}
  sizeOf :: PackInto a b -> Int
sizeOf = (b -> PackInto a b) -> (b -> Int) -> PackInto a b -> Int
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over b -> PackInto a b
forall a b. b -> PackInto a b
PackInto b -> Int
forall a. Storable a => a -> Int
sizeOf
  {-# INLINE alignment #-}
  alignment :: PackInto a b -> Int
alignment = (b -> PackInto a b) -> (b -> Int) -> PackInto a b -> Int
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over b -> PackInto a b
forall a b. b -> PackInto a b
PackInto b -> Int
forall a. Storable a => a -> Int
alignment
  {-# INLINE peek #-}
  peek :: Ptr (PackInto a b) -> IO (PackInto a b)
peek = (b -> PackInto a b) -> IO b -> IO (PackInto a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> PackInto a b
forall a b. b -> PackInto a b
PackInto (IO b -> IO (PackInto a b))
-> (Ptr (PackInto a b) -> IO b)
-> Ptr (PackInto a b)
-> IO (PackInto a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek (Ptr b -> IO b)
-> (Ptr (PackInto a b) -> Ptr b) -> Ptr (PackInto a b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (PackInto a b) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr
  {-# INLINE poke #-}
  poke :: Ptr (PackInto a b) -> PackInto a b -> IO ()
poke Ptr (PackInto a b)
ptr = Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (PackInto a b) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackInto a b)
ptr) (b -> IO ()) -> (PackInto a b -> b) -> PackInto a b -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> PackInto a b) -> PackInto a b -> b
forall a b. Coercible a b => (a -> b) -> b -> a
op b -> PackInto a b
forall a b. b -> PackInto a b
PackInto

-- We can pack a into b if the cardinality of b is at least as large as a (could

-- be larger)

instance (Finitary a, Finitary b, Cardinality a <= Cardinality b) => Finitary (PackInto a b) where
  type Cardinality (PackInto a b) = Cardinality a
  {-# INLINE fromFinite #-}
  fromFinite :: Finite (Cardinality (PackInto a b)) -> PackInto a b
fromFinite = b -> PackInto a b
forall a b. b -> PackInto a b
PackInto (b -> PackInto a b)
-> (Finite (Cardinality a) -> b)
-> Finite (Cardinality a)
-> PackInto a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite (Cardinality b) -> b
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite (Finite (Cardinality b) -> b)
-> (Finite (Cardinality a) -> Finite (Cardinality b))
-> Finite (Cardinality a)
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite (Cardinality a) -> Finite (Cardinality b)
forall (n :: Nat) (m :: Nat). (n <= m) => Finite n -> Finite m
weakenN
  {-# INLINE toFinite #-}
  toFinite :: PackInto a b -> Finite (Cardinality (PackInto a b))
toFinite = Maybe (Finite (Cardinality a)) -> Finite (Cardinality a)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Finite (Cardinality a)) -> Finite (Cardinality a))
-> (PackInto a b -> Maybe (Finite (Cardinality a)))
-> PackInto a b
-> Finite (Cardinality a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite (Cardinality b) -> Maybe (Finite (Cardinality a))
forall (n :: Nat) (m :: Nat).
(KnownNat n, n <= m) =>
Finite m -> Maybe (Finite n)
strengthenN (Finite (Cardinality b) -> Maybe (Finite (Cardinality a)))
-> (PackInto a b -> Finite (Cardinality b))
-> PackInto a b
-> Maybe (Finite (Cardinality a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Finite (Cardinality b)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite (b -> Finite (Cardinality b))
-> (PackInto a b -> b) -> PackInto a b -> Finite (Cardinality b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> PackInto a b) -> PackInto a b -> b
forall a b. Coercible a b => (a -> b) -> b -> a
op b -> PackInto a b
forall a b. b -> PackInto a b
PackInto

instance (Finitary a, Finitary b, 1 <= Cardinality a, Cardinality a <= Cardinality b) => Bounded (PackInto a b) where
  {-# INLINE minBound #-}
  minBound :: PackInto a b
minBound = PackInto a b
forall a. (Finitary a, 1 <= Cardinality a) => a
start
  {-# INLINE maxBound #-}
  maxBound :: PackInto a b
maxBound = PackInto a b
forall a. (Finitary a, 1 <= Cardinality a) => a
end 

newtype instance VU.MVector s (PackInto a b) = MV_PackInto (VU.MVector s b)

instance (VU.Unbox b) => VGM.MVector VU.MVector (PackInto a b) where
  {-# INLINE basicLength #-}
  basicLength :: MVector s (PackInto a b) -> Int
basicLength = (MVector s b -> MVector s (PackInto a b))
-> (MVector s b -> Int) -> MVector s (PackInto a b) -> Int
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over MVector s b -> MVector s (PackInto a b)
forall s a b. MVector s b -> MVector s (PackInto a b)
MV_PackInto MVector s b -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.basicLength
  {-# INLINE basicOverlaps #-}
  basicOverlaps :: MVector s (PackInto a b) -> MVector s (PackInto a b) -> Bool
basicOverlaps = (MVector s b -> MVector s (PackInto a b))
-> (MVector s b -> MVector s b -> Bool)
-> MVector s (PackInto a b)
-> MVector s (PackInto a b)
-> Bool
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a -> a') -> b -> b -> b'
over2 MVector s b -> MVector s (PackInto a b)
forall s a b. MVector s b -> MVector s (PackInto a b)
MV_PackInto MVector s b -> MVector s b -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
VGM.basicOverlaps
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice :: Int -> Int -> MVector s (PackInto a b) -> MVector s (PackInto a b)
basicUnsafeSlice Int
i Int
len = (MVector s b -> MVector s (PackInto a b))
-> (MVector s b -> MVector s b)
-> MVector s (PackInto a b)
-> MVector s (PackInto a b)
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over MVector s b -> MVector s (PackInto a b)
forall s a b. MVector s b -> MVector s (PackInto a b)
MV_PackInto (Int -> Int -> MVector s b -> MVector s b
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VGM.basicUnsafeSlice Int
i Int
len)
  {-# INLINE basicUnsafeNew #-}
  basicUnsafeNew :: Int -> m (MVector (PrimState m) (PackInto a b))
basicUnsafeNew Int
len = MVector (PrimState m) b -> MVector (PrimState m) (PackInto a b)
forall s a b. MVector s b -> MVector s (PackInto a b)
MV_PackInto (MVector (PrimState m) b -> MVector (PrimState m) (PackInto a b))
-> m (MVector (PrimState m) b)
-> m (MVector (PrimState m) (PackInto a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) b)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
VGM.basicUnsafeNew Int
len
  {-# INLINE basicInitialize #-}
  basicInitialize :: MVector (PrimState m) (PackInto a b) -> m ()
basicInitialize = MVector (PrimState m) b -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VGM.basicInitialize (MVector (PrimState m) b -> m ())
-> (MVector (PrimState m) (PackInto a b)
    -> MVector (PrimState m) b)
-> MVector (PrimState m) (PackInto a b)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVector (PrimState m) b -> MVector (PrimState m) (PackInto a b))
-> MVector (PrimState m) (PackInto a b) -> MVector (PrimState m) b
forall a b. Coercible a b => (a -> b) -> b -> a
op MVector (PrimState m) b -> MVector (PrimState m) (PackInto a b)
forall s a b. MVector s b -> MVector s (PackInto a b)
MV_PackInto
  {-# INLINE basicUnsafeRead #-}
  basicUnsafeRead :: MVector (PrimState m) (PackInto a b) -> Int -> m (PackInto a b)
basicUnsafeRead (MV_PackInto v) Int
i = b -> PackInto a b
forall a b. b -> PackInto a b
PackInto (b -> PackInto a b) -> m b -> m (PackInto a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) b -> Int -> m b
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
VGM.basicUnsafeRead MVector (PrimState m) b
v Int
i
  {-# INLINE basicUnsafeWrite #-}
  basicUnsafeWrite :: MVector (PrimState m) (PackInto a b) -> Int -> PackInto a b -> m ()
basicUnsafeWrite (MV_PackInto v) Int
i (PackInto b
x) = MVector (PrimState m) b -> Int -> b -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
VGM.basicUnsafeWrite MVector (PrimState m) b
v Int
i b
x

newtype instance VU.Vector (PackInto a b) = V_PackInto (VU.Vector b)

instance (VU.Unbox b) => VG.Vector VU.Vector (PackInto a b) where
  {-# INLINE basicLength #-}
  basicLength :: Vector (PackInto a b) -> Int
basicLength = (Vector b -> Vector (PackInto a b))
-> (Vector b -> Int) -> Vector (PackInto a b) -> Int
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over Vector b -> Vector (PackInto a b)
forall a b. Vector b -> Vector (PackInto a b)
V_PackInto Vector b -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.basicLength
  {-# INLINE basicUnsafeFreeze #-}
  basicUnsafeFreeze :: Mutable Vector (PrimState m) (PackInto a b)
-> m (Vector (PackInto a b))
basicUnsafeFreeze = (Vector b -> Vector (PackInto a b))
-> m (Vector b) -> m (Vector (PackInto a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector b -> Vector (PackInto a b)
forall a b. Vector b -> Vector (PackInto a b)
V_PackInto (m (Vector b) -> m (Vector (PackInto a b)))
-> (MVector (PrimState m) (PackInto a b) -> m (Vector b))
-> MVector (PrimState m) (PackInto a b)
-> m (Vector (PackInto a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVector (PrimState m) b -> m (Vector b)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
VG.basicUnsafeFreeze (MVector (PrimState m) b -> m (Vector b))
-> (MVector (PrimState m) (PackInto a b)
    -> MVector (PrimState m) b)
-> MVector (PrimState m) (PackInto a b)
-> m (Vector b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVector (PrimState m) b -> MVector (PrimState m) (PackInto a b))
-> MVector (PrimState m) (PackInto a b) -> MVector (PrimState m) b
forall a b. Coercible a b => (a -> b) -> b -> a
op MVector (PrimState m) b -> MVector (PrimState m) (PackInto a b)
forall s a b. MVector s b -> MVector s (PackInto a b)
MV_PackInto
  {-# INLINE basicUnsafeThaw #-}
  basicUnsafeThaw :: Vector (PackInto a b)
-> m (Mutable Vector (PrimState m) (PackInto a b))
basicUnsafeThaw = (MVector (PrimState m) b -> MVector (PrimState m) (PackInto a b))
-> m (MVector (PrimState m) b)
-> m (MVector (PrimState m) (PackInto a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) b -> MVector (PrimState m) (PackInto a b)
forall s a b. MVector s b -> MVector s (PackInto a b)
MV_PackInto (m (MVector (PrimState m) b)
 -> m (MVector (PrimState m) (PackInto a b)))
-> (Vector (PackInto a b) -> m (MVector (PrimState m) b))
-> Vector (PackInto a b)
-> m (MVector (PrimState m) (PackInto a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector b -> m (MVector (PrimState m) b)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
VG.basicUnsafeThaw (Vector b -> m (MVector (PrimState m) b))
-> (Vector (PackInto a b) -> Vector b)
-> Vector (PackInto a b)
-> m (MVector (PrimState m) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector b -> Vector (PackInto a b))
-> Vector (PackInto a b) -> Vector b
forall a b. Coercible a b => (a -> b) -> b -> a
op Vector b -> Vector (PackInto a b)
forall a b. Vector b -> Vector (PackInto a b)
V_PackInto
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice :: Int -> Int -> Vector (PackInto a b) -> Vector (PackInto a b)
basicUnsafeSlice Int
i Int
len = (Vector b -> Vector (PackInto a b))
-> (Vector b -> Vector b)
-> Vector (PackInto a b)
-> Vector (PackInto a b)
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over Vector b -> Vector (PackInto a b)
forall a b. Vector b -> Vector (PackInto a b)
V_PackInto (Int -> Int -> Vector b -> Vector b
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
VG.basicUnsafeSlice Int
i Int
len)
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeIndexM :: Vector (PackInto a b) -> Int -> m (PackInto a b)
basicUnsafeIndexM (V_PackInto v) Int
i = b -> PackInto a b
forall a b. b -> PackInto a b
PackInto (b -> PackInto a b) -> m b -> m (PackInto a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector b -> Int -> m b
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
VG.basicUnsafeIndexM Vector b
v Int
i

instance (VU.Unbox b) => VU.Unbox (PackInto a b)

-- Helpers


{-# INLINE packInto #-}
packInto :: forall (b :: Type) (a :: Type) .
  (Finitary a, Finitary b, Cardinality a <= Cardinality b) =>  
  a -> PackInto a b
packInto :: a -> PackInto a b
packInto = Finite (Cardinality a) -> PackInto a b
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite (Finite (Cardinality a) -> PackInto a b)
-> (a -> Finite (Cardinality a)) -> a -> PackInto a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite

{-# INLINE unpackOutOf #-}
unpackOutOf :: forall (b :: Type) (a :: Type) . 
  (Finitary a, Finitary b, Cardinality a <= Cardinality b) => 
  PackInto a b -> a
unpackOutOf :: PackInto a b -> a
unpackOutOf = Finite (Cardinality a) -> a
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite (Finite (Cardinality a) -> a)
-> (PackInto a b -> Finite (Cardinality a)) -> PackInto a b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackInto a b -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite