{-# OPTIONS_GHC -fplugin GHC.TypeLits.Extra.Solver #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
module Data.Finitary.PackBytes
(
PackBytes, pattern Packed
) where
import Data.Proxy (Proxy(..))
import GHC.TypeLits.Extra
import GHC.TypeNats
import CoercibleUtils (op, over, over2)
import Data.Kind (Type)
import Data.Word (Word8)
import Data.Vector.Binary ()
import Data.Vector.Instances ()
import Data.Hashable (Hashable(..))
import Control.DeepSeq (NFData(..))
import Data.Finitary (Finitary(..))
import Foreign.Storable (Storable(..))
import Foreign.Ptr (castPtr, plusPtr)
import Numeric.Natural (Natural)
import Data.Finite (Finite)
import Control.Monad.Trans.State.Strict (evalState, get, modify, put)
import qualified Data.Binary as Bin
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
newtype PackBytes (a :: Type) = PackBytes (VU.Vector Word8)
deriving (PackBytes a -> PackBytes a -> Bool
(PackBytes a -> PackBytes a -> Bool)
-> (PackBytes a -> PackBytes a -> Bool) -> Eq (PackBytes a)
forall a. PackBytes a -> PackBytes a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackBytes a -> PackBytes a -> Bool
$c/= :: forall a. PackBytes a -> PackBytes a -> Bool
== :: PackBytes a -> PackBytes a -> Bool
$c== :: forall a. PackBytes a -> PackBytes a -> Bool
Eq, Eq (PackBytes a)
Eq (PackBytes a) =>
(PackBytes a -> PackBytes a -> Ordering)
-> (PackBytes a -> PackBytes a -> Bool)
-> (PackBytes a -> PackBytes a -> Bool)
-> (PackBytes a -> PackBytes a -> Bool)
-> (PackBytes a -> PackBytes a -> Bool)
-> (PackBytes a -> PackBytes a -> PackBytes a)
-> (PackBytes a -> PackBytes a -> PackBytes a)
-> Ord (PackBytes a)
PackBytes a -> PackBytes a -> Bool
PackBytes a -> PackBytes a -> Ordering
PackBytes a -> PackBytes a -> PackBytes a
forall a. Eq (PackBytes a)
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 a. PackBytes a -> PackBytes a -> Bool
forall a. PackBytes a -> PackBytes a -> Ordering
forall a. PackBytes a -> PackBytes a -> PackBytes a
min :: PackBytes a -> PackBytes a -> PackBytes a
$cmin :: forall a. PackBytes a -> PackBytes a -> PackBytes a
max :: PackBytes a -> PackBytes a -> PackBytes a
$cmax :: forall a. PackBytes a -> PackBytes a -> PackBytes a
>= :: PackBytes a -> PackBytes a -> Bool
$c>= :: forall a. PackBytes a -> PackBytes a -> Bool
> :: PackBytes a -> PackBytes a -> Bool
$c> :: forall a. PackBytes a -> PackBytes a -> Bool
<= :: PackBytes a -> PackBytes a -> Bool
$c<= :: forall a. PackBytes a -> PackBytes a -> Bool
< :: PackBytes a -> PackBytes a -> Bool
$c< :: forall a. PackBytes a -> PackBytes a -> Bool
compare :: PackBytes a -> PackBytes a -> Ordering
$ccompare :: forall a. PackBytes a -> PackBytes a -> Ordering
$cp1Ord :: forall a. Eq (PackBytes a)
Ord, Int -> PackBytes a -> ShowS
[PackBytes a] -> ShowS
PackBytes a -> String
(Int -> PackBytes a -> ShowS)
-> (PackBytes a -> String)
-> ([PackBytes a] -> ShowS)
-> Show (PackBytes a)
forall a. Int -> PackBytes a -> ShowS
forall a. [PackBytes a] -> ShowS
forall a. PackBytes a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackBytes a] -> ShowS
$cshowList :: forall a. [PackBytes a] -> ShowS
show :: PackBytes a -> String
$cshow :: forall a. PackBytes a -> String
showsPrec :: Int -> PackBytes a -> ShowS
$cshowsPrec :: forall a. Int -> PackBytes a -> ShowS
Show)
type role PackBytes nominal
pattern Packed :: forall (a :: Type) .
(Finitary a, 1 <= Cardinality a) =>
PackBytes a -> a
pattern $bPacked :: PackBytes a -> a
$mPacked :: forall r a.
(Finitary a, 1 <= Cardinality a) =>
a -> (PackBytes a -> r) -> (Void# -> r) -> r
Packed x <- (packBytes -> x)
where Packed x :: PackBytes a
x = PackBytes a -> a
forall a. (Finitary a, 1 <= Cardinality a) => PackBytes a -> a
unpackBytes PackBytes a
x
instance Bin.Binary (PackBytes a) where
{-# INLINE put #-}
put :: PackBytes a -> Put
put = Vector Word8 -> Put
forall t. Binary t => t -> Put
Bin.put (Vector Word8 -> Put)
-> (PackBytes a -> Vector Word8) -> PackBytes a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Word8 -> PackBytes a) -> PackBytes a -> Vector Word8
forall a b. Coercible a b => (a -> b) -> b -> a
op Vector Word8 -> PackBytes a
forall a. Vector Word8 -> PackBytes a
PackBytes
{-# INLINE get #-}
get :: Get (PackBytes a)
get = Vector Word8 -> PackBytes a
forall a. Vector Word8 -> PackBytes a
PackBytes (Vector Word8 -> PackBytes a)
-> Get (Vector Word8) -> Get (PackBytes a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Vector Word8)
forall t. Binary t => Get t
Bin.get
instance Hashable (PackBytes a) where
{-# INLINE hashWithSalt #-}
hashWithSalt :: Int -> PackBytes a -> Int
hashWithSalt salt :: Int
salt = Int -> Vector Word8 -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Vector Word8 -> Int)
-> (PackBytes a -> Vector Word8) -> PackBytes a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Word8 -> PackBytes a) -> PackBytes a -> Vector Word8
forall a b. Coercible a b => (a -> b) -> b -> a
op Vector Word8 -> PackBytes a
forall a. Vector Word8 -> PackBytes a
PackBytes
instance NFData (PackBytes a) where
{-# INLINE rnf #-}
rnf :: PackBytes a -> ()
rnf = Vector Word8 -> ()
forall a. NFData a => a -> ()
rnf (Vector Word8 -> ())
-> (PackBytes a -> Vector Word8) -> PackBytes a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Word8 -> PackBytes a) -> PackBytes a -> Vector Word8
forall a b. Coercible a b => (a -> b) -> b -> a
op Vector Word8 -> PackBytes a
forall a. Vector Word8 -> PackBytes a
PackBytes
instance (Finitary a, 1 <= Cardinality a) => Finitary (PackBytes a) where
type Cardinality (PackBytes a) = Cardinality a
{-# INLINE fromFinite #-}
fromFinite :: Finite (Cardinality (PackBytes a)) -> PackBytes a
fromFinite = Vector Word8 -> PackBytes a
forall a. Vector Word8 -> PackBytes a
PackBytes (Vector Word8 -> PackBytes a)
-> (Finite (Cardinality a) -> Vector Word8)
-> Finite (Cardinality a)
-> PackBytes a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite (Cardinality a) -> Vector Word8
forall (n :: Nat). (KnownNat n, 1 <= n) => Finite n -> Vector Word8
intoBytes
{-# INLINE toFinite #-}
toFinite :: PackBytes a -> Finite (Cardinality (PackBytes a))
toFinite = Vector Word8 -> Finite (Cardinality a)
forall (n :: Nat). KnownNat n => Vector Word8 -> Finite n
outOfBytes (Vector Word8 -> Finite (Cardinality a))
-> (PackBytes a -> Vector Word8)
-> PackBytes a
-> Finite (Cardinality a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Word8 -> PackBytes a) -> PackBytes a -> Vector Word8
forall a b. Coercible a b => (a -> b) -> b -> a
op Vector Word8 -> PackBytes a
forall a. Vector Word8 -> PackBytes a
PackBytes
instance (Finitary a, 1 <= Cardinality a) => Bounded (PackBytes a) where
{-# INLINE minBound #-}
minBound :: PackBytes a
minBound = PackBytes a
forall a. (Finitary a, 1 <= Cardinality a) => a
start
{-# INLINE maxBound #-}
maxBound :: PackBytes a
maxBound = PackBytes a
forall a. (Finitary a, 1 <= Cardinality a) => a
end
instance (Finitary a, 1 <= Cardinality a) => Storable (PackBytes a) where
{-# INLINE sizeOf #-}
sizeOf :: PackBytes a -> Int
sizeOf _ = forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a
{-# INLINE alignment #-}
alignment :: PackBytes a -> Int
alignment _ = Word8 -> Int
forall a. Storable a => a -> Int
alignment (Word8
forall a. HasCallStack => a
undefined :: Word8)
{-# INLINE peek #-}
peek :: Ptr (PackBytes a) -> IO (PackBytes a)
peek ptr :: Ptr (PackBytes a)
ptr = do let bytePtr :: Ptr Any
bytePtr = Ptr (PackBytes a) -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackBytes a)
ptr
Vector Word8 -> PackBytes a
forall a. Vector Word8 -> PackBytes a
PackBytes (Vector Word8 -> PackBytes a)
-> IO (Vector Word8) -> IO (PackBytes a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Int -> IO Word8) -> IO (Vector Word8)
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> (Int -> m a) -> m (Vector a)
VU.generateM (forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a) (Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> IO Word8) -> (Int -> Ptr Word8) -> Int -> IO Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Any
bytePtr)
{-# INLINE poke #-}
poke :: Ptr (PackBytes a) -> PackBytes a -> IO ()
poke ptr :: Ptr (PackBytes a)
ptr (PackBytes v :: Vector Word8
v) = do let bytePtr :: Ptr Word8
bytePtr = Ptr (PackBytes a) -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr (PackBytes a)
ptr
(Ptr Word8 -> Word8 -> IO (Ptr Word8))
-> Ptr Word8 -> Vector Word8 -> IO ()
forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> b -> m a) -> a -> Vector b -> m ()
VU.foldM'_ Ptr Word8 -> Word8 -> IO (Ptr Word8)
forall a b. Storable a => Ptr a -> a -> IO (Ptr b)
go Ptr Word8
bytePtr Vector Word8
v
where go :: Ptr a -> a -> IO (Ptr b)
go p :: Ptr a
p e :: a
e = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
p a
e IO () -> IO (Ptr b) -> IO (Ptr b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> IO (Ptr b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
p 1)
newtype instance VU.MVector s (PackBytes a) = MV_PackBytes (VU.MVector s Word8)
instance (Finitary a, 1 <= Cardinality a) => VGM.MVector VU.MVector (PackBytes a) where
{-# INLINE basicLength #-}
basicLength :: MVector s (PackBytes a) -> Int
basicLength = (MVector s Word8 -> MVector s (PackBytes a))
-> (MVector s Word8 -> Int) -> MVector s (PackBytes a) -> Int
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over MVector s Word8 -> MVector s (PackBytes a)
forall s a. MVector s Word8 -> MVector s (PackBytes a)
MV_PackBytes ((Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a) (Int -> Int) -> (MVector s Word8 -> Int) -> MVector s Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVector s Word8 -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.basicLength)
{-# INLINE basicOverlaps #-}
basicOverlaps :: MVector s (PackBytes a) -> MVector s (PackBytes a) -> Bool
basicOverlaps = (MVector s Word8 -> MVector s (PackBytes a))
-> (MVector s Word8 -> MVector s Word8 -> Bool)
-> MVector s (PackBytes a)
-> MVector s (PackBytes a)
-> Bool
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a -> a') -> b -> b -> b'
over2 MVector s Word8 -> MVector s (PackBytes a)
forall s a. MVector s Word8 -> MVector s (PackBytes a)
MV_PackBytes MVector s Word8 -> MVector s Word8 -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
VGM.basicOverlaps
{-# INLINE basicUnsafeSlice #-}
basicUnsafeSlice :: Int -> Int -> MVector s (PackBytes a) -> MVector s (PackBytes a)
basicUnsafeSlice i :: Int
i len :: Int
len = (MVector s Word8 -> MVector s (PackBytes a))
-> (MVector s Word8 -> MVector s Word8)
-> MVector s (PackBytes a)
-> MVector s (PackBytes a)
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over MVector s Word8 -> MVector s (PackBytes a)
forall s a. MVector s Word8 -> MVector s (PackBytes a)
MV_PackBytes (Int -> Int -> MVector s Word8 -> MVector s Word8
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VGM.basicUnsafeSlice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a))
{-# INLINE basicUnsafeNew #-}
basicUnsafeNew :: Int -> m (MVector (PrimState m) (PackBytes a))
basicUnsafeNew len :: Int
len = MVector (PrimState m) Word8 -> MVector (PrimState m) (PackBytes a)
forall s a. MVector s Word8 -> MVector s (PackBytes a)
MV_PackBytes (MVector (PrimState m) Word8
-> MVector (PrimState m) (PackBytes a))
-> m (MVector (PrimState m) Word8)
-> m (MVector (PrimState m) (PackBytes a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) Word8)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
VGM.basicUnsafeNew (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a)
{-# INLINE basicInitialize #-}
basicInitialize :: MVector (PrimState m) (PackBytes a) -> m ()
basicInitialize = MVector (PrimState m) Word8 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VGM.basicInitialize (MVector (PrimState m) Word8 -> m ())
-> (MVector (PrimState m) (PackBytes a)
-> MVector (PrimState m) Word8)
-> MVector (PrimState m) (PackBytes a)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVector (PrimState m) Word8
-> MVector (PrimState m) (PackBytes a))
-> MVector (PrimState m) (PackBytes a)
-> MVector (PrimState m) Word8
forall a b. Coercible a b => (a -> b) -> b -> a
op MVector (PrimState m) Word8 -> MVector (PrimState m) (PackBytes a)
forall s a. MVector s Word8 -> MVector s (PackBytes a)
MV_PackBytes
{-# INLINE basicUnsafeRead #-}
basicUnsafeRead :: MVector (PrimState m) (PackBytes a) -> Int -> m (PackBytes a)
basicUnsafeRead (MV_PackBytes v) i :: Int
i = (Vector Word8 -> PackBytes a)
-> m (Vector Word8) -> m (PackBytes a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Word8 -> PackBytes a
forall a. Vector Word8 -> PackBytes a
PackBytes (m (Vector Word8) -> m (PackBytes a))
-> (MVector (PrimState m) Word8 -> m (Vector Word8))
-> MVector (PrimState m) Word8
-> m (PackBytes a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVector (PrimState m) Word8 -> m (Vector Word8)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze (MVector (PrimState m) Word8 -> m (Vector Word8))
-> (MVector (PrimState m) Word8 -> MVector (PrimState m) Word8)
-> MVector (PrimState m) Word8
-> m (Vector Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> MVector (PrimState m) Word8
-> MVector (PrimState m) Word8
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VGM.unsafeSlice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a) (forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a) (MVector (PrimState m) Word8 -> m (PackBytes a))
-> MVector (PrimState m) Word8 -> m (PackBytes a)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) Word8
v
{-# INLINE basicUnsafeWrite #-}
basicUnsafeWrite :: MVector (PrimState m) (PackBytes a) -> Int -> PackBytes a -> m ()
basicUnsafeWrite (MV_PackBytes v) i :: Int
i (PackBytes x :: Vector Word8
x) = let slice :: MVector (PrimState m) Word8
slice = Int
-> Int
-> MVector (PrimState m) Word8
-> MVector (PrimState m) Word8
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VGM.unsafeSlice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a) (forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a) MVector (PrimState m) Word8
v in
Mutable Vector (PrimState m) Word8 -> Vector Word8 -> m ()
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> v a -> m ()
VG.unsafeCopy MVector (PrimState m) Word8
Mutable Vector (PrimState m) Word8
slice Vector Word8
x
newtype instance VU.Vector (PackBytes a) = V_PackBytes (VU.Vector Word8)
instance (Finitary a, 1 <= Cardinality a) => VG.Vector VU.Vector (PackBytes a) where
{-# INLINE basicLength #-}
basicLength :: Vector (PackBytes a) -> Int
basicLength = (Vector Word8 -> Vector (PackBytes a))
-> (Vector Word8 -> Int) -> Vector (PackBytes a) -> Int
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over Vector Word8 -> Vector (PackBytes a)
forall a. Vector Word8 -> Vector (PackBytes a)
V_PackBytes ((Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a) (Int -> Int) -> (Vector Word8 -> Int) -> Vector Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.basicLength)
{-# INLINE basicUnsafeFreeze #-}
basicUnsafeFreeze :: Mutable Vector (PrimState m) (PackBytes a)
-> m (Vector (PackBytes a))
basicUnsafeFreeze = (Vector Word8 -> Vector (PackBytes a))
-> m (Vector Word8) -> m (Vector (PackBytes a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Word8 -> Vector (PackBytes a)
forall a. Vector Word8 -> Vector (PackBytes a)
V_PackBytes (m (Vector Word8) -> m (Vector (PackBytes a)))
-> (MVector (PrimState m) (PackBytes a) -> m (Vector Word8))
-> MVector (PrimState m) (PackBytes a)
-> m (Vector (PackBytes a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVector (PrimState m) Word8 -> m (Vector Word8)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
VG.basicUnsafeFreeze (MVector (PrimState m) Word8 -> m (Vector Word8))
-> (MVector (PrimState m) (PackBytes a)
-> MVector (PrimState m) Word8)
-> MVector (PrimState m) (PackBytes a)
-> m (Vector Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVector (PrimState m) Word8
-> MVector (PrimState m) (PackBytes a))
-> MVector (PrimState m) (PackBytes a)
-> MVector (PrimState m) Word8
forall a b. Coercible a b => (a -> b) -> b -> a
op MVector (PrimState m) Word8 -> MVector (PrimState m) (PackBytes a)
forall s a. MVector s Word8 -> MVector s (PackBytes a)
MV_PackBytes
{-# INLINE basicUnsafeThaw #-}
basicUnsafeThaw :: Vector (PackBytes a)
-> m (Mutable Vector (PrimState m) (PackBytes a))
basicUnsafeThaw = (MVector (PrimState m) Word8
-> MVector (PrimState m) (PackBytes a))
-> m (MVector (PrimState m) Word8)
-> m (MVector (PrimState m) (PackBytes a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) Word8 -> MVector (PrimState m) (PackBytes a)
forall s a. MVector s Word8 -> MVector s (PackBytes a)
MV_PackBytes (m (MVector (PrimState m) Word8)
-> m (MVector (PrimState m) (PackBytes a)))
-> (Vector (PackBytes a) -> m (MVector (PrimState m) Word8))
-> Vector (PackBytes a)
-> m (MVector (PrimState m) (PackBytes a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> m (MVector (PrimState m) Word8)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
VG.basicUnsafeThaw (Vector Word8 -> m (MVector (PrimState m) Word8))
-> (Vector (PackBytes a) -> Vector Word8)
-> Vector (PackBytes a)
-> m (MVector (PrimState m) Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Word8 -> Vector (PackBytes a))
-> Vector (PackBytes a) -> Vector Word8
forall a b. Coercible a b => (a -> b) -> b -> a
op Vector Word8 -> Vector (PackBytes a)
forall a. Vector Word8 -> Vector (PackBytes a)
V_PackBytes
{-# INLINE basicUnsafeSlice #-}
basicUnsafeSlice :: Int -> Int -> Vector (PackBytes a) -> Vector (PackBytes a)
basicUnsafeSlice i :: Int
i len :: Int
len = (Vector Word8 -> Vector (PackBytes a))
-> (Vector Word8 -> Vector Word8)
-> Vector (PackBytes a)
-> Vector (PackBytes a)
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over Vector Word8 -> Vector (PackBytes a)
forall a. Vector Word8 -> Vector (PackBytes a)
V_PackBytes (Int -> Int -> Vector Word8 -> Vector Word8
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
VG.basicUnsafeSlice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a))
{-# INLINE basicUnsafeIndexM #-}
basicUnsafeIndexM :: Vector (PackBytes a) -> Int -> m (PackBytes a)
basicUnsafeIndexM (V_PackBytes v) i :: Int
i = PackBytes a -> m (PackBytes a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackBytes a -> m (PackBytes a))
-> (Vector Word8 -> PackBytes a) -> Vector Word8 -> m (PackBytes a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> PackBytes a
forall a. Vector Word8 -> PackBytes a
PackBytes (Vector Word8 -> PackBytes a)
-> (Vector Word8 -> Vector Word8) -> Vector Word8 -> PackBytes a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Vector Word8 -> Vector Word8
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
VG.unsafeSlice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a) (forall b. (Finitary a, 1 <= Cardinality a, Num b) => b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @a) (Vector Word8 -> m (PackBytes a))
-> Vector Word8 -> m (PackBytes a)
forall a b. (a -> b) -> a -> b
$ Vector Word8
v
instance (Finitary a, 1 <= Cardinality a) => VU.Unbox (PackBytes a)
type ByteLength a = CLog (Cardinality Word8) (Cardinality a)
{-# INLINE byteLength #-}
byteLength :: forall (a :: Type) (b :: Type) .
(Finitary a, 1 <= Cardinality a, Num b) =>
b
byteLength :: b
byteLength = Natural -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> b)
-> (Proxy (CLog 256 (Cardinality a)) -> Natural)
-> Proxy (CLog 256 (Cardinality a))
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (CLog 256 (Cardinality a)) -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy (CLog 256 (Cardinality a)) -> b)
-> Proxy (CLog 256 (Cardinality a)) -> b
forall a b. (a -> b) -> a -> b
$ (Proxy (ByteLength a)
forall k (t :: k). Proxy t
Proxy :: Proxy (ByteLength a))
{-# INLINE packBytes #-}
packBytes :: forall (a :: Type) .
(Finitary a, 1 <= Cardinality a) =>
a -> PackBytes a
packBytes :: a -> PackBytes a
packBytes = Finite (Cardinality a) -> PackBytes a
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite (Finite (Cardinality a) -> PackBytes a)
-> (a -> Finite (Cardinality a)) -> a -> PackBytes a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite
{-# INLINE unpackBytes #-}
unpackBytes :: forall (a :: Type) .
(Finitary a, 1 <= Cardinality a) =>
PackBytes a -> a
unpackBytes :: PackBytes a -> a
unpackBytes = Finite (Cardinality a) -> a
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite (Finite (Cardinality a) -> a)
-> (PackBytes a -> Finite (Cardinality a)) -> PackBytes a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackBytes a -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite
{-# INLINE intoBytes #-}
intoBytes :: forall (n :: Nat) .
(KnownNat n, 1 <= n) =>
Finite n -> VU.Vector Word8
intoBytes :: Finite n -> Vector Word8
intoBytes = State Natural (Vector Word8) -> Natural -> Vector Word8
forall s a. State s a -> s -> a
evalState (Int
-> StateT Natural Identity Word8 -> State Natural (Vector Word8)
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> m a -> m (Vector a)
VU.replicateM (forall b.
(Finitary (Finite n), 1 <= Cardinality (Finite n), Num b) =>
b
forall a b. (Finitary a, 1 <= Cardinality a, Num b) => b
byteLength @(Finite n)) StateT Natural Identity Word8
go) (Natural -> Vector Word8)
-> (Finite n -> Natural) -> Finite n -> Vector Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integral (Finite n), Num Natural) => Finite n -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Natural
where go :: StateT Natural Identity Word8
go = do Natural
remaining <- StateT Natural Identity Natural
forall (m :: * -> *) s. Monad m => StateT s m s
get
let (d :: Natural
d, r :: Natural
r) = Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
quotRem Natural
remaining 256
Natural -> StateT Natural Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Natural
d StateT Natural Identity ()
-> StateT Natural Identity Word8 -> StateT Natural Identity Word8
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> StateT Natural Identity Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
r)
{-# INLINE outOfBytes #-}
outOfBytes :: forall (n :: Nat) .
(KnownNat n) =>
VU.Vector Word8 -> Finite n
outOfBytes :: Vector Word8 -> Finite n
outOfBytes v :: Vector Word8
v = State (Finite n) (Finite n) -> Finite n -> Finite n
forall s a. State s a -> s -> a
evalState ((Finite n -> Word8 -> State (Finite n) (Finite n))
-> Finite n -> Vector Word8 -> State (Finite n) (Finite n)
forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> b -> m a) -> a -> Vector b -> m a
VU.foldM' Finite n -> Word8 -> State (Finite n) (Finite n)
forall (m :: * -> *) a b.
(Monad m, Integral a, Num b) =>
b -> a -> StateT b m b
go 0 Vector Word8
v) 1
where go :: b -> a -> StateT b m b
go old :: b
old w :: a
w = do b
power <- StateT b m b
forall (m :: * -> *) s. Monad m => StateT s m s
get
let placeValue :: b
placeValue = b
power b -> b -> b
forall a. Num a => a -> a -> a
* a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w
(b -> b) -> StateT b m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (b -> b -> b
forall a. Num a => a -> a -> a
* 256)
b -> StateT b m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b
old b -> b -> b
forall a. Num a => a -> a -> a
+ b
placeValue)