{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, Rank2Types #-}moduleGeneral.Binary(BinaryOp (..),binaryOpMap ,binarySplit ,binarySplit2 ,binarySplit3 ,unsafeBinarySplit ,Builder (..),runBuilder ,sizeBuilder ,BinaryEx (..),Storable,putExStorable ,getExStorable ,putExStorableList ,getExStorableList ,putExList ,getExList ,putExN ,getExN )whereimportDevelopment.Shake.Classes importControl.MonadimportData.BinaryimportData.List.ExtraimportData.Tuple.ExtraimportForeign.Marshal.UtilsimportForeign.StorableimportForeign.PtrimportSystem.IO.UnsafeasUimportqualifiedData.ByteStringasBSimportqualifiedData.ByteString.InternalasBSimportqualifiedData.ByteString.UnsafeasBSimportqualifiedData.ByteString.LazyasLBSimportqualifiedData.ByteString.UTF8asUTF8importData.SemigroupimportPrelude----------------------------------------------------------------------- STORE TYPE-- | An explicit and more efficient version of BinarydataBinaryOp v =BinaryOp {forall v. BinaryOp v -> v -> Builder
putOp ::v ->Builder ,forall v. BinaryOp v -> ByteString -> v
getOp ::BS.ByteString->v }binaryOpMap ::BinaryEx a =>(a ->BinaryOp b )->BinaryOp (a ,b )binaryOpMap :: forall a b. BinaryEx a => (a -> BinaryOp b) -> BinaryOp (a, b)
binaryOpMap a -> BinaryOp b
mp =BinaryOp {putOp :: (a, b) -> Builder
putOp =\(a
a ,b
b )->Builder -> Builder
putExN (a -> Builder
forall a. BinaryEx a => a -> Builder
putEx a
a )Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>BinaryOp b -> b -> Builder
forall v. BinaryOp v -> v -> Builder
putOp (a -> BinaryOp b
mp a
a )b
b ,getOp :: ByteString -> (a, b)
getOp =\ByteString
bs ->let(ByteString
bs1 ,ByteString
bs2 )=ByteString -> (ByteString, ByteString)
getExN ByteString
bs ;a :: a
a =ByteString -> a
forall a. BinaryEx a => ByteString -> a
getEx ByteString
bs1 in(a
a ,BinaryOp b -> ByteString -> b
forall v. BinaryOp v -> ByteString -> v
getOp (a -> BinaryOp b
mp a
a )ByteString
bs2 )}binarySplit ::foralla .Storablea =>BS.ByteString->(a ,BS.ByteString)binarySplit :: forall a. Storable a => ByteString -> (a, ByteString)
binarySplit ByteString
bs |ByteString -> Int
BS.lengthByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<a -> Int
forall a. Storable a => a -> Int
sizeOf(a
forall a. HasCallStack => a
undefined::a )=[Char] -> (a, ByteString)
forall a. HasCallStack => [Char] -> a
error[Char]
"Reading from ByteString, insufficient left"|Bool
otherwise=ByteString -> (a, ByteString)
forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs binarySplit2 ::foralla b .(Storablea ,Storableb )=>BS.ByteString->(a ,b ,BS.ByteString)binarySplit2 :: forall a b.
(Storable a, Storable b) =>
ByteString -> (a, b, ByteString)
binarySplit2 ByteString
bs |ByteString -> Int
BS.lengthByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<a -> Int
forall a. Storable a => a -> Int
sizeOf(a
forall a. HasCallStack => a
undefined::a )Int -> Int -> Int
forall a. Num a => a -> a -> a
+b -> Int
forall a. Storable a => a -> Int
sizeOf(b
forall a. HasCallStack => a
undefined::b )=[Char] -> (a, b, ByteString)
forall a. HasCallStack => [Char] -> a
error[Char]
"Reading from ByteString, insufficient left"|(a
a ,ByteString
bs )<-ByteString -> (a, ByteString)
forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs ,(b
b ,ByteString
bs )<-ByteString -> (b, ByteString)
forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs =(a
a ,b
b ,ByteString
bs )binarySplit3 ::foralla b c .(Storablea ,Storableb ,Storablec )=>BS.ByteString->(a ,b ,c ,BS.ByteString)binarySplit3 :: forall a b c.
(Storable a, Storable b, Storable c) =>
ByteString -> (a, b, c, ByteString)
binarySplit3 ByteString
bs |ByteString -> Int
BS.lengthByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<a -> Int
forall a. Storable a => a -> Int
sizeOf(a
forall a. HasCallStack => a
undefined::a )Int -> Int -> Int
forall a. Num a => a -> a -> a
+b -> Int
forall a. Storable a => a -> Int
sizeOf(b
forall a. HasCallStack => a
undefined::b )Int -> Int -> Int
forall a. Num a => a -> a -> a
+c -> Int
forall a. Storable a => a -> Int
sizeOf(c
forall a. HasCallStack => a
undefined::c )=[Char] -> (a, b, c, ByteString)
forall a. HasCallStack => [Char] -> a
error[Char]
"Reading from ByteString, insufficient left"|(a
a ,ByteString
bs )<-ByteString -> (a, ByteString)
forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs ,(b
b ,ByteString
bs )<-ByteString -> (b, ByteString)
forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs ,(c
c ,ByteString
bs )<-ByteString -> (c, ByteString)
forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs =(a
a ,b
b ,c
c ,ByteString
bs )unsafeBinarySplit ::Storablea =>BS.ByteString->(a ,BS.ByteString)unsafeBinarySplit :: forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs =(a
v ,Int -> ByteString -> ByteString
BS.unsafeDrop(a -> Int
forall a. Storable a => a -> Int
sizeOfa
v )ByteString
bs )wherev :: a
v =IO a -> a
forall a. IO a -> a
unsafePerformIO(IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
BS.unsafeUseAsCStringByteString
bs ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$\CString
ptr ->Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek(CString -> Ptr a
forall a b. Ptr a -> Ptr b
castPtrCString
ptr )-- forM for zipWithfor2M_ :: [a] -> [b] -> (a -> b -> m c) -> m ()
for2M_ [a]
as [b]
bs a -> b -> m c
f =(a -> b -> m c) -> [a] -> [b] -> m ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_a -> b -> m c
f [a]
as [b]
bs ----------------------------------------------------------------------- BINARY SERIALISATION-- We can't use the Data.ByteString builder as that doesn't track the size of the chunk.dataBuilder =Builder {-# UNPACK#-}!Int(foralla .Ptra ->Int->IO())sizeBuilder ::Builder ->IntsizeBuilder :: Builder -> Int
sizeBuilder (Builder Int
i forall a. Ptr a -> Int -> IO ()
_)=Int
i runBuilder ::Builder ->BS.ByteStringrunBuilder :: Builder -> ByteString
runBuilder (Builder Int
i forall a. Ptr a -> Int -> IO ()
f )=IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO(IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BS.createInt
i ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$\Ptr Word8
ptr ->Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Int -> IO ()
f Ptr Word8
ptr Int
0instanceSemigroupBuilder where(Builder Int
x1 forall a. Ptr a -> Int -> IO ()
x2 )<> :: Builder -> Builder -> Builder
<>(Builder Int
y1 forall a. Ptr a -> Int -> IO ()
y2 )=Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y1 )((forall a. Ptr a -> Int -> IO ()) -> Builder)
-> (forall a. Ptr a -> Int -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$\Ptr a
p Int
i ->doPtr a -> Int -> IO ()
forall a. Ptr a -> Int -> IO ()
x2 Ptr a
p Int
i ;Ptr a -> Int -> IO ()
forall a. Ptr a -> Int -> IO ()
y2 Ptr a
p (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
x1 instanceMonoidBuilder wheremempty :: Builder
mempty=Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder Int
0((forall a. Ptr a -> Int -> IO ()) -> Builder)
-> (forall a. Ptr a -> Int -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$\Ptr a
_Int
_->() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure()mappend :: Builder -> Builder -> Builder
mappend=Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>)-- | Methods for Binary serialisation that go directly between strict ByteString values.-- When the Database is read each key/value will be loaded as a separate ByteString,-- and for certain types (e.g. file rules) this may remain the preferred format for storing keys.-- Optimised for performance.classBinaryEx a whereputEx ::a ->Builder getEx ::BS.ByteString->a instanceBinaryEx BS.ByteStringwhereputEx :: ByteString -> Builder
putEx ByteString
x =Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder Int
n ((forall a. Ptr a -> Int -> IO ()) -> Builder)
-> (forall a. Ptr a -> Int -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$\Ptr a
ptr Int
i ->ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
BS.unsafeUseAsCStringByteString
x ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\CString
bs ->Ptr Any -> Ptr Any -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes(Ptr a
ptr Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`Int
i )(CString -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtrCString
bs )(Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
n )wheren :: Int
n =ByteString -> Int
BS.lengthByteString
x getEx :: ByteString -> ByteString
getEx =ByteString -> ByteString
forall a. a -> a
idinstanceBinaryEx LBS.ByteStringwhereputEx :: ByteString -> Builder
putEx ByteString
x =Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ByteString -> Int64
LBS.lengthByteString
x )((forall a. Ptr a -> Int -> IO ()) -> Builder)
-> (forall a. Ptr a -> Int -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$\Ptr a
ptr Int
i ->doletgo :: Int -> [ByteString] -> IO ()
go Int
_[]=() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure()go Int
i (ByteString
x :[ByteString]
xs )=doletn :: Int
n =ByteString -> Int
BS.lengthByteString
x ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
BS.unsafeUseAsCStringByteString
x ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\CString
bs ->Ptr Any -> Ptr Any -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes(Ptr a
ptr Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`Int
i )(CString -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtrCString
bs )(Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
n )Int -> [ByteString] -> IO ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n )[ByteString]
xs Int -> [ByteString] -> IO ()
go Int
i ([ByteString] -> IO ()) -> [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ByteString -> [ByteString]
LBS.toChunksByteString
x getEx :: ByteString -> ByteString
getEx =[ByteString] -> ByteString
LBS.fromChunks([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> [ByteString]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pureinstanceBinaryEx [BS.ByteString]where-- Format:-- n :: Word32 - number of strings-- ns :: [Word32]{n} - length of each string-- contents of each string concatenated (sum ns bytes)putEx :: [ByteString] -> Builder
putEx [ByteString]
xs =Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4)Int -> Int -> Int
forall a. Num a => a -> a -> a
+[Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum[Int]
ns )((forall a. Ptr a -> Int -> IO ()) -> Builder)
-> (forall a. Ptr a -> Int -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$\Ptr a
p Int
i ->doPtr a -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOffPtr a
p Int
i (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
n ::Word32)[Int] -> [Int] -> (Int -> Int -> IO ()) -> IO ()
forall {m :: * -> *} {a} {b} {c}.
Applicative m =>
[a] -> [b] -> (a -> b -> m c) -> m ()
for2M_ [Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i ,Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i ..][Int]
ns ((Int -> Int -> IO ()) -> IO ()) -> (Int -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Int
i Int
x ->Ptr a -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOffPtr a
p Int
i (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
x ::Word32)Ptr Any
p <-Ptr Any -> IO (Ptr Any)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure(Ptr Any -> IO (Ptr Any)) -> Ptr Any -> IO (Ptr Any)
forall a b. (a -> b) -> a -> b
$Ptr a
p Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`(Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4))[Int] -> [ByteString] -> (Int -> ByteString -> IO ()) -> IO ()
forall {m :: * -> *} {a} {b} {c}.
Applicative m =>
[a] -> [b] -> (a -> b -> m c) -> m ()
for2M_ ((Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanlInt -> Int -> Int
forall a. Num a => a -> a -> a
(+)Int
0[Int]
ns )[ByteString]
xs ((Int -> ByteString -> IO ()) -> IO ())
-> (Int -> ByteString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Int
i ByteString
x ->ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLenByteString
x ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\(CString
bs ,Int
n )->Ptr Any -> Ptr Any -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes(Ptr Any
p Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`Int
i )(CString -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtrCString
bs )(Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
n )wherens :: [Int]
ns =(ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
mapByteString -> Int
BS.length[ByteString]
xs n :: Int
n =[Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length[Int]
ns getEx :: ByteString -> [ByteString]
getEx ByteString
bs =IO [ByteString] -> [ByteString]
forall a. IO a -> a
unsafePerformIO(IO [ByteString] -> [ByteString])
-> IO [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ByteString -> (CString -> IO [ByteString]) -> IO [ByteString]
forall a. ByteString -> (CString -> IO a) -> IO a
BS.unsafeUseAsCStringByteString
bs ((CString -> IO [ByteString]) -> IO [ByteString])
-> (CString -> IO [ByteString]) -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$\CString
p ->doInt
n <-Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(CString -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOffCString
p Int
0::IOWord32)[Word32]
ns ::[Word32]<-[Int] -> (Int -> IO Word32) -> IO [Word32]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM[Int
1..Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
n ]((Int -> IO Word32) -> IO [Word32])
-> (Int -> IO Word32) -> IO [Word32]
forall a b. (a -> b) -> a -> b
$\Int
i ->CString -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOffCString
p (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4)[ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure([ByteString] -> IO [ByteString])
-> [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$(ByteString, [ByteString]) -> [ByteString]
forall a b. (a, b) -> b
snd((ByteString, [ByteString]) -> [ByteString])
-> (ByteString, [ByteString]) -> [ByteString]
forall a b. (a -> b) -> a -> b
$(ByteString -> Word32 -> (ByteString, ByteString))
-> ByteString -> [Word32] -> (ByteString, [ByteString])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL(\ByteString
bs Word32
i ->(ByteString, ByteString) -> (ByteString, ByteString)
forall a b. (a, b) -> (b, a)
swap((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$Int -> ByteString -> (ByteString, ByteString)
BS.splitAt(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralWord32
i )ByteString
bs )(Int -> ByteString -> ByteString
BS.drop(Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4))ByteString
bs )[Word32]
ns instanceBinaryEx ()whereputEx :: () -> Builder
putEx ()=Builder
forall a. Monoid a => a
memptygetEx :: ByteString -> ()
getEx ByteString
_=()instanceBinaryEx StringwhereputEx :: [Char] -> Builder
putEx =ByteString -> Builder
forall a. BinaryEx a => a -> Builder
putEx (ByteString -> Builder)
-> ([Char] -> ByteString) -> [Char] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Char] -> ByteString
UTF8.fromStringgetEx :: ByteString -> [Char]
getEx =ByteString -> [Char]
UTF8.toStringinstanceBinaryEx (MaybeString)whereputEx :: Maybe [Char] -> Builder
putEx Maybe [Char]
Nothing=Builder
forall a. Monoid a => a
memptyputEx (Just[Char]
xs )=ByteString -> Builder
forall a. BinaryEx a => a -> Builder
putEx (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$[Char] -> ByteString
UTF8.fromString([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$Char
'0円'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
xs getEx :: ByteString -> Maybe [Char]
getEx =((Char, [Char]) -> [Char]) -> Maybe (Char, [Char]) -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(Char, [Char]) -> [Char]
forall a b. (a, b) -> b
snd(Maybe (Char, [Char]) -> Maybe [Char])
-> (ByteString -> Maybe (Char, [Char]))
-> ByteString
-> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Char] -> Maybe (Char, [Char])
forall a. [a] -> Maybe (a, [a])
uncons([Char] -> Maybe (Char, [Char]))
-> (ByteString -> [Char]) -> ByteString -> Maybe (Char, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> [Char]
UTF8.toStringinstanceBinaryEx [String]whereputEx :: [[Char]] -> Builder
putEx =[ByteString] -> Builder
forall a. BinaryEx a => a -> Builder
putEx ([ByteString] -> Builder)
-> ([[Char]] -> [ByteString]) -> [[Char]] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Char] -> ByteString) -> [[Char]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map[Char] -> ByteString
UTF8.fromStringgetEx :: ByteString -> [[Char]]
getEx =(ByteString -> [Char]) -> [ByteString] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
mapByteString -> [Char]
UTF8.toString([ByteString] -> [[Char]])
-> (ByteString -> [ByteString]) -> ByteString -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> [ByteString]
forall a. BinaryEx a => ByteString -> a
getEx instanceBinaryEx (String,[String])whereputEx :: ([Char], [[Char]]) -> Builder
putEx ([Char]
a ,[[Char]]
bs )=[[Char]] -> Builder
forall a. BinaryEx a => a -> Builder
putEx ([[Char]] -> Builder) -> [[Char]] -> Builder
forall a b. (a -> b) -> a -> b
$[Char]
a [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
bs getEx :: ByteString -> ([Char], [[Char]])
getEx ByteString
x =let[Char]
a :[[Char]]
bs =ByteString -> [[Char]]
forall a. BinaryEx a => ByteString -> a
getEx ByteString
x in([Char]
a ,[[Char]]
bs )instanceBinaryEx BoolwhereputEx :: Bool -> Builder
putEx Bool
False=Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder Int
1((forall a. Ptr a -> Int -> IO ()) -> Builder)
-> (forall a. Ptr a -> Int -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$\Ptr a
ptr Int
i ->Ptr a -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOffPtr a
ptr Int
i (Word8
0::Word8)putEx Bool
True=Builder
forall a. Monoid a => a
memptygetEx :: ByteString -> Bool
getEx =ByteString -> Bool
BS.nullinstanceBinaryEx Word8whereputEx :: Word8 -> Builder
putEx =Word8 -> Builder
forall a. Storable a => a -> Builder
putExStorable getEx :: ByteString -> Word8
getEx =ByteString -> Word8
forall a. Storable a => ByteString -> a
getExStorable instanceBinaryEx Word16whereputEx :: Word16 -> Builder
putEx =Word16 -> Builder
forall a. Storable a => a -> Builder
putExStorable getEx :: ByteString -> Word16
getEx =ByteString -> Word16
forall a. Storable a => ByteString -> a
getExStorable instanceBinaryEx Word32whereputEx :: Word32 -> Builder
putEx =Word32 -> Builder
forall a. Storable a => a -> Builder
putExStorable getEx :: ByteString -> Word32
getEx =ByteString -> Word32
forall a. Storable a => ByteString -> a
getExStorable instanceBinaryEx IntwhereputEx :: Int -> Builder
putEx =Int -> Builder
forall a. Storable a => a -> Builder
putExStorable getEx :: ByteString -> Int
getEx =ByteString -> Int
forall a. Storable a => ByteString -> a
getExStorable instanceBinaryEx FloatwhereputEx :: Float -> Builder
putEx =Float -> Builder
forall a. Storable a => a -> Builder
putExStorable getEx :: ByteString -> Float
getEx =ByteString -> Float
forall a. Storable a => ByteString -> a
getExStorable putExStorable ::foralla .Storablea =>a ->Builder putExStorable :: forall a. Storable a => a -> Builder
putExStorable a
x =Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (a -> Int
forall a. Storable a => a -> Int
sizeOfa
x )((forall a. Ptr a -> Int -> IO ()) -> Builder)
-> (forall a. Ptr a -> Int -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$\Ptr a
p Int
i ->Ptr a -> Int -> a -> IO ()
forall b. Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOffPtr a
p Int
i a
x getExStorable ::foralla .Storablea =>BS.ByteString->a getExStorable :: forall a. Storable a => ByteString -> a
getExStorable =\ByteString
bs ->IO a -> a
forall a. IO a -> a
unsafePerformIO(IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLenByteString
bs ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$\(CString
p ,Int
size )->ifInt
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
n then[Char] -> IO a
forall a. HasCallStack => [Char] -> a
error[Char]
"size mismatch"elsePtr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek(CString -> Ptr a
forall a b. Ptr a -> Ptr b
castPtrCString
p )wheren :: Int
n =a -> Int
forall a. Storable a => a -> Int
sizeOf(a
forall a. HasCallStack => a
undefined::a )putExStorableList ::foralla .Storablea =>[a ]->Builder putExStorableList :: forall a. Storable a => [a] -> Builder
putExStorableList [a]
xs =Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
*[a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length[a]
xs )((forall a. Ptr a -> Int -> IO ()) -> Builder)
-> (forall a. Ptr a -> Int -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$\Ptr a
ptr Int
i ->[Int] -> [a] -> (Int -> a -> IO ()) -> IO ()
forall {m :: * -> *} {a} {b} {c}.
Applicative m =>
[a] -> [b] -> (a -> b -> m c) -> m ()
for2M_ [Int
i ,Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n ..][a]
xs ((Int -> a -> IO ()) -> IO ()) -> (Int -> a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Int
i a
x ->Ptr a -> Int -> a -> IO ()
forall b. Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOffPtr a
ptr Int
i a
x wheren :: Int
n =a -> Int
forall a. Storable a => a -> Int
sizeOf(a
forall a. HasCallStack => a
undefined::a )getExStorableList ::foralla .Storablea =>BS.ByteString->[a ]getExStorableList :: forall a. Storable a => ByteString -> [a]
getExStorableList =\ByteString
bs ->IO [a] -> [a]
forall a. IO a -> a
unsafePerformIO(IO [a] -> [a]) -> IO [a] -> [a]
forall a b. (a -> b) -> a -> b
$ByteString -> (CStringLen -> IO [a]) -> IO [a]
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLenByteString
bs ((CStringLen -> IO [a]) -> IO [a])
-> (CStringLen -> IO [a]) -> IO [a]
forall a b. (a -> b) -> a -> b
$\(CString
p ,Int
size )->let(Int
d ,Int
m )=Int
size Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod`Int
n inifInt
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0then[Char] -> IO [a]
forall a. HasCallStack => [Char] -> a
error[Char]
"size mismatch"else[Int] -> (Int -> IO a) -> IO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM[Int
0..Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]((Int -> IO a) -> IO [a]) -> (Int -> IO a) -> IO [a]
forall a b. (a -> b) -> a -> b
$\Int
i ->Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff(CString -> Ptr a
forall a b. Ptr a -> Ptr b
castPtrCString
p )Int
i wheren :: Int
n =a -> Int
forall a. Storable a => a -> Int
sizeOf(a
forall a. HasCallStack => a
undefined::a )-- repeating:-- Word32, length of BS-- BSputExList ::[Builder ]->Builder putExList :: [Builder] -> Builder
putExList [Builder]
xs =Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$(Builder -> Int) -> [Builder] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map(\Builder
b ->Builder -> Int
sizeBuilder Builder
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4)[Builder]
xs )((forall a. Ptr a -> Int -> IO ()) -> Builder)
-> (forall a. Ptr a -> Int -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$\Ptr a
p Int
i ->doletgo :: Int -> [Builder] -> IO ()
go Int
_[]=() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure()go Int
i (Builder Int
n forall a. Ptr a -> Int -> IO ()
b :[Builder]
xs )=doPtr a -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOffPtr a
p Int
i (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
n ::Word32)Ptr a -> Int -> IO ()
forall a. Ptr a -> Int -> IO ()
b Ptr a
p (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4)Int -> [Builder] -> IO ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n )[Builder]
xs Int -> [Builder] -> IO ()
go Int
i [Builder]
xs getExList ::BS.ByteString->[BS.ByteString]getExList :: ByteString -> [ByteString]
getExList ByteString
bs |Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0=[]|Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
4,(Word32
n ::Word32,ByteString
bs )<-ByteString -> (Word32, ByteString)
forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs ,Int
n <-Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralWord32
n ,(Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
4)Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
n =Int -> ByteString -> ByteString
BS.unsafeTakeInt
n ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString]
getExList (Int -> ByteString -> ByteString
BS.unsafeDropInt
n ByteString
bs )|Bool
otherwise=[Char] -> [ByteString]
forall a. HasCallStack => [Char] -> a
error[Char]
"getList, corrupted binary"wherelen :: Int
len =ByteString -> Int
BS.lengthByteString
bs putExN ::Builder ->Builder putExN :: Builder -> Builder
putExN (Builder Int
n forall a. Ptr a -> Int -> IO ()
old )=Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4)((forall a. Ptr a -> Int -> IO ()) -> Builder)
-> (forall a. Ptr a -> Int -> IO ()) -> Builder
forall a b. (a -> b) -> a -> b
$\Ptr a
p Int
i ->doPtr a -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOffPtr a
p Int
i (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
n ::Word32)Ptr a -> Int -> IO ()
forall a. Ptr a -> Int -> IO ()
old Ptr a
p (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4getExN ::BS.ByteString->(BS.ByteString,BS.ByteString)getExN :: ByteString -> (ByteString, ByteString)
getExN ByteString
bs |Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
4,(Word32
n ::Word32,ByteString
bs )<-ByteString -> (Word32, ByteString)
forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs ,Int
n <-Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralWord32
n ,(Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
4)Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
n =(Int -> ByteString -> ByteString
BS.unsafeTakeInt
n ByteString
bs ,Int -> ByteString -> ByteString
BS.unsafeDropInt
n ByteString
bs )|Bool
otherwise=[Char] -> (ByteString, ByteString)
forall a. HasCallStack => [Char] -> a
error[Char]
"getList, corrupted binary"wherelen :: Int
len =ByteString -> Int
BS.lengthByteString
bs