{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_HADDOCK hide #-}

module PopKey.Encoding where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Store as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT

import PopKey.Internal2

-- for instance decls only
import Data.Functor.Const
import Data.Functor.Identity
import Data.Graph (Graph)
import Data.IntMap (IntMap)
import Data.IntSet (IntSet)
import Data.Map (Map)
import Data.Proxy
import Data.Ratio
import Data.Semigroup
import Data.Sequence (Seq)
import Data.Set (Set)
-- import Data.Tree (Tree) - no store instance available
import GHC.Generics
import GHC.Natural
import GHC.Int
import GHC.Word


-- | A simple wrapper to declare you do not want this data to be granularly partitioned by poppy.
newtype StoreBlob a = StoreBlob { forall a. StoreBlob a -> a
unStoreBlob :: a }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (StoreBlob a) x -> StoreBlob a
forall a x. StoreBlob a -> Rep (StoreBlob a) x
$cto :: forall a x. Rep (StoreBlob a) x -> StoreBlob a
$cfrom :: forall a x. StoreBlob a -> Rep (StoreBlob a) x
Generic,StoreBlob a -> StoreBlob a -> Bool
forall a. Eq a => StoreBlob a -> StoreBlob a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StoreBlob a -> StoreBlob a -> Bool
$c/= :: forall a. Eq a => StoreBlob a -> StoreBlob a -> Bool
== :: StoreBlob a -> StoreBlob a -> Bool
$c== :: forall a. Eq a => StoreBlob a -> StoreBlob a -> Bool
Eq,StoreBlob a -> StoreBlob a -> Bool
StoreBlob a -> StoreBlob a -> Ordering
StoreBlob a -> StoreBlob a -> StoreBlob a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (StoreBlob a)
forall a. Ord a => StoreBlob a -> StoreBlob a -> Bool
forall a. Ord a => StoreBlob a -> StoreBlob a -> Ordering
forall a. Ord a => StoreBlob a -> StoreBlob a -> StoreBlob a
min :: StoreBlob a -> StoreBlob a -> StoreBlob a
$cmin :: forall a. Ord a => StoreBlob a -> StoreBlob a -> StoreBlob a
max :: StoreBlob a -> StoreBlob a -> StoreBlob a
$cmax :: forall a. Ord a => StoreBlob a -> StoreBlob a -> StoreBlob a
>= :: StoreBlob a -> StoreBlob a -> Bool
$c>= :: forall a. Ord a => StoreBlob a -> StoreBlob a -> Bool
> :: StoreBlob a -> StoreBlob a -> Bool
$c> :: forall a. Ord a => StoreBlob a -> StoreBlob a -> Bool
<= :: StoreBlob a -> StoreBlob a -> Bool
$c<= :: forall a. Ord a => StoreBlob a -> StoreBlob a -> Bool
< :: StoreBlob a -> StoreBlob a -> Bool
$c< :: forall a. Ord a => StoreBlob a -> StoreBlob a -> Bool
compare :: StoreBlob a -> StoreBlob a -> Ordering
$ccompare :: forall a. Ord a => StoreBlob a -> StoreBlob a -> Ordering
Ord,Int -> StoreBlob a -> ShowS
forall a. Show a => Int -> StoreBlob a -> ShowS
forall a. Show a => [StoreBlob a] -> ShowS
forall a. Show a => StoreBlob a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoreBlob a] -> ShowS
$cshowList :: forall a. Show a => [StoreBlob a] -> ShowS
show :: StoreBlob a -> String
$cshow :: forall a. Show a => StoreBlob a -> String
showsPrec :: Int -> StoreBlob a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StoreBlob a -> ShowS
Show,StoreBlob a
forall a. a -> a -> Bounded a
forall a. Bounded a => StoreBlob a
maxBound :: StoreBlob a
$cmaxBound :: forall a. Bounded a => StoreBlob a
minBound :: StoreBlob a
$cminBound :: forall a. Bounded a => StoreBlob a
Bounded)
  deriving newtype Int -> StoreBlob a
