{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
module PlutusCore.Flat.AsBin(AsBin,unbin) where
import Data.ByteString qualified as B
import Foreign (plusPtr)
import PlutusCore.Flat.Bits (bits, fromBools, toBools)
import PlutusCore.Flat.Class (Flat (..))
import PlutusCore.Flat.Decoder.Prim (binOf)
import PlutusCore.Flat.Decoder.Types (Get (Get, runGet), GetResult (GetResult),
S (S, currPtr, usedBits))
import PlutusCore.Flat.Run (unflatRawWithOffset)
import Text.PrettyPrint.HughesPJClass (Doc, Pretty (pPrint), prettyShow, text)
data AsBin a = AsBin {
forall a. AsBin a -> ByteString
repr :: B.ByteString
,forall a. AsBin a -> Int
offsetBits :: Int
} deriving Int -> AsBin a -> ShowS
[AsBin a] -> ShowS
AsBin a -> String
(Int -> AsBin a -> ShowS)
-> (AsBin a -> String) -> ([AsBin a] -> ShowS) -> Show (AsBin a)
forall a. Int -> AsBin a -> ShowS
forall a. [AsBin a] -> ShowS
forall a. AsBin a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> AsBin a -> ShowS
showsPrec :: Int -> AsBin a -> ShowS
$cshow :: forall a. AsBin a -> String
show :: AsBin a -> String
$cshowList :: forall a. [AsBin a] -> ShowS
showList :: [AsBin a] -> ShowS
Show
instance Flat a => Pretty (AsBin a) where
pPrint :: AsBin a -> Doc
pPrint :: AsBin a -> Doc
pPrint AsBin a
r = let n :: a -> [a]
n = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (AsBin a -> Int
forall a. AsBin a -> Int
offsetBits AsBin a
r) in String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> String
forall {a}. a -> [a]
n Char
'_' String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (AsBin a -> Int
forall a. AsBin a -> Int
offsetBits AsBin a
r) ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bits -> String
forall a. Pretty a => a -> String
prettyShow (Bits -> String) -> (a -> Bits) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Bits
fromBools ([Bool] -> Bits) -> (a -> [Bool]) -> a -> Bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> [Bool]
forall {a}. a -> [a]
n Bool
False [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++) ([Bool] -> [Bool]) -> (a -> [Bool]) -> a -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bits -> [Bool]
toBools (Bits -> [Bool]) -> (a -> Bits) -> a -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bits
forall a. Flat a => a -> Bits
bits (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ AsBin a -> a
forall a. Flat a => AsBin a -> a
unbin AsBin a
r)
unbin :: Flat a => AsBin a -> a
unbin :: forall a. Flat a => AsBin a -> a
unbin AsBin a
a =
case Get a -> ByteString -> Int -> Decoded a
forall b a. AsByteString b => Get a -> b -> Int -> Decoded a
unflatRawWithOffset Get a
forall {a}. Flat a => Get a
dec (AsBin a -> ByteString
forall a. AsBin a -> ByteString
repr AsBin a
a) (AsBin a -> Int
forall a. AsBin a -> Int
offsetBits AsBin a
a) of
Right a
a -> a
a
Left DecodeException
e -> String -> a
forall a. HasCallStack => String -> a
error (DecodeException -> String
forall a. Show a => a -> String
show DecodeException
e)
where
dec :: Get a
dec = (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult a)) -> Get a)
-> (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end S
s -> do
GetResult S
s' a
a <- Get a -> Ptr Word8 -> S -> IO (GetResult a)
forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get a
forall {a}. Flat a => Get a
decode Ptr Word8
end S
s
let s'' :: S
s'' = Ptr Word8 -> Int -> S
S (S -> Ptr Word8
currPtr S
s' Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` if S -> Int
usedBits S
s' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
1) Int
0
GetResult a -> IO (GetResult a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult a -> IO (GetResult a))
-> GetResult a -> IO (GetResult a)
forall a b. (a -> b) -> a -> b
$ S -> a -> GetResult a
forall a. S -> a -> GetResult a
GetResult S
s'' a
a
instance Flat a => Flat (AsBin a) where
size :: AsBin a -> Int -> Int
size = String -> AsBin a -> Int -> Int
forall a. HasCallStack => String -> a
error String
"unused"
encode :: AsBin a -> Encoding
encode = String -> AsBin a -> Encoding
forall a. HasCallStack => String -> a
error String
"unused"
decode :: Flat a => Get (AsBin a)
decode :: Flat a => Get (AsBin a)
decode = (ByteString -> Int -> AsBin a) -> (ByteString, Int) -> AsBin a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> Int -> AsBin a
forall a. ByteString -> Int -> AsBin a
AsBin ((ByteString, Int) -> AsBin a)
-> Get (ByteString, Int) -> Get (AsBin a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a -> Get (ByteString, Int)
forall a. Get a -> Get (ByteString, Int)
binOf (Get a
forall {a}. Flat a => Get a
decode :: Get a)