{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | This is an unstable API, exposed only for testing. Relying on
-- this may break your code! Caveat emptor.
--
-- This module can (and perhaps should) be separate into its own
-- package, it's generally useful.
module Pantry.Internal.StaticBytes
  ( Bytes8
  , Bytes16
  , Bytes32
  , Bytes64
  , Bytes128
  , DynamicBytes
  , StaticBytes
  , StaticBytesException (..)
  , toStaticExact
  , toStaticPad
  , toStaticTruncate
  , toStaticPadTruncate
  , fromStatic
  ) where

import RIO hiding (words)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Base as VU
import qualified Data.Vector.Storable as VS
import System.IO.Unsafe (unsafePerformIO)
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import Data.Bits
import qualified Data.Primitive.ByteArray as BA
import Data.ByteArray

newtype Bytes8 = Bytes8 Word64
  deriving (Bytes8 -> Bytes8 -> Bool
(Bytes8 -> Bytes8 -> Bool)
-> (Bytes8 -> Bytes8 -> Bool) -> Eq Bytes8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bytes8 -> Bytes8 -> Bool
$c/= :: Bytes8 -> Bytes8 -> Bool
== :: Bytes8 -> Bytes8 -> Bool
$c== :: Bytes8 -> Bytes8 -> Bool
Eq, Eq Bytes8
Eq Bytes8
-> (Bytes8 -> Bytes8 -> Ordering)
-> (Bytes8 -> Bytes8 -> Bool)
-> (Bytes8 -> Bytes8 -> Bool)
-> (Bytes8 -> Bytes8 -> Bool)
-> (Bytes8 -> Bytes8 -> Bool)
-> (Bytes8 -> Bytes8 -> Bytes8)
-> (Bytes8 -> Bytes8 -> Bytes8)
-> Ord Bytes8
Bytes8 -> Bytes8 -> Bool
Bytes8 -> Bytes8 -> Ordering
Bytes8 -> Bytes8 -> Bytes8
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
min :: Bytes8 -> Bytes8 -> Bytes8
$cmin :: Bytes8 -> Bytes8 -> Bytes8
max :: Bytes8 -> Bytes8 -> Bytes8
$cmax :: Bytes8 -> Bytes8 -> Bytes8
>= :: Bytes8 -> Bytes8 -> Bool
$c>= :: Bytes8 -> Bytes8 -> Bool
> :: Bytes8 -> Bytes8 -> Bool
$c> :: Bytes8 -> Bytes8 -> Bool
<= :: Bytes8 -> Bytes8 -> Bool
$c<= :: Bytes8 -> Bytes8 -> Bool
< :: Bytes8 -> Bytes8 -> Bool
$c< :: Bytes8 -> Bytes8 -> Bool
compare :: Bytes8 -> Bytes8 -> Ordering
$ccompare :: Bytes8 -> Bytes8 -> Ordering
$cp1Ord :: Eq Bytes8
Ord, (forall x. Bytes8 -> Rep Bytes8 x)
-> (forall x. Rep Bytes8 x -> Bytes8) -> Generic Bytes8
forall x. Rep Bytes8 x -> Bytes8
forall x. Bytes8 -> Rep Bytes8 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bytes8 x -> Bytes8
$cfrom :: forall x. Bytes8 -> Rep Bytes8 x
Generic, Bytes8 -> ()
(Bytes8 -> ()) -> NFData Bytes8
forall a. (a -> ()) -> NFData a
rnf :: Bytes8 -> ()
$crnf :: Bytes8 -> ()
NFData, Eq Bytes8
Eq Bytes8
-> (Int -> Bytes8 -> Int) -> (Bytes8 -> Int) -> Hashable Bytes8
Int -> Bytes8 -> Int
Bytes8 -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Bytes8 -> Int
$chash :: Bytes8 -> Int
hashWithSalt :: Int -> Bytes8 -> Int
$chashWithSalt :: Int -> Bytes8 -> Int
$cp1Hashable :: Eq Bytes8
Hashable, Typeable Bytes8
DataType
Constr
Typeable Bytes8
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Bytes8 -> c Bytes8)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Bytes8)
-> (Bytes8 -> Constr)
-> (Bytes8 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Bytes8))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes8))
-> ((forall b. Data b => b -> b) -> Bytes8 -> Bytes8)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bytes8 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bytes8 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8)
-> Data Bytes8
Bytes8 -> DataType
Bytes8 -> Constr
(forall b. Data b => b -> b) -> Bytes8 -> Bytes8
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes8 -> c Bytes8
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes8
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bytes8 -> u
forall u. (forall d. Data d => d -> u) -> Bytes8 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes8
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes8 -> c Bytes8
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes8)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes8)
$cBytes8 :: Constr
$tBytes8 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
gmapMp :: (forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
gmapM :: (forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes8 -> m Bytes8
gmapQi :: Int -> (forall d. Data d => d -> u) -> Bytes8 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes8 -> u
gmapQ :: (forall d. Data d => d -> u) -> Bytes8 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes8 -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bytes8 -> r
gmapT :: (forall b. Data b => b -> b) -> Bytes8 -> Bytes8
$cgmapT :: (forall b. Data b => b -> b) -> Bytes8 -> Bytes8
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes8)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes8)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Bytes8)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes8)
dataTypeOf :: Bytes8 -> DataType
$cdataTypeOf :: Bytes8 -> DataType
toConstr :: Bytes8 -> Constr
$ctoConstr :: Bytes8 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes8
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes8
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes8 -> c Bytes8
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes8 -> c Bytes8
$cp1Data :: Typeable Bytes8
Data)
instance Show Bytes8 where
  show :: Bytes8 -> String
