{-# LANGUAGE OverloadedStrings #-}
module PlutusIR.Compiler.Names (safeFreshName, safeFreshTyName) where
import PlutusCore qualified as PLC
import PlutusCore.Name.Unique (isQuotedIdentifierChar)
import PlutusCore.Quote
import Data.List qualified as List
import Data.Text qualified as T
typeReplacements :: [(T.Text, T.Text)]
typeReplacements :: [(Text, Text)]
typeReplacements =
[ (Text
"[]", Text
"List")
, (Text
"()", Text
"Unit")
, (Text
"(,)", Text
"Tuple2")
, (Text
"(,,)", Text
"Tuple3")
, (Text
"(,,,)", Text
"Tuple4")
, (Text
"(,,,,)", Text
"Tuple5")
, (Text
"(#,#)", Text
"UTuple2")
, (Text
"(#,,#)", Text
"UTuple3")
, (Text
"(#,,,#)", Text
"UTuple4")
, (Text
"(#,,,,#)", Text
"UTuple5")
]
termReplacements :: [(T.Text, T.Text)]
termReplacements :: [(Text, Text)]
termReplacements =
[ (Text
":", Text
"Cons")
, (Text
"[]", Text
"Nil")
, (Text
"()", Text
"Unit")
, (Text
"(,)", Text
"Tuple2")
, (Text
"(,,)", Text
"Tuple3")
, (Text
"(,,,)", Text
"Tuple4")
, (Text
"(,,,,)", Text
"Tuple5")
, (Text
"(#,#)", Text
"UTuple2")
, (Text
"(#,,#)", Text
"UTuple3")
, (Text
"(#,,,#)", Text
"UTuple4")
, (Text
"(#,,,,#)", Text
"UTuple5")
]
data NameKind = TypeName | TermName
safeName :: NameKind -> T.Text -> T.Text
safeName :: NameKind -> Text -> Text
safeName NameKind
kind Text
t =
let
toReplace :: [(Text, Text)]
toReplace = case NameKind
kind of
NameKind
TypeName -> [(Text, Text)]
typeReplacements
NameKind
TermName -> [(Text, Text)]
termReplacements
replaced :: Text
replaced = (Text -> (Text, Text) -> Text) -> Text -> [(Text, Text)] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Text
acc (Text
old, Text
new) -> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
old Text
new Text
acc) Text
t [(Text, Text)]
toReplace
stripped :: Text
stripped = (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isQuotedIdentifierChar Text
replaced
in if Text -> Bool
T.null Text
stripped then Text
"bad_name" else Text
stripped
safeFreshName :: MonadQuote m => T.Text -> m PLC.Name
safeFreshName :: forall (m :: * -> *). MonadQuote m => Text -> m Name
safeFreshName Text
s = Quote Name -> m Name
forall a. Quote a -> m a
forall (m :: * -> *) a. MonadQuote m => Quote a -> m a
liftQuote (Quote Name -> m Name) -> Quote Name -> m Name
forall a b. (a -> b) -> a -> b
$ Text -> Quote Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName (Text -> Quote Name) -> Text -> Quote Name
forall a b. (a -> b) -> a -> b
$ NameKind -> Text -> Text
safeName NameKind
TermName Text
s
safeFreshTyName :: MonadQuote m => T.Text -> m PLC.TyName
safeFreshTyName :: forall (m :: * -> *). MonadQuote m => Text -> m TyName
safeFreshTyName Text
s = Quote TyName -> m TyName
forall a. Quote a -> m a
forall (m :: * -> *) a. MonadQuote m => Quote a -> m a
liftQuote (Quote TyName -> m TyName) -> Quote TyName -> m TyName
forall a b. (a -> b) -> a -> b
$ Text -> Quote TyName
forall (m :: * -> *). MonadQuote m => Text -> m TyName
freshTyName (Text -> Quote TyName) -> Text -> Quote TyName
forall a b. (a -> b) -> a -> b
$ NameKind -> Text -> Text
safeName NameKind
TypeName Text
s