{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_HADDOCK hide #-}
module PopKey.Internal3 where
import Data.Bifunctor
import qualified Data.ByteString as BS
import Data.Functor.Contravariant
import HaskellWorks.Data.RankSelect.CsPoppy
import qualified HaskellWorks.Data.RankSelect.CsPoppy.Internal.Alpha0 as A0
import qualified HaskellWorks.Data.RankSelect.CsPoppy.Internal.Alpha1 as A1
import Data.Foldable
import Data.List (sortOn)
import Data.Store
import GHC.Generics hiding (R)
import GHC.Word
import Unsafe.Coerce
import PopKey.Internal1
import PopKey.Internal2
import PopKey.Encoding
data PopKey k v where
PopKeyInt :: forall s v . Bool -> !(F s PKPrim) -> (F' s BS.ByteString -> v) -> PopKey Int v
PopKeyAny :: forall s k v . Bool -> !(F s PKPrim) -> (F' s BS.ByteString -> v) -> !(F (Shape k) PKPrim) -> PopKey k v
instance Functor (PopKey k) where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> PopKey k a -> PopKey k b
fmap a -> b
f (PopKeyInt Bool
_ F s PKPrim
p F' s ByteString -> a
d) = forall s1 v.
Bool -> F s1 PKPrim -> (F' s1 ByteString -> v) -> PopKey Int v
PopKeyInt Bool
False F s PKPrim
p (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. F' s ByteString -> a
d)
fmap a -> b
f (PopKeyAny Bool
_ F s PKPrim
pv F' s ByteString -> a
d F (Shape k) PKPrim
pk) = forall s1 k v.
Bool
-> F s1 PKPrim
-> (F' s1 ByteString -> v)
-> F (Shape k) PKPrim
-> PopKey k v
PopKeyAny Bool
False F s PKPrim
pv (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. F' s ByteString -> a
d) F (Shape k) PKPrim
pk
instance Foldable (PopKey k) where
{-# INLINE foldr #-}
foldr :: forall a b. (a -> b -> b) -> b -> PopKey k a -> b
foldr a -> b -> b
f b
z p :: PopKey k a
p@(PopKeyInt Bool
_ F s PKPrim
pr F' s ByteString -> a
vd) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
i -> a -> b -> b
f (F' s ByteString -> a
vd do forall s. Int -> F s PKPrim -> F' s ByteString
rawq Int
i F s PKPrim
pr)) b
z [ Int
0 .. (forall (t :: * -> *) a. Foldable t => t a -> Int
length PopKey k a
p forall a. Num a => a -> a -> a
- Int
1) ]
foldr a -> b -> b
f b
z p :: PopKey k a
p@(PopKeyAny Bool
_ F s PKPrim
pr F' s ByteString -> a
vd F (Shape k) PKPrim
_) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
i -> a -> b -> b
f (F' s ByteString -> a
vd do forall s. Int -> F s PKPrim -> F' s ByteString
rawq Int
i F s PKPrim
pr)) b
z [ Int
0 .. (forall (t :: * -> *) a. Foldable t => t a -> Int
length PopKey k a
p forall a. Num a => a -> a -> a
- Int
1) ]
{-# INLINE length #-}
length :: forall a. PopKey k a -> Int
length (PopKeyInt Bool
_ F s PKPrim
p F' s ByteString -> a
_) = forall s. F s PKPrim -> Int
flength F s PKPrim
p
length (PopKeyAny Bool
_ F s PKPrim
_ F' s ByteString -> a
_ F (Shape k) PKPrim
p) = forall s. F s PKPrim -> Int
flength F (Shape k) PKPrim
p
{-# INLINABLE foldrWithKey #-}
foldrWithKey :: PopKeyEncoding k => (k -> v -> b -> b) -> b -> PopKey k v -> b
foldrWithKey :: forall k v b.
PopKeyEncoding k =>
(k -> v -> b -> b) -> b -> PopKey k v -> b
foldrWithKey k -> v -> b -> b
f b
z p :: PopKey k v
p@(PopKeyInt Bool
_ F s PKPrim
pr F' s ByteString -> v
vd) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr do \k
i -> k -> v -> b -> b
f k
i (F' s ByteString -> v
vd do forall s. Int -> F s PKPrim -> F' s ByteString
rawq k
i F s PKPrim
pr)
do b
z
do [ k
0 .. (forall (t :: * -> *) a. Foldable t => t a -> Int
length PopKey k v
p forall a. Num a => a -> a -> a
- k
1) ]
foldrWithKey k -> v -> b -> b
f b
z p :: PopKey k v
p@(PopKeyAny Bool
_ F s PKPrim
pr F' s ByteString -> v
vd F (Shape k) PKPrim
pk) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr do \Int
i -> k -> v -> b -> b
f (forall a. PopKeyEncoding a => F' (Shape a) ByteString -> a
pkDecode forall a b. (a -> b) -> a -> b
$ forall s. Int -> F s PKPrim -> F' s ByteString
rawq Int
i F (Shape k) PKPrim
pk) (F' s ByteString -> v
vd do forall s. Int -> F s PKPrim -> F' s ByteString
rawq Int
i F s PKPrim
pr)
do b
z
do [ Int
0 .. (forall (t :: * -> *) a. Foldable t => t a -> Int
length PopKey k v
p forall a. Num a => a -> a -> a
- Int
1) ]
{-# INLINABLE foldlWithKey' #-}
foldlWithKey' :: PopKeyEncoding k => (a -> k -> v -> a) -> a -> PopKey k v -> a
foldlWithKey' :: forall k a v.
PopKeyEncoding k =>
(a -> k -> v -> a) -> a -> PopKey k v -> a
foldlWithKey' a -> k -> v -> a
f a
z p :: PopKey k v
p@(PopKeyInt Bool
_ F s PKPrim
pr F' s ByteString -> v
vd) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' do \a
a k
i -> a -> k -> v -> a
f a
a k
i (F' s ByteString -> v
vd do forall s. Int -> F s PKPrim -> F' s ByteString
rawq k
i F s PKPrim
pr)
do a
z
do [ k
0 .. (forall (t :: * -> *) a. Foldable t => t a -> Int
length PopKey k v
p forall a. Num a => a -> a -> a
- k
1) ]
foldlWithKey' a -> k -> v -> a
f a
z p :: PopKey k v
p@(PopKeyAny Bool
_ F s PKPrim
pr F' s ByteString -> v
vd F (Shape k) PKPrim
pk) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' do \a
a Int
i -> a -> k -> v -> a
f a
a (forall a. PopKeyEncoding a => F' (Shape a) ByteString -> a
pkDecode forall a b. (a -> b) -> a -> b
$ forall s. Int -> F s PKPrim -> F' s ByteString
rawq Int
i F (Shape k) PKPrim
pk) (F' s ByteString -> v
vd do forall s. Int -> F s PKPrim -> F' s ByteString
rawq Int
i F s PKPrim
pr)
do a
z
do [ Int
0 .. (forall (t :: * -> *) a. Foldable t => t a -> Int
length PopKey k v
p forall a. Num a => a -> a -> a
- Int
1) ]
class BiSerialize a where
bencode :: a -> (BS.ByteString , BS.ByteString)
default bencode :: (Generic a , GBiSerialize a (Rep a)) => a -> (BS.ByteString , BS.ByteString)
bencode = forall s (f :: * -> *) a.
GBiSerialize s f =>
f a -> (ByteString, ByteString)
gbencode @a @(Rep a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from
bdecode :: (BS.ByteString , BS.ByteString) -> a
default bdecode :: (Generic a , GBiSerialize a (Rep a)) => (BS.ByteString , BS.ByteString) -> a
bdecode = forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (f :: * -> *) a.
GBiSerialize s f =>
(ByteString, ByteString) -> f a
gbdecode @a @(Rep a)
class GBiSerialize s f where
gbencode :: f a -> (BS.ByteString , BS.ByteString)
gbdecode :: (BS.ByteString , BS.ByteString) -> f a
instance GBiSerialize s U1 where
{-# INLINE gbencode #-}
gbencode :: forall a. U1 a -> (ByteString, ByteString)
gbencode = forall a b. a -> b -> a
const forall a. Monoid a => a
mempty
{-# INLINE gbdecode #-}
gbdecode :: forall a. (ByteString, ByteString) -> U1 a
gbdecode = forall a b. a -> b -> a
const forall a. Monoid a => a
mempty
instance BiSerialize a => GBiSerialize s (K1 i a) where
{-# INLINE gbencode #-}
gbencode :: forall a. K1 i a a -> (ByteString, ByteString)
gbencode (K1 a
x) = forall a. BiSerialize a => a -> (ByteString, ByteString)
bencode a
x
{-# INLINE gbdecode #-}
gbdecode :: forall a. (ByteString, ByteString) -> K1 i a a
gbdecode = forall k i c (p :: k). c -> K1 i c p
K1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BiSerialize a => (ByteString, ByteString) -> a
bdecode
instance (GBiSerialize s a , GBiSerialize s b) => GBiSerialize s (a :*: b) where
{-# INLINE gbencode #-}
gbencode :: forall a. (:*:) a b a -> (ByteString, ByteString)
gbencode (a a
a :*: b a
b) = do
let (ByteString
a1 , ByteString
a2) = forall s (f :: * -> *) a.
GBiSerialize s f =>
f a -> (ByteString, ByteString)
gbencode @s a a
a
(ByteString
b1 , ByteString
b2) = forall s (f :: * -> *) a.
GBiSerialize s f =>
f a -> (ByteString, ByteString)
gbencode @s b a
b
(forall a. Store a => a -> ByteString
encode (ByteString
a1 , ByteString
b1) , forall a. Store a => a -> ByteString
encode (ByteString
a2 , ByteString
b2))
{-# INLINE gbdecode #-}
gbdecode :: forall a. (ByteString, ByteString) -> (:*:) a b a
gbdecode (ByteString
r1 , ByteString
r2) = do
let (ByteString
a1 , ByteString
b1) = forall a. Store a => ByteString -> a
decodeEx ByteString
r1
(ByteString
a2 , ByteString
b2) = forall a. Store a => ByteString -> a
decodeEx ByteString
r2
forall s (f :: * -> *) a.
GBiSerialize s f =>
(ByteString, ByteString) -> f a
gbdecode @s (ByteString
a1 , ByteString
a2) forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall s (f :: * -> *) a.
GBiSerialize s f =>
(ByteString, ByteString) -> f a
gbdecode @s (ByteString
b1 , ByteString
b2)
instance (GBiSerialize s a , GBiSerialize s b) => GBiSerialize s (a :+: b) where
gbencode :: forall a. (:+:) a b a -> (ByteString, ByteString)
gbencode (L1 a a
x) = do
let (ByteString
b1 , ByteString
b2) = forall s (f :: * -> *) a.
GBiSerialize s f =>
f a -> (ByteString, ByteString)
gbencode @s a a
x
(forall a. Store a => a -> ByteString
encode Bool
False forall a. Semigroup a => a -> a -> a
<> ByteString
b1 , ByteString
b2)
gbencode (R1 b a
x) = do
let (ByteString
b1 , ByteString
b2) = forall s (f :: * -> *) a.
GBiSerialize s f =>
f a -> (ByteString, ByteString)
gbencode @s b a
x
(forall a. Store a => a -> ByteString
encode Bool
True forall a. Semigroup a => a -> a -> a
<> ByteString
b1 , ByteString
b2)
gbdecode :: forall a. (ByteString, ByteString) -> (:+:) a b a
gbdecode ((Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
1 -> (ByteString
b , ByteString
b1)) , ByteString
b2) =
if forall a. Store a => ByteString -> a
decodeEx ByteString
b
then forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall s (f :: * -> *) a.
GBiSerialize s f =>
(ByteString, ByteString) -> f a
gbdecode @s (ByteString
b1 , ByteString
b2))
else forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall s (f :: * -> *) a.
GBiSerialize s f =>
(ByteString, ByteString) -> f a
gbdecode @s (ByteString
b1 , ByteString
b2))
instance GBiSerialize s f => GBiSerialize s (M1 i t f) where
{-# INLINE gbencode #-}
gbencode :: forall a. M1 i t f a -> (ByteString, ByteString)
gbencode (M1 f a
x) = forall s (f :: * -> *) a.
GBiSerialize s f =>
f a -> (ByteString, ByteString)
gbencode @s f a
x
{-# INLINE gbdecode #-}
gbdecode :: forall a. (ByteString, ByteString) -> M1 i t f a
gbdecode = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (f :: * -> *) a.
GBiSerialize s f =>
(ByteString, ByteString) -> f a
gbdecode @s
instance BiSerialize CsPoppy where
bencode :: CsPoppy -> (ByteString, ByteString)
bencode (CsPoppy Vector Word64
bv (A0.CsPoppyIndex Vector Word64
a01 Vector Word64
a02) (A1.CsPoppyIndex Vector Word64
a11 Vector Word64
a12)) =
(,) do forall a. Store a => a -> ByteString
encode (Vector Word64
a01 , Vector Word64
a02 , Vector Word64
a11 , Vector Word64
a12)
do forall a. Store a => a -> ByteString
encode Vector Word64
bv
bdecode :: (ByteString, ByteString) -> CsPoppy
bdecode (ByteString
bs , ByteString
bv) = do
let (Vector Word64
a01 , Vector Word64
a02 , Vector Word64
a11 , Vector Word64
a12) = forall a. Store a => ByteString -> a
decodeEx ByteString
bs
Vector Word64 -> CsPoppyIndex -> CsPoppyIndex -> CsPoppy
CsPoppy (forall a. Store a => ByteString -> a
decodeEx ByteString
bv) (Vector Word64 -> Vector Word64 -> CsPoppyIndex
A0.CsPoppyIndex Vector Word64
a01 Vector Word64
a02) (Vector Word64 -> Vector Word64 -> CsPoppyIndex
A1.CsPoppyIndex Vector Word64
a11 Vector Word64
a12)
instance BiSerialize BS.ByteString where
{-# INLINE bencode #-}
bencode :: ByteString -> (ByteString, ByteString)
bencode ByteString
x = (forall a. Monoid a => a
mempty , ByteString
x)
{-# INLINE bdecode #-}
bdecode :: (ByteString, ByteString) -> ByteString
bdecode (ByteString
_ , ByteString
x) = ByteString
x
instance BiSerialize Word32 where
{-# INLINE bencode #-}
bencode :: Word32 -> (ByteString, ByteString)
bencode Word32
x = (forall a. Store a => a -> ByteString
encode Word32
x , forall a. Monoid a => a
mempty)
{-# INLINE bdecode #-}
bdecode :: (ByteString, ByteString) -> Word32
bdecode (ByteString
x , ByteString
_) = forall a. Store a => ByteString -> a
decodeEx ByteString
x
instance BiSerialize PKPrim
instance BiSerialize a => BiSerialize (Maybe a)
instance (BiSerialize a , BiSerialize b) => BiSerialize (a , b)
data Custom = Custom {-# UNPACK #-} !Word32 CsPoppy
instance BiSerialize Custom where
bencode :: Custom -> (ByteString, ByteString)
bencode (Custom Word32
l CsPoppy
ppy) = do
let Maybe (Word32, CsPoppy)
x :: Maybe (Word32 , CsPoppy) =
if Word32
l forall a. Eq a => a -> a -> Bool
== Word32
0
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (Word32
l , CsPoppy
ppy)
forall a. BiSerialize a => a -> (ByteString, ByteString)
bencode Maybe (Word32, CsPoppy)
x
bdecode :: (ByteString, ByteString) -> Custom
bdecode (ByteString, ByteString)
r = case forall a. BiSerialize a => (ByteString, ByteString) -> a
bdecode (ByteString, ByteString)
r of
Maybe (Word32, CsPoppy)
Nothing -> Word32 -> CsPoppy -> Custom
Custom Word32
0 forall a. HasCallStack => a
undefined
Just (Word32
l , CsPoppy
ppy) -> Word32 -> CsPoppy -> Custom
Custom Word32
l CsPoppy
ppy
data SF a =
SSingle a
| SProd !(SF a) !(SF a)
| SSum !Custom !(SF a) !(SF a)
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (SF a) x -> SF a
forall a x. SF a -> Rep (SF a) x
$cto :: forall a x. Rep (SF a) x -> SF a
$cfrom :: forall a x. SF a -> Rep (SF a) x
Generic,forall a. BiSerialize a => (ByteString, ByteString) -> SF a
forall a. BiSerialize a => SF a -> (ByteString, ByteString)
forall a.
(a -> (ByteString, ByteString))
-> ((ByteString, ByteString) -> a) -> BiSerialize a
bdecode :: (ByteString, ByteString) -> SF a
$cbdecode :: forall a. BiSerialize a => (ByteString, ByteString) -> SF a
bencode :: SF a -> (ByteString, ByteString)
$cbencode :: forall a. BiSerialize a => SF a -> (ByteString, ByteString)
BiSerialize)
fromF :: F s a -> SF a
fromF :: forall s a. F s a -> SF a
fromF (Single a
x) = forall a. a -> SF a
SSingle a
x
fromF (Prod F s1 a
x F s2 a
y) = forall a. SF a -> SF a -> SF a
SProd (forall s a. F s a -> SF a
fromF F s1 a
x) (forall s a. F s a -> SF a
fromF F s2 a
y)
fromF (Sum Word32
l CsPoppy
ppy F s1 a
x F s2 a
y) = forall a. Custom -> SF a -> SF a -> SF a
SSum (Word32 -> CsPoppy -> Custom
Custom Word32
l CsPoppy
ppy) (forall s a. F s a -> SF a
fromF F s1 a
x) (forall s a. F s a -> SF a
fromF F s2 a
y)
toF :: SF a -> F s a
toF :: forall a s. SF a -> F s a
toF (SSingle a
x) = forall a b. a -> b
unsafeCoerce do forall a. a -> F () a
Single a
x
toF (SProd SF a
x SF a
y) = forall a b. a -> b
unsafeCoerce do forall s1 a s2. F s1 a -> F s2 a -> F (s1, s2) a
Prod (forall a s. SF a -> F s a
toF SF a
x) (forall a s. SF a -> F s a
toF SF a
y)
toF (SSum (Custom Word32
l CsPoppy
ppy) SF a
x SF a
y) = forall a b. a -> b
unsafeCoerce do forall s1 a s2.
Word32 -> CsPoppy -> F s1 a -> F s2 a -> F (Either s1 s2) a
Sum Word32
l CsPoppy
ppy (forall a s. SF a -> F s a
toF SF a
x) (forall a s. SF a -> F s a
toF SF a
y)
data SPopKey k v =
SPopKeyInt !(SF PKPrim)
| SPopKeyAny !(SF PKPrim) !(SF PKPrim)
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k v x. Rep (SPopKey k v) x -> SPopKey k v
forall k v x. SPopKey k v -> Rep (SPopKey k v) x
$cto :: forall k v x. Rep (SPopKey k v) x -> SPopKey k v
$cfrom :: forall k v x. SPopKey k v -> Rep (SPopKey k v) x
Generic,forall a.
(a -> (ByteString, ByteString))
-> ((ByteString, ByteString) -> a) -> BiSerialize a
forall k v. (ByteString, ByteString) -> SPopKey k v
forall k v. SPopKey k v -> (ByteString, ByteString)
bdecode :: (ByteString, ByteString) -> SPopKey k v
$cbdecode :: forall k v. (ByteString, ByteString) -> SPopKey k v
bencode :: SPopKey k v -> (ByteString, ByteString)
$cbencode :: forall k v. SPopKey k v -> (ByteString, ByteString)
BiSerialize)
toSPopKey :: PopKey k v -> SPopKey k v
toSPopKey :: forall k v. PopKey k v -> SPopKey k v
toSPopKey (PopKeyInt Bool
_ F s PKPrim
p F' s ByteString -> v
_) = forall k v. SF PKPrim -> SPopKey k v
SPopKeyInt (forall s a. F s a -> SF a
fromF F s PKPrim
p)
toSPopKey (PopKeyAny Bool
_ F s PKPrim
p1 F' s ByteString -> v
_ F (Shape k) PKPrim
p2) = forall k v. SF PKPrim -> SF PKPrim -> SPopKey k v
SPopKeyAny (forall s a. F s a -> SF a
fromF F s PKPrim
p1) (forall s a. F s a -> SF a
fromF F (Shape k) PKPrim
p2)
fromSPopKey :: forall k v . (PopKeyEncoding k , PopKeyEncoding v) => SPopKey k v -> PopKey k v
fromSPopKey :: forall k v.
(PopKeyEncoding k, PopKeyEncoding v) =>
SPopKey k v -> PopKey k v
fromSPopKey (SPopKeyInt SF PKPrim
p) = forall a b. a -> b
unsafeCoerce (forall s1 v.
Bool -> F s1 PKPrim -> (F' s1 ByteString -> v) -> PopKey Int v
PopKeyInt Bool
True (forall a s. SF a -> F s a
toF SF PKPrim
p) (forall a. PopKeyEncoding a => F' (Shape a) ByteString -> a
pkDecode @v))
fromSPopKey (SPopKeyAny SF PKPrim
pv SF PKPrim
pk) = forall s1 k v.
Bool
-> F s1 PKPrim
-> (F' s1 ByteString -> v)
-> F (Shape k) PKPrim
-> PopKey k v
PopKeyAny Bool
True (forall a s. SF a -> F s a
toF SF PKPrim
pv) (forall a. PopKeyEncoding a => F' (Shape a) ByteString -> a
pkDecode @v) (forall a s. SF a -> F s a
toF SF PKPrim
pk)
fromSPopKey' :: PopKeyEncoding v => SPopKey Int v -> PopKey Int v
fromSPopKey' :: forall v. PopKeyEncoding v => SPopKey Int v -> PopKey Int v
fromSPopKey' (SPopKeyInt SF PKPrim
p) = forall s1 v.
Bool -> F s1 PKPrim -> (F' s1 ByteString -> v) -> PopKey Int v
PopKeyInt Bool
True (forall a s. SF a -> F s a
toF SF PKPrim
p) forall a. PopKeyEncoding a => F' (Shape a) ByteString -> a
pkDecode
fromSPopKey' SPopKey Int v
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Incorrect PopKey type: expected Int."
{-# INLINABLE normalise #-}
normalise :: (PopKeyEncoding k , PopKeyEncoding v) => PopKey k v -> PopKey k v
normalise :: forall k v.
(PopKeyEncoding k, PopKeyEncoding v) =>
PopKey k v -> PopKey k v
normalise p :: PopKey k v
p@(PopKeyInt Bool
True F s PKPrim
_ F' s ByteString -> v
_) = PopKey k v
p
normalise p :: PopKey k v
p@(PopKeyInt Bool
_ F s PKPrim
_ F' s ByteString -> v
_) =
forall (f :: * -> *) v.
(Foldable f, PopKeyEncoding v) =>
f v -> PopKey Int v
makePopKey' (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList PopKey k v
p)
normalise p :: PopKey k v
p@(PopKeyAny Bool
True F s PKPrim
_ F' s ByteString -> v
_ F (Shape k) PKPrim
_) = PopKey k v
p
normalise p :: PopKey k v
p@(PopKeyAny Bool
_ F s PKPrim
_ F' s ByteString -> v
_ F (Shape k) PKPrim
_) =
forall (f :: * -> *) k v.
(Foldable f, PopKeyEncoding k, PopKeyEncoding v) =>
f (k, v) -> PopKey k v
makePopKey (forall k v b.
PopKeyEncoding k =>
(k -> v -> b -> b) -> b -> PopKey k v -> b
foldrWithKey (\k
k v
v -> (:) (k
k,v
v)) [] PopKey k v
p)
toStoreEnc :: (PopKeyEncoding k , PopKeyEncoding v) => PopKey k v -> (Bool , BS.ByteString , BS.ByteString)
toStoreEnc :: forall k v.
(PopKeyEncoding k, PopKeyEncoding v) =>
PopKey k v -> (Bool, ByteString, ByteString)
toStoreEnc (forall k v.
(PopKeyEncoding k, PopKeyEncoding v) =>
PopKey k v -> PopKey k v
normalise -> PopKey k v
p) = do
let (ByteString
b1 , ByteString
b2) = forall a. BiSerialize a => a -> (ByteString, ByteString)
bencode (forall k v. PopKey k v -> SPopKey k v
toSPopKey PopKey k v
p)
case PopKey k v
p of
PopKeyInt Bool
_ F s PKPrim
_ F' s ByteString -> v
_ -> (Bool
True , ByteString
b1 , ByteString
b2)
PopKeyAny Bool
_ F s PKPrim
_ F' s ByteString -> v
_ F (Shape k) PKPrim
_ -> (Bool
False , ByteString
b1 , ByteString
b2)
fromStoreEnc :: forall k v . (PopKeyEncoding k , PopKeyEncoding v) => (Bool , BS.ByteString , BS.ByteString) -> PopKey k v
fromStoreEnc :: forall k v.
(PopKeyEncoding k, PopKeyEncoding v) =>
(Bool, ByteString, ByteString) -> PopKey k v
fromStoreEnc (Bool
True , ByteString
b1 , ByteString
b2) = forall a b. a -> b
unsafeCoerce (forall v. PopKeyEncoding v => SPopKey Int v -> PopKey Int v
fromSPopKey' (forall a. BiSerialize a => (ByteString, ByteString) -> a
bdecode (ByteString
b1 , ByteString
b2) :: SPopKey Int v))
fromStoreEnc (Bool
False , ByteString
b1 , ByteString
b2) = forall k v.
(PopKeyEncoding k, PopKeyEncoding v) =>
SPopKey k v -> PopKey k v
fromSPopKey (forall a. BiSerialize a => (ByteString, ByteString) -> a
bdecode (ByteString
b1 , ByteString
b2))
instance (PopKeyEncoding k , PopKeyEncoding v) => Store (PopKey k v) where
size :: Size (PopKey k v)
size = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall k v.
(PopKeyEncoding k, PopKeyEncoding v) =>
PopKey k v -> (Bool, ByteString, ByteString)
toStoreEnc forall a. Store a => Size a
size
peek :: Peek (PopKey k v)
peek = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k v.
(PopKeyEncoding k, PopKeyEncoding v) =>
(Bool, ByteString, ByteString) -> PopKey k v
fromStoreEnc forall a. Store a => Peek a
peek
poke :: PopKey k v -> Poke ()
poke = forall a. Store a => a -> Poke ()
poke forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(PopKeyEncoding k, PopKeyEncoding v) =>
PopKey k v -> (Bool, ByteString, ByteString)
toStoreEnc
{-# INLINE makePopKey #-}
makePopKey :: forall f k v . (Foldable f , PopKeyEncoding k , PopKeyEncoding v) => f (k , v) -> PopKey k v
makePopKey :: forall (f :: * -> *) k v.
(Foldable f, PopKeyEncoding k, PopKeyEncoding v) =>
f (k, v) -> PopKey k v
makePopKey =
forall s.
Foldable f =>
I (Shape k)
-> I s
-> (v -> F' s ByteString)
-> (F' s ByteString -> v)
-> f (k, v)
-> PopKey k v
makePopKeyWithEncoding (forall a. PopKeyEncoding a => I (Shape a)
shape @k) (forall a. PopKeyEncoding a => I (Shape a)
shape @v) (forall a. PopKeyEncoding a => a -> F' (Shape a) ByteString
pkEncode @v) (forall a. PopKeyEncoding a => F' (Shape a) ByteString -> a
pkDecode @v)
where
makePopKeyWithEncoding :: Foldable f
=> I (Shape k)
-> I s -> (v -> F' s BS.ByteString) -> (F' s BS.ByteString -> v)
-> f (k , v)
-> PopKey k v
makePopKeyWithEncoding :: forall s.
Foldable f =>
I (Shape k)
-> I s
-> (v -> F' s ByteString)
-> (F' s ByteString -> v)
-> f (k, v)
-> PopKey k v
makePopKeyWithEncoding I (Shape k)
ik I s
iv v -> F' s ByteString
ev F' s ByteString -> v
dv f (k, v)
xs = do
let ([F' (Shape k) ByteString]
ks , [v]
vs) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall a b. Ord a => [(a, b)] -> [(a, b)]
lastv forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. PopKeyEncoding a => a -> F' (Shape a) ByteString
pkEncode) [] f (k, v)
xs))
forall s1 k v.
Bool
-> F s1 PKPrim
-> (F' s1 ByteString -> v)
-> F (Shape k) PKPrim
-> PopKey k v
PopKeyAny do Bool
True
do forall a s (f :: * -> *).
Foldable f =>
I s -> (a -> F' s ByteString) -> f a -> F s PKPrim
construct I s
iv v -> F' s ByteString
ev [v]
vs
do F' s ByteString -> v
dv
do forall a s (f :: * -> *).
Foldable f =>
I s -> (a -> F' s ByteString) -> f a -> F s PKPrim
construct I (Shape k)
ik forall a. a -> a
id [F' (Shape k) ByteString]
ks
where
lastv :: forall a b . Ord a => [(a,b)] -> [(a,b)]
lastv :: forall a b. Ord a => [(a, b)] -> [(a, b)]
lastv [] = []
lastv [ (a, b)
x ] = [ (a, b)
x ]
lastv ((a, b)
x : ys :: [(a, b)]
ys@((a, b)
y : [(a, b)]
_)) =
if forall a b. (a, b) -> a
fst (a, b)
x forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (a, b)
y
then forall a b. Ord a => [(a, b)] -> [(a, b)]
lastv [(a, b)]
ys
else (a, b)
x forall a. a -> [a] -> [a]
: forall a b. Ord a => [(a, b)] -> [(a, b)]
lastv [(a, b)]
ys
{-# INLINE makePopKey' #-}
makePopKey' :: forall f v . (Foldable f , PopKeyEncoding v) => f v -> PopKey Int v
makePopKey' :: forall (f :: * -> *) v.
(Foldable f, PopKeyEncoding v) =>
f v -> PopKey Int v
makePopKey' = forall s a.
I s
-> (a -> F' s ByteString)
-> (F' s ByteString -> a)
-> [a]
-> PopKey Int a
go (forall a. PopKeyEncoding a => I (Shape a)
shape @v) (forall a. PopKeyEncoding a => a -> F' (Shape a) ByteString
pkEncode @v) (forall a. PopKeyEncoding a => F' (Shape a) ByteString -> a
pkDecode @v) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) []
where
go :: I s -> (a -> F' s BS.ByteString) -> (F' s BS.ByteString -> a) -> [ a ] -> PopKey Int a
go :: forall s a.
I s
-> (a -> F' s ByteString)
-> (F' s ByteString -> a)
-> [a]
-> PopKey Int a
go I s
i a -> F' s ByteString
e F' s ByteString -> a
d [a]
xs =
forall s1 v.
Bool -> F s1 PKPrim -> (F' s1 ByteString -> v) -> PopKey Int v
PopKeyInt do Bool
True
do forall a s (f :: * -> *).
Foldable f =>
I s -> (a -> F' s ByteString) -> f a -> F s PKPrim
construct I s
i a -> F' s ByteString
e [a]
xs
do F' s ByteString -> a
d
data PopKeyStore k v =
PopKeyStore (forall f . Foldable f => f (k , v) -> IO ())
(IO (PopKey k v))
data PopKeyStore' v =
PopKeyStore' (forall f . Foldable f => f v -> IO ())
(IO (PopKey Int v))
class StorePopKey k v f | f -> k , f -> v where
type Input f
storePopKey :: Foldable t => f -> t (Input f) -> IO ()
loadPopKey :: f -> IO (PopKey k v)
instance StorePopKey k v (PopKeyStore k v) where
type Input (PopKeyStore k v) = (k , v)
storePopKey :: forall (t :: * -> *).
Foldable t =>
PopKeyStore k v -> t (Input (PopKeyStore k v)) -> IO ()
storePopKey (PopKeyStore forall (f :: * -> *). Foldable f => f (k, v) -> IO ()
a IO (PopKey k v)
_) = forall (f :: * -> *). Foldable f => f (k, v) -> IO ()
a
loadPopKey :: PopKeyStore k v -> IO (PopKey k v)
loadPopKey (PopKeyStore forall (f :: * -> *). Foldable f => f (k, v) -> IO ()
_ IO (PopKey k v)
b) = IO (PopKey k v)
b
instance StorePopKey Int v (PopKeyStore' v) where
type Input (PopKeyStore' v) = v
storePopKey :: forall (t :: * -> *).
Foldable t =>
PopKeyStore' v -> t (Input (PopKeyStore' v)) -> IO ()
storePopKey (PopKeyStore' forall (f :: * -> *). Foldable f => f v -> IO ()
a IO (PopKey Int v)
_) = forall (f :: * -> *). Foldable f => f v -> IO ()
a
loadPopKey :: PopKeyStore' v -> IO (PopKey Int v)
loadPopKey (PopKeyStore' forall (f :: * -> *). Foldable f => f v -> IO ()
_ IO (PopKey Int v)
b) = IO (PopKey Int v)
b