show (Bytes8 Word64
w) = ByteString -> String
forall a. Show a => a -> String
show (Int -> [Word64] -> ByteString
forall dbytes. DynamicBytes dbytes => Int -> [Word64] -> dbytes
fromWordsD Int
8 [Word64
w] :: B.ByteString)
data Bytes16 = Bytes16 !Bytes8 !Bytes8
  deriving (Int -> Bytes16 -> ShowS
[Bytes16] -> ShowS
Bytes16 -> String
(Int -> Bytes16 -> ShowS)
-> (Bytes16 -> String) -> ([Bytes16] -> ShowS) -> Show Bytes16
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bytes16] -> ShowS
$cshowList :: [Bytes16] -> ShowS
show :: Bytes16 -> String
$cshow :: Bytes16 -> String
showsPrec :: Int -> Bytes16 -> ShowS
$cshowsPrec :: Int -> Bytes16 -> ShowS
Show, Bytes16 -> Bytes16 -> Bool
(Bytes16 -> Bytes16 -> Bool)
-> (Bytes16 -> Bytes16 -> Bool) -> Eq Bytes16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bytes16 -> Bytes16 -> Bool
$c/= :: Bytes16 -> Bytes16 -> Bool
== :: Bytes16 -> Bytes16 -> Bool
$c== :: Bytes16 -> Bytes16 -> Bool
Eq, Eq Bytes16
Eq Bytes16
-> (Bytes16 -> Bytes16 -> Ordering)
-> (Bytes16 -> Bytes16 -> Bool)
-> (Bytes16 -> Bytes16 -> Bool)
-> (Bytes16 -> Bytes16 -> Bool)
-> (Bytes16 -> Bytes16 -> Bool)
-> (Bytes16 -> Bytes16 -> Bytes16)
-> (Bytes16 -> Bytes16 -> Bytes16)
-> Ord Bytes16
Bytes16 -> Bytes16 -> Bool
Bytes16 -> Bytes16 -> Ordering
Bytes16 -> Bytes16 -> Bytes16
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
min :: Bytes16 -> Bytes16 -> Bytes16
$cmin :: Bytes16 -> Bytes16 -> Bytes16
max :: Bytes16 -> Bytes16 -> Bytes16
$cmax :: Bytes16 -> Bytes16 -> Bytes16
>= :: Bytes16 -> Bytes16 -> Bool
$c>= :: Bytes16 -> Bytes16 -> Bool
> :: Bytes16 -> Bytes16 -> Bool
$c> :: Bytes16 -> Bytes16 -> Bool
<= :: Bytes16 -> Bytes16 -> Bool
$c<= :: Bytes16 -> Bytes16 -> Bool
< :: Bytes16 -> Bytes16 -> Bool
$c< :: Bytes16 -> Bytes16 -> Bool
compare :: Bytes16 -> Bytes16 -> Ordering
$ccompare :: Bytes16 -> Bytes16 -> Ordering
$cp1Ord :: Eq Bytes16
Ord, (forall x. Bytes16 -> Rep Bytes16 x)
-> (forall x. Rep Bytes16 x -> Bytes16) -> Generic Bytes16
forall x. Rep Bytes16 x -> Bytes16
forall x. Bytes16 -> Rep Bytes16 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bytes16 x -> Bytes16
$cfrom :: forall x. Bytes16 -> Rep Bytes16 x
Generic, Bytes16 -> ()
(Bytes16 -> ()) -> NFData Bytes16
forall a. (a -> ()) -> NFData a
rnf :: Bytes16 -> ()
$crnf :: Bytes16 -> ()
NFData, Eq Bytes16
Eq Bytes16
-> (Int -> Bytes16 -> Int) -> (Bytes16 -> Int) -> Hashable Bytes16
Int -> Bytes16 -> Int
Bytes16 -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Bytes16 -> Int
$chash :: Bytes16 -> Int
hashWithSalt :: Int -> Bytes16 -> Int
$chashWithSalt :: Int -> Bytes16 -> Int
$cp1Hashable :: Eq Bytes16
Hashable, Typeable Bytes16
DataType
Constr
Typeable Bytes16
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Bytes16 -> c Bytes16)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Bytes16)
-> (Bytes16 -> Constr)
-> (Bytes16 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Bytes16))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes16))
-> ((forall b. Data b => b -> b) -> Bytes16 -> Bytes16)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes16 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes16 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bytes16 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bytes16 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16)
-> Data Bytes16
Bytes16 -> DataType
Bytes16 -> Constr
(forall b. Data b => b -> b) -> Bytes16 -> Bytes16
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes16 -> c Bytes16
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes16
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bytes16 -> u
forall u. (forall d. Data d => d -> u) -> Bytes16 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes16
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes16 -> c Bytes16
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes16)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes16)
$cBytes16 :: Constr
$tBytes16 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
gmapMp :: (forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
gmapM :: (forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes16 -> m Bytes16
gmapQi :: Int -> (forall d. Data d => d -> u) -> Bytes16 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes16 -> u
gmapQ :: (forall d. Data d => d -> u) -> Bytes16 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes16 -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes16 -> r
gmapT :: (forall b. Data b => b -> b) -> Bytes16 -> Bytes16
$cgmapT :: (forall b. Data b => b -> b) -> Bytes16 -> Bytes16
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes16)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes16)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Bytes16)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes16)
dataTypeOf :: Bytes16 -> DataType
$cdataTypeOf :: Bytes16 -> DataType
toConstr :: Bytes16 -> Constr
$ctoConstr :: Bytes16 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes16
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes16
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes16 -> c Bytes16
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes16 -> c Bytes16
$cp1Data :: Typeable Bytes16
Data)
data Bytes32 = Bytes32 !Bytes16 !Bytes16
  deriving (Int -> Bytes32 -> ShowS
[Bytes32] -> ShowS
Bytes32 -> String
(Int -> Bytes32 -> ShowS)
-> (Bytes32 -> String) -> ([Bytes32] -> ShowS) -> Show Bytes32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bytes32] -> ShowS
$cshowList :: [Bytes32] -> ShowS
show :: Bytes32 -> String
$cshow :: Bytes32 -> String
showsPrec :: Int -> Bytes32 -> ShowS
$cshowsPrec :: Int -> Bytes32 -> ShowS
Show, Bytes32 -> Bytes32 -> Bool
(Bytes32 -> Bytes32 -> Bool)
-> (Bytes32 -> Bytes32 -> Bool) -> Eq Bytes32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bytes32 -> Bytes32 -> Bool
$c/= :: Bytes32 -> Bytes32 -> Bool
== :: Bytes32 -> Bytes32 -> Bool
$c== :: Bytes32 -> Bytes32 -> Bool
Eq, Eq Bytes32
Eq Bytes32
-> (Bytes32 -> Bytes32 -> Ordering)
-> (Bytes32 -> Bytes32 -> Bool)
-> (Bytes32 -> Bytes32 -> Bool)
-> (Bytes32 -> Bytes32 -> Bool)
-> (Bytes32 -> Bytes32 -> Bool)
-> (Bytes32 -> Bytes32 -> Bytes32)
-> (Bytes32 -> Bytes32 -> Bytes32)
-> Ord Bytes32
Bytes32 -> Bytes32 -> Bool
Bytes32 -> Bytes32 -> Ordering
Bytes32 -> Bytes32 -> Bytes32
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
min :: Bytes32 -> Bytes32 -> Bytes32
$cmin :: Bytes32 -> Bytes32 -> Bytes32
max :: Bytes32 -> Bytes32 -> Bytes32
$cmax :: Bytes32 -> Bytes32 -> Bytes32
>= :: Bytes32 -> Bytes32 -> Bool
$c>= :: Bytes32 -> Bytes32 -> Bool
> :: Bytes32 -> Bytes32 -> Bool
$c> :: Bytes32 -> Bytes32 -> Bool
<= :: Bytes32 -> Bytes32 -> Bool
$c<= :: Bytes32 -> Bytes32 -> Bool
< :: Bytes32 -> Bytes32 -> Bool
$c< :: Bytes32 -> Bytes32 -> Bool
compare :: Bytes32 -> Bytes32 -> Ordering
$ccompare :: Bytes32 -> Bytes32 -> Ordering
$cp1Ord :: Eq Bytes32
Ord, (forall x. Bytes32 -> Rep Bytes32 x)
-> (forall x. Rep Bytes32 x -> Bytes32) -> Generic Bytes32
forall x. Rep Bytes32 x -> Bytes32
forall x. Bytes32 -> Rep Bytes32 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bytes32 x -> Bytes32
$cfrom :: forall x. Bytes32 -> Rep Bytes32 x
Generic, Bytes32 -> ()
(Bytes32 -> ()) -> NFData Bytes32
forall a. (a -> ()) -> NFData a
rnf :: Bytes32 -> ()
$crnf :: Bytes32 -> ()
NFData, Eq Bytes32
Eq Bytes32
-> (Int -> Bytes32 -> Int) -> (Bytes32 -> Int) -> Hashable Bytes32
Int -> Bytes32 -> Int
Bytes32 -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Bytes32 -> Int
$chash :: Bytes32 -> Int
hashWithSalt :: Int -> Bytes32 -> Int
$chashWithSalt :: Int -> Bytes32 -> Int
$cp1Hashable :: Eq Bytes32
Hashable, Typeable Bytes32
DataType
Constr
Typeable Bytes32
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Bytes32 -> c Bytes32)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Bytes32)
-> (Bytes32 -> Constr)
-> (Bytes32 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Bytes32))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes32))
-> ((forall b. Data b => b -> b) -> Bytes32 -> Bytes32)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes32 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes32 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bytes32 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bytes32 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32)
-> Data Bytes32
Bytes32 -> DataType
Bytes32 -> Constr
(forall b. Data b => b -> b) -> Bytes32 -> Bytes32
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes32 -> c Bytes32
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes32
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bytes32 -> u
forall u. (forall d. Data d => d -> u) -> Bytes32 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes32
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes32 -> c Bytes32
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes32)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes32)
$cBytes32 :: Constr
$tBytes32 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
gmapMp :: (forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
gmapM :: (forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes32 -> m Bytes32
gmapQi :: Int -> (forall d. Data d => d -> u) -> Bytes32 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes32 -> u
gmapQ :: (forall d. Data d => d -> u) -> Bytes32 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes32 -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes32 -> r
gmapT :: (forall b. Data b => b -> b) -> Bytes32 -> Bytes32
$cgmapT :: (forall b. Data b => b -> b) -> Bytes32 -> Bytes32
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes32)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes32)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Bytes32)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes32)
dataTypeOf :: Bytes32 -> DataType
$cdataTypeOf :: Bytes32 -> DataType
toConstr :: Bytes32 -> Constr
$ctoConstr :: Bytes32 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes32
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes32
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes32 -> c Bytes32
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes32 -> c Bytes32
$cp1Data :: Typeable Bytes32
Data)
data Bytes64 = Bytes64 !Bytes32 !Bytes32
  deriving (Int -> Bytes64 -> ShowS
[Bytes64] -> ShowS
Bytes64 -> String
(Int -> Bytes64 -> ShowS)
-> (Bytes64 -> String) -> ([Bytes64] -> ShowS) -> Show Bytes64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bytes64] -> ShowS
$cshowList :: [Bytes64] -> ShowS
show :: Bytes64 -> String
$cshow :: Bytes64 -> String
showsPrec :: Int -> Bytes64 -> ShowS
$cshowsPrec :: Int -> Bytes64 -> ShowS
Show, Bytes64 -> Bytes64 -> Bool
(Bytes64 -> Bytes64 -> Bool)
-> (Bytes64 -> Bytes64 -> Bool) -> Eq Bytes64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bytes64 -> Bytes64 -> Bool
$c/= :: Bytes64 -> Bytes64 -> Bool
== :: Bytes64 -> Bytes64 -> Bool
$c== :: Bytes64 -> Bytes64 -> Bool
Eq, Eq Bytes64
Eq Bytes64
-> (Bytes64 -> Bytes64 -> Ordering)
-> (Bytes64 -> Bytes64 -> Bool)
-> (Bytes64 -> Bytes64 -> Bool)
-> (Bytes64 -> Bytes64 -> Bool)
-> (Bytes64 -> Bytes64 -> Bool)
-> (Bytes64 -> Bytes64 -> Bytes64)
-> (Bytes64 -> Bytes64 -> Bytes64)
-> Ord Bytes64
Bytes64 -> Bytes64 -> Bool
Bytes64 -> Bytes64 -> Ordering
Bytes64 -> Bytes64 -> Bytes64
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
min :: Bytes64 -> Bytes64 -> Bytes64
$cmin :: Bytes64 -> Bytes64 -> Bytes64
max :: Bytes64 -> Bytes64 -> Bytes64
$cmax :: Bytes64 -> Bytes64 -> Bytes64
>= :: Bytes64 -> Bytes64 -> Bool
$c>= :: Bytes64 -> Bytes64 -> Bool
> :: Bytes64 -> Bytes64 -> Bool
$c> :: Bytes64 -> Bytes64 -> Bool
<= :: Bytes64 -> Bytes64 -> Bool
$c<= :: Bytes64 -> Bytes64 -> Bool
< :: Bytes64 -> Bytes64 -> Bool
$c< :: Bytes64 -> Bytes64 -> Bool
compare :: Bytes64 -> Bytes64 -> Ordering
$ccompare :: Bytes64 -> Bytes64 -> Ordering
$cp1Ord :: Eq Bytes64
Ord, (forall x. Bytes64 -> Rep Bytes64 x)
-> (forall x. Rep Bytes64 x -> Bytes64) -> Generic Bytes64
forall x. Rep Bytes64 x -> Bytes64
forall x. Bytes64 -> Rep Bytes64 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bytes64 x -> Bytes64
$cfrom :: forall x. Bytes64 -> Rep Bytes64 x
Generic, Bytes64 -> ()
(Bytes64 -> ()) -> NFData Bytes64
forall a. (a -> ()) -> NFData a
rnf :: Bytes64 -> ()
$crnf :: Bytes64 -> ()
NFData, Eq Bytes64
Eq Bytes64
-> (Int -> Bytes64 -> Int) -> (Bytes64 -> Int) -> Hashable Bytes64
Int -> Bytes64 -> Int
Bytes64 -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Bytes64 -> Int
$chash :: Bytes64 -> Int
hashWithSalt :: Int -> Bytes64 -> Int
$chashWithSalt :: Int -> Bytes64 -> Int
$cp1Hashable :: Eq Bytes64
Hashable, Typeable Bytes64
DataType
Constr
Typeable Bytes64
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Bytes64 -> c Bytes64)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Bytes64)
-> (Bytes64 -> Constr)
-> (Bytes64 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Bytes64))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes64))
-> ((forall b. Data b => b -> b) -> Bytes64 -> Bytes64)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes64 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes64 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bytes64 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bytes64 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64)
-> Data Bytes64
Bytes64 -> DataType
Bytes64 -> Constr
(forall b. Data b => b -> b) -> Bytes64 -> Bytes64
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes64 -> c Bytes64
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes64
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bytes64 -> u
forall u. (forall d. Data d => d -> u) -> Bytes64 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes64
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes64 -> c Bytes64
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes64)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes64)
$cBytes64 :: Constr
$tBytes64 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
gmapMp :: (forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
gmapM :: (forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes64 -> m Bytes64
gmapQi :: Int -> (forall d. Data d => d -> u) -> Bytes64 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes64 -> u
gmapQ :: (forall d. Data d => d -> u) -> Bytes64 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes64 -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes64 -> r
gmapT :: (forall b. Data b => b -> b) -> Bytes64 -> Bytes64
$cgmapT :: (forall b. Data b => b -> b) -> Bytes64 -> Bytes64
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes64)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes64)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Bytes64)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes64)
dataTypeOf :: Bytes64 -> DataType
$cdataTypeOf :: Bytes64 -> DataType
toConstr :: Bytes64 -> Constr
$ctoConstr :: Bytes64 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes64
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes64
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes64 -> c Bytes64
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes64 -> c Bytes64
$cp1Data :: Typeable Bytes64
Data)
data Bytes128 = Bytes128 !Bytes64 !Bytes64
  deriving (Int -> Bytes128 -> ShowS
[Bytes128] -> ShowS
Bytes128 -> String
(Int -> Bytes128 -> ShowS)
-> (Bytes128 -> String) -> ([Bytes128] -> ShowS) -> Show Bytes128
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bytes128] -> ShowS
$cshowList :: [Bytes128] -> ShowS
show :: Bytes128 -> String
$cshow :: Bytes128 -> String
showsPrec :: Int -> Bytes128 -> ShowS
$cshowsPrec :: Int -> Bytes128 -> ShowS
Show, Bytes128 -> Bytes128 -> Bool
(Bytes128 -> Bytes128 -> Bool)
-> (Bytes128 -> Bytes128 -> Bool) -> Eq Bytes128
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bytes128 -> Bytes128 -> Bool
$c/= :: Bytes128 -> Bytes128 -> Bool
== :: Bytes128 -> Bytes128 -> Bool
$c== :: Bytes128 -> Bytes128 -> Bool
Eq, Eq Bytes128
Eq Bytes128
-> (Bytes128 -> Bytes128 -> Ordering)
-> (Bytes128 -> Bytes128 -> Bool)
-> (Bytes128 -> Bytes128 -> Bool)
-> (Bytes128 -> Bytes128 -> Bool)
-> (Bytes128 -> Bytes128 -> Bool)
-> (Bytes128 -> Bytes128 -> Bytes128)
-> (Bytes128 -> Bytes128 -> Bytes128)
-> Ord Bytes128
Bytes128 -> Bytes128 -> Bool
Bytes128 -> Bytes128 -> Ordering
Bytes128 -> Bytes128 -> Bytes128
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
min :: Bytes128 -> Bytes128 -> Bytes128
$cmin :: Bytes128 -> Bytes128 -> Bytes128
max :: Bytes128 -> Bytes128 -> Bytes128
$cmax :: Bytes128 -> Bytes128 -> Bytes128
>= :: Bytes128 -> Bytes128 -> Bool
$c>= :: Bytes128 -> Bytes128 -> Bool
> :: Bytes128 -> Bytes128 -> Bool
$c> :: Bytes128 -> Bytes128 -> Bool
<= :: Bytes128 -> Bytes128 -> Bool
$c<= :: Bytes128 -> Bytes128 -> Bool
< :: Bytes128 -> Bytes128 -> Bool
$c< :: Bytes128 -> Bytes128 -> Bool
compare :: Bytes128 -> Bytes128 -> Ordering
$ccompare :: Bytes128 -> Bytes128 -> Ordering
$cp1Ord :: Eq Bytes128
Ord, (forall x. Bytes128 -> Rep Bytes128 x)
-> (forall x. Rep Bytes128 x -> Bytes128) -> Generic Bytes128
forall x. Rep Bytes128 x -> Bytes128
forall x. Bytes128 -> Rep Bytes128 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bytes128 x -> Bytes128
$cfrom :: forall x. Bytes128 -> Rep Bytes128 x
Generic, Bytes128 -> ()
(Bytes128 -> ()) -> NFData Bytes128
forall a. (a -> ()) -> NFData a
rnf :: Bytes128 -> ()
$crnf :: Bytes128 -> ()
NFData, Eq Bytes128
Eq Bytes128
-> (Int -> Bytes128 -> Int)
-> (Bytes128 -> Int)
-> Hashable Bytes128
Int -> Bytes128 -> Int
Bytes128 -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Bytes128 -> Int
$chash :: Bytes128 -> Int
hashWithSalt :: Int -> Bytes128 -> Int
$chashWithSalt :: Int -> Bytes128 -> Int
$cp1Hashable :: Eq Bytes128
Hashable, Typeable Bytes128
DataType
Constr
Typeable Bytes128
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Bytes128 -> c Bytes128)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Bytes128)
-> (Bytes128 -> Constr)
-> (Bytes128 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Bytes128))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes128))
-> ((forall b. Data b => b -> b) -> Bytes128 -> Bytes128)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes128 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bytes128 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bytes128 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bytes128 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128)
-> Data Bytes128
Bytes128 -> DataType
Bytes128 -> Constr
(forall b. Data b => b -> b) -> Bytes128 -> Bytes128
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes128 -> c Bytes128
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes128
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bytes128 -> u
forall u. (forall d. Data d => d -> u) -> Bytes128 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes128
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes128 -> c Bytes128
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes128)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes128)
$cBytes128 :: Constr
$tBytes128 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
gmapMp :: (forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
gmapM :: (forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bytes128 -> m Bytes128
gmapQi :: Int -> (forall d. Data d => d -> u) -> Bytes128 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bytes128 -> u
gmapQ :: (forall d. Data d => d -> u) -> Bytes128 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bytes128 -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bytes128 -> r
gmapT :: (forall b. Data b => b -> b) -> Bytes128 -> Bytes128
$cgmapT :: (forall b. Data b => b -> b) -> Bytes128 -> Bytes128
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes128)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bytes128)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Bytes128)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bytes128)
dataTypeOf :: Bytes128 -> DataType
$cdataTypeOf :: Bytes128 -> DataType
toConstr :: Bytes128 -> Constr
$ctoConstr :: Bytes128 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes128
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bytes128
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes128 -> c Bytes128
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bytes128 -> c Bytes128
$cp1Data :: Typeable Bytes128
Data)