StoreBlob a -> Int
StoreBlob a -> [StoreBlob a]
StoreBlob a -> StoreBlob a
StoreBlob a -> StoreBlob a -> [StoreBlob a]
StoreBlob a -> StoreBlob a -> StoreBlob a -> [StoreBlob a]
forall a. Enum a => Int -> StoreBlob a
forall a. Enum a => StoreBlob a -> Int
forall a. Enum a => StoreBlob a -> [StoreBlob a]
forall a. Enum a => StoreBlob a -> StoreBlob a
forall a. Enum a => StoreBlob a -> StoreBlob a -> [StoreBlob a]
forall a.
Enum a =>
StoreBlob a -> StoreBlob a -> StoreBlob a -> [StoreBlob a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StoreBlob a -> StoreBlob a -> StoreBlob a -> [StoreBlob a]
$cenumFromThenTo :: forall a.
Enum a =>
StoreBlob a -> StoreBlob a -> StoreBlob a -> [StoreBlob a]
enumFromTo :: StoreBlob a -> StoreBlob a -> [StoreBlob a]
$cenumFromTo :: forall a. Enum a => StoreBlob a -> StoreBlob a -> [StoreBlob a]
enumFromThen :: StoreBlob a -> StoreBlob a -> [StoreBlob a]
$cenumFromThen :: forall a. Enum a => StoreBlob a -> StoreBlob a -> [StoreBlob a]
enumFrom :: StoreBlob a -> [StoreBlob a]
$cenumFrom :: forall a. Enum a => StoreBlob a -> [StoreBlob a]
fromEnum :: StoreBlob a -> Int
$cfromEnum :: forall a. Enum a => StoreBlob a -> Int
toEnum :: Int -> StoreBlob a
$ctoEnum :: forall a. Enum a => Int -> StoreBlob a
pred :: StoreBlob a -> StoreBlob a
$cpred :: forall a. Enum a => StoreBlob a -> StoreBlob a
succ :: StoreBlob a -> StoreBlob a
$csucc :: forall a. Enum a => StoreBlob a -> StoreBlob a
Enum


-- | Inverse law: @pkDecode . pkEncode = id@. Note that this encoding is explicitly for use with poppy - use your discretion (or better, test!) to decide the granularity with which you wish to use this encoding as opposed to the standard store encoding. Relying more on PopKeyEncoding will probably use less space, but at the cost of storing items in less contiguous memory.
class PopKeyEncoding a where
  type Shape a
  type Shape a = GShape (Rep a)
  shape :: I (Shape a)
  default shape :: (GPopKeyEncoding a (Rep a) , GShape (Rep a) ~ Shape a) => I (Shape a)
  shape = forall s (f :: * -> *). GPopKeyEncoding s f => I (GShape f)
gshape @a @(Rep a)
  
  pkEncode :: a -> F' (Shape a) BS.ByteString
  default pkEncode :: (Generic a , GPopKeyEncoding a (Rep a) , GShape (Rep a) ~ Shape a) => a -> F' (Shape a) BS.ByteString
  pkEncode = forall s (f :: * -> *) a.
GPopKeyEncoding s f =>
f a -> F' (GShape f) ByteString
gpkEncode @a @(Rep a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from
  
  pkDecode :: F' (Shape a) BS.ByteString -> a
  default pkDecode :: (Generic a , GPopKeyEncoding a (Rep a) , GShape (Rep a) ~ Shape a) => F' (Shape a) BS.ByteString -> a
  pkDecode = forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (f :: * -> *) a.
GPopKeyEncoding s f =>
F' (GShape f) ByteString -> f a
gpkDecode @a @(Rep a)

class GPopKeyEncoding s f where
  type GShape f
  gshape :: I (GShape f)

  gpkEncode :: f a -> F' (GShape f) BS.ByteString
  gpkDecode :: F' (GShape f) BS.ByteString -> f a

instance GPopKeyEncoding s U1 where
  type GShape U1 = ()
  {-# INLINE gshape #-}
  gshape :: I (GShape U1)
gshape = I ()
ISingle
  {-# INLINE gpkEncode #-}
  gpkEncode :: forall a. U1 a -> F' (GShape U1) ByteString
gpkEncode = forall a b. a -> b -> a
const (forall a. a -> F' () a
Single' forall a. Monoid a => a
mempty)
  {-# INLINE gpkDecode #-}
  gpkDecode :: forall a. F' (GShape U1) ByteString -> U1 a
gpkDecode = forall a b. a -> b -> a
const forall k (p :: k). U1 p
U1


instance PopKeyEncoding a => GPopKeyEncoding s (K1 i a) where
  type GShape (K1 i a) = Shape a
  {-# INLINE gshape #-}
  gshape :: I (GShape (K1 i a))
gshape = forall a. PopKeyEncoding a => I (Shape a)
shape @a
  {-# INLINE gpkEncode #-}
  gpkEncode :: forall a. K1 i a a -> F' (GShape (K1 i a)) ByteString
gpkEncode (K1 a
x) = forall a. PopKeyEncoding a => a -> F' (Shape a) ByteString
pkEncode a
x
  {-# INLINE gpkDecode #-}
  gpkDecode :: forall a. F' (GShape (K1 i a)) ByteString -> K1 i a a
gpkDecode = forall k i c (p :: k). c -> K1 i c p
K1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PopKeyEncoding a => F' (Shape a) ByteString -> a
pkDecode

instance (GPopKeyEncoding s a , GPopKeyEncoding s b) => GPopKeyEncoding s (a :*: b) where
  type GShape (a :*: b) = (GShape a , GShape b)
  {-# INLINE gshape #-}
  gshape :: I (GShape (a :*: b))
gshape = forall s1 s2. I s1 -> I s2 -> I (s1, s2)
IProd (forall s (f :: * -> *). GPopKeyEncoding s f => I (GShape f)
gshape @s @a) (forall s (f :: * -> *). GPopKeyEncoding s f => I (GShape f)
gshape @s @b)
  {-# INLINE gpkEncode #-}
  gpkEncode :: forall a. (:*:) a b a -> F' (GShape (a :*: b)) ByteString
gpkEncode (a a
a :*: b a
b) = forall s1 a s2. F' s1 a -> F' s2 a -> F' (s1, s2) a
Prod' (forall s (f :: * -> *) a.
GPopKeyEncoding s f =>
f a -> F' (GShape f) ByteString
gpkEncode @s a a
a) (forall s (f :: * -> *) a.
GPopKeyEncoding s f =>
f a -> F' (GShape f) ByteString
gpkEncode @s b a
b)
  {-# INLINE gpkDecode #-}
  gpkDecode :: forall a. F' (GShape (a :*: b)) ByteString -> (:*:) a b a
gpkDecode (Prod' F' s1 ByteString
a F' s2 ByteString
b) = forall s (f :: * -> *) a.
GPopKeyEncoding s f =>
F' (GShape f) ByteString -> f a
gpkDecode @s F' s1 ByteString
a forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall s (f :: * -> *) a.
GPopKeyEncoding s f =>
F' (GShape f) ByteString -> f a
gpkDecode @s F' s2 ByteString
b

instance (GPopKeyEncoding s a , GPopKeyEncoding s b) => GPopKeyEncoding s (a :+: b) where
  type GShape (a :+: b) = Either (GShape a) (GShape b)
  {-# INLINE gshape #-}
  gshape :: I (GShape (a :+: b))
gshape = forall s1 s2. I s1 -> I s2 -> I (Either s1 s2)
ISum (forall s (f :: * -> *). GPopKeyEncoding s f => I (GShape f)
gshape @s @a) (forall s (f :: * -> *). GPopKeyEncoding s f => I (GShape f)
gshape @s @b)
  {-# INLINE gpkEncode #-}
  gpkEncode :: forall a. (:+:) a b a -> F' (GShape (a :+: b)) ByteString
gpkEncode (L1 a a
x) = forall s1 a s2. Either (F' s1 a) (F' s2 a) -> F' (Either s1 s2) a
Sum' (forall a b. a -> Either a b
Left (forall s (f :: * -> *) a.
GPopKeyEncoding s f =>
f a -> F' (GShape f) ByteString
gpkEncode @s a a
x))
  gpkEncode (R1 b a
x) = forall s1 a s2. Either (F' s1 a) (F' s2 a) -> F' (Either s1 s2) a
Sum' (forall a b. b -> Either a b
Right (forall s (f :: * -> *) a.
GPopKeyEncoding s f =>
f a -> F' (GShape f) ByteString
gpkEncode @s b a
x))
  {-# INLINE gpkDecode #-}
  gpkDecode :: forall a. F' (GShape (a :+: b)) ByteString -> (:+:) a b a
gpkDecode (Sum' Either (F' s1 ByteString) (F' s2 ByteString)
x) = case Either (F' s1 ByteString) (F' s2 ByteString)
x of
    Left F' s1 ByteString
l -> forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall s (f :: * -> *) a.
GPopKeyEncoding s f =>
F' (GShape f) ByteString -> f a
gpkDecode @s F' s1 ByteString
l)
    Right F' s2 ByteString
r -> forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall s (f :: * -> *) a.
GPopKeyEncoding s f =>
F' (GShape f) ByteString -> f a
gpkDecode @s F' s2 ByteString
r)

instance GPopKeyEncoding s f => GPopKeyEncoding s (M1 i t f) where
  type GShape (M1 i t f) = GShape f
  {-# INLINE gshape #-}
  gshape :: I (GShape (M1 i t f))
gshape = forall s (f :: * -> *). GPopKeyEncoding s f => I (GShape f)
gshape @s @f
  {-# INLINE gpkEncode #-}
  gpkEncode :: forall a. M1 i t f a -> F' (GShape (M1 i t f)) ByteString
gpkEncode (M1 f a
x) = forall s (f :: * -> *) a.
GPopKeyEncoding s f =>
f a -> F' (GShape f) ByteString
gpkEncode @s f a
x
  {-# INLINE gpkDecode #-}
  gpkDecode :: forall a. F' (GShape (M1 i t f)) ByteString -> M1 i t f a
gpkDecode = 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.
GPopKeyEncoding s f =>
F' (GShape f) ByteString -> f a
gpkDecode @s

---------------
-- INSTANCES --
---------------

instance S.Store a => PopKeyEncoding (StoreBlob a) where
  type Shape (StoreBlob a) = ()
  {-# INLINE shape #-}
  shape :: I (Shape (StoreBlob a))
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: StoreBlob a -> F' (Shape (StoreBlob a)) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StoreBlob a -> a
unStoreBlob
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape (StoreBlob a)) ByteString -> StoreBlob a
pkDecode (Single' ByteString
x) = forall a. a -> StoreBlob a
StoreBlob do forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding BS.ByteString where
  type Shape BS.ByteString = ()
  {-# INLINE shape #-}
  shape :: I (Shape ByteString)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: ByteString -> F' (Shape ByteString) ByteString
pkEncode = forall a. a -> F' () a
Single'
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape ByteString) ByteString -> ByteString
pkDecode (Single' ByteString
x) = ByteString
x

instance PopKeyEncoding LBS.ByteString where
  type Shape LBS.ByteString = ()
  {-# INLINE shape #-}
  shape :: I (Shape ByteString)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: ByteString -> F' (Shape ByteString) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape ByteString) ByteString -> ByteString
pkDecode (Single' ByteString
x) = ByteString -> ByteString
LBS.fromStrict ByteString
x

instance S.Store a => PopKeyEncoding [ a ] where
  type Shape [ a ] = ()
  {-# INLINE shape #-}
  shape :: I (Shape [a])
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: [a] -> F' (Shape [a]) ByteString
pkEncode = case forall a. Store a => Size a
S.size @a of
    S.ConstSize Int
_ -> forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Store a => a -> ByteString
S.encode
    Size a
_ -> forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape [a]) ByteString -> [a]
pkDecode = \(Single' ByteString
r) -> case forall a. Store a => Size a
S.size @a of
    S.ConstSize Int
k -> forall a. Store a => ByteString -> a
S.decodeEx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ByteString -> [ByteString]
chunks Int
k ByteString
r
    Size a
_ -> forall a. Store a => ByteString -> a
S.decodeEx ByteString
r
    where
      chunks :: Int -> BS.ByteString -> [ BS.ByteString ]
      chunks :: Int -> ByteString -> [ByteString]
chunks Int
i ByteString
b
        | ByteString -> Int
BS.length ByteString
b forall a. Eq a => a -> a -> Bool
== Int
0 = []
        | Bool
otherwise = let (ByteString
x , ByteString
xs) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
i ByteString
b in ByteString
x forall a. a -> [a] -> [a]
: Int -> ByteString -> [ByteString]
chunks Int
i ByteString
xs

-- override text store instance since it uses Haskell's bloaded UTF16 encoding, which in this
-- context would be a terrible choice.
instance PopKeyEncoding T.Text where
  type Shape T.Text = ()
  {-# INLINE shape #-}
  shape :: I (Shape Text)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Text -> F' (Shape Text) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Text) ByteString -> Text
pkDecode (Single' ByteString
x) = ByteString -> Text
T.decodeUtf8 ByteString
x

instance PopKeyEncoding LT.Text where
  type Shape LT.Text = ()
  {-# INLINE shape #-}
  shape :: I (Shape Text)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Text -> F' (Shape Text) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
LT.encodeUtf8
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Text) ByteString -> Text
pkDecode (Single' ByteString
x) = ByteString -> Text
LT.decodeUtf8 (ByteString -> ByteString
LBS.fromStrict ByteString
x)

instance PopKeyEncoding Char where
  type Shape Char = ()
  {-# INLINE shape #-}
  shape :: I (Shape Char)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Char -> F' (Shape Char) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Char) ByteString -> Char
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Double where
  type Shape Double = ()
  {-# INLINE shape #-}
  shape :: I (Shape Double)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Double -> F' (Shape Double) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Double) ByteString -> Double
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Float where
  type Shape Float = ()
  {-# INLINE shape #-}
  shape :: I (Shape Float)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Float -> F' (Shape Float) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Float) ByteString -> Float
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Int8 where
  type Shape Int8 = ()
  {-# INLINE shape #-}
  shape :: I (Shape Int8)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Int8 -> F' (Shape Int8) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Int8) ByteString -> Int8
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Int16 where
  type Shape Int16 = ()
  {-# INLINE shape #-}
  shape :: I (Shape Int16)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Int16 -> F' (Shape Int16) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Int16) ByteString -> Int16
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Int32 where
  type Shape Int32 = ()
  {-# INLINE shape #-}
  shape :: I (Shape Int32)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Int32 -> F' (Shape Int32) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Int32) ByteString -> Int32
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Int64 where
  type Shape Int64 = ()
  {-# INLINE shape #-}
  shape :: I (Shape Int64)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Int64 -> F' (Shape Int64) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Int64) ByteString -> Int64
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Int where
  type Shape Int = ()
  {-# INLINE shape #-}
  shape :: I (Shape Int)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Int -> F' (Shape Int) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Int) ByteString -> Int
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Word8 where
  type Shape Word8 = ()
  {-# INLINE shape #-}
  shape :: I (Shape Word8)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Word8 -> F' (Shape Word8) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Word8) ByteString -> Word8
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Word16 where
  type Shape Word16 = ()
  {-# INLINE shape #-}
  shape :: I (Shape Word16)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Word16 -> F' (Shape Word16) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Word16) ByteString -> Word16
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Word32 where
  type Shape Word32 = ()
  {-# INLINE shape #-}
  shape :: I (Shape Word32)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Word32 -> F' (Shape Word32) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Word32) ByteString -> Word32
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Word64 where
  type Shape Word64 = ()
  {-# INLINE shape #-}
  shape :: I (Shape Word64)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Word64 -> F' (Shape Word64) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Word64) ByteString -> Word64
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Word where
  type Shape Word = ()
  {-# INLINE shape #-}
  shape :: I (Shape Word)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Word -> F' (Shape Word) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Word) ByteString -> Word
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Integer where
  type Shape Integer = ()
  {-# INLINE shape #-}
  shape :: I (Shape Integer)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Integer -> F' (Shape Integer) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Integer) ByteString -> Integer
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Natural where
  type Shape Natural = ()
  {-# INLINE shape #-}
  shape :: I (Shape Natural)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Natural -> F' (Shape Natural) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Natural) ByteString -> Natural
pkDecode (Single' ByteString
x) = forall a. Num a => Integer -> a
fromInteger do forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Rational where
  type Shape Rational = ()
  {-# INLINE shape #-}
  shape :: I (Shape Rational)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Rational -> F' (Shape Rational) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Rational) ByteString -> Rational
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance S.Store a => PopKeyEncoding (Ratio a) where
  type Shape (Ratio a) = ()
  {-# INLINE shape #-}
  shape :: I (Shape (Ratio a))
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Ratio a -> F' (Shape (Ratio a)) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape (Ratio a)) ByteString -> Ratio a
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding Graph where
  type Shape Graph = ()
  {-# INLINE shape #-}
  shape :: I (Shape Graph)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Graph -> F' (Shape Graph) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape Graph) ByteString -> Graph
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance S.Store a => PopKeyEncoding (IntMap a) where
  type Shape (IntMap a) = ()
  {-# INLINE shape #-}
  shape :: I (Shape (IntMap a))
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: IntMap a -> F' (Shape (IntMap a)) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape (IntMap a)) ByteString -> IntMap a
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance PopKeyEncoding IntSet where
  type Shape IntSet = ()
  {-# INLINE shape #-}
  shape :: I (Shape IntSet)
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: IntSet -> F' (Shape IntSet) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape IntSet) ByteString -> IntSet
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x

instance (Ord a , S.Store a , S.Store b) => PopKeyEncoding (Map a b) where
  type Shape (Map a b) = ()
  {-# INLINE shape #-}
  shape :: I (Shape (Map a b))
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Map a b -> F' (Shape (Map a b)) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape (Map a b)) ByteString -> Map a b
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x  

instance S.Store a => PopKeyEncoding (Seq a) where
  type Shape (Seq a) = ()
  {-# INLINE shape #-}
  shape :: I (Shape (Seq a))
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Seq a -> F' (Shape (Seq a)) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape (Seq a)) ByteString -> Seq a
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x  

instance (Ord a , S.Store a) => PopKeyEncoding (Set a) where
  type Shape (Set a) = ()
  {-# INLINE shape #-}
  shape :: I (Shape (Set a))
shape = I ()
ISingle
  {-# INLINE pkEncode #-}
  pkEncode :: Set a -> F' (Shape (Set a)) ByteString
pkEncode = forall a. a -> F' () a
Single' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Store a => a -> ByteString
S.encode
  {-# INLINE pkDecode #-}
  pkDecode :: F' (Shape (Set a)) ByteString -> Set a
pkDecode (Single' ByteString
x) = forall a. Store a => ByteString -> a
S.decodeEx ByteString
x  

instance PopKeyEncoding ()
instance PopKeyEncoding (Proxy a)
instance PopKeyEncoding Bool
instance PopKeyEncoding a => PopKeyEncoding (Maybe a)
instance PopKeyEncoding a => PopKeyEncoding (Min a)
instance PopKeyEncoding a => PopKeyEncoding (Max a)
instance PopKeyEncoding a => PopKeyEncoding (First a)
instance PopKeyEncoding a => PopKeyEncoding (Last a)
instance PopKeyEncoding a => PopKeyEncoding (Identity a)
instance PopKeyEncoding a => PopKeyEncoding (Sum a)
instance PopKeyEncoding a => PopKeyEncoding (Product a)
instance PopKeyEncoding a => PopKeyEncoding (Const a b)

instance (PopKeyEncoding a , PopKeyEncoding b) => PopKeyEncoding (Arg a b)
instance (PopKeyEncoding a , PopKeyEncoding b) => PopKeyEncoding (Either a b)

instance (PopKeyEncoding a , PopKeyEncoding b) => PopKeyEncoding (a , b)
instance (PopKeyEncoding a , PopKeyEncoding b , PopKeyEncoding c) => PopKeyEncoding (a , b , c)
instance (PopKeyEncoding a , PopKeyEncoding b , PopKeyEncoding c , PopKeyEncoding d) => PopKeyEncoding (a , b , c , d)
instance (PopKeyEncoding a , PopKeyEncoding b , PopKeyEncoding c , PopKeyEncoding d , PopKeyEncoding e) => PopKeyEncoding (a , b , c , d , e)