{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module PlutusTx.Show (
    Show (..),
    ShowS,
    toDigits,
    showString,
    showSpace,
    showCommaSpace,
    showParen,
    appPrec,
    appPrec1,
    deriveShow,
) where

import PlutusTx.Base
import PlutusTx.Bool
import PlutusTx.Builtins qualified as Builtins
import PlutusTx.Either
import PlutusTx.List (foldr)
import PlutusTx.Maybe
import PlutusTx.Prelude hiding (foldr)
import PlutusTx.Show.TH
import PlutusTx.These

instance Show Builtins.Integer where
    {-# INLINEABLE showsPrec #-}
    showsPrec :: Integer -> Integer -> ShowS
showsPrec Integer
p Integer
n =
        if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
            then BuiltinString -> ShowS
showString BuiltinString
"-" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> ShowS
forall a. Show a => Integer -> a -> ShowS
showsPrec Integer
p (Integer -> Integer
forall a. AdditiveGroup a => a -> a
negate Integer
n)
            else (Integer -> ShowS -> ShowS) -> ShowS -> [Integer] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr Integer -> ShowS -> ShowS
alg ShowS
forall a. a -> a
id (Integer -> [Integer]
toDigits Integer
n)
      where
        alg :: Builtins.Integer -> ShowS -> ShowS
        alg :: Integer -> ShowS -> ShowS
alg Integer
digit ShowS
acc =
            BuiltinString -> ShowS
showString
                ( if
                    | Integer
digit Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> BuiltinString
"0"
                    | Integer
digit Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 -> BuiltinString
"1"
                    | Integer
digit Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 -> BuiltinString
"2"
                    | Integer
digit Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3 -> BuiltinString
"3"
                    | Integer
digit Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
4 -> BuiltinString
"4"
                    | Integer
digit Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
5 -> BuiltinString
"5"
                    | Integer
digit Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
6 -> BuiltinString
"6"
                    | Integer
digit Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
7 -> BuiltinString
"7"
                    | Integer
digit Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
8 -> BuiltinString
"8"
                    | Integer
digit Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
9 -> BuiltinString
"9"
                    | Bool
otherwise  -> BuiltinString
"<invalid digit>"
                )
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
acc

{-# INLINEABLE toDigits #-}
-- | Convert a non-negative integer to individual digits.
toDigits :: Builtins.Integer -> [Builtins.Integer]
toDigits :: Integer -> [Integer]
toDigits = [Integer] -> Integer -> [Integer]
go []
  where
    go :: [Integer] -> Integer -> [Integer]
go [Integer]
acc Integer
n = case Integer
n Integer -> Integer -> (Integer, Integer)
`quotRem` Integer
10 of
        (Integer
q, Integer
r) ->
            if Integer
q Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
                then Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
acc
                else [Integer] -> Integer -> [Integer]
go (Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
acc) Integer
q

instance Show Builtins.BuiltinByteString where
    {-# INLINEABLE showsPrec #-}
    -- Base16-encode the ByteString and show the result.
    showsPrec :: Integer -> BuiltinByteString -> ShowS
showsPrec Integer
_ BuiltinByteString
s = (Integer -> ShowS -> ShowS) -> ShowS -> [Integer] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr Integer -> ShowS -> ShowS
alg ShowS
forall a. a -> a
id (Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromTo Integer
0 (Integer
len Integer -> Integer -> Integer
forall a. AdditiveGroup a => a -> a -> a
- Integer
1))
      where
        len :: Integer
len = BuiltinByteString -> Integer
Builtins.lengthOfByteString BuiltinByteString
s

        showWord8 :: Builtins.Integer -> ShowS
        showWord8 :: Integer -> ShowS
showWord8 Integer
x =
            Integer -> ShowS
toHex (Integer
x Integer -> Integer -> Integer
`Builtins.divideInteger` Integer
16)
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
toHex (Integer
x Integer -> Integer -> Integer
`Builtins.modInteger` Integer
16)

        toHex :: Integer -> ShowS
        toHex :: Integer -> ShowS
toHex Integer
x =
            if
                | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
9    -> Integer -> Integer -> ShowS
forall a. Show a => Integer -> a -> ShowS
showsPrec Integer
0 Integer
x
                | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
10   -> BuiltinString -> ShowS
showString BuiltinString
"a"
                | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
11   -> BuiltinString -> ShowS
showString BuiltinString
"b"
                | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
12   -> BuiltinString -> ShowS
showString BuiltinString
"c"
                | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
13   -> BuiltinString -> ShowS
showString BuiltinString
"d"
                | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
14   -> BuiltinString -> ShowS
showString BuiltinString
"e"
                | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
15   -> BuiltinString -> ShowS
showString BuiltinString
"f"
                | Bool
otherwise -> BuiltinString -> ShowS
showString BuiltinString
"<invalid byte>"
        alg :: Builtins.Integer -> ShowS -> ShowS
        alg :: Integer -> ShowS -> ShowS
alg Integer
i ShowS
acc = Integer -> ShowS
showWord8 (BuiltinByteString -> Integer -> Integer
Builtins.indexByteString BuiltinByteString
s Integer
i) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
acc

instance Show Builtins.BuiltinString where
    {-# INLINEABLE showsPrec #-}
    -- Add quotes to the given string. `Prelude.show @String` uses @showLitChar@ to process
    -- non-ascii characters and escape characters, in additional to adding quotes. We have
    -- no builtin that operates on `Char`, so we cannot implement the same behavior.
    showsPrec :: Integer -> BuiltinString -> ShowS
showsPrec Integer
_ BuiltinString
s = BuiltinString -> ShowS
showString BuiltinString
"\"" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinString -> ShowS
showString BuiltinString
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinString -> ShowS
showString BuiltinString
"\""

instance Show Builtins.BuiltinData where
    {-# INLINEABLE showsPrec #-}
    showsPrec :: Integer -> BuiltinData -> ShowS
showsPrec Integer
p BuiltinData
d = Integer -> BuiltinByteString -> ShowS
forall a. Show a => Integer -> a -> ShowS
showsPrec Integer
p (BuiltinData -> BuiltinByteString
Builtins.serialiseData BuiltinData
d)

instance Show Bool where
    {-# INLINEABLE show #-}
    show :: Bool -> BuiltinString
show Bool
b = if Bool
b then BuiltinString
"True" else BuiltinString
"False"

instance Show () where
    {-# INLINEABLE show #-}
    show :: () -> BuiltinString
show () = BuiltinString
"()"

-- It is possible to make it so that when `a` is a builtin type, `show (xs :: [a])`
-- is compiled into a single `showConstant` call, rathern than `length xs` calls.
-- To do so the plugin would need to try to solve the @uni `HasTermLevel` [a]@ constraint,
-- and branch based on whether it is solvable. But the complexity doesn't seem to
-- be worth it: the saving in budget is likely small, and on mainnet the trace messages
-- are often erased anyway.
--
-- Same for the `Show (a, b)` instance.
instance Show a => Show [a] where
    {-# INLINEABLE showsPrec #-}
    showsPrec :: Integer -> [a] -> ShowS
showsPrec Integer
_ = (a -> ShowS) -> [a] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showList (Integer -> a -> ShowS
forall a. Show a => Integer -> a -> ShowS
showsPrec Integer
0)

{-# INLINEABLE showList #-}
showList :: forall a. (a -> ShowS) -> [a] -> ShowS
showList :: forall a. (a -> ShowS) -> [a] -> ShowS
showList a -> ShowS
showElem = \case
    [] -> BuiltinString -> ShowS
showString BuiltinString
"[]"
    a
x : [a]
xs ->
        BuiltinString -> ShowS
showString BuiltinString
"["
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
showElem a
x
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ShowS -> ShowS) -> ShowS -> [a] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> ShowS -> ShowS
alg ShowS
forall a. a -> a
id [a]
xs
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinString -> ShowS
showString BuiltinString
"]"
      where
        alg :: a -> ShowS -> ShowS
        alg :: a -> ShowS -> ShowS
alg a
a ShowS
acc = BuiltinString -> ShowS
showString BuiltinString
"," ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
showElem a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
acc

deriveShow ''(,)
deriveShow ''(,,)
deriveShow ''(,,,)
deriveShow ''(,,,,)
deriveShow ''(,,,,,)
deriveShow ''(,,,,,,)
deriveShow ''(,,,,,,,)
deriveShow ''(,,,,,,,,)
deriveShow ''(,,,,,,,,,)
deriveShow ''(,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,,,,,,,,,,,)
deriveShow ''(,,,,,,,,,,,,,,,,,,,,,,,,,,)
deriveShow ''Maybe
deriveShow ''Either
deriveShow ''These