data StaticBytesException
  = NotEnoughBytes
  | TooManyBytes
  deriving (Int -> StaticBytesException -> ShowS
[StaticBytesException] -> ShowS
StaticBytesException -> String
(Int -> StaticBytesException -> ShowS)
-> (StaticBytesException -> String)
-> ([StaticBytesException] -> ShowS)
-> Show StaticBytesException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticBytesException] -> ShowS
$cshowList :: [StaticBytesException] -> ShowS
show :: StaticBytesException -> String
$cshow :: StaticBytesException -> String
showsPrec :: Int -> StaticBytesException -> ShowS
$cshowsPrec :: Int -> StaticBytesException -> ShowS
Show, StaticBytesException -> StaticBytesException -> Bool
(StaticBytesException -> StaticBytesException -> Bool)
-> (StaticBytesException -> StaticBytesException -> Bool)
-> Eq StaticBytesException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaticBytesException -> StaticBytesException -> Bool
$c/= :: StaticBytesException -> StaticBytesException -> Bool
== :: StaticBytesException -> StaticBytesException -> Bool
$c== :: StaticBytesException -> StaticBytesException -> Bool
Eq, Typeable)
instance Exception StaticBytesException

-- All lengths below are given in bytes

class DynamicBytes dbytes where
  lengthD :: dbytes -> Int
  -- | Yeah, it looks terrible to use a list here, but fusion should
  -- kick in
  withPeekD :: dbytes -> ((Int -> IO Word64) -> IO a) -> IO a
  -- | May throw a runtime exception if invariants are violated!
  fromWordsD :: Int -> [Word64] -> dbytes

