module Cooked.Pretty.Class
( DocCooked,
PrettyCooked (..),
PrettyCookedList (..),
PrettyCookedMaybe (..),
printCookedOpt,
printCooked,
renderString,
prettyHash,
prettyItemize,
prettyItemizeNoTitle,
prettyItemizeNonEmpty,
)
where
import Cooked.Pretty.Hashable
import Cooked.Pretty.Options
import Data.ByteString qualified as ByteString
import Data.Default
import Data.Map qualified as Map
import Data.Maybe (catMaybes)
import Data.Ratio
import Data.Set (Set)
import Data.Set qualified as Set
import Numeric qualified
import PlutusTx.Builtins.Internal qualified as PlutusTx
import Prettyprinter (Doc, (<+>))
import Prettyprinter qualified as PP
import Prettyprinter.Render.String qualified as PP
import Prettyprinter.Render.Text qualified as PP
type DocCooked = Doc ()
class PrettyCooked a where
prettyCookedOpt :: PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
_ = a -> DocCooked
forall a. PrettyCooked a => a -> DocCooked
prettyCooked
prettyCooked :: a -> DocCooked
prettyCooked = PrettyCookedOpts -> a -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
forall a. Default a => a
def
instance PrettyCooked DocCooked where
prettyCookedOpt :: PrettyCookedOpts -> DocCooked -> DocCooked
prettyCookedOpt PrettyCookedOpts
_ = DocCooked -> DocCooked
forall a. a -> a
id
class PrettyCookedList a where
prettyCookedOptList :: PrettyCookedOpts -> a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts = [Maybe DocCooked] -> [DocCooked]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe DocCooked] -> [DocCooked])
-> (a -> [Maybe DocCooked]) -> a -> [DocCooked]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyCookedOpts -> a -> [Maybe DocCooked]
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> a -> [Maybe DocCooked]
prettyCookedOptListMaybe PrettyCookedOpts
opts
prettyCookedOptListMaybe :: PrettyCookedOpts -> a -> [Maybe DocCooked]
prettyCookedOptListMaybe PrettyCookedOpts
opts = (DocCooked -> Maybe DocCooked) -> [DocCooked] -> [Maybe DocCooked]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocCooked -> Maybe DocCooked
forall a. a -> Maybe a
Just ([DocCooked] -> [Maybe DocCooked])
-> (a -> [DocCooked]) -> a -> [Maybe DocCooked]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyCookedOpts -> a -> [DocCooked]
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts
prettyCookedList :: a -> [DocCooked]
prettyCookedList = PrettyCookedOpts -> a -> [DocCooked]
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
forall a. Default a => a
def
instance (PrettyCooked a) => PrettyCookedList [a] where
prettyCookedOptList :: PrettyCookedOpts -> [a] -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts = (a -> DocCooked) -> [a] -> [DocCooked]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrettyCookedOpts -> a -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts)
instance (PrettyCooked a) => PrettyCookedList (Set a) where
prettyCookedOptList :: PrettyCookedOpts -> Set a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts = PrettyCookedOpts -> [a] -> [DocCooked]
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts ([a] -> [DocCooked]) -> (Set a -> [a]) -> Set a -> [DocCooked]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList
class PrettyCookedMaybe a where
prettyCookedOptMaybe :: PrettyCookedOpts -> a -> Maybe DocCooked
prettyCookedOptMaybe PrettyCookedOpts
_ = a -> Maybe DocCooked
forall a. PrettyCookedMaybe a => a -> Maybe DocCooked
prettyCookedMaybe
prettyCookedMaybe :: a -> Maybe DocCooked
prettyCookedMaybe = PrettyCookedOpts -> a -> Maybe DocCooked
forall a.
PrettyCookedMaybe a =>
PrettyCookedOpts -> a -> Maybe DocCooked
prettyCookedOptMaybe PrettyCookedOpts
forall a. Default a => a
def
instance PrettyCookedMaybe (Maybe DocCooked) where
prettyCookedOptMaybe :: PrettyCookedOpts -> Maybe DocCooked -> Maybe DocCooked
prettyCookedOptMaybe PrettyCookedOpts
_ = Maybe DocCooked -> Maybe DocCooked
forall a. a -> a
id
printCookedOpt :: (PrettyCooked a) => PrettyCookedOpts -> a -> IO ()
printCookedOpt :: forall a. PrettyCooked a => PrettyCookedOpts -> a -> IO ()
printCookedOpt PrettyCookedOpts
opts a
e = DocCooked -> IO ()
forall ann. Doc ann -> IO ()
PP.putDoc (DocCooked -> IO ()) -> DocCooked -> IO ()
forall a b. (a -> b) -> a -> b
$ PrettyCookedOpts -> a -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts a
e DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
forall ann. Doc ann
PP.line
printCooked :: (PrettyCooked a) => a -> IO ()
printCooked :: forall a. PrettyCooked a => a -> IO ()
printCooked = PrettyCookedOpts -> a -> IO ()
forall a. PrettyCooked a => PrettyCookedOpts -> a -> IO ()
printCookedOpt PrettyCookedOpts
forall a. Default a => a
def
renderString :: (a -> DocCooked) -> a -> String
renderString :: forall a. (a -> DocCooked) -> a -> String
renderString a -> DocCooked
printer = SimpleDocStream () -> String
forall ann. SimpleDocStream ann -> String
PP.renderString (SimpleDocStream () -> String)
-> (a -> SimpleDocStream ()) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> DocCooked -> SimpleDocStream ()
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
PP.layoutPretty LayoutOptions
PP.defaultLayoutOptions (DocCooked -> SimpleDocStream ())
-> (a -> DocCooked) -> a -> SimpleDocStream ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DocCooked
printer
prettyItemize :: (PrettyCookedList a) => PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize :: forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
title DocCooked
bullet a
items =
[DocCooked] -> DocCooked
forall ann. [Doc ann] -> Doc ann
PP.vsep
[ DocCooked
title,
Int -> DocCooked -> DocCooked
forall ann. Int -> Doc ann -> Doc ann
PP.indent Int
2 (DocCooked -> DocCooked) -> DocCooked -> DocCooked
forall a b. (a -> b) -> a -> b
$ PrettyCookedOpts -> DocCooked -> a -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> a -> DocCooked
prettyItemizeNoTitle PrettyCookedOpts
opts DocCooked
bullet a
items
]
prettyItemizeNoTitle :: (PrettyCookedList a) => PrettyCookedOpts -> DocCooked -> a -> DocCooked
prettyItemizeNoTitle :: forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> a -> DocCooked
prettyItemizeNoTitle PrettyCookedOpts
opts DocCooked
bullet a
docs = [DocCooked] -> DocCooked
forall ann. [Doc ann] -> Doc ann
PP.vsep ([DocCooked] -> DocCooked) -> [DocCooked] -> DocCooked
forall a b. (a -> b) -> a -> b
$ (DocCooked -> DocCooked) -> [DocCooked] -> [DocCooked]
forall a b. (a -> b) -> [a] -> [b]
map (DocCooked
bullet DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) ([DocCooked] -> [DocCooked]) -> [DocCooked] -> [DocCooked]
forall a b. (a -> b) -> a -> b
$ PrettyCookedOpts -> a -> [DocCooked]
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts a
docs
prettyItemizeNonEmpty :: (PrettyCookedList a) => PrettyCookedOpts -> DocCooked -> DocCooked -> a -> Maybe DocCooked
prettyItemizeNonEmpty :: forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> Maybe DocCooked
prettyItemizeNonEmpty PrettyCookedOpts
opts DocCooked
_ DocCooked
_ (PrettyCookedOpts -> a -> [DocCooked]
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> a -> [DocCooked]
prettyCookedOptList PrettyCookedOpts
opts -> []) = Maybe DocCooked
forall a. Maybe a
Nothing
prettyItemizeNonEmpty PrettyCookedOpts
opts DocCooked
title DocCooked
bullet a
items = DocCooked -> Maybe DocCooked
forall a. a -> Maybe a
Just (DocCooked -> Maybe DocCooked) -> DocCooked -> Maybe DocCooked
forall a b. (a -> b) -> a -> b
$ PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
title DocCooked
bullet a
items
prettyHash :: (ToHash a) => PrettyCookedOpts -> a -> DocCooked
prettyHash :: forall a. ToHash a => PrettyCookedOpts -> a -> DocCooked
prettyHash
(PrettyCookedOpts {pcOptHashes :: PrettyCookedOpts -> PrettyCookedHashOpts
pcOptHashes = PrettyCookedHashOpts {Bool
Int
Map BuiltinByteString String
pcOptHashLength :: Int
pcOptHashNames :: Map BuiltinByteString String
pcOptHashVerbose :: Bool
pcOptHashLength :: PrettyCookedHashOpts -> Int
pcOptHashNames :: PrettyCookedHashOpts -> Map BuiltinByteString String
pcOptHashVerbose :: PrettyCookedHashOpts -> Bool
..}})
(a -> BuiltinByteString
forall a. ToHash a => a -> BuiltinByteString
toHash -> bbs :: BuiltinByteString
bbs@(PlutusTx.BuiltinByteString ByteString
bs)) =
let hexRepresentation :: DocCooked
hexRepresentation =
String -> DocCooked
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty
(String -> DocCooked)
-> (ByteString -> String) -> ByteString -> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
pcOptHashLength
(String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> String) -> [Word8] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\((Word8 -> String -> String
forall a. Integral a => a -> String -> String
`Numeric.showHex` String
"") -> String
res) -> if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
res Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: String
res else String
res)
([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
ByteString.unpack
(ByteString -> DocCooked) -> ByteString -> DocCooked
forall a b. (a -> b) -> a -> b
$ ByteString
bs
in case BuiltinByteString -> Map BuiltinByteString String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup BuiltinByteString
bbs Map BuiltinByteString String
pcOptHashNames of
Maybe String
Nothing -> DocCooked
"#" DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
hexRepresentation
Just String
name | Bool
pcOptHashVerbose -> DocCooked
"#" DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
hexRepresentation DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann
PP.parens (String -> DocCooked
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty String
name)
Just String
name -> String -> DocCooked
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty String
name
instance PrettyCooked Int where
prettyCookedOpt :: PrettyCookedOpts -> Int -> DocCooked
prettyCookedOpt PrettyCookedOpts
_ = Int -> DocCooked
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty
instance PrettyCooked Integer where
prettyCookedOpt :: PrettyCookedOpts -> Integer -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts =
if PrettyCookedOpts -> Bool
pcOptNumericUnderscores PrettyCookedOpts
opts
then Integer -> DocCooked
prettyNumericUnderscore
else Integer -> DocCooked
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty
where
prettyNumericUnderscore :: Integer -> DocCooked
prettyNumericUnderscore :: Integer -> DocCooked
prettyNumericUnderscore Integer
i
| Integer
0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
i = DocCooked
"0"
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = DocCooked -> Integer -> Integer -> DocCooked
psnTerm DocCooked
"" Integer
0 Integer
i
| Bool
otherwise = DocCooked
"-" DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked -> Integer -> Integer -> DocCooked
psnTerm DocCooked
"" Integer
0 (-Integer
i)
where
psnTerm :: DocCooked -> Integer -> Integer -> DocCooked
psnTerm :: DocCooked -> Integer -> Integer -> DocCooked
psnTerm DocCooked
acc Integer
_ Integer
0 = DocCooked
acc
psnTerm DocCooked
acc Integer
3 Integer
nb = DocCooked -> Integer -> Integer -> DocCooked
psnTerm (Integer -> DocCooked
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty (Integer
nb Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
10) DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
"_" DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
acc) Integer
1 (Integer
nb Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
10)
psnTerm DocCooked
acc Integer
n Integer
nb = DocCooked -> Integer -> Integer -> DocCooked
psnTerm (Integer -> DocCooked
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty (Integer
nb Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
10) DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
acc) (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) (Integer
nb Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
10)
instance PrettyCooked Bool where
prettyCookedOpt :: PrettyCookedOpts -> Bool -> DocCooked
prettyCookedOpt PrettyCookedOpts
_ = Bool -> DocCooked
forall ann. Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty
instance PrettyCooked () where
prettyCookedOpt :: PrettyCookedOpts -> () -> DocCooked
prettyCookedOpt PrettyCookedOpts
_ = () -> DocCooked
forall ann. () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty
instance PrettyCooked Rational where
prettyCookedOpt :: PrettyCookedOpts -> Rational -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Rational
q = DocCooked
"(" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Integer -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
q) DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
"/" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Integer -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
q) DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked
")"