{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UnboxedTuples #-}
module Codec.CBOR.Pretty
( prettyHexEnc
) where
#include "cbor.h"
import Data.Word
import qualified Data.ByteString as S
import qualified Data.Text as T
import Codec.CBOR.ByteArray.Sliced
import Codec.CBOR.Encoding
import Codec.CBOR.Write
import qualified Control.Monad.Fail as Fail
import Control.Monad (replicateM_)
import GHC.Int (Int64)
import Numeric
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
newtype PP a = PP (Tokens -> Int -> ShowS -> Either String (Tokens,Int,ShowS,a))
prettyHexEnc :: Encoding -> String
prettyHexEnc :: Encoding -> String
prettyHexEnc e :: Encoding
e = case PP () -> Encoding -> Either String (Tokens, Int, ShowS, ())
forall a. PP a -> Encoding -> Either String (Tokens, Int, ShowS, a)
runPP PP ()
pprint Encoding
e of
Left s :: String
s -> String
s
Right (TkEnd,_,ss :: ShowS
ss,_) -> ShowS
ss ""
Right (toks :: Tokens
toks,_,ss :: ShowS
ss,_) -> ShowS
ss ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "\nprettyEnc: Not all input was consumed (this is probably a problem with the pretty printing code). Tokens left: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tokens -> String
forall a. Show a => a -> String
show Tokens
toks
runPP :: PP a -> Encoding -> Either String (Tokens, Int, ShowS, a)
runPP :: PP a -> Encoding -> Either String (Tokens, Int, ShowS, a)
runPP (PP f :: Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a)
f) (Encoding enc :: Tokens -> Tokens
enc) = Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a)
f (Tokens -> Tokens
enc Tokens
TkEnd) 0 ShowS
forall a. a -> a
id
deriving instance Functor PP
instance Applicative PP where
pure :: a -> PP a
pure a :: a
a = (Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
forall a.
(Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
PP (\toks :: Tokens
toks ind :: Int
ind ss :: ShowS
ss -> (Tokens, Int, ShowS, a) -> Either String (Tokens, Int, ShowS, a)
forall a b. b -> Either a b
Right (Tokens
toks, Int
ind, ShowS
ss, a
a))
(PP f :: Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, a -> b)
f) <*> :: PP (a -> b) -> PP a -> PP b
<*> (PP x :: Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a)
x) = (Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, b))
-> PP b
forall a.
(Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
PP ((Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, b))
-> PP b)
-> (Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, b))
-> PP b
forall a b. (a -> b) -> a -> b
$ \toks :: Tokens
toks ind :: Int
ind ss :: ShowS
ss -> case Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, a -> b)
f Tokens
toks Int
ind ShowS
ss of
Left s :: String
s -> String -> Either String (Tokens, Int, ShowS, b)
forall a b. a -> Either a b
Left String
s
Right (toks' :: Tokens
toks', ind' :: Int
ind',ss' :: ShowS
ss',f' :: a -> b
f') -> case Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a)
x Tokens
toks' Int
ind' ShowS
ss' of
Left s :: String
s -> String -> Either String (Tokens, Int, ShowS, b)
forall a b. a -> Either a b
Left String
s
Right (toks'' :: Tokens
toks'', ind'' :: Int
ind'', ss'' :: ShowS
ss'', x' :: a
x') -> (Tokens, Int, ShowS, b) -> Either String (Tokens, Int, ShowS, b)
forall a b. b -> Either a b
Right (Tokens
toks'', Int
ind'', ShowS
ss'', a -> b
f' a
x')
instance Monad PP where
(PP f :: Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a)
f) >>= :: PP a -> (a -> PP b) -> PP b
>>= g :: a -> PP b
g = (Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, b))
-> PP b
forall a.
(Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
PP ((Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, b))
-> PP b)
-> (Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, b))
-> PP b
forall a b. (a -> b) -> a -> b
$ \toks :: Tokens
toks ind :: Int
ind ss :: ShowS
ss -> case Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a)
f Tokens
toks Int
ind ShowS
ss of
Left s :: String
s -> String -> Either String (Tokens, Int, ShowS, b)
forall a b. a -> Either a b
Left String
s
Right (toks' :: Tokens
toks', ind' :: Int
ind', ss' :: ShowS
ss', x :: a
x) -> let PP g' :: Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, b)
g' = a -> PP b
g a
x
in Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, b)
g' Tokens
toks' Int
ind' ShowS
ss'
return :: a -> PP a
return = a -> PP a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance Fail.MonadFail PP where
fail :: String -> PP a
fail s :: String
s = (Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
forall a.
(Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
PP ((Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a)
-> (Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
forall a b. (a -> b) -> a -> b
$ \_ _ _ -> String -> Either String (Tokens, Int, ShowS, a)
forall a b. a -> Either a b
Left String
s
indent :: PP ()
indent :: PP ()
indent = (Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, ()))
-> PP ()
forall a.
(Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
PP (\toks :: Tokens
toks ind :: Int
ind ss :: ShowS
ss -> (Tokens, Int, ShowS, ()) -> Either String (Tokens, Int, ShowS, ())
forall a b. b -> Either a b
Right (Tokens
toks,Int
ind,ShowS
ss ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
ind ' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++),()))
nl :: PP ()
nl :: PP ()
nl = (Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, ()))
-> PP ()
forall a.
(Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
PP (\toks :: Tokens
toks ind :: Int
ind ss :: ShowS
ss -> (Tokens, Int, ShowS, ()) -> Either String (Tokens, Int, ShowS, ())
forall a b. b -> Either a b
Right (Tokens
toks,Int
ind,ShowS
ss ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ('\n'Char -> ShowS
forall a. a -> [a] -> [a]
:), ()))
inc :: Int -> PP ()
inc :: Int -> PP ()
inc i :: Int
i = (Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, ()))
-> PP ()
forall a.
(Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
PP (\toks :: Tokens
toks ind :: Int
ind ss :: ShowS
ss -> (Tokens, Int, ShowS, ()) -> Either String (Tokens, Int, ShowS, ())
forall a b. b -> Either a b
Right (Tokens
toks,Int
indInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i,ShowS
ss,()))
dec :: Int -> PP ()
dec :: Int -> PP ()
dec i :: Int
i = Int -> PP ()
inc (-Int
i)
getTerm :: PP Tokens
getTerm :: PP Tokens
getTerm = (Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, Tokens))
-> PP Tokens
forall a.
(Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
PP ((Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, Tokens))
-> PP Tokens)
-> (Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, Tokens))
-> PP Tokens
forall a b. (a -> b) -> a -> b
$ \toks :: Tokens
toks ind :: Int
ind ss :: ShowS
ss ->
case Tokens -> Maybe (Tokens, Tokens)
unconsToken Tokens
toks of
Just (tk :: Tokens
tk,rest :: Tokens
rest) -> (Tokens, Int, ShowS, Tokens)
-> Either String (Tokens, Int, ShowS, Tokens)
forall a b. b -> Either a b
Right (Tokens
rest,Int
ind,ShowS
ss,Tokens
tk)
Nothing -> String -> Either String (Tokens, Int, ShowS, Tokens)
forall a b. a -> Either a b
Left "getTok: Unexpected end of input"
peekTerm :: PP Tokens
peekTerm :: PP Tokens
peekTerm = (Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, Tokens))
-> PP Tokens
forall a.
(Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
PP ((Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, Tokens))
-> PP Tokens)
-> (Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, Tokens))
-> PP Tokens
forall a b. (a -> b) -> a -> b
$ \toks :: Tokens
toks ind :: Int
ind ss :: ShowS
ss ->
case Tokens -> Maybe (Tokens, Tokens)
unconsToken Tokens
toks of
Just (tk :: Tokens
tk,_) -> (Tokens, Int, ShowS, Tokens)
-> Either String (Tokens, Int, ShowS, Tokens)
forall a b. b -> Either a b
Right (Tokens
toks,Int
ind,ShowS
ss,Tokens
tk)
Nothing -> String -> Either String (Tokens, Int, ShowS, Tokens)
forall a b. a -> Either a b
Left "peekTerm: Unexpected end of input"
appShowS :: ShowS -> PP ()
appShowS :: ShowS -> PP ()
appShowS s :: ShowS
s = (Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, ()))
-> PP ()
forall a.
(Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, a))
-> PP a
PP ((Tokens -> Int -> ShowS -> Either String (Tokens, Int, ShowS, ()))
-> PP ())
-> (Tokens
-> Int -> ShowS -> Either String (Tokens, Int, ShowS, ()))
-> PP ()
forall a b. (a -> b) -> a -> b
$ \toks :: Tokens
toks ind :: Int
ind ss :: ShowS
ss -> (Tokens, Int, ShowS, ()) -> Either String (Tokens, Int, ShowS, ())
forall a b. b -> Either a b
Right (Tokens
toks,Int
ind,ShowS
ss ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s,())
str :: String -> PP ()
str :: String -> PP ()
str = ShowS -> PP ()
appShowS (ShowS -> PP ()) -> (String -> ShowS) -> String -> PP ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString
shown :: Show a => a -> PP ()
shown :: a -> PP ()
shown = ShowS -> PP ()
appShowS (ShowS -> PP ()) -> (a -> ShowS) -> a -> PP ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows
parens :: PP a -> PP a
parens :: PP a -> PP a
parens pp :: PP a
pp = String -> PP ()
str "(" PP () -> PP a -> PP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PP a
pp PP a -> PP () -> PP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> PP ()
str ")"
indef :: PP () -> PP ()
indef :: PP () -> PP ()
indef pp :: PP ()
pp = do
Tokens
tk <- PP Tokens
peekTerm
case Tokens
tk of
TkBreak TkEnd -> Int -> PP ()
dec 3 PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP ()
pprint
_ -> PP ()
pp PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
indef PP ()
pp
pprint :: PP ()
pprint :: PP ()
pprint = do
PP ()
nl
Tokens
term <- PP Tokens
getTerm
Tokens -> PP ()
hexRep Tokens
term
String -> PP ()
str " "
case Tokens
term of
TkInt i :: Int
i TkEnd -> Int -> PP ()
ppTkInt Int
i
TkInt _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkInt64 i :: Int64
i TkEnd -> Int64 -> PP ()
ppTkInt64 Int64
i
TkInt64 _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkInteger i :: Integer
i TkEnd -> Integer -> PP ()
ppTkInteger Integer
i
TkInteger _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkWord64 w :: Word64
w TkEnd -> Word64 -> PP ()
ppTkWord64 Word64
w
TkWord64 _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkWord w :: Word
w TkEnd -> Word -> PP ()
ppTkWord Word
w
TkWord _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkBytes bs :: ByteString
bs TkEnd -> ByteString -> PP ()
ppTkBytes ByteString
bs
TkBytes _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkBytesBegin TkEnd -> PP ()
ppTkBytesBegin
TkBytesBegin _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkByteArray ba :: SlicedByteArray
ba TkEnd -> SlicedByteArray -> PP ()
ppTkByteArray SlicedByteArray
ba
TkByteArray _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkUtf8ByteArray ba :: SlicedByteArray
ba TkEnd -> SlicedByteArray -> PP ()
ppTkUtf8ByteArray SlicedByteArray
ba
TkUtf8ByteArray _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkString t :: Text
t TkEnd -> Text -> PP ()
ppTkString Text
t
TkString _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkStringBegin TkEnd -> PP ()
ppTkStringBegin
TkStringBegin _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkListLen w :: Word
w TkEnd -> Word -> PP ()
ppTkListLen Word
w
TkListLen _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkListBegin TkEnd -> PP ()
ppTkListBegin
TkListBegin _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkMapLen w :: Word
w TkEnd -> Word -> PP ()
ppTkMapLen Word
w
TkMapLen _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkMapBegin TkEnd -> PP ()
ppTkMapBegin
TkMapBegin _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkBreak TkEnd -> PP ()
ppTkBreak
TkBreak _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkTag w :: Word
w TkEnd -> Word -> PP ()
ppTkTag Word
w
TkTag _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkTag64 w :: Word64
w TkEnd -> Word64 -> PP ()
ppTkTag64 Word64
w
TkTag64 _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkBool b :: Bool
b TkEnd -> Bool -> PP ()
ppTkBool Bool
b
TkBool _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkNull TkEnd -> PP ()
ppTkNull
TkNull _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkUndef TkEnd -> PP ()
ppTkUndef
TkUndef _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkSimple w :: Word8
w TkEnd -> Word8 -> PP ()
ppTkSimple Word8
w
TkSimple _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkFloat16 f :: Float
f TkEnd -> Float -> PP ()
ppTkFloat16 Float
f
TkFloat16 _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkFloat32 f :: Float
f TkEnd -> Float -> PP ()
ppTkFloat32 Float
f
TkFloat32 _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkFloat64 f :: Double
f TkEnd -> Double -> PP ()
ppTkFloat64 Double
f
TkFloat64 _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkEncoded _ TkEnd -> PP ()
ppTkEncoded
TkEncoded _ _ -> Tokens -> PP ()
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
termFailure Tokens
term
TkEnd -> String -> PP ()
str "# End of input"
where
termFailure :: a -> m a
termFailure t :: a
t = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ["pprint: Unexpected token:", a -> String
forall a. Show a => a -> String
show a
t]
ppTkInt :: Int -> PP ()
ppTkInt :: Int -> PP ()
ppTkInt i :: Int
i = String -> PP ()
str "# int" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Int -> PP ()
forall a. Show a => a -> PP ()
shown Int
i)
ppTkInt64 :: Int64 -> PP ()
ppTkInt64 :: Int64 -> PP ()
ppTkInt64 i :: Int64
i = String -> PP ()
str "# int" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Int64 -> PP ()
forall a. Show a => a -> PP ()
shown Int64
i)
ppTkInteger :: Integer -> PP ()
ppTkInteger :: Integer -> PP ()
ppTkInteger i :: Integer
i = String -> PP ()
str "# integer" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Integer -> PP ()
forall a. Show a => a -> PP ()
shown Integer
i)
ppTkWord64 :: Word64 -> PP ()
ppTkWord64 :: Word64 -> PP ()
ppTkWord64 w :: Word64
w = String -> PP ()
str "# word" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Word64 -> PP ()
forall a. Show a => a -> PP ()
shown Word64
w)
ppTkWord :: Word -> PP ()
ppTkWord :: Word -> PP ()
ppTkWord w :: Word
w = String -> PP ()
str "# word" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Word -> PP ()
forall a. Show a => a -> PP ()
shown Word
w)
ppTkByteArray :: SlicedByteArray -> PP ()
ppTkByteArray :: SlicedByteArray -> PP ()
ppTkByteArray bs :: SlicedByteArray
bs = String -> PP ()
str "# bytes" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Int -> PP ()
forall a. Show a => a -> PP ()
shown (Int -> PP ()) -> Int -> PP ()
forall a b. (a -> b) -> a -> b
$ SlicedByteArray -> Int
sizeofSlicedByteArray SlicedByteArray
bs)
ppTkUtf8ByteArray :: SlicedByteArray -> PP ()
ppTkUtf8ByteArray :: SlicedByteArray -> PP ()
ppTkUtf8ByteArray bs :: SlicedByteArray
bs = String -> PP ()
str "# text" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Int -> PP ()
forall a. Show a => a -> PP ()
shown (Int -> PP ()) -> Int -> PP ()
forall a b. (a -> b) -> a -> b
$ SlicedByteArray -> Int
sizeofSlicedByteArray SlicedByteArray
bs)
ppTkBytes :: S.ByteString -> PP ()
ppTkBytes :: ByteString -> PP ()
ppTkBytes bs :: ByteString
bs = String -> PP ()
str "# bytes" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Int -> PP ()
forall a. Show a => a -> PP ()
shown (ByteString -> Int
S.length ByteString
bs))
ppTkBytesBegin :: PP ()
ppTkBytesBegin :: PP ()
ppTkBytesBegin = String -> PP ()
str "# bytes(*)" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> PP ()
inc 3 PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
indef PP ()
pprint
ppTkString :: T.Text -> PP ()
ppTkString :: Text -> PP ()
ppTkString t :: Text
t = String -> PP ()
str "# text" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Text -> PP ()
forall a. Show a => a -> PP ()
shown Text
t)
ppTkStringBegin:: PP ()
ppTkStringBegin :: PP ()
ppTkStringBegin = String -> PP ()
str "# text(*)" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> PP ()
inc 3 PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
indef PP ()
pprint
ppTkEncoded :: PP ()
ppTkEncoded :: PP ()
ppTkEncoded = String -> PP ()
str "# pre-encoded CBOR term"
ppTkListLen :: Word -> PP ()
ppTkListLen :: Word -> PP ()
ppTkListLen n :: Word
n = do
String -> PP ()
str "# list"
PP () -> PP ()
forall a. PP a -> PP a
parens (Word -> PP ()
forall a. Show a => a -> PP ()
shown Word
n)
Int -> PP ()
inc 3
Int -> PP () -> PP ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n) PP ()
pprint
Int -> PP ()
dec 3
ppTkListBegin :: PP ()
ppTkListBegin :: PP ()
ppTkListBegin = String -> PP ()
str "# list(*)" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> PP ()
inc 3 PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
indef PP ()
pprint
ppMapPairs :: PP ()
ppMapPairs :: PP ()
ppMapPairs = do
PP ()
nl
Int -> PP ()
inc 3
PP ()
indent
String -> PP ()
str " # key"
PP ()
pprint
Int -> PP ()
dec 3
PP ()
nl
Int -> PP ()
inc 3
PP ()
indent
String -> PP ()
str " # value"
PP ()
pprint
Int -> PP ()
dec 3
ppTkMapLen :: Word -> PP ()
ppTkMapLen :: Word -> PP ()
ppTkMapLen w :: Word
w = do
String -> PP ()
str "# map"
PP () -> PP ()
forall a. PP a -> PP a
parens (Word -> PP ()
forall a. Show a => a -> PP ()
shown Word
w)
Int -> PP () -> PP ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w) PP ()
ppMapPairs
ppTkMapBegin :: PP ()
ppTkMapBegin :: PP ()
ppTkMapBegin = String -> PP ()
str "# map(*)" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> PP ()
inc 3 PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
indef PP ()
ppMapPairs
ppTkBreak :: PP ()
ppTkBreak :: PP ()
ppTkBreak = String -> PP ()
str "# break"
ppTkTag :: Word -> PP ()
ppTkTag :: Word -> PP ()
ppTkTag w :: Word
w = do
String -> PP ()
str "# tag"
PP () -> PP ()
forall a. PP a -> PP a
parens (Word -> PP ()
forall a. Show a => a -> PP ()
shown Word
w)
Int -> PP ()
inc 3
PP ()
pprint
Int -> PP ()
dec 3
ppTkTag64 :: Word64 -> PP ()
ppTkTag64 :: Word64 -> PP ()
ppTkTag64 w :: Word64
w = do
String -> PP ()
str "# tag"
PP () -> PP ()
forall a. PP a -> PP a
parens (Word64 -> PP ()
forall a. Show a => a -> PP ()
shown Word64
w)
Int -> PP ()
inc 3
PP ()
pprint
Int -> PP ()
dec 3
ppTkBool :: Bool -> PP ()
ppTkBool :: Bool -> PP ()
ppTkBool True = String -> PP ()
str "# bool" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (String -> PP ()
str "true")
ppTkBool False = String -> PP ()
str "# bool" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (String -> PP ()
str "false")
ppTkNull :: PP ()
ppTkNull :: PP ()
ppTkNull = String -> PP ()
str "# null"
ppTkUndef :: PP ()
ppTkUndef :: PP ()
ppTkUndef = String -> PP ()
str "# undefined"
ppTkSimple :: Word8 -> PP ()
ppTkSimple :: Word8 -> PP ()
ppTkSimple w :: Word8
w = String -> PP ()
str "# simple" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Word8 -> PP ()
forall a. Show a => a -> PP ()
shown Word8
w)
ppTkFloat16 :: Float -> PP ()
ppTkFloat16 :: Float -> PP ()
ppTkFloat16 f :: Float
f = String -> PP ()
str "# float16" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Float -> PP ()
forall a. Show a => a -> PP ()
shown Float
f)
ppTkFloat32 :: Float -> PP ()
ppTkFloat32 :: Float -> PP ()
ppTkFloat32 f :: Float
f = String -> PP ()
str "# float32" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Float -> PP ()
forall a. Show a => a -> PP ()
shown Float
f)
ppTkFloat64 :: Double -> PP ()
ppTkFloat64 :: Double -> PP ()
ppTkFloat64 f :: Double
f = String -> PP ()
str "# float64" PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP () -> PP ()
forall a. PP a -> PP a
parens (Double -> PP ()
forall a. Show a => a -> PP ()
shown Double
f)
unconsToken :: Tokens -> Maybe (Tokens, Tokens)
unconsToken :: Tokens -> Maybe (Tokens, Tokens)
unconsToken TkEnd = Maybe (Tokens, Tokens)
forall a. Maybe a
Nothing
unconsToken (TkWord w :: Word
w tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Word -> Tokens -> Tokens
TkWord Word
w Tokens
TkEnd,Tokens
tks)
unconsToken (TkWord64 w :: Word64
w tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Word64 -> Tokens -> Tokens
TkWord64 Word64
w Tokens
TkEnd,Tokens
tks)
unconsToken (TkInt i :: Int
i tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Int -> Tokens -> Tokens
TkInt Int
i Tokens
TkEnd,Tokens
tks)
unconsToken (TkInt64 i :: Int64
i tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Int64 -> Tokens -> Tokens
TkInt64 Int64
i Tokens
TkEnd,Tokens
tks)
unconsToken (TkBytes bs :: ByteString
bs tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (ByteString -> Tokens -> Tokens
TkBytes ByteString
bs Tokens
TkEnd,Tokens
tks)
unconsToken (TkBytesBegin tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Tokens -> Tokens
TkBytesBegin Tokens
TkEnd,Tokens
tks)
unconsToken (TkByteArray a :: SlicedByteArray
a tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (SlicedByteArray -> Tokens -> Tokens
TkByteArray SlicedByteArray
a Tokens
TkEnd,Tokens
tks)
unconsToken (TkString t :: Text
t tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Text -> Tokens -> Tokens
TkString Text
t Tokens
TkEnd,Tokens
tks)
unconsToken (TkStringBegin tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Tokens -> Tokens
TkStringBegin Tokens
TkEnd,Tokens
tks)
unconsToken (TkUtf8ByteArray a :: SlicedByteArray
a tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (SlicedByteArray -> Tokens -> Tokens
TkUtf8ByteArray SlicedByteArray
a Tokens
TkEnd,Tokens
tks)
unconsToken (TkListLen len :: Word
len tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Word -> Tokens -> Tokens
TkListLen Word
len Tokens
TkEnd,Tokens
tks)
unconsToken (TkListBegin tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Tokens -> Tokens
TkListBegin Tokens
TkEnd,Tokens
tks)
unconsToken (TkMapLen len :: Word
len tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Word -> Tokens -> Tokens
TkMapLen Word
len Tokens
TkEnd,Tokens
tks)
unconsToken (TkMapBegin tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Tokens -> Tokens
TkMapBegin Tokens
TkEnd,Tokens
tks)
unconsToken (TkTag w :: Word
w tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Word -> Tokens -> Tokens
TkTag Word
w Tokens
TkEnd,Tokens
tks)
unconsToken (TkTag64 w64 :: Word64
w64 tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Word64 -> Tokens -> Tokens
TkTag64 Word64
w64 Tokens
TkEnd,Tokens
tks)
unconsToken (TkInteger i :: Integer
i tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Integer -> Tokens -> Tokens
TkInteger Integer
i Tokens
TkEnd,Tokens
tks)
unconsToken (TkNull tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Tokens -> Tokens
TkNull Tokens
TkEnd,Tokens
tks)
unconsToken (TkUndef tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Tokens -> Tokens
TkUndef Tokens
TkEnd,Tokens
tks)
unconsToken (TkBool b :: Bool
b tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Bool -> Tokens -> Tokens
TkBool Bool
b Tokens
TkEnd,Tokens
tks)
unconsToken (TkSimple w8 :: Word8
w8 tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Word8 -> Tokens -> Tokens
TkSimple Word8
w8 Tokens
TkEnd,Tokens
tks)
unconsToken (TkFloat16 f16 :: Float
f16 tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Float -> Tokens -> Tokens
TkFloat16 Float
f16 Tokens
TkEnd,Tokens
tks)
unconsToken (TkFloat32 f32 :: Float
f32 tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Float -> Tokens -> Tokens
TkFloat32 Float
f32 Tokens
TkEnd,Tokens
tks)
unconsToken (TkFloat64 f64 :: Double
f64 tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Double -> Tokens -> Tokens
TkFloat64 Double
f64 Tokens
TkEnd,Tokens
tks)
unconsToken (TkEncoded bs :: ByteString
bs tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (ByteString -> Tokens -> Tokens
TkEncoded ByteString
bs Tokens
TkEnd,Tokens
tks)
unconsToken (TkBreak tks :: Tokens
tks) = (Tokens, Tokens) -> Maybe (Tokens, Tokens)
forall a. a -> Maybe a
Just (Tokens -> Tokens
TkBreak Tokens
TkEnd,Tokens
tks)
hexRep :: Tokens -> PP ()
hexRep :: Tokens -> PP ()
hexRep tk :: Tokens
tk = ByteString -> PP ()
go (ByteString -> PP ())
-> ((Tokens -> Tokens) -> ByteString)
-> (Tokens -> Tokens)
-> PP ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
toStrictByteString (Encoding -> ByteString)
-> ((Tokens -> Tokens) -> Encoding)
-> (Tokens -> Tokens)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tokens -> Tokens) -> Encoding
Encoding ((Tokens -> Tokens) -> PP ()) -> (Tokens -> Tokens) -> PP ()
forall a b. (a -> b) -> a -> b
$ Tokens -> Tokens -> Tokens
forall a b. a -> b -> a
const Tokens
tk where
go :: ByteString -> PP ()
go bs :: ByteString
bs | ByteString -> Int
S.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 16 = case Int -> ByteString -> (ByteString, ByteString)
S.splitAt 16 ByteString
bs of
(h :: ByteString
h,t :: ByteString
t) -> PP ()
indent PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ShowS -> PP ()
appShowS (ByteString -> ShowS
hexBS ByteString
h) PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PP ()
nl PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> PP ()
go ByteString
t
| Bool
otherwise = PP ()
indent PP () -> PP () -> PP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ShowS -> PP ()
appShowS (ByteString -> ShowS
hexBS ByteString
bs)
hexBS :: S.ByteString -> ShowS
hexBS :: ByteString -> ShowS
hexBS = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id ([ShowS] -> ShowS)
-> (ByteString -> [ShowS]) -> ByteString -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> ShowS) -> [Word8] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (\n :: Word8
n -> ((if Word8
n Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< 16 then ('0'Char -> ShowS
forall a. a -> [a] -> [a]
:) else ShowS
forall a. a -> a
id) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
n ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (' 'Char -> ShowS
forall a. a -> [a] -> [a]
:))) ([Word8] -> [ShowS])
-> (ByteString -> [Word8]) -> ByteString -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
S.unpack