-- | This module provides common functions to help implement pretty-printers in
-- cooked-validators
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

-- | A standard 'PP.Doc' without any annotation
type DocCooked = Doc ()

-- | Type class of things that can be pretty printed as a single document. You
-- need to implement either 'prettyCookedOpt' or 'prettyCooked' manually,
-- otherwise calling either of them will resulting in a infinite loop.
class PrettyCooked a where
  -- | Pretty prints an element based on some 'PrettyCookedOpts'
  prettyCookedOpt :: PrettyCookedOpts -> a -> DocCooked
  prettyCookedOpt PrettyCookedOpts
_ = a -> DocCooked
forall a. PrettyCooked a => a -> DocCooked
prettyCooked

  -- | Pretty prints an element directly
  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

-- | Type class of things that can be pretty printed as a list of
-- documents. Similarly to 'PrettyCooked', at least of the functions from this
-- class needs to be manually implemented to avoid infinite loops.
class PrettyCookedList a where
  -- | Pretty prints an element as a list on some 'PrettyCookedOpts'
  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

  -- | Pretty prints an element as a list of optional documents
  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

  -- | Pretty prints an elements as a list
  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

-- | Type class of things that can be optionally pretty printed as a document
class PrettyCookedMaybe a where
  -- | Pretty prints an optional document on some 'PrettyCookedOpts'
  prettyCookedOptMaybe :: PrettyCookedOpts -> a -> Maybe DocCooked
  prettyCookedOptMaybe PrettyCookedOpts
_ = a -> Maybe DocCooked
forall a. PrettyCookedMaybe a => a -> Maybe DocCooked
prettyCookedMaybe

  -- | Pretty prints an option document
  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

-- | Use this in the REPL as an alternative to the default 'print' function when
-- dealing with pretty-printable cooked values.
--
-- For example, @printCookedOpt def runMockChain i0 foo@
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

-- | Version of 'printCookedOpt' that uses default pretty printing options.
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

-- | Use this to convert a pretty-printer to a regular show function using
-- default layout options. This is used in "Testing" because Tasty uses strings.
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

-- | Print an item list with a title
--
-- >>> prettyCookedOpts opts "Foo" "-" ["bar1", "bar2", "bar3"]
-- Foo
--   - bar1
--   - bar2
--   - bar3
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
    ]

-- | Print an item list without a title
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

-- | Print an item list with a title, but only when the list is non-empty
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

-- * Pretty printing of hashable data types

-- | Pretty prints hashable elements based on 'pcOptHashes' in the
-- 'PrettyCookedOpts'. This cannot be made an instance as it would be
-- undecidable (the hope was @(ToHash a) => PrettyCooked a@)
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
              -- We pad the result of 'Numeric.showHex' to reach exactly
              -- 2 characters as it might only have 1 in some occasions.
              (\((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

-- * Pretty instances for some common base types

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 23798423723
      -- 23_798_423_723
      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
")"