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

module PlutusTx.Show (
    Show (..),
    ShowS,
    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

instance Show Builtins.Integer where
    {-# INLINEABLE showsPrec #-}
    showsPrec :: Integer -> Integer -> ShowS
showsPrec Integer
p Integer
n =
        if Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0
            then BuiltinString -> ShowS
showString BuiltinString
"-" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Integer -> a -> ShowS
showsPrec Integer
p (forall a. AdditiveGroup a => a -> a
negate Integer
n)
            else forall a b. (a -> b -> b) -> b -> [a] -> b
foldr Integer -> ShowS -> ShowS
alg 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 forall a. Eq a => a -> a -> Bool
== Integer
0 -> BuiltinString
"0"
                    | Integer
digit forall a. Eq a => a -> a -> Bool
== Integer
1 -> BuiltinString
"1"
                    | Integer
digit forall a. Eq a => a -> a -> Bool
== Integer
2 -> BuiltinString
"2"
                    | Integer
digit forall a. Eq a => a -> a -> Bool
== Integer
3 -> BuiltinString
"3"
                    | Integer
digit forall a. Eq a => a -> a -> Bool
== Integer
4 -> BuiltinString
"4"
                    | Integer
digit forall a. Eq a => a -> a -> Bool
== Integer
5 -> BuiltinString
"5"
                    | Integer
digit forall a. Eq a => a -> a -> Bool
== Integer
6 -> BuiltinString
"6"
                    | Integer
digit forall a. Eq a => a -> a -> Bool
== Integer
7 -> BuiltinString
"7"
                    | Integer
digit forall a. Eq a => a -> a -> Bool
== Integer
8 -> BuiltinString
"8"
                    | Integer
digit forall a. Eq a => a -> a -> Bool
== Integer
9 -> BuiltinString
"9"
                    | Bool
otherwise  -> BuiltinString
"<invalid digit>"
                )
                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 forall a. Eq a => a -> a -> Bool
== Integer
0
                then Integer
r forall a. a -> [a] -> [a]
: [Integer]
acc
                else [Integer] -> Integer -> [Integer]
go (Integer
r 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 = forall a b. (a -> b -> b) -> b -> [a] -> b
foldr Integer -> ShowS -> ShowS
alg forall a. a -> a
id (forall a. Enum a => a -> a -> [a]
enumFromTo Integer
0 (Integer
len 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)
                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 forall a. Ord a => a -> a -> Bool
<= Integer
9    -> forall a. Show a => Integer -> a -> ShowS
showsPrec Integer
0 Integer
x
                | Integer
x forall a. Eq a => a -> a -> Bool
== Integer
10   -> BuiltinString -> ShowS
showString BuiltinString
"a"
                | Integer
x forall a. Eq a => a -> a -> Bool
== Integer
11   -> BuiltinString -> ShowS
showString BuiltinString
"b"
                | Integer
x forall a. Eq a => a -> a -> Bool
== Integer
12   -> BuiltinString -> ShowS
showString BuiltinString
"c"
                | Integer
x forall a. Eq a => a -> a -> Bool
== Integer
13   -> BuiltinString -> ShowS
showString BuiltinString
"d"
                | Integer
x forall a. Eq a => a -> a -> Bool
== Integer
14   -> BuiltinString -> ShowS
showString BuiltinString
"e"
                | Integer
x 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) 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
"\"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinString -> ShowS
showString BuiltinString
s 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 = 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 `Contains` [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
_ = forall a. (a -> ShowS) -> [a] -> ShowS
showList (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
"["
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
showElem a
x
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> ShowS -> ShowS
alg forall a. a -> a
id [a]
xs
            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
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
showElem a
a 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