fromWordsForeign
  :: (ForeignPtr a -> Int -> b)
  -> Int
  -> [Word64]
  -> b
fromWordsForeign :: (ForeignPtr a -> Int -> b) -> Int -> [Word64] -> b
fromWordsForeign ForeignPtr a -> Int -> b
wrapper Int
len [Word64]
words0 = IO b -> b
forall a. IO a -> a
unsafePerformIO (IO b -> b) -> IO b -> b
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr a
fptr <- Int -> IO (ForeignPtr a)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
len
  ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
    let loop :: Int -> [Word64] -> IO ()
loop Int
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        loop Int
off (Word64
w:[Word64]
ws) = do
          Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (Ptr a -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
off Word64
w
          Int -> [Word64] -> IO ()
loop (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Word64]
ws
    Int -> [Word64] -> IO ()
loop Int
0 [Word64]
words0
  b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> Int -> b
wrapper ForeignPtr a
fptr Int
len

withPeekForeign
  :: (ForeignPtr a, Int, Int)
  -> ((Int -> IO Word64) -> IO b)
  -> IO b
withPeekForeign :: (ForeignPtr a, Int, Int) -> ((Int -> IO Word64) -> IO b) -> IO b
withPeekForeign (ForeignPtr a
fptr, Int
off, Int
len) (Int -> IO Word64) -> IO b
inner =
  ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
    let f :: Int -> IO Word64
f Int
off'
          | Int
off' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
0
          | Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len = do
              let loop :: Word64 -> Int -> IO Word64
loop Word64
w64 Int
i
                    | Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
w64
                    | Bool
otherwise = do
                        Word8
w8 :: Word8 <- Ptr a -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
                        let w64' :: Word64
w64' = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w64
                        Word64 -> Int -> IO Word64
loop Word64
w64' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              Word64 -> Int -> IO Word64
loop Word64
0 Int
0
          | Bool
otherwise = Ptr a -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off')
    (Int -> IO Word64) -> IO b
inner Int -> IO Word64
f

instance DynamicBytes B.ByteString where
  lengthD :: ByteString -> Int
lengthD = ByteString -> Int
B.length
  fromWordsD :: Int -> [Word64] -> ByteString
fromWordsD = (ForeignPtr Word8 -> Int -> ByteString)
-> Int -> [Word64] -> ByteString
forall a b. (ForeignPtr a -> Int -> b) -> Int -> [Word64] -> b
fromWordsForeign (\ForeignPtr Word8
fptr Int
len -> ForeignPtr Word8 -> Int -> Int -> ByteString
B.fromForeignPtr ForeignPtr Word8
fptr Int
0 Int
len)
  withPeekD :: ByteString -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD = (ForeignPtr Word8, Int, Int)
-> ((Int -> IO Word64) -> IO a) -> IO a
forall a b.
(ForeignPtr a, Int, Int) -> ((Int -> IO Word64) -> IO b) -> IO b
withPeekForeign ((ForeignPtr Word8, Int, Int)
 -> ((Int -> IO Word64) -> IO a) -> IO a)
-> (ByteString -> (ForeignPtr Word8, Int, Int))
-> ByteString
-> ((Int -> IO Word64) -> IO a)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ForeignPtr Word8, Int, Int)
B.toForeignPtr

