{-# LANGUAGE DefaultSignatures    #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS -fno-warn-orphans     #-}
module Data.RLP.Types where

import qualified Data.ByteString       as S
import qualified Data.ByteString.Char8 as S8

import           Data.Bits
import           Data.Char             (ord)
import           Data.Foldable
import           Data.Int
import           Data.List             (foldl')
import           Data.Word

import           GHC.Generics

data RLPObject = String S.ByteString | Array [RLPObject] deriving (RLPObject -> RLPObject -> Bool
(RLPObject -> RLPObject -> Bool)
-> (RLPObject -> RLPObject -> Bool) -> Eq RLPObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLPObject -> RLPObject -> Bool
$c/= :: RLPObject -> RLPObject -> Bool
== :: RLPObject -> RLPObject -> Bool
$c== :: RLPObject -> RLPObject -> Bool
Eq, Eq RLPObject
Eq RLPObject
-> (RLPObject -> RLPObject -> Ordering)
-> (RLPObject -> RLPObject -> Bool)
-> (RLPObject -> RLPObject -> Bool)
-> (RLPObject -> RLPObject -> Bool)
-> (RLPObject -> RLPObject -> Bool)
-> (RLPObject -> RLPObject -> RLPObject)
-> (RLPObject -> RLPObject -> RLPObject)
-> Ord RLPObject
RLPObject -> RLPObject -> Bool
RLPObject -> RLPObject -> Ordering
RLPObject -> RLPObject -> RLPObject
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RLPObject -> RLPObject -> RLPObject
$cmin :: RLPObject -> RLPObject -> RLPObject
max :: RLPObject -> RLPObject -> RLPObject
$cmax :: RLPObject -> RLPObject -> RLPObject
>= :: RLPObject -> RLPObject -> Bool
$c>= :: RLPObject -> RLPObject -> Bool
> :: RLPObject -> RLPObject -> Bool
$c> :: RLPObject -> RLPObject -> Bool
<= :: RLPObject -> RLPObject -> Bool
$c<= :: RLPObject -> RLPObject -> Bool
< :: RLPObject -> RLPObject -> Bool
$c< :: RLPObject -> RLPObject -> Bool
compare :: RLPObject -> RLPObject -> Ordering
$ccompare :: RLPObject -> RLPObject -> Ordering
$cp1Ord :: Eq RLPObject
Ord, ReadPrec [RLPObject]
ReadPrec RLPObject
Int -> ReadS RLPObject
ReadS [RLPObject]
(Int -> ReadS RLPObject)
-> ReadS [RLPObject]
-> ReadPrec RLPObject
-> ReadPrec [RLPObject]
-> Read RLPObject
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RLPObject]
$creadListPrec :: ReadPrec [RLPObject]
readPrec :: ReadPrec RLPObject
$creadPrec :: ReadPrec RLPObject
readList :: ReadS [RLPObject]
$creadList :: ReadS [RLPObject]
readsPrec :: Int -> ReadS RLPObject
$creadsPrec :: Int -> ReadS RLPObject
Read, Int -> RLPObject -> ShowS
[RLPObject] -> ShowS
RLPObject -> String
(Int -> RLPObject -> ShowS)
-> (RLPObject -> String)
-> ([RLPObject] -> ShowS)
-> Show RLPObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLPObject] -> ShowS
$cshowList :: [RLPObject] -> ShowS
show :: RLPObject -> String
$cshow :: RLPObject -> String
showsPrec :: Int -> RLPObject -> ShowS
$cshowsPrec :: Int -> RLPObject -> ShowS
Show)

rlp0 :: RLPObject
rlp0 :: RLPObject
rlp0 = ByteString -> RLPObject
String ByteString
S.empty

class RLPEncodable a where
    rlpEncode :: a -> RLPObject
    rlpDecode :: RLPObject -> Either String a

    default rlpEncode :: (Generic a, GRLPEncodable (Rep a)) => a -> RLPObject
    rlpEncode = Rep a Any -> RLPObject
