{-# LANGUAGE TemplateHaskell #-}
module Streamly.Internal.Data.Serialize.TH.Bottom
(
SerializeConfig(..)
, serializeConfig
, inlineAddSizeTo
, inlineSerializeAt
, inlineDeserializeAt
, encodeConstrNames
, encodeRecordFields
, TypeOfType(..)
, typeOfType
, SimpleDataCon(..)
, simplifyDataCon
, Field
, mkFieldName
, isUnitType
, isRecordSyntax
, c2w
, wListToString
, xorCmp
, serializeW8List
, litIntegral
, litProxy
, matchConstructor
, openConstructor
, makeI
, makeN
, makeA
, int_w8
, int_w32
, w32_int
, w8_int
, _acc
, _arr
, _endOffset
, _initialOffset
, _x
, _tag
, _val
, errorUnsupported
, errorUnimplemented
) where
import Data.Maybe (isJust)
import Data.Char (chr, ord)
import Data.List (foldl')
import Data.Word (Word16, Word32, Word64, Word8)
import Data.Bits (Bits, (.|.), shiftL, zeroBits, xor)
import Streamly.Internal.System.IO (unsafeInlineIO)
import Streamly.Internal.Data.Unbox (Unbox)
import Data.Proxy (Proxy)
import Language.Haskell.TH
import Streamly.Internal.Data.Serialize.Type
import qualified Streamly.Internal.Data.Unbox as Unbox
import Streamly.Internal.Data.Unbox.TH (DataCon(..))
data SerializeConfig =
SerializeConfig
{ SerializeConfig -> Maybe Inline
cfgInlineSize :: Maybe Inline
, SerializeConfig -> Maybe Inline
cfgInlineSerialize :: Maybe Inline
, SerializeConfig -> Maybe Inline
cfgInlineDeserialize :: Maybe Inline
, SerializeConfig -> Bool
cfgConstructorTagAsString :: Bool
, :: Bool
}
inlineAddSizeTo :: Maybe Inline -> SerializeConfig -> SerializeConfig
inlineAddSizeTo :: Maybe Inline -> SerializeConfig -> SerializeConfig
inlineAddSizeTo Maybe Inline
v SerializeConfig
cfg = SerializeConfig
cfg {cfgInlineSize :: Maybe Inline
cfgInlineSize = Maybe Inline
v}
inlineSerializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig
inlineSerializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig
inlineSerializeAt Maybe Inline
v SerializeConfig
cfg = SerializeConfig
cfg {cfgInlineSerialize :: Maybe Inline
cfgInlineSerialize = Maybe Inline
v}
inlineDeserializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig
inlineDeserializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig
inlineDeserializeAt Maybe Inline
v SerializeConfig
cfg = SerializeConfig
cfg {cfgInlineDeserialize :: Maybe Inline
cfgInlineDeserialize = Maybe Inline
v}
encodeConstrNames :: Bool -> SerializeConfig -> SerializeConfig
encodeConstrNames :: Bool -> SerializeConfig -> SerializeConfig
encodeConstrNames Bool
v SerializeConfig
cfg = SerializeConfig
cfg {cfgConstructorTagAsString :: Bool
cfgConstructorTagAsString = Bool
v}
encodeRecordFields :: Bool -> SerializeConfig -> SerializeConfig
encodeRecordFields :: Bool -> SerializeConfig -> SerializeConfig
encodeRecordFields Bool
v SerializeConfig
cfg = SerializeConfig
cfg {cfgRecordSyntaxWithHeader :: Bool
cfgRecordSyntaxWithHeader = Bool
v}
serializeConfig :: SerializeConfig
serializeConfig :: SerializeConfig
serializeConfig =
SerializeConfig
{ cfgInlineSize :: Maybe Inline
cfgInlineSize = Maybe Inline
forall a. Maybe a
Nothing
, cfgInlineSerialize :: Maybe Inline
cfgInlineSerialize = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
Inline
, cfgInlineDeserialize :: Maybe Inline
cfgInlineDeserialize = Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
Inline
, cfgConstructorTagAsString :: Bool
cfgConstructorTagAsString = Bool
False
, cfgRecordSyntaxWithHeader :: Bool
cfgRecordSyntaxWithHeader = Bool
False
}
type Field = (Maybe Name, Type)
_x :: Name
_x :: Name
_x = String -> Name
mkName String
"x"
_acc :: Name
_acc :: Name
_acc = String -> Name
mkName String
"acc"
_arr :: Name
_arr :: Name
_arr = String -> Name
mkName String
"arr"
_tag :: Name
_tag :: Name
_tag = String -> Name
mkName String
"tag"
_initialOffset :: Name
_initialOffset :: Name
_initialOffset = String -> Name
mkName String
"initialOffset"
_endOffset :: Name
_endOffset :: Name
_endOffset = String -> Name
mkName String
"endOffset"
_val :: Name
_val :: Name
_val = String -> Name
mkName String
"val"
mkFieldName :: Int -> Name
mkFieldName :: Int -> Name
mkFieldName Int
i = String -> Name
mkName (String
"field" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)
makeI :: Int -> Name
makeI :: Int -> Name
makeI Int
i = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"i" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
makeN :: Int -> Name
makeN :: Int -> Name
makeN Int
i = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
makeA :: Int -> Name
makeA :: Int -> Name
makeA Int
i = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"a" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
openConstructor :: Name -> Int -> Q Pat
openConstructor :: Name -> Int -> Q Pat
openConstructor Name
cname Int
numFields =
Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
cname ((Name -> Q Pat) -> [Name] -> [Q Pat]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP ((Int -> Name) -> [Int] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Name
mkFieldName [Int
0 .. (Int
numFields Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]))
matchConstructor :: Name -> Int -> Q Exp -> Q Match
matchConstructor :: Name -> Int -> Q Exp -> Q Match
matchConstructor Name
cname Int
numFields Q Exp
exp0 =
Q Pat -> Q Body -> [Q Dec] -> Q Match
forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Match
match (Name -> Int -> Q Pat
openConstructor Name
cname Int
numFields) (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB Q Exp
exp0) []
data SimpleDataCon =
SimpleDataCon Name [Field]
deriving (SimpleDataCon -> SimpleDataCon -> Bool
(SimpleDataCon -> SimpleDataCon -> Bool)
-> (SimpleDataCon -> SimpleDataCon -> Bool) -> Eq SimpleDataCon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleDataCon -> SimpleDataCon -> Bool
== :: SimpleDataCon -> SimpleDataCon -> Bool
$c/= :: SimpleDataCon -> SimpleDataCon -> Bool
/= :: SimpleDataCon -> SimpleDataCon -> Bool
Eq)
simplifyDataCon :: DataCon -> SimpleDataCon
simplifyDataCon :: DataCon -> SimpleDataCon
simplifyDataCon (DataCon Name
cname [Name]
_ Cxt
_ [Field]
fields) = Name -> [Field] -> SimpleDataCon
SimpleDataCon Name
cname [Field]
fields
data TypeOfType
= UnitType Name
| TheType SimpleDataCon
| MultiType [SimpleDataCon]
deriving (TypeOfType -> TypeOfType -> Bool
(TypeOfType -> TypeOfType -> Bool)
-> (TypeOfType -> TypeOfType -> Bool) -> Eq TypeOfType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeOfType -> TypeOfType -> Bool
== :: TypeOfType -> TypeOfType -> Bool
$c/= :: TypeOfType -> TypeOfType -> Bool
/= :: TypeOfType -> TypeOfType -> Bool
Eq)
typeOfType :: Type -> [DataCon] -> TypeOfType
typeOfType :: Type -> [DataCon] -> TypeOfType
typeOfType Type
headTy [] =
String -> TypeOfType
forall a. HasCallStack => String -> a
error
(String
"Attempting to get size with no constructors (" String -> String -> String
forall a. [a] -> [a] -> [a]
++
(Type -> String
forall a. Ppr a => a -> String
pprint Type
headTy) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
typeOfType Type
_ [DataCon Name
cname [Name]
_ Cxt
_ []] = Name -> TypeOfType
UnitType Name
cname
typeOfType Type
_ [con :: DataCon
con@(DataCon Name
_ [Name]
_ Cxt
_ [Field]
_)] = SimpleDataCon -> TypeOfType
TheType (SimpleDataCon -> TypeOfType) -> SimpleDataCon -> TypeOfType
forall a b. (a -> b) -> a -> b
$ DataCon -> SimpleDataCon
simplifyDataCon DataCon
con
typeOfType Type
_ [DataCon]
cons = [SimpleDataCon] -> TypeOfType
MultiType ([SimpleDataCon] -> TypeOfType) -> [SimpleDataCon] -> TypeOfType
forall a b. (a -> b) -> a -> b
$ (DataCon -> SimpleDataCon) -> [DataCon] -> [SimpleDataCon]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> SimpleDataCon
simplifyDataCon [DataCon]
cons
isUnitType :: [DataCon] -> Bool
isUnitType :: [DataCon] -> Bool
isUnitType [DataCon Name
_ [Name]
_ Cxt
_ []] = Bool
True
isUnitType [DataCon]
_ = Bool
False
isRecordSyntax :: SimpleDataCon -> Bool
isRecordSyntax :: SimpleDataCon -> Bool
isRecordSyntax (SimpleDataCon Name
_ [Field]
fields) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Name -> Bool) -> (Field -> Maybe Name) -> Field -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Maybe Name
forall a b. (a, b) -> a
fst (Field -> Bool) -> [Field] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field]
fields)
int_w8 :: Int -> Word8
int_w8 :: Int -> Word8
int_w8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
int_w32 :: Int -> Word32
int_w32 :: Int -> Word32
int_w32 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
w8_w16 :: Word8 -> Word16
w8_w16 :: Word8 -> Word16
w8_w16 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
w8_w32 :: Word8 -> Word32
w8_w32 :: Word8 -> Word32
w8_w32 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
w8_w64 :: Word8 -> Word64
w8_w64 :: Word8 -> Word64
w8_w64 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
w8_int :: Word8 -> Int
w8_int :: Word8 -> Int
w8_int = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
w32_int :: Word32 -> Int
w32_int :: Word32 -> Int
w32_int = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
c2w :: Char -> Word8
c2w :: Char -> Word8
c2w = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
wListToString :: [Word8] -> String
wListToString :: [Word8] -> String
wListToString = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
shiftAdd :: Bits a => (b -> a) -> [b] -> a
shiftAdd :: forall a b. Bits a => (b -> a) -> [b] -> a
shiftAdd b -> a
conv [b]
xs =
(a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Bits a => a -> a -> a
(.|.) a
forall a. Bits a => a
zeroBits ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$
((Int, a) -> a) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
j, a
x) -> a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
x (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)) ([(Int, a)] -> [a]) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ([a] -> [(Int, a)]) -> [a] -> [(Int, a)]
forall a b. (a -> b) -> a -> b
$ (b -> a) -> [b] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map b -> a
conv [b]
xs
xorCmp :: [Word8] -> Name -> Name -> Q Exp
xorCmp :: [Word8] -> Name -> Name -> Q Exp
xorCmp [Word8]
tag Name
off Name
arr =
case Int
tagLen of
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 -> [|$(Int -> Q Exp
go8 Int
0) == zeroBits|]
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 -> [|$(Int -> Q Exp
go16 Int
0) == zeroBits|]
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 -> [|$(Int -> Q Exp
go32 Int
0) == zeroBits|]
Int
_ -> [|$(Int -> Q Exp
go64 Int
0) == zeroBits|]
where
tagLen :: Int
tagLen = [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
tag
go8 :: Int -> Q Exp
go8 Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
tagLen = [|zeroBits|]
go8 Int
i = do
let wIntegral :: Q Exp
wIntegral = Int -> Q Exp
forall a. Integral a => a -> Q Exp
litIntegral Int
i
[|xor (unsafeInlineIO
(Unbox.peekAt
($(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
off) + $(Int -> Q Exp
forall a. Integral a => a -> Q Exp
litIntegral Int
i))
$(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
arr)))
($(Q Exp
wIntegral) :: Word8) .|.
$(Int -> Q Exp
go8 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))|]
go16 :: Int -> Q Exp
go16 Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
tagLen = [|zeroBits|]
go16 Int
i
| Int
tagLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Int -> Q Exp
go16 (Int
tagLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
go16 Int
i = do
let wIntegral :: Q Exp
wIntegral =
Word16 -> Q Exp
forall a. Integral a => a -> Q Exp
litIntegral
((Word8 -> Word16) -> [Word8] -> Word16
forall a b. Bits a => (b -> a) -> [b] -> a
shiftAdd Word8 -> Word16
w8_w16 [[Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! Int
i, [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)] :: Word16)
[|xor (unsafeInlineIO
(Unbox.peekAt
($(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
off) + $(Int -> Q Exp
forall a. Integral a => a -> Q Exp
litIntegral Int
i))
$(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
arr)))
($(Q Exp
wIntegral) :: Word16) .|.
$(Int -> Q Exp
go16 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))|]
go32 :: Int -> Q Exp
go32 Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
tagLen = [|zeroBits|]
go32 Int
i
| Int
tagLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 = Int -> Q Exp
go32 (Int
tagLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
go32 Int
i = do
let wIntegral :: Q Exp
wIntegral =
Word32 -> Q Exp
forall a. Integral a => a -> Q Exp
litIntegral
((Word8 -> Word32) -> [Word8] -> Word32
forall a b. Bits a => (b -> a) -> [b] -> a
shiftAdd
Word8 -> Word32
w8_w32
[ [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
, [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
, [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
, [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
] :: Word32)
[|xor (unsafeInlineIO
(Unbox.peekAt
($(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
off) + $(Int -> Q Exp
forall a. Integral a => a -> Q Exp
litIntegral Int
i))
$(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
arr)))
($(Q Exp
wIntegral) :: Word32) .|.
$(Int -> Q Exp
go32 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4))|]
go64 :: Int -> Q Exp
go64 Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
tagLen = [|zeroBits|]
go64 Int
i
| Int
tagLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 = Int -> Q Exp
go64 (Int
tagLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8)
go64 Int
i = do
let wIntegral :: Q Exp
wIntegral =
Word64 -> Q Exp
forall a. Integral a => a -> Q Exp
litIntegral
((Word8 -> Word64) -> [Word8] -> Word64
forall a b. Bits a => (b -> a) -> [b] -> a
shiftAdd
Word8 -> Word64
w8_w64
[ [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
, [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
, [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
, [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
, [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
, [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)
, [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)
, [Word8]
tag [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)
])
[|xor (unsafeInlineIO
(Unbox.peekAt
($(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
off) + $(Int -> Q Exp
forall a. Integral a => a -> Q Exp
litIntegral Int
i))
$(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
arr)))
($(Q Exp
wIntegral) :: Word64) .|.
$(Int -> Q Exp
go64 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8))|]
serializeW8List :: Name -> Name -> [Word8] -> Q Exp
serializeW8List :: Name -> Name -> [Word8] -> Q Exp
serializeW8List Name
off Name
arr [Word8]
w8List = do
[|let $(Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP (Int -> Name
makeN Int
0)) = $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
off)
in $([Q Stmt] -> Q Exp
forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
doE ((Int -> Q Stmt) -> [Int] -> [Q Stmt]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Q Stmt
makeBind [Int
0 .. (Int
lenW8List Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] [Q Stmt] -> [Q Stmt] -> [Q Stmt]
forall a. [a] -> [a] -> [a]
++
[Q Exp -> Q Stmt
forall (m :: * -> *). Quote m => m Exp -> m Stmt
noBindS ([|pure $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Int -> Name
makeN Int
lenW8List))|])]))|]
where
lenW8List :: Int
lenW8List = [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
w8List
makeBind :: Int -> Q Stmt
makeBind Int
i =
Q Pat -> Q Exp -> Q Stmt
forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Stmt
bindS
(Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP (Int -> Name
makeN (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)))
[|$(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'serializeAt)
$(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Int -> Name
makeN Int
i))
$(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
arr)
($(Word8 -> Q Exp
forall a. Integral a => a -> Q Exp
litIntegral ([Word8]
w8List [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! Int
i)) :: Word8)|]
litIntegral :: Integral a => a -> Q Exp
litIntegral :: forall a. Integral a => a -> Q Exp
litIntegral = Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> Q Exp) -> (a -> Lit) -> a -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
IntegerL (Integer -> Lit) -> (a -> Integer) -> a -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
litProxy :: Unbox a => Proxy a -> Q Exp
litProxy :: forall a. Unbox a => Proxy a -> Q Exp
litProxy = Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> Q Exp) -> (Proxy a -> Lit) -> Proxy a -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
IntegerL (Integer -> Lit) -> (Proxy a -> Integer) -> Proxy a -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> (Proxy a -> Int) -> Proxy a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> Int
forall a. Unbox a => Proxy a -> Int
Unbox.sizeOf
errorUnsupported :: String -> a
errorUnsupported :: forall a. String -> a
errorUnsupported String
err =
String -> a
forall a. HasCallStack => String -> a
error
(String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"Unsupported"
, String
"==========="
, String
"This is improper use of the library."
, String
"This case is unsupported."
, String
"Please contact the developer if this case is of interest."
, String
""
, String
"Message"
, String
"-------"
, String
err
]
errorUnimplemented :: a
errorUnimplemented :: forall a. a
errorUnimplemented =
String -> a
forall a. HasCallStack => String -> a
error
(String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"Unimplemented"
, String
"============="
, String
"Please contact the developer if this case is of interest."
]