instance word8 ~ Word8 => DynamicBytes (VS.Vector word8) where
  lengthD :: Vector word8 -> Int
lengthD = Vector word8 -> Int
forall a. Storable a => Vector a -> Int
VS.length
  fromWordsD :: Int -> [Word64] -> Vector word8
fromWordsD = (ForeignPtr word8 -> Int -> Vector word8)
-> Int -> [Word64] -> Vector word8
forall a b. (ForeignPtr a -> Int -> b) -> Int -> [Word64] -> b
fromWordsForeign ForeignPtr word8 -> Int -> Vector word8
forall a. Storable a => ForeignPtr a -> Int -> Vector a
VS.unsafeFromForeignPtr0
  withPeekD :: Vector word8 -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD = (ForeignPtr word8, Int, Int)
-> ((Int -> IO Word64) -> IO a) -> IO a
forall a b.
(ForeignPtr a, Int, Int) -> ((Int -> IO Word64) -> IO b) -> IO b
withPeekForeign ((ForeignPtr word8, Int, Int)
 -> ((Int -> IO Word64) -> IO a) -> IO a)
-> (Vector word8 -> (ForeignPtr word8, Int, Int))
-> Vector word8
-> ((Int -> IO Word64) -> IO a)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector word8 -> (ForeignPtr word8, Int, Int)
forall a. Storable a => Vector a -> (ForeignPtr a, Int, Int)
VS.unsafeToForeignPtr

instance word8 ~ Word8 => DynamicBytes (VP.Vector word8) where
  lengthD :: Vector word8 -> Int
lengthD = Vector word8 -> Int
forall a. Prim a => Vector a -> Int
VP.length
  fromWordsD :: Int -> [Word64] -> Vector word8
fromWordsD Int
len [Word64]
words0 = IO (Vector word8) -> Vector word8
forall a. IO a -> a
unsafePerformIO (IO (Vector word8) -> Vector word8)
-> IO (Vector word8) -> Vector word8
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray RealWorld
ba <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
BA.newByteArray Int
len
    let loop :: Int -> [Word64] -> IO (Vector word8)
loop Int
_ [] =
          Int -> Int -> ByteArray -> Vector word8
forall a. Int -> Int -> ByteArray -> Vector a
VP.Vector Int
0 Int
len (ByteArray -> Vector word8) -> IO ByteArray -> IO (Vector word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
BA.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
ba
        loop Int
i (Word64
w:[Word64]
ws) = do
          MutableByteArray (PrimState IO) -> Int -> Word64 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
ba Int
i Word64
w
          Int -> [Word64] -> IO (Vector word8)
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Word64]
ws
    Int -> [Word64] -> IO (Vector word8)
loop Int
0 [Word64]
words0
  withPeekD :: Vector word8 -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD (VP.Vector Int
off Int
len ByteArray
ba) (Int -> IO Word64) -> IO a
inner = do
    let f :: Int -> IO Word64
f Int
off'
          | Int
off' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
0
          | Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len = do
              let loop :: Word64 -> Int -> IO Word64
loop Word64
w64 Int
i
                    | Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
w64
                    | Bool
otherwise = do
                        let Word8
w8 :: Word8 = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
                        let w64' :: Word64
w64' = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w64
                        Word64 -> Int -> IO Word64
loop Word64
w64' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              Word64 -> Int -> IO Word64
loop Word64
0 Int
0
          | Bool
otherwise = Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> IO Word64) -> Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Word64
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
off' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8))
    (Int -> IO Word64) -> IO a
inner Int -> IO Word64
f

instance word8 ~ Word8 => DynamicBytes (VU.Vector word8) where
  lengthD :: Vector word8 -> Int
lengthD = Vector word8 -> Int
forall a. Unbox a => Vector a -> Int
VU.length
  fromWordsD :: Int -> [Word64] -> Vector word8
fromWordsD Int
len [Word64]
words = Vector Word8 -> Vector Word8
VU.V_Word8 (Int -> [Word64] -> Vector Word8
forall dbytes. DynamicBytes dbytes => Int -> [Word64] -> dbytes
fromWordsD Int
len [Word64]
words)
  withPeekD :: Vector word8 -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD (VU.V_Word8 v) = Vector Word8 -> ((Int -> IO Word64) -> IO a) -> IO a
