{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Plutarch.String (
  -- * Type
  PString,
  -- Functions
  pisHexDigit,
  pfromText,
  pencodeUtf8,
  pdecodeUtf8,
) where

import Data.String (IsString, fromString)
import Data.Text (Text)
import Data.Text qualified as Text
import GHC.Generics (Generic)
import Plutarch.Builtin.Bool (PBool, (#&&), (#||))
import Plutarch.ByteString (PByteString)
import Plutarch.Integer (PInteger)
import Plutarch.Internal.Eq (PEq ((#==)))
import Plutarch.Internal.Lift (DeriveBuiltinPLiftable, PLiftable, PLifted (PLifted), pconstant)
import Plutarch.Internal.Newtype (PlutusTypeNewtype)
import Plutarch.Internal.Ord ((#<=))
import Plutarch.Internal.Other (POpaque)
import Plutarch.Internal.PLam (plam)
import Plutarch.Internal.PlutusType (DPTStrat, DerivePlutusType, PlutusType)
import Plutarch.Internal.Term (
  S,
  Term,
  phoistAcyclic,
  (#),
  (:-->),
 )
import Plutarch.Unsafe (punsafeBuiltin)
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)
  deriving anyclass ((forall (s :: S). PString s -> Term s (PInner PString))
-> (forall (s :: S) (b :: PType).
    Term s (PInner PString) -> (PString s -> Term s b) -> Term s b)
-> PlutusType PString
forall (s :: S). PString s -> Term s (PInner PString)
forall (s :: S) (b :: PType).
Term s (PInner PString) -> (PString s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
$cpcon' :: forall (s :: S). PString s -> Term s (PInner PString)
pcon' :: forall (s :: S). PString s -> Term s (PInner PString)
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PString) -> (PString s -> Term s b) -> Term s b
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PString) -> (PString s -> Term s b) -> Term s b
PlutusType)

instance DerivePlutusType PString where type DPTStrat _ = PlutusTypeNewtype

-- | @since WIP
deriving via
  (DeriveBuiltinPLiftable PString Text)
  instance
    PLiftable PString

{-# DEPRECATED pfromText "Use `pconstant` instead." #-}

-- | Create a PString from 'Text'
pfromText :: Text.Text -> Term s PString
pfromText :: forall (s :: S). Text -> Term s PString
pfromText = Text -> Term s PString
AsHaskell PString -> Term s PString
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant

instance IsString (Term s PString) where
  fromString :: String -> Term s PString
fromString = AsHaskell PString -> Term s PString
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AsHaskell PString -> Term s PString)
-> (String -> AsHaskell PString) -> String -> Term s PString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
String -> AsHaskell PString
Text.pack

instance PEq PString where
  Term s PString
x #== :: forall (s :: S). Term s PString -> Term s PString -> Term s PBool
#== Term s PString
y = DefaultFun -> Term s (PString :--> (PString :--> PBool))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.EqualsString Term s (PString :--> (PString :--> PBool))
-> Term s PString -> Term s (PString :--> PBool)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PString
x Term s (PString :--> PBool) -> Term s PString -> Term s PBool
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PString
y

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 = AsHaskell PString -> Term s PString
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant Text
AsHaskell PString
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

{- | Verify if the given argument is the ASCII encoding of a hex digit. This
includes specifically the following ASCII ranges (inclusively):

* 48-54 (digits 0 through 9)
* 65-70 (upper-case A through upper-case F)
* 97-102 (lower-case a through lower-case f)

@since WIP
-}
pisHexDigit :: forall (s :: S). Term s (PInteger :--> PBool)
pisHexDigit :: forall (s :: S). Term s (PInteger :--> PBool)
pisHexDigit = (forall (s :: S). Term s (PInteger :--> PBool))
-> Term s (PInteger :--> PBool)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PInteger :--> PBool))
 -> Term s (PInteger :--> PBool))
-> (forall (s :: S). Term s (PInteger :--> PBool))
-> Term s (PInteger :--> PBool)
forall a b. (a -> b) -> a -> b
$ (Term s PInteger -> Term s PBool) -> Term s (PInteger :--> PBool)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PBool) -> Term s (c :--> PBool)
plam ((Term s PInteger -> Term s PBool) -> Term s (PInteger :--> PBool))
-> (Term s PInteger -> Term s PBool)
-> Term s (PInteger :--> PBool)
forall a b. (a -> b) -> a -> b
$ \Term s PInteger
c ->
  (Term s PInteger
c Term s PInteger -> Term s PInteger -> Term s PBool
forall (s :: S). Term s PInteger -> Term s PInteger -> Term s PBool
forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#<= Term s PInteger
57 Term s PBool -> Term s PBool -> Term s PBool
forall (s :: S). Term s PBool -> Term s PBool -> Term s PBool
#&& Term s PInteger
48 Term s PInteger -> Term s PInteger -> Term s PBool
forall (s :: S). Term s PInteger -> Term s PInteger -> Term s PBool
forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#<= Term s PInteger
c)
    #|| (c #<= 70 #&& 65 #<= c)
    #|| (c #<= 102 #&& 97 #<= c)