-- | This module provides common functions to help implement pretty-printers in
-- cooked-validators
module Cooked.Pretty.Common
  ( DocCooked,
    renderString,
    prettyItemize,
    prettyItemizeNoTitle,
    prettyItemizeNonEmpty,
    prettyEnumerate,
    prettyHash,
  )
where

import Cooked.Pretty.Options (PrettyCookedHashOpts (..))
import Data.ByteString qualified as ByteString
import Data.Map qualified as Map
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

type DocCooked = Doc ()

-- | 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 -> [Char]
renderString a -> DocCooked
printer = SimpleDocStream () -> [Char]
forall ann. SimpleDocStream ann -> [Char]
PP.renderString (SimpleDocStream () -> [Char])
-> (a -> SimpleDocStream ()) -> a -> [Char]
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.
--
-- >>> prettyItemize "Foo" "-" ["bar1", "bar2", "bar3"]
-- Foo
--   - bar1
--   - bar2
--   - bar3
prettyItemize :: DocCooked -> DocCooked -> [DocCooked] -> DocCooked
prettyItemize :: DocCooked -> DocCooked -> [DocCooked] -> DocCooked
prettyItemize DocCooked
title DocCooked
bullet [DocCooked]
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) -> [DocCooked] -> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocCooked -> [DocCooked] -> DocCooked
prettyItemizeNoTitle DocCooked
bullet ([DocCooked] -> DocCooked) -> [DocCooked] -> DocCooked
forall a b. (a -> b) -> a -> b
$ [DocCooked]
items
    ]

prettyItemizeNoTitle :: DocCooked -> [DocCooked] -> DocCooked
prettyItemizeNoTitle :: DocCooked -> [DocCooked] -> DocCooked
prettyItemizeNoTitle DocCooked
bullet = [DocCooked] -> DocCooked
forall ann. [Doc ann] -> Doc ann
PP.vsep ([DocCooked] -> DocCooked)
-> ([DocCooked] -> [DocCooked]) -> [DocCooked] -> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
<+>)

prettyItemizeNonEmpty :: DocCooked -> DocCooked -> [DocCooked] -> Maybe DocCooked
prettyItemizeNonEmpty :: DocCooked -> DocCooked -> [DocCooked] -> Maybe DocCooked
prettyItemizeNonEmpty DocCooked
_ DocCooked
_ [] = Maybe DocCooked
forall a. Maybe a
Nothing
prettyItemizeNonEmpty DocCooked
title DocCooked
bullet [DocCooked]
items = DocCooked -> Maybe DocCooked
forall a. a -> Maybe a
Just (DocCooked -> Maybe DocCooked) -> DocCooked -> Maybe DocCooked
forall a b. (a -> b) -> a -> b
$ DocCooked -> DocCooked -> [DocCooked] -> DocCooked
prettyItemize DocCooked
title DocCooked
bullet [DocCooked]
items

prettyEnumerate :: DocCooked -> DocCooked -> [DocCooked] -> DocCooked
prettyEnumerate :: DocCooked -> DocCooked -> [DocCooked] -> DocCooked
prettyEnumerate DocCooked
title DocCooked
bullet [DocCooked]
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) -> [DocCooked] -> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DocCooked] -> DocCooked
forall ann. [Doc ann] -> Doc ann
PP.vsep ([DocCooked] -> DocCooked) -> [DocCooked] -> DocCooked
forall a b. (a -> b) -> a -> b
$
        (Int -> DocCooked -> DocCooked)
-> [Int] -> [DocCooked] -> [DocCooked]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
index DocCooked
item -> Int -> DocCooked
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty Int
index DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> DocCooked
bullet DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann
PP.align DocCooked
item) [Int
1 :: Int ..] [DocCooked]
items
    ]

-- | Pretty print a prefix of a hash with a given length.
prettyHash :: PrettyCookedHashOpts -> PlutusTx.BuiltinByteString -> DocCooked
prettyHash :: PrettyCookedHashOpts -> BuiltinByteString -> DocCooked
prettyHash PrettyCookedHashOpts {Bool
Int
Map BuiltinByteString [Char]
pcOptHashLength :: Int
pcOptHashNames :: Map BuiltinByteString [Char]
pcOptHashVerbose :: Bool
pcOptHashLength :: PrettyCookedHashOpts -> Int
pcOptHashNames :: PrettyCookedHashOpts -> Map BuiltinByteString [Char]
pcOptHashVerbose :: PrettyCookedHashOpts -> Bool
..} bbs :: BuiltinByteString
bbs@(PlutusTx.BuiltinByteString ByteString
bs) =
  let hexRepresentation :: DocCooked
      hexRepresentation :: DocCooked
hexRepresentation =
        DocCooked
"#"
          DocCooked -> DocCooked -> DocCooked
forall a. Semigroup a => a -> a -> a
<> ( [Char] -> DocCooked
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty
                 ([Char] -> DocCooked)
-> (ByteString -> [Char]) -> ByteString -> DocCooked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
pcOptHashLength
                 ([Char] -> [Char])
-> (ByteString -> [Char]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> [Char]) -> [Word8] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Word8 -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
`Numeric.showHex` [Char]
"")
                 ([Word8] -> [Char])
-> (ByteString -> [Word8]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
ByteString.unpack
             )
            ByteString
bs
   in case BuiltinByteString -> Map BuiltinByteString [Char] -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup BuiltinByteString
bbs Map BuiltinByteString [Char]
pcOptHashNames of
        Maybe [Char]
Nothing -> DocCooked
hexRepresentation
        Just [Char]
name ->
          if Bool
pcOptHashVerbose
            then DocCooked
hexRepresentation DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann
PP.parens ([Char] -> DocCooked
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty [Char]
name)
            else [Char] -> DocCooked
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty [Char]
name