forall dbytes a.
DynamicBytes dbytes =>
dbytes -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD Vector Word8
v

class StaticBytes sbytes where
  lengthS :: proxy sbytes -> Int -- use type level literals instead?
  -- difference list
  toWordsS :: sbytes -> [Word64] -> [Word64]
  usePeekS :: Int -> (Int -> IO Word64) -> IO sbytes

instance StaticBytes Bytes8 where
  lengthS :: proxy Bytes8 -> Int
lengthS proxy Bytes8
_ = Int
8
  toWordsS :: Bytes8 -> [Word64] -> [Word64]
toWordsS (Bytes8 Word64
w) = (Word64
wWord64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
:)
  usePeekS :: Int -> (Int -> IO Word64) -> IO Bytes8
usePeekS Int
off Int -> IO Word64
f = Word64 -> Bytes8
Bytes8 (Word64 -> Bytes8) -> IO Word64 -> IO Bytes8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Word64
f Int
off

instance StaticBytes Bytes16 where
  lengthS :: proxy Bytes16 -> Int
lengthS proxy Bytes16
_ = Int
16
  toWordsS :: Bytes16 -> [Word64] -> [Word64]
toWordsS (Bytes16 Bytes8
b1 Bytes8
b2) = Bytes8 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes8
b1 ([Word64] -> [Word64])
-> ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes8 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes8
b2
  usePeekS :: Int -> (Int -> IO Word64) -> IO Bytes16
usePeekS Int
off Int -> IO Word64
f = Bytes8 -> Bytes8 -> Bytes16
Bytes16 (Bytes8 -> Bytes8 -> Bytes16)
-> IO Bytes8 -> IO (Bytes8 -> Bytes16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Int -> IO Word64) -> IO Bytes8
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS Int
off Int -> IO Word64
f IO (Bytes8 -> Bytes16) -> IO Bytes8 -> IO Bytes16
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> (Int -> IO Word64) -> IO Bytes8
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Int -> IO Word64
f

instance StaticBytes Bytes32 where
  lengthS :: proxy Bytes32 -> Int
lengthS proxy Bytes32
_ = Int
32
  toWordsS :: Bytes32 -> [Word64] -> [Word64]
toWordsS (Bytes32 Bytes16
b1 Bytes16
b2) = Bytes16 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes16
b1 ([Word64] -> [Word64])
-> ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes16 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes16
b2
  usePeekS :: Int -> (Int -> IO Word64) -> IO Bytes32
usePeekS Int
off Int -> IO Word64
f = Bytes16 -> Bytes16 -> Bytes32
Bytes32 (Bytes16 -> Bytes16 -> Bytes32)
-> IO Bytes16 -> IO (Bytes16 -> Bytes32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Int -> IO Word64) -> IO Bytes16
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS Int
off Int -> IO Word64
f IO (Bytes16 -> Bytes32) -> IO Bytes16 -> IO Bytes32
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> (Int -> IO Word64) -> IO Bytes16
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16) Int -> IO Word64
f

instance StaticBytes Bytes64 where
  lengthS :: proxy Bytes64 -> Int
lengthS proxy Bytes64
_ = Int
64
  toWordsS :: Bytes64 -> [Word64] -> [Word64]
toWordsS (Bytes64 Bytes32
b1 Bytes32
b2) = Bytes32 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes32
b1 ([Word64] -> [Word64])
-> ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes32 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes32
b2
  usePeekS :: Int -> (Int -> IO Word64) -> IO Bytes64
usePeekS Int
off Int -> IO Word64
f = Bytes32 -> Bytes32 -> Bytes64
Bytes64 (Bytes32 -> Bytes32 -> Bytes64)
-> IO Bytes32 -> IO (Bytes32 -> Bytes64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Int -> IO Word64) -> IO Bytes32
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS Int
off Int -> IO Word64
f IO (Bytes32 -> Bytes64) -> IO Bytes32 -> IO Bytes64
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> (Int -> IO Word64) -> IO Bytes32
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32) Int -> IO Word64
f

instance StaticBytes Bytes128 where
  lengthS :: proxy Bytes128 -> Int
lengthS proxy Bytes128
_ = Int
128
  toWordsS :: Bytes128 -> [Word64] -> [Word64]
toWordsS (Bytes128 Bytes64
b1 Bytes64
b2) = Bytes64 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes64
b1 ([Word64] -> [Word64])
-> ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes64 -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS Bytes64
b2
  usePeekS :: Int -> (Int -> IO Word64) -> IO Bytes128
usePeekS Int
off Int -> IO Word64
f = Bytes64 -> Bytes64 -> Bytes128
Bytes128 (Bytes64 -> Bytes64 -> Bytes128)
-> IO Bytes64 -> IO (Bytes64 -> Bytes128)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Int -> IO Word64) -> IO Bytes64
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS Int
off Int -> IO Word64
f IO (Bytes64 -> Bytes128) -> IO Bytes64 -> IO Bytes128
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> (Int -> IO Word64) -> IO Bytes64
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64) Int -> IO Word64
f

instance ByteArrayAccess Bytes8 where
  length :: Bytes8 -> Int
length Bytes8
_ = Int
8
  withByteArray :: Bytes8 -> (Ptr p -> IO a) -> IO a
withByteArray = Bytes8 -> (Ptr p -> IO a) -> IO a
forall sbytes p a.
StaticBytes sbytes =>
sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS
instance ByteArrayAccess Bytes16 where
  length :: Bytes16 -> Int
length Bytes16
_ = Int
16
  withByteArray :: Bytes16 -> (Ptr p -> IO a) -> IO a
withByteArray = Bytes16 -> (Ptr p -> IO a) -> IO a
forall sbytes p a.
StaticBytes sbytes =>
sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS
instance ByteArrayAccess Bytes32 where
  length :: Bytes32 -> Int
length Bytes32
_ = Int
32
  withByteArray :: Bytes32 -> (Ptr p -> IO a) -> IO a
withByteArray = Bytes32 -> (Ptr p -> IO a) -> IO a
forall sbytes p a.
StaticBytes sbytes =>
sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS
instance ByteArrayAccess Bytes64 where
  length :: Bytes64 -> Int
