{-# LANGUAGE FlexibleInstances #-}

module Plutarch.Builtin.String (PString (PString), pdecodeUtf8, pencodeUtf8, ptrace', ptraceInfo) where

import Data.Kind (Type)
import Data.String (IsString, fromString)
import Data.Text qualified as Text
import GHC.Generics (Generic)

import Plutarch.Builtin.ByteString (PByteString)
import Plutarch.Builtin.Opaque (POpaque)

import Plutarch.Internal.Term (
  Config (NoTracing, Tracing),
  S,
  Term,
  pdelay,
  pforce,
  pgetConfig,
  phoistAcyclic,
  punsafeBuiltin,
  punsafeConstantInternal,
  (#),
  type (:-->),
 )
import PlutusCore qualified as PLC

-- | Plutus 'BuiltinString' values
newtype PString s = PString (Term s POpaque)
  deriving stock ((forall x. PString s -> Rep (PString s) x)
-> (forall x. Rep (PString s) x -> PString s)
-> Generic (PString s)
forall x. Rep (PString s) x -> PString s
forall x. PString s -> Rep (PString s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PString s) x -> PString s
forall (s :: S) x. PString s -> Rep (PString s) x
$cfrom :: forall (s :: S) x. PString s -> Rep (PString s) x
from :: forall x. PString s -> Rep (PString s) x
$cto :: forall (s :: S) x. Rep (PString s) x -> PString s
to :: forall x. Rep (PString s) x -> PString s
Generic)

instance IsString (Term s PString) where
  fromString :: String -> Term s PString
fromString = Some @Type (ValueOf DefaultUni) -> Term s PString
forall (s :: S) (a :: PType).
Some @Type (ValueOf DefaultUni) -> Term s a
punsafeConstantInternal (Some @Type (ValueOf DefaultUni) -> Term s PString)
-> (String -> Some @Type (ValueOf DefaultUni))
-> String
-> Term s PString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Some @Type (ValueOf DefaultUni)
forall a (uni :: Type -> Type).
Contains @Type uni a =>
a -> Some @Type (ValueOf uni)
PLC.someValue (Text -> Some @Type (ValueOf DefaultUni))
-> (String -> Text) -> String -> Some @Type (ValueOf DefaultUni)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance Semigroup (Term s PString) where
  Term s PString
x <> :: Term s PString -> Term s PString -> Term s PString
<> Term s PString
y = DefaultFun -> Term s (PString :--> (PString :--> PString))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.AppendString Term s (PString :--> (PString :--> PString))
-> Term s PString -> Term s (PString :--> PString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PString
x Term s (PString :--> PString) -> Term s PString -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PString
y

instance Monoid (Term s PString) where
  mempty :: Term s PString
mempty = Some @Type (ValueOf DefaultUni) -> Term s PString
forall (s :: S) (a :: PType).
Some @Type (ValueOf DefaultUni) -> Term s a
punsafeConstantInternal (Some @Type (ValueOf DefaultUni) -> Term s PString)
-> Some @Type (ValueOf DefaultUni) -> Term s PString
forall a b. (a -> b) -> a -> b
$ Text -> Some @Type (ValueOf DefaultUni)
forall a (uni :: Type -> Type).
Contains @Type uni a =>
a -> Some @Type (ValueOf uni)
PLC.someValue Text
Text.empty

-- | Encode a 'PString' using UTF-8.
pencodeUtf8 :: Term s (PString :--> PByteString)
pencodeUtf8 :: forall (s :: S). Term s (PString :--> PByteString)
pencodeUtf8 = DefaultFun -> Term s (PString :--> PByteString)
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.EncodeUtf8

-- | Decode a 'PByteString' using UTF-8.
pdecodeUtf8 :: Term s (PByteString :--> PString)
pdecodeUtf8 :: forall (s :: S). Term s (PByteString :--> PString)
pdecodeUtf8 = DefaultFun -> Term s (PByteString :--> PString)
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.DecodeUtf8

ptrace' :: Term s (PString :--> a :--> a)
ptrace' :: forall (s :: S) (a :: PType). Term s (PString :--> (a :--> a))
ptrace' = ClosedTerm (PString :--> (a :--> a))
-> Term s (PString :--> (a :--> a))
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic (ClosedTerm (PString :--> (a :--> a))
 -> Term s (PString :--> (a :--> a)))
-> ClosedTerm (PString :--> (a :--> a))
-> Term s (PString :--> (a :--> a))
forall a b. (a -> b) -> a -> b
$ Term s (PDelayed (PString :--> (a :--> a)))
-> Term s (PString :--> (a :--> a))
forall (s :: S) (a :: PType). Term s (PDelayed a) -> Term s a
pforce (Term s (PDelayed (PString :--> (a :--> a)))
 -> Term s (PString :--> (a :--> a)))
-> Term s (PDelayed (PString :--> (a :--> a)))
-> Term s (PString :--> (a :--> a))
forall a b. (a -> b) -> a -> b
$ DefaultFun -> Term s (PDelayed (PString :--> (a :--> a)))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.Trace

{- | Trace the given message at the info level before evaluating the given
argument.

@since 1.6.0
-}
ptraceInfo ::
  forall (a :: S -> Type) (s :: S).
  Term s PString ->
  Term s a ->
  Term s a
ptraceInfo :: forall (a :: PType) (s :: S).
Term s PString -> Term s a -> Term s a
ptraceInfo Term s PString
msg Term s a
x = (Config -> Term s a) -> Term s a
forall (s :: S) (a :: PType). (Config -> Term s a) -> Term s a
pgetConfig ((Config -> Term s a) -> Term s a)
-> (Config -> Term s a) -> Term s a
forall a b. (a -> b) -> a -> b
$ \case
  Config
NoTracing -> Term s a
x
  Tracing LogLevel
_ TracingMode
_ -> Term s (PDelayed a) -> Term s a
forall (s :: S) (a :: PType). Term s (PDelayed a) -> Term s a
pforce (Term s (PDelayed a) -> Term s a)
-> Term s (PDelayed a) -> Term s a
forall a b. (a -> b) -> a -> b
$ Term s (PString :--> (PDelayed a :--> PDelayed a))
forall (s :: S) (a :: PType). Term s (PString :--> (a :--> a))
ptrace' Term s (PString :--> (PDelayed a :--> PDelayed a))
-> Term s PString -> Term s (PDelayed a :--> PDelayed a)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PString
msg Term s (PDelayed a :--> PDelayed a)
-> Term s (PDelayed a) -> Term s (PDelayed a)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s a -> Term s (PDelayed a)
forall (s :: S) (a :: PType). Term s a -> Term s (PDelayed a)
pdelay Term s a
x