forall (g :: * -> *) a. GRLPEncodable g => g a -> RLPObject
gRLPEncode (Rep a Any -> RLPObject) -> (a -> Rep a Any) -> a -> RLPObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

    default rlpDecode :: (Generic a, GRLPEncodable (Rep a)) => RLPObject -> Either String a
    rlpDecode = (Rep a Any -> a) -> Either String (Rep a Any) -> Either String a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Either String (Rep a Any) -> Either String a)
-> (RLPObject -> Either String (Rep a Any))
-> RLPObject
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RLPObject -> Either String (Rep a Any)
forall (g :: * -> *) a.
GRLPEncodable g =>
RLPObject -> Either String (g a)
gRLPDecode

rlpEncodeFinite :: (FiniteBits n, Integral n) => n -> RLPObject
rlpEncodeFinite :: n -> RLPObject
rlpEncodeFinite = ByteString -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode (ByteString -> RLPObject) -> (n -> ByteString) -> n -> RLPObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
S.pack ([Word8] -> ByteString) -> (n -> [Word8]) -> n -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> [Word8]
forall n. (FiniteBits n, Integral n) => n -> [Word8]
packFiniteBE
{-# INLINE rlpEncodeFinite #-}

rlpDecodeIntegralBE :: (Bits n, Integral n) => RLPObject -> Either String n
rlpDecodeIntegralBE :: RLPObject -> Either String n
rlpDecodeIntegralBE = \case
    String ByteString
s -> n -> Either String n
forall a b. b -> Either a b
Right (n -> Either String n)
-> ([Word8] -> n) -> [Word8] -> Either String n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> n
forall n. (Bits n, Integral n) => [Word8] -> n
unpackBE ([Word8] -> Either String n) -> [Word8] -> Either String n
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
S.unpack ByteString
s
    RLPObject
x        -> String -> RLPObject -> Either String n
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"String" RLPObject
x
{-# INLINE rlpDecodeIntegralBE #-}

rlpDecodeFail :: String -> RLPObject -> Either String a
rlpDecodeFail :: String -> RLPObject -> Either String a
rlpDecodeFail String
myType RLPObject
instead =
    String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Expected an RLPObject that's isomorphic to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
myType String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", instead got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RLPObject -> String
forall a. Show a => a -> String
show RLPObject
instead
{-# INLINE rlpDecodeFail #-}

-- todo: more efficient?
unpackBE :: (Bits n, Integral n) => [Word8] -> n
unpackBE :: [Word8] -> n
unpackBE [Word8]
words = (n -> n -> n) -> n -> [n] -> n
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' n -> n -> n
forall a. Bits a => a -> a -> a
(.|.) n
0 [n]
shifted
    where shifts :: [Int]
shifts  = [((Int
wc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8), ((Int
wc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)..Int
0]
          wc :: Int
wc      = [Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
words
          doShift :: a -> Int -> a
doShift a
word Int
shift = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
word a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
shift
          shifted :: [n]
shifted = (Word8 -> Int -> n) -> [Word8] -> [Int] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word8 -> Int -> n
forall a a. (Bits a, Integral a, Num a) => a -> Int -> a
doShift [Word8]
words [Int]
shifts
{-# INLINE unpackBE #-}

-- todo: ditto
packFiniteBE :: (FiniteBits n, Integral n) => n -> [Word8]
packFiniteBE :: n -> [Word8]
packFiniteBE n
n = Int -> n -> [Word8]
forall n. (Bits n, Integral n) => Int -> n -> [Word8]
packWithByteCount Int
byteCount n
n
    where byteCount :: Int
byteCount = (n -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize n
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8
{-# INLINE packFiniteBE #-}

packIntegerBE :: Integer -> [Word8]
packIntegerBE :: Integer -> [Word8]
packIntegerBE Integer
n = Int -> Integer -> [Word8]
forall n. (Bits n, Integral n) => Int -> n -> [Word8]
packWithByteCount Int
byteCount Integer
n
    where byteCount :: Int
byteCount = (Int
bitCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8
          bitCount :: Int
bitCount  = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
{-# INLINE packIntegerBE #-}

packWithByteCount :: (Bits n, Integral n) => Int -> n -> [Word8]
packWithByteCount :: Int -> n -> [Word8]
packWithByteCount Int
byteCount n
n = (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ (n -> Int -> Word8) -> [n] -> [Int] -> [Word8]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> Int -> Word8
forall a b. (Integral a, Bits a, Num b) => a -> Int -> b
f [n]
rep [Int]
shifts
    where rep :: [n]
rep    = Int -> n -> [n]
forall a. Int -> a -> [a]
replicate Int
byteCount n
n
          shifts :: [Int]
shifts = [((Int
byteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8), ((Int
byteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)..Int
0]
          f :: a -> Int -> b
f a
r Int
s  = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
r a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
s)
{-# INLINE packWithByteCount #-}

instance RLPEncodable S.ByteString where
    rlpEncode :: ByteString -> RLPObject
rlpEncode = ByteString -> RLPObject
String
    rlpDecode :: RLPObject -> Either String ByteString
rlpDecode = \case
        String ByteString
s -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
s
        RLPObject
x        -> String -> RLPObject -> Either String ByteString
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"String" RLPObject
x

instance {-# OVERLAPPABLE #-} (Integral n, FiniteBits n) => RLPEncodable n where
    rlpEncode :: n -> RLPObject
rlpEncode = n -> RLPObject
forall n. (FiniteBits n, Integral n) => n -> RLPObject
rlpEncodeFinite
    rlpDecode :: RLPObject -> Either String n
rlpDecode = RLPObject -> Either String n
forall n. (Bits n, Integral n) => RLPObject -> Either String n
rlpDecodeIntegralBE

instance RLPEncodable Integer where
    rlpEncode :: Integer -> RLPObject
rlpEncode = ByteString -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode (ByteString -> RLPObject)
-> (Integer -> ByteString) -> Integer -> RLPObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
S.pack ([Word8] -> ByteString)
-> (Integer -> [Word8]) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Word8]
packIntegerBE
    rlpDecode :: RLPObject -> Either String Integer
rlpDecode = RLPObject -> Either String Integer
forall n. (Bits n, Integral n) => RLPObject -> Either String n
rlpDecodeIntegralBE

instance {-# OVERLAPPABLE #-} (RLPEncodable a) => RLPEncodable [a] where
    rlpEncode :: [a] -> RLPObject
rlpEncode = [RLPObject] -> RLPObject
Array ([RLPObject] -> RLPObject)
-> ([a] -> [RLPObject]) -> [a] -> RLPObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RLPObject] -> [RLPObject]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([RLPObject] -> [RLPObject])
-> ([a] -> [RLPObject]) -> [a] -> [RLPObject]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> RLPObject) -> [a] -> [RLPObject]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode
    rlpDecode :: RLPObject -> Either String [a]
rlpDecode = \case
        Array [RLPObject]
xs -> [Either String a] -> Either String [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Either String a] -> Either String [a])
-> [Either String a] -> Either String [a]
forall a b. (a -> b) -> a -> b
$ RLPObject -> Either String a
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode (RLPObject -> Either String a) -> [RLPObject] -> [Either String a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RLPObject]
xs
        RLPObject
x        -> String -> RLPObject -> Either String [a]
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"Array" RLPObject
x

instance {-# OVERLAPPING #-} RLPEncodable String where
    rlpEncode :: String -> RLPObject
rlpEncode = ByteString -> RLPObject
String (ByteString -> RLPObject)
-> (String -> ByteString) -> String -> RLPObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
S8.pack
    rlpDecode :: RLPObject -> Either String String
rlpDecode = \case
        String ByteString
s -> String -> Either String String
forall a b. b -> Either a b
Right (ByteString -> String
S8.unpack ByteString
s)
        RLPObject
x        -> String -> RLPObject -> Either String String
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"String" RLPObject
x

instance RLPEncodable () where
    rlpEncode :: () -> RLPObject
rlpEncode ()
_ = RLPObject
rlp0
    rlpDecode :: RLPObject -> Either String ()
rlpDecode RLPObject
x = if RLPObject
x RLPObject -> RLPObject -> Bool
forall a. Eq a => a -> a -> Bool
== RLPObject
rlp0 then () -> Either String ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> RLPObject -> Either String ()
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"()" RLPObject
x

instance (RLPEncodable a, RLPEncodable b) => RLPEncodable (a,b) where
    rlpEncode :: (a, b) -> RLPObject
rlpEncode (a
a,b
b) = [RLPObject] -> RLPObject
Array [a -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode a
a,b -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode b
b]
    rlpDecode :: RLPObject -> Either String (a, b)
rlpDecode = \case
      Array [RLPObject
a,RLPObject
b] -> (,) (a -> b -> (a, b))
-> Either String a -> Either String (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RLPObject -> Either String a
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
a Either String (b -> (a, b))
-> Either String b -> Either String (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String b
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
b
      RLPObject
x           -> String -> RLPObject -> Either String (a, b)
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"Pair" RLPObject
x

instance
  ( RLPEncodable a
  , RLPEncodable b
  , RLPEncodable c
  ) => RLPEncodable (a,b,c) where
  rlpEncode :: (a, b, c) -> RLPObject
rlpEncode (a
a,b
b,c
c) = [RLPObject] -> RLPObject
Array
    [ a -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode a
a
    , b -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode b
b
    , c -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode c
c
    ]
  rlpDecode :: RLPObject -> Either String (a, b, c)
rlpDecode = \case
    Array [RLPObject
a,RLPObject
b,RLPObject
c] -> (,,)
      (a -> b -> c -> (a, b, c))
-> Either String a -> Either String (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RLPObject -> Either String a
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
a
      Either String (b -> c -> (a, b, c))
-> Either String b -> Either String (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String b
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
b
      Either String (c -> (a, b, c))
-> Either String c -> Either String (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String c
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
c
    RLPObject
x -> String -> RLPObject -> Either String (a, b, c)
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"Triple" RLPObject
x

instance
  ( RLPEncodable a
  , RLPEncodable b
  , RLPEncodable c
  , RLPEncodable d
  ) => RLPEncodable (a,b,c,d) where
  rlpEncode :: (a, b, c, d) -> RLPObject
rlpEncode (a
a,b
b,c
c,d
d) = [RLPObject] -> RLPObject
Array
    [ a -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode a
a
    , b -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode b
b
    , c -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode c
c
    , d -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode d
d
    ]
  rlpDecode :: RLPObject -> Either String (a, b, c, d)
rlpDecode = \case
    Array [RLPObject
a,RLPObject
b,RLPObject
c,RLPObject
d] -> (,,,)
      (a -> b -> c -> d -> (a, b, c, d))
-> Either String a -> Either String (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RLPObject -> Either String a
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
a
      Either String (b -> c -> d -> (a, b, c, d))
-> Either String b -> Either String (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String b
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
b
      Either String (c -> d -> (a, b, c, d))
-> Either String c -> Either String (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String c
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
c
      Either String (d -> (a, b, c, d))
-> Either String d -> Either String (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String d
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
d
    RLPObject
x -> String -> RLPObject -> Either String (a, b, c, d)
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"Quadruple" RLPObject
x

instance
  ( RLPEncodable a
  , RLPEncodable b
  , RLPEncodable c
  , RLPEncodable d
  , RLPEncodable e
  ) => RLPEncodable (a,b,c,d,e) where
  rlpEncode :: (a, b, c, d, e) -> RLPObject
rlpEncode (a
a,b
b,c
c,d
d,e
e) = [RLPObject] -> RLPObject
Array
    [ a -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode a
a
    , b -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode b
b
    , c -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode c
c
    , d -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode d
d
    , e -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode e
e
    ]
  rlpDecode :: RLPObject -> Either String (a, b, c, d, e)
rlpDecode = \case
    Array [RLPObject
a,RLPObject
b,RLPObject
c,RLPObject
d,RLPObject
e] -> (,,,,)
      (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Either String a
-> Either String (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RLPObject -> Either String a
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
a
      Either String (b -> c -> d -> e -> (a, b, c, d, e))
-> Either String b
-> Either String (c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String b
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
b
      Either String (c -> d -> e -> (a, b, c, d, e))
-> Either String c -> Either String (d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String c
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
c
      Either String (d -> e -> (a, b, c, d, e))
-> Either String d -> Either String (e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String d
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
d
      Either String (e -> (a, b, c, d, e))
-> Either String e -> Either String (a, b, c, d, e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String e
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
e
    RLPObject
x -> String -> RLPObject -> Either String (a, b, c, d, e)
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"Quintuple" RLPObject
x

instance
  ( RLPEncodable a
  , RLPEncodable b
  , RLPEncodable c
  , RLPEncodable d
  , RLPEncodable e
  , RLPEncodable f
  ) => RLPEncodable (a,b,c,d,e,f) where
  rlpEncode :: (a, b, c, d, e, f) -> RLPObject
rlpEncode (a
a,b
b,c
c,d
d,e
e,f
f) = [RLPObject] -> RLPObject
Array
    [ a -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode a
a
    , b -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode b
b
    , c -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode c
c
    , d -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode d
d
    , e -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode e
e
    , f -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode f
f
    ]
  rlpDecode :: RLPObject -> Either String (a, b, c, d, e, f)
rlpDecode = \case
    Array [RLPObject
a,RLPObject
b,RLPObject
c,RLPObject
d,RLPObject
e,RLPObject
f] -> (,,,,,)
      (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Either String a
-> Either String (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RLPObject -> Either String a
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
a
      Either String (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Either String b
-> Either String (c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String b
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
b
      Either String (c -> d -> e -> f -> (a, b, c, d, e, f))
-> Either String c
-> Either String (d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String c
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
c
      Either String (d -> e -> f -> (a, b, c, d, e, f))
-> Either String d -> Either String (e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String d
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
d
      Either String (e -> f -> (a, b, c, d, e, f))
-> Either String e -> Either String (f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String e
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
e
      Either String (f -> (a, b, c, d, e, f))
-> Either String f -> Either String (a, b, c, d, e, f)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String f
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
f
    RLPObject
x -> String -> RLPObject -> Either String (a, b, c, d, e, f)
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"Sextuple" RLPObject
x

instance
  ( RLPEncodable a
  , RLPEncodable b
  , RLPEncodable c
  , RLPEncodable d
  , RLPEncodable e
  , RLPEncodable f
  , RLPEncodable g
  ) => RLPEncodable (a,b,c,d,e,f,g) where
  rlpEncode :: (a, b, c, d, e, f, g) -> RLPObject
rlpEncode (a
a,b
b,c
c,d
d,e
e,f
f,g
g) = [RLPObject] -> RLPObject
Array
    [ a -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode a
a
    , b -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode b
b
    , c -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode c
c
    , d -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode d
d
    , e -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode e
e
    , f -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode f
f
    , g -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode g
g
    ]
  rlpDecode :: RLPObject -> Either String (a, b, c, d, e, f, g)
rlpDecode = \case
    Array [RLPObject
a,RLPObject
b,RLPObject
c,RLPObject
d,RLPObject
e,RLPObject
f,RLPObject
g] -> (,,,,,,)
      (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Either String a
-> Either
     String (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RLPObject -> Either String a
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
a
      Either String (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Either String b
-> Either String (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String b
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
b
      Either String (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Either String c
-> Either String (d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String c
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
c
      Either String (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Either String d
-> Either String (e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String d
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
d
      Either String (e -> f -> g -> (a, b, c, d, e, f, g))
-> Either String e
-> Either String (f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String e
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
e
      Either String (f -> g -> (a, b, c, d, e, f, g))
-> Either String f -> Either String (g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String f
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
f
      Either String (g -> (a, b, c, d, e, f, g))
-> Either String g -> Either String (a, b, c, d, e, f, g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String g
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
g
    RLPObject
x -> String -> RLPObject -> Either String (a, b, c, d, e, f, g)
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"Septuple" RLPObject
x

instance
  ( RLPEncodable a
  , RLPEncodable b
  , RLPEncodable c
  , RLPEncodable d
  , RLPEncodable e
  , RLPEncodable f
  , RLPEncodable g
  , RLPEncodable h
  ) => RLPEncodable (a,b,c,d,e,f,g,h) where
  rlpEncode :: (a, b, c, d, e, f, g, h) -> RLPObject
rlpEncode (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = [RLPObject] -> RLPObject
Array
    [ a -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode a
a
    , b -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode b
b
    , c -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode c
c
    , d -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode d
d
    , e -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode e
e
    , f -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode f
f
    , g -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode g
g
    , h -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode h
h
    ]
  rlpDecode :: RLPObject -> Either String (a, b, c, d, e, f, g, h)
rlpDecode = \case
    Array [RLPObject
a,RLPObject
b,RLPObject
c,RLPObject
d,RLPObject
e,RLPObject
f,RLPObject
g,RLPObject
h] -> (,,,,,,,)
      (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Either String a
-> Either
     String
     (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RLPObject -> Either String a
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
a
      Either
  String
  (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Either String b
-> Either
     String (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String b
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
b
      Either
  String (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Either String c
-> Either
     String (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String c
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
c
      Either String (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Either String d
-> Either String (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String d
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
d
      Either String (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Either String e
-> Either String (f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String e
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
e
      Either String (f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Either String f
-> Either String (g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String f
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
f
      Either String (g -> h -> (a, b, c, d, e, f, g, h))
-> Either String g -> Either String (h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String g
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
g
      Either String (h -> (a, b, c, d, e, f, g, h))
-> Either String h -> Either String (a, b, c, d, e, f, g, h)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String h
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
h
    RLPObject
x -> String -> RLPObject -> Either String (a, b, c, d, e, f, g, h)
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"Octuple" RLPObject
x

instance
  ( RLPEncodable a
  , RLPEncodable b
  , RLPEncodable c
  , RLPEncodable d
  , RLPEncodable e
  , RLPEncodable f
  , RLPEncodable g
  , RLPEncodable h
  , RLPEncodable i
  ) => RLPEncodable (a,b,c,d,e,f,g,h,i) where
  rlpEncode :: (a, b, c, d, e, f, g, h, i) -> RLPObject
rlpEncode (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = [RLPObject] -> RLPObject
Array
    [ a -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode a
a
    , b -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode b
b
    , c -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode c
c
    , d -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode d
d
    , e -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode e
e
    , f -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode f
f
    , g -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode g
g
    , h -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode h
h
    , i -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode i
i
    ]
  rlpDecode :: RLPObject -> Either String (a, b, c, d, e, f, g, h, i)
rlpDecode = \case
    Array [RLPObject
a,RLPObject
b,RLPObject
c,RLPObject
d,RLPObject
e,RLPObject
f,RLPObject
g,RLPObject
h,RLPObject
i] -> (,,,,,,,,)
      (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> (a, b, c, d, e, f, g, h, i))
-> Either String a
-> Either
     String
     (b
      -> c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RLPObject -> Either String a
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
a
      Either
  String
  (b
   -> c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Either String b
-> Either
     String
     (c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String b
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
b
      Either
  String
  (c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Either String c
-> Either
     String (d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String c
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
c
      Either
  String (d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Either String d
-> Either
     String (e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String d
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
d
      Either
  String (e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Either String e
-> Either String (f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String e
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
e
      Either String (f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Either String f
-> Either String (g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String f
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
f
      Either String (g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Either String g
-> Either String (h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String g
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
g
      Either String (h -> i -> (a, b, c, d, e, f, g, h, i))
-> Either String h
-> Either String (i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String h
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
h
      Either String (i -> (a, b, c, d, e, f, g, h, i))
-> Either String i -> Either String (a, b, c, d, e, f, g, h, i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RLPObject -> Either String i
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
i
    RLPObject
x -> String -> RLPObject -> Either String (a, b, c, d, e, f, g, h, i)
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"Nontuple" RLPObject
x

instance RLPEncodable RLPObject where -- ayy lmao
    rlpEncode :: RLPObject -> RLPObject
rlpEncode = RLPObject -> RLPObject
forall a. a -> a
id
    rlpDecode :: RLPObject -> Either String RLPObject
rlpDecode = RLPObject -> Either String RLPObject
forall a b. b -> Either a b
Right

instance RLPEncodable Char where
    rlpEncode :: Char -> RLPObject
rlpEncode = Int -> RLPObject
forall n. (FiniteBits n, Integral n) => n -> RLPObject
rlpEncodeFinite (Int -> RLPObject) -> (Char -> Int) -> Char -> RLPObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
    rlpDecode :: RLPObject -> Either String Char
rlpDecode = \case
        String ByteString
s | ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Char -> Either String Char
forall a b. b -> Either a b
Right (ByteString -> Char
S8.head ByteString
s)
        RLPObject
x                          -> String -> RLPObject -> Either String Char
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"String of length 1" RLPObject
x


-- Generic instances
class GRLPEncodable g where
  gRLPEncode :: g a -> RLPObject
  gRLPDecode :: RLPObject -> Either String (g a)

-- Reuse () instance for Unit generic
instance GRLPEncodable U1 where
    gRLPEncode :: U1 a -> RLPObject
gRLPEncode U1 a
U1 = () -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode ()
    gRLPDecode :: RLPObject -> Either String (U1 a)
gRLPDecode = (() -> U1 a) -> Either String () -> Either String (U1 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (U1 a -> () -> U1 a
forall a b. a -> b -> a
const U1 a
forall k (p :: k). U1 p
U1) (Either String () -> Either String (U1 a))
-> (RLPObject -> Either String ())
-> RLPObject
-> Either String (U1 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RLPObject -> Either String ()
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode :: RLPObject -> Either String ())

-- Products are just an RLP object with two sub-objects
instance (GRLPEncodable a, GRLPEncodable b) => GRLPEncodable (a :*: b) where
  gRLPEncode :: (:*:) a b a -> RLPObject
gRLPEncode (a a
a :*: b a
b) = RLPObject -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode (RLPObject -> RLPObject) -> RLPObject -> RLPObject
forall a b. (a -> b) -> a -> b
$ [RLPObject] -> RLPObject
Array [a a -> RLPObject
forall (g :: * -> *) a. GRLPEncodable g => g a -> RLPObject
gRLPEncode a a
a, b a -> RLPObject
forall (g :: * -> *) a. GRLPEncodable g => g a -> RLPObject
gRLPEncode b a
b]
  gRLPDecode :: RLPObject -> Either String ((:*:) a b a)
gRLPDecode RLPObject
x = RLPObject -> Either String RLPObject
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
x Either String RLPObject
-> (RLPObject -> Either String ((:*:) a b a))
-> Either String ((:*:) a b a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Array [RLPObject
a, RLPObject
b] -> do
        a a
a' <- RLPObject -> Either String (a a)
forall (g :: * -> *) a.
GRLPEncodable g =>
RLPObject -> Either String (g a)
gRLPDecode RLPObject
a
        b a
b' <- RLPObject -> Either String (b a)
forall (g :: * -> *) a.
GRLPEncodable g =>
RLPObject -> Either String (g a)
gRLPDecode RLPObject
b
        (:*:) a b a -> Either String ((:*:) a b a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a a
a' a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a
b')
      RLPObject
_ -> String -> RLPObject -> Either String ((:*:) a b a)
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"expected RLP list of two subobjects for generic product type decode" RLPObject
x

-- Sums use a [identifier_string, rlp_obj] structure to pick correct constructor
instance (GRLPEncodable a, GRLPEncodable b) => GRLPEncodable (a :+: b) where
  gRLPEncode :: (:+:) a b a -> RLPObject
gRLPEncode (L1 a a
a) = RLPObject -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode (RLPObject -> RLPObject) -> RLPObject -> RLPObject
forall a b. (a -> b) -> a -> b
$ [RLPObject] -> RLPObject
Array [ByteString -> RLPObject
String (String -> ByteString
S8.pack String
"L"), a a -> RLPObject
forall (g :: * -> *) a. GRLPEncodable g => g a -> RLPObject
gRLPEncode a a
a]
  gRLPEncode (R1 b a
b) = RLPObject -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode (RLPObject -> RLPObject) -> RLPObject -> RLPObject
forall a b. (a -> b) -> a -> b
$ [RLPObject] -> RLPObject
Array [ByteString -> RLPObject
String (String -> ByteString
S8.pack String
"R"), b a -> RLPObject
forall (g :: * -> *) a. GRLPEncodable g => g a -> RLPObject
gRLPEncode b a
b]

  gRLPDecode :: RLPObject -> Either String ((:+:) a b a)
gRLPDecode RLPObject
x = RLPObject -> Either String RLPObject
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode RLPObject
x Either String RLPObject
-> (RLPObject -> Either String ((:+:) a b a))
-> Either String ((:+:) a b a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Array [String ByteString
"L", RLPObject
l] -> a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a a -> (:+:) a b a)
-> Either String (a a) -> Either String ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RLPObject -> Either String (a a)
forall (g :: * -> *) a.
GRLPEncodable g =>
RLPObject -> Either String (g a)
gRLPDecode RLPObject
l
    Array [String ByteString
"R", RLPObject
r] -> b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b a -> (:+:) a b a)
-> Either String (b a) -> Either String ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RLPObject -> Either String (b a)
forall (g :: * -> *) a.
GRLPEncodable g =>
RLPObject -> Either String (g a)
gRLPDecode RLPObject
r
    RLPObject
x -> String -> RLPObject -> Either String ((:+:) a b a)
forall a. String -> RLPObject -> Either String a
rlpDecodeFail String
"expected RLP list of [\"L\" | \"R\", RLPObject] for generic sum type decode" RLPObject
x

-- MetaInfo is just passthrough
instance (GRLPEncodable a) => GRLPEncodable (M1 i c a) where
  gRLPEncode :: M1 i c a a -> RLPObject
gRLPEncode (M1 a a
a) = a a -> RLPObject
forall (g :: * -> *) a. GRLPEncodable g => g a -> RLPObject
gRLPEncode a a
a
  gRLPDecode :: RLPObject -> Either String (M1 i c a a)
gRLPDecode = (a a -> M1 i c a a)
-> Either String (a a) -> Either String (M1 i c a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Either String (a a) -> Either String (M1 i c a a))
-> (RLPObject -> Either String (a a))
-> RLPObject
-> Either String (M1 i c a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RLPObject -> Either String (a a)
forall (g :: * -> *) a.
GRLPEncodable g =>
RLPObject -> Either String (g a)
gRLPDecode

-- ditto for constant arg application
instance (RLPEncodable a) => GRLPEncodable (K1 i a) where
  gRLPEncode :: K1 i a a -> RLPObject
gRLPEncode (K1 a
a) = a -> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode a
a
  gRLPDecode :: RLPObject -> Either String (K1 i a a)
gRLPDecode = (a -> K1 i a a) -> Either String a -> Either String (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (Either String a -> Either String (K1 i a a))
-> (RLPObject -> Either String a)
-> RLPObject
-> Either String (K1 i a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RLPObject -> Either String a
forall a. RLPEncodable a => RLPObject -> Either String a
rlpDecode