length Bytes64
_ = Int
64
  withByteArray :: Bytes64 -> (Ptr p -> IO a) -> IO a
withByteArray = Bytes64 -> (Ptr p -> IO a) -> IO a
forall sbytes p a.
StaticBytes sbytes =>
sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS
instance ByteArrayAccess Bytes128 where
  length :: Bytes128 -> Int
length Bytes128
_ = Int
128
  withByteArray :: Bytes128 -> (Ptr p -> IO a) -> IO a
withByteArray = Bytes128 -> (Ptr p -> IO a) -> IO a
forall sbytes p a.
StaticBytes sbytes =>
sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS

withByteArrayS :: StaticBytes sbytes => sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS :: sbytes -> (Ptr p -> IO a) -> IO a
withByteArrayS sbytes
sbytes = ByteString -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray (sbytes -> ByteString
forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
sbytes -> dbytes
fromStatic sbytes
sbytes :: ByteString)

toStaticExact
  :: forall dbytes sbytes.
     (DynamicBytes dbytes, StaticBytes sbytes)
  => dbytes
  -> Either StaticBytesException sbytes
toStaticExact :: dbytes -> Either StaticBytesException sbytes
toStaticExact dbytes
dbytes =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (dbytes -> Int
forall dbytes. DynamicBytes dbytes => dbytes -> Int
lengthD dbytes
dbytes) (Maybe sbytes -> Int
forall sbytes (proxy :: * -> *).
StaticBytes sbytes =>
proxy sbytes -> Int
lengthS (Maybe sbytes
forall a. Maybe a
Nothing :: Maybe sbytes)) of
    Ordering
LT -> StaticBytesException -> Either StaticBytesException sbytes
forall a b. a -> Either a b
Left StaticBytesException
NotEnoughBytes
    Ordering
GT -> StaticBytesException -> Either StaticBytesException sbytes
forall a b. a -> Either a b
Left StaticBytesException
TooManyBytes
    Ordering
EQ -> sbytes -> Either StaticBytesException sbytes
forall a b. b -> Either a b
Right (dbytes -> sbytes
forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> sbytes
toStaticPadTruncate dbytes
dbytes)

toStaticPad
  :: forall dbytes sbytes.
     (DynamicBytes dbytes, StaticBytes sbytes)
  => dbytes
  -> Either StaticBytesException sbytes
toStaticPad :: dbytes -> Either StaticBytesException sbytes
toStaticPad dbytes
dbytes =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (dbytes -> Int
forall dbytes. DynamicBytes dbytes => dbytes -> Int
lengthD dbytes
dbytes) (Maybe sbytes -> Int
forall sbytes (proxy :: * -> *).
StaticBytes sbytes =>
proxy sbytes -> Int
lengthS (Maybe sbytes
forall a. Maybe a
Nothing :: Maybe sbytes)) of
    Ordering
GT -> StaticBytesException -> Either StaticBytesException sbytes
forall a b. a -> Either a b
Left StaticBytesException
TooManyBytes
    Ordering
_  -> sbytes -> Either StaticBytesException sbytes
forall a b. b -> Either a b
Right (dbytes -> sbytes
forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> sbytes
toStaticPadTruncate dbytes
dbytes)

toStaticTruncate
  :: forall dbytes sbytes.
     (DynamicBytes dbytes, StaticBytes sbytes)
  => dbytes
  -> Either StaticBytesException sbytes
toStaticTruncate :: dbytes -> Either StaticBytesException sbytes
toStaticTruncate dbytes
dbytes =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (dbytes -> Int
forall dbytes. DynamicBytes dbytes => dbytes -> Int
lengthD dbytes
dbytes) (Maybe sbytes -> Int
forall sbytes (proxy :: * -> *).
StaticBytes sbytes =>
proxy sbytes -> Int
lengthS (Maybe sbytes
forall a. Maybe a
Nothing :: Maybe sbytes)) of
    Ordering
LT -> StaticBytesException -> Either StaticBytesException sbytes
forall a b. a -> Either a b
Left StaticBytesException
NotEnoughBytes
    Ordering
_  -> sbytes -> Either StaticBytesException sbytes
forall a b. b -> Either a b
Right (dbytes -> sbytes
forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> sbytes
toStaticPadTruncate dbytes
dbytes)

toStaticPadTruncate
  :: (DynamicBytes dbytes, StaticBytes sbytes)
  => dbytes
  -> sbytes
toStaticPadTruncate :: dbytes -> sbytes
toStaticPadTruncate dbytes
dbytes = IO sbytes -> sbytes
forall a. IO a -> a
unsafePerformIO (dbytes -> ((Int -> IO Word64) -> IO sbytes) -> IO sbytes
forall dbytes a.
DynamicBytes dbytes =>
dbytes -> ((Int -> IO Word64) -> IO a) -> IO a
withPeekD dbytes
dbytes (Int -> (Int -> IO Word64) -> IO sbytes
forall sbytes.
StaticBytes sbytes =>
Int -> (Int -> IO Word64) -> IO sbytes
usePeekS Int
0))

fromStatic
  :: forall dbytes sbytes.
     (DynamicBytes dbytes, StaticBytes sbytes)
  => sbytes
  -> dbytes
fromStatic :: sbytes -> dbytes
fromStatic = Int -> [Word64] -> dbytes
forall dbytes. DynamicBytes dbytes => Int -> [Word64] -> dbytes
fromWordsD (Maybe sbytes -> Int
forall sbytes (proxy :: * -> *).
StaticBytes sbytes =>
proxy sbytes -> Int
lengthS (Maybe sbytes
forall a. Maybe a
Nothing :: Maybe sbytes)) ([Word64] -> dbytes) -> (sbytes -> [Word64]) -> sbytes -> dbytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ []) (([Word64] -> [Word64]) -> [Word64])
-> (sbytes -> [Word64] -> [Word64]) -> sbytes -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sbytes -> [Word64] -> [Word64]
forall sbytes. StaticBytes sbytes => sbytes -> [Word64] -> [Word64]
toWordsS