{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

{-| A 'Name' is a datatype used to identify a variable inside the Plutus Core languages.
 Name comparisons are a fundamental part of the domain logic, and comparing 'Text' directly
 is inefficient. As a solution to this problem, we provide the 'Unique' type which is an
 integer associated to the 'Name', unique to each instantiation of the type. We can,
 therefore, compare the integers instead, which is obviously much more cost-effective.

 We distinguish between the names of term variables and type variables by defining the
 'TyName' wrapper over 'Name'. Since the code we usually write is polymorphic in the
 name type, we want to be able to define a class of names which have an associated 'Unique'.
 This class is 'HasUnique', see the definition below. -}
module PlutusCore.Name.Unique
  ( -- * Types
    Name (..)
  , isIdentifierStartingChar
  , isIdentifierChar
  , isQuotedIdentifierChar
  , isValidUnquotedName
  , toPrintedName
  , TyName (..)
  , Named (..)
  , Unique (..)
  , TypeUnique (..)
  , TermUnique (..)
  , HasText (..)
  , HasUnique (..)
  , theUnique

    -- * Functions
  , mapNameString
  , mapTyNameString
  ) where

import PlutusPrelude
  ( Coercible
  , Generic
  , Lens'
  , NFData
  , Pretty (pretty)
  , PrettyBy (prettyBy)
  , Render (render)
  , coerce
  , on
  , over
  )

import PlutusCore.Pretty.ConfigName (HasPrettyConfigName (..), PrettyConfigName (PrettyConfigName))

import Control.Lens (Wrapped (..), coerced, makeLenses)
import Data.Char (isAlpha, isAscii, isDigit, isPunctuation, isSymbol)
import Data.Hashable (Hashable (hashWithSalt))
import Data.Text (Text)
import Data.Text qualified as T
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)

-- | A 'Name' represents variables/names in Plutus Core.
data Name = Name
  { Name -> Text
_nameText :: T.Text
  -- ^ The identifier name, for use in error messages.
  , Name -> Unique
_nameUnique :: Unique
  -- ^ A 'Unique' assigned to the name, allowing for cheap comparisons in the compiler.
  }
  deriving stock (Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show, (forall x. Name -> Rep Name x)
-> (forall x. Rep Name x -> Name) -> Generic Name
forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Name -> Rep Name x
from :: forall x. Name -> Rep Name x
$cto :: forall x. Rep Name x -> Name
to :: forall x. Rep Name x -> Name
Generic, (forall (m :: * -> *). Quote m => Name -> m Exp)
-> (forall (m :: * -> *). Quote m => Name -> Code m Name)
-> Lift Name
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Name -> m Exp
forall (m :: * -> *). Quote m => Name -> Code m Name
$clift :: forall (m :: * -> *). Quote m => Name -> m Exp
lift :: forall (m :: * -> *). Quote m => Name -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Name -> Code m Name
liftTyped :: forall (m :: * -> *). Quote m => Name -> Code m Name
Lift)
  deriving anyclass (Name -> ()
(Name -> ()) -> NFData Name
forall a. (a -> ()) -> NFData a
$crnf :: Name -> ()
rnf :: Name -> ()
NFData)

-- | Allowed characters in the starting position of a non-quoted identifier.
isIdentifierStartingChar :: Char -> Bool
isIdentifierStartingChar :: Char -> Bool
isIdentifierStartingChar Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

-- | Allowed characters in a non-starting position of a non-quoted identifier.
isIdentifierChar :: Char -> Bool
isIdentifierChar :: Char -> Bool
isIdentifierChar Char
c = Char -> Bool
isIdentifierStartingChar Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''

-- | Allowed characters in a quoted identifier.
isQuotedIdentifierChar :: Char -> Bool
isQuotedIdentifierChar :: Char -> Bool
isQuotedIdentifierChar Char
c =
  (Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
c)
    Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
c
    Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'`'

isValidUnquotedName :: Text -> Bool
isValidUnquotedName :: Text -> Bool
isValidUnquotedName Text
n = case Text -> Maybe (Char, Text)
T.uncons Text
n of
  Just (Char
hd, Text
tl) -> Char -> Bool
isIdentifierStartingChar Char
hd Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isIdentifierChar Text
tl
  Maybe (Char, Text)
Nothing -> Bool
False

{-| Quote the name with backticks if it is not a valid unquoted name.
It does not check whether the given name is a valid quoted name. -}
toPrintedName :: Text -> Text
toPrintedName :: Text -> Text
toPrintedName Text
txt = if Text -> Bool
isValidUnquotedName Text
txt then Text
txt else Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"

{-| We use a @newtype@ to enforce separation between names used for types and
those used for terms. -}
newtype TyName = TyName {TyName -> Name
unTyName :: Name}
  deriving stock (Int -> TyName -> ShowS
[TyName] -> ShowS
TyName -> String
(Int -> TyName -> ShowS)
-> (TyName -> String) -> ([TyName] -> ShowS) -> Show TyName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TyName -> ShowS
showsPrec :: Int -> TyName -> ShowS
$cshow :: TyName -> String
show :: TyName -> String
$cshowList :: [TyName] -> ShowS
showList :: [TyName] -> ShowS
Show, (forall x. TyName -> Rep TyName x)
-> (forall x. Rep TyName x -> TyName) -> Generic TyName
forall x. Rep TyName x -> TyName
forall x. TyName -> Rep TyName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TyName -> Rep TyName x
from :: forall x. TyName -> Rep TyName x
$cto :: forall x. Rep TyName x -> TyName
to :: forall x. Rep TyName x -> TyName
Generic, (forall (m :: * -> *). Quote m => TyName -> m Exp)
-> (forall (m :: * -> *). Quote m => TyName -> Code m TyName)
-> Lift TyName
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TyName -> m Exp
forall (m :: * -> *). Quote m => TyName -> Code m TyName
$clift :: forall (m :: * -> *). Quote m => TyName -> m Exp
lift :: forall (m :: * -> *). Quote m => TyName -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => TyName -> Code m TyName
liftTyped :: forall (m :: * -> *). Quote m => TyName -> Code m TyName
Lift)
  deriving newtype (TyName -> TyName -> Bool
(TyName -> TyName -> Bool)
-> (TyName -> TyName -> Bool) -> Eq TyName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TyName -> TyName -> Bool
== :: TyName -> TyName -> Bool
$c/= :: TyName -> TyName -> Bool
/= :: TyName -> TyName -> Bool
Eq, Eq TyName
Eq TyName =>
(TyName -> TyName -> Ordering)
-> (TyName -> TyName -> Bool)
-> (TyName -> TyName -> Bool)
-> (TyName -> TyName -> Bool)
-> (TyName -> TyName -> Bool)
-> (TyName -> TyName -> TyName)
-> (TyName -> TyName -> TyName)
-> Ord TyName
TyName -> TyName -> Bool
TyName -> TyName -> Ordering
TyName -> TyName -> TyName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TyName -> TyName -> Ordering
compare :: TyName -> TyName -> Ordering
$c< :: TyName -> TyName -> Bool
< :: TyName -> TyName -> Bool
$c<= :: TyName -> TyName -> Bool
<= :: TyName -> TyName -> Bool
$c> :: TyName -> TyName -> Bool
> :: TyName -> TyName -> Bool
$c>= :: TyName -> TyName -> Bool
>= :: TyName -> TyName -> Bool
$cmax :: TyName -> TyName -> TyName
max :: TyName -> TyName -> TyName
$cmin :: TyName -> TyName -> TyName
min :: TyName -> TyName -> TyName
Ord, TyName -> ()
(TyName -> ()) -> NFData TyName
forall a. (a -> ()) -> NFData a
$crnf :: TyName -> ()
rnf :: TyName -> ()
NFData, Eq TyName
Eq TyName =>
(Int -> TyName -> Int) -> (TyName -> Int) -> Hashable TyName
Int -> TyName -> Int
TyName -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TyName -> Int
hashWithSalt :: Int -> TyName -> Int
$chash :: TyName -> Int
hash :: TyName -> Int
Hashable, PrettyBy config)

instance Wrapped TyName

data Named a = Named
  { forall a. Named a -> Text
_namedString :: Text
  , forall a. Named a -> a
_namedValue :: a
  }
  deriving stock ((forall a b. (a -> b) -> Named a -> Named b)
-> (forall a b. a -> Named b -> Named a) -> Functor Named
forall a b. a -> Named b -> Named a
forall a b. (a -> b) -> Named a -> Named b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Named a -> Named b
fmap :: forall a b. (a -> b) -> Named a -> Named b
$c<$ :: forall a b. a -> Named b -> Named a
<$ :: forall a b. a -> Named b -> Named a
Functor, (forall m. Monoid m => Named m -> m)
-> (forall m a. Monoid m => (a -> m) -> Named a -> m)
-> (forall m a. Monoid m => (a -> m) -> Named a -> m)
-> (forall a b. (a -> b -> b) -> b -> Named a -> b)
-> (forall a b. (a -> b -> b) -> b -> Named a -> b)
-> (forall b a. (b -> a -> b) -> b -> Named a -> b)
-> (forall b a. (b -> a -> b) -> b -> Named a -> b)
-> (forall a. (a -> a -> a) -> Named a -> a)
-> (forall a. (a -> a -> a) -> Named a -> a)
-> (forall a. Named a -> [a])
-> (forall a. Named a -> Bool)
-> (forall a. Named a -> Int)
-> (forall a. Eq a => a -> Named a -> Bool)
-> (forall a. Ord a => Named a -> a)
-> (forall a. Ord a => Named a -> a)
-> (forall a. Num a => Named a -> a)
-> (forall a. Num a => Named a -> a)
-> Foldable Named
forall a. Eq a => a -> Named a -> Bool
forall a. Num a => Named a -> a
forall a. Ord a => Named a -> a
forall m. Monoid m => Named m -> m
forall a. Named a -> Bool
forall a. Named a -> Int
forall a. Named a -> [a]
forall a. (a -> a -> a) -> Named a -> a
forall m a. Monoid m => (a -> m) -> Named a -> m
forall b a. (b -> a -> b) -> b -> Named a -> b
forall a b. (a -> b -> b) -> b -> Named a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Named m -> m
fold :: forall m. Monoid m => Named m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Named a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Named a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Named a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Named a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Named a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Named a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Named a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Named a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Named a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Named a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Named a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Named a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Named a -> a
foldr1 :: forall a. (a -> a -> a) -> Named a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Named a -> a
foldl1 :: forall a. (a -> a -> a) -> Named a -> a
$ctoList :: forall a. Named a -> [a]
toList :: forall a. Named a -> [a]
$cnull :: forall a. Named a -> Bool
null :: forall a. Named a -> Bool
$clength :: forall a. Named a -> Int
length :: forall a. Named a -> Int
$celem :: forall a. Eq a => a -> Named a -> Bool
elem :: forall a. Eq a => a -> Named a -> Bool
$cmaximum :: forall a. Ord a => Named a -> a
maximum :: forall a. Ord a => Named a -> a
$cminimum :: forall a. Ord a => Named a -> a
minimum :: forall a. Ord a => Named a -> a
$csum :: forall a. Num a => Named a -> a
sum :: forall a. Num a => Named a -> a
$cproduct :: forall a. Num a => Named a -> a
product :: forall a. Num a => Named a -> a
Foldable, Functor Named
Foldable Named
(Functor Named, Foldable Named) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Named a -> f (Named b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Named (f a) -> f (Named a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Named a -> m (Named b))
-> (forall (m :: * -> *) a. Monad m => Named (m a) -> m (Named a))
-> Traversable Named
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Named (m a) -> m (Named a)
forall (f :: * -> *) a. Applicative f => Named (f a) -> f (Named a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Named a -> m (Named b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Named a -> f (Named b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Named a -> f (Named b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Named a -> f (Named b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Named (f a) -> f (Named a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Named (f a) -> f (Named a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Named a -> m (Named b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Named a -> m (Named b)
$csequence :: forall (m :: * -> *) a. Monad m => Named (m a) -> m (Named a)
sequence :: forall (m :: * -> *) a. Monad m => Named (m a) -> m (Named a)
Traversable)

instance HasPrettyConfigName config => PrettyBy config Name where
  prettyBy :: forall ann. config -> Name -> Doc ann
prettyBy config
config (Name Text
txt (Unique Int
uniq))
    | Bool
showsUnique = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> Text
toPrintedName Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doc Any -> Text
forall ann. Doc ann -> Text
forall str ann. Render str => Doc ann -> str
render (Int -> Doc Any
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
uniq)
    | Bool
otherwise = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> Text
toPrintedName Text
txt
    where
      PrettyConfigName Bool
showsUnique = config -> PrettyConfigName
forall config.
HasPrettyConfigName config =>
config -> PrettyConfigName
toPrettyConfigName config
config

instance Eq Name where
  == :: Name -> Name -> Bool
(==) = Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Unique -> Unique -> Bool)
-> (Name -> Unique) -> Name -> Name -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> Unique
_nameUnique

instance Ord Name where
  <= :: Name -> Name -> Bool
(<=) = Unique -> Unique -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (Unique -> Unique -> Bool)
-> (Name -> Unique) -> Name -> Name -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> Unique
_nameUnique

-- Hashable follows Eq and Ord in only depending on the unique
instance Hashable Name where
  hashWithSalt :: Int -> Name -> Int
hashWithSalt Int
s = Int -> Unique -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Unique -> Int) -> (Name -> Unique) -> Name -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Unique
_nameUnique

{-| A unique identifier
This is normally a positive integral number, except
in `LetFloatOut.topUnique` where we make use of a negative unique to signify top-level. -}
newtype Unique = Unique {Unique -> Int
unUnique :: Int}
  deriving stock (Unique -> Unique -> Bool
(Unique -> Unique -> Bool)
-> (Unique -> Unique -> Bool) -> Eq Unique
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Unique -> Unique -> Bool
== :: Unique -> Unique -> Bool
$c/= :: Unique -> Unique -> Bool
/= :: Unique -> Unique -> Bool
Eq, Int -> Unique -> ShowS
[Unique] -> ShowS
Unique -> String
(Int -> Unique -> ShowS)
-> (Unique -> String) -> ([Unique] -> ShowS) -> Show Unique
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Unique -> ShowS
showsPrec :: Int -> Unique -> ShowS
$cshow :: Unique -> String
show :: Unique -> String
$cshowList :: [Unique] -> ShowS
showList :: [Unique] -> ShowS
Show, Eq Unique
Eq Unique =>
(Unique -> Unique -> Ordering)
-> (Unique -> Unique -> Bool)
-> (Unique -> Unique -> Bool)
-> (Unique -> Unique -> Bool)
-> (Unique -> Unique -> Bool)
-> (Unique -> Unique -> Unique)
-> (Unique -> Unique -> Unique)
-> Ord Unique
Unique -> Unique -> Bool
Unique -> Unique -> Ordering
Unique -> Unique -> Unique
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Unique -> Unique -> Ordering
compare :: Unique -> Unique -> Ordering
$c< :: Unique -> Unique -> Bool
< :: Unique -> Unique -> Bool
$c<= :: Unique -> Unique -> Bool
<= :: Unique -> Unique -> Bool
$c> :: Unique -> Unique -> Bool
> :: Unique -> Unique -> Bool
$c>= :: Unique -> Unique -> Bool
>= :: Unique -> Unique -> Bool
$cmax :: Unique -> Unique -> Unique
max :: Unique -> Unique -> Unique
$cmin :: Unique -> Unique -> Unique
min :: Unique -> Unique -> Unique
Ord, (forall (m :: * -> *). Quote m => Unique -> m Exp)
-> (forall (m :: * -> *). Quote m => Unique -> Code m Unique)
-> Lift Unique
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Unique -> m Exp
forall (m :: * -> *). Quote m => Unique -> Code m Unique
$clift :: forall (m :: * -> *). Quote m => Unique -> m Exp
lift :: forall (m :: * -> *). Quote m => Unique -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Unique -> Code m Unique
liftTyped :: forall (m :: * -> *). Quote m => Unique -> Code m Unique
Lift)
  deriving newtype (Int -> Unique
Unique -> Int
Unique -> [Unique]
Unique -> Unique
Unique -> Unique -> [Unique]
Unique -> Unique -> Unique -> [Unique]
(Unique -> Unique)
-> (Unique -> Unique)
-> (Int -> Unique)
-> (Unique -> Int)
-> (Unique -> [Unique])
-> (Unique -> Unique -> [Unique])
-> (Unique -> Unique -> [Unique])
-> (Unique -> Unique -> Unique -> [Unique])
-> Enum Unique
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Unique -> Unique
succ :: Unique -> Unique
$cpred :: Unique -> Unique
pred :: Unique -> Unique
$ctoEnum :: Int -> Unique
toEnum :: Int -> Unique
$cfromEnum :: Unique -> Int
fromEnum :: Unique -> Int
$cenumFrom :: Unique -> [Unique]
enumFrom :: Unique -> [Unique]
$cenumFromThen :: Unique -> Unique -> [Unique]
enumFromThen :: Unique -> Unique -> [Unique]
$cenumFromTo :: Unique -> Unique -> [Unique]
enumFromTo :: Unique -> Unique -> [Unique]
$cenumFromThenTo :: Unique -> Unique -> Unique -> [Unique]
enumFromThenTo :: Unique -> Unique -> Unique -> [Unique]
Enum, Unique -> ()
(Unique -> ()) -> NFData Unique
forall a. (a -> ()) -> NFData a
$crnf :: Unique -> ()
rnf :: Unique -> ()
NFData, (forall ann. Unique -> Doc ann)
-> (forall ann. [Unique] -> Doc ann) -> Pretty Unique
forall ann. [Unique] -> Doc ann
forall ann. Unique -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. Unique -> Doc ann
pretty :: forall ann. Unique -> Doc ann
$cprettyList :: forall ann. [Unique] -> Doc ann
prettyList :: forall ann. [Unique] -> Doc ann
Pretty, Eq Unique
Eq Unique =>
(Int -> Unique -> Int) -> (Unique -> Int) -> Hashable Unique
Int -> Unique -> Int
Unique -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Unique -> Int
hashWithSalt :: Int -> Unique -> Int
$chash :: Unique -> Int
hash :: Unique -> Int
Hashable)

-- | The unique of a type-level name.
newtype TypeUnique = TypeUnique
  { TypeUnique -> Unique
unTypeUnique :: Unique
  }
  deriving stock (TypeUnique -> TypeUnique -> Bool
(TypeUnique -> TypeUnique -> Bool)
-> (TypeUnique -> TypeUnique -> Bool) -> Eq TypeUnique
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeUnique -> TypeUnique -> Bool
== :: TypeUnique -> TypeUnique -> Bool
$c/= :: TypeUnique -> TypeUnique -> Bool
/= :: TypeUnique -> TypeUnique -> Bool
Eq, Eq TypeUnique
Eq TypeUnique =>
(TypeUnique -> TypeUnique -> Ordering)
-> (TypeUnique -> TypeUnique -> Bool)
-> (TypeUnique -> TypeUnique -> Bool)
-> (TypeUnique -> TypeUnique -> Bool)
-> (TypeUnique -> TypeUnique -> Bool)
-> (TypeUnique -> TypeUnique -> TypeUnique)
-> (TypeUnique -> TypeUnique -> TypeUnique)
-> Ord TypeUnique
TypeUnique -> TypeUnique -> Bool
TypeUnique -> TypeUnique -> Ordering
TypeUnique -> TypeUnique -> TypeUnique
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeUnique -> TypeUnique -> Ordering
compare :: TypeUnique -> TypeUnique -> Ordering
$c< :: TypeUnique -> TypeUnique -> Bool
< :: TypeUnique -> TypeUnique -> Bool
$c<= :: TypeUnique -> TypeUnique -> Bool
<= :: TypeUnique -> TypeUnique -> Bool
$c> :: TypeUnique -> TypeUnique -> Bool
> :: TypeUnique -> TypeUnique -> Bool
$c>= :: TypeUnique -> TypeUnique -> Bool
>= :: TypeUnique -> TypeUnique -> Bool
$cmax :: TypeUnique -> TypeUnique -> TypeUnique
max :: TypeUnique -> TypeUnique -> TypeUnique
$cmin :: TypeUnique -> TypeUnique -> TypeUnique
min :: TypeUnique -> TypeUnique -> TypeUnique
Ord)
  deriving newtype (Eq TypeUnique
Eq TypeUnique =>
(Int -> TypeUnique -> Int)
-> (TypeUnique -> Int) -> Hashable TypeUnique
Int -> TypeUnique -> Int
TypeUnique -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TypeUnique -> Int
hashWithSalt :: Int -> TypeUnique -> Int
$chash :: TypeUnique -> Int
hash :: TypeUnique -> Int
Hashable)

-- | The unique of a term-level name.
newtype TermUnique = TermUnique
  { TermUnique -> Unique
unTermUnique :: Unique
  }
  deriving stock (TermUnique -> TermUnique -> Bool
(TermUnique -> TermUnique -> Bool)
-> (TermUnique -> TermUnique -> Bool) -> Eq TermUnique
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TermUnique -> TermUnique -> Bool
== :: TermUnique -> TermUnique -> Bool
$c/= :: TermUnique -> TermUnique -> Bool
/= :: TermUnique -> TermUnique -> Bool
Eq, Eq TermUnique
Eq TermUnique =>
(TermUnique -> TermUnique -> Ordering)
-> (TermUnique -> TermUnique -> Bool)
-> (TermUnique -> TermUnique -> Bool)
-> (TermUnique -> TermUnique -> Bool)
-> (TermUnique -> TermUnique -> Bool)
-> (TermUnique -> TermUnique -> TermUnique)
-> (TermUnique -> TermUnique -> TermUnique)
-> Ord TermUnique
TermUnique -> TermUnique -> Bool
TermUnique -> TermUnique -> Ordering
TermUnique -> TermUnique -> TermUnique
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TermUnique -> TermUnique -> Ordering
compare :: TermUnique -> TermUnique -> Ordering
$c< :: TermUnique -> TermUnique -> Bool
< :: TermUnique -> TermUnique -> Bool
$c<= :: TermUnique -> TermUnique -> Bool
<= :: TermUnique -> TermUnique -> Bool
$c> :: TermUnique -> TermUnique -> Bool
> :: TermUnique -> TermUnique -> Bool
$c>= :: TermUnique -> TermUnique -> Bool
>= :: TermUnique -> TermUnique -> Bool
$cmax :: TermUnique -> TermUnique -> TermUnique
max :: TermUnique -> TermUnique -> TermUnique
$cmin :: TermUnique -> TermUnique -> TermUnique
min :: TermUnique -> TermUnique -> TermUnique
Ord)
  deriving newtype (Eq TermUnique
Eq TermUnique =>
(Int -> TermUnique -> Int)
-> (TermUnique -> Int) -> Hashable TermUnique
Int -> TermUnique -> Int
TermUnique -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TermUnique -> Int
hashWithSalt :: Int -> TermUnique -> Int
$chash :: TermUnique -> Int
hash :: TermUnique -> Int
Hashable)

makeLenses 'Name

-- | Apply a function to the string representation of a 'Name'.
mapNameString :: (T.Text -> T.Text) -> Name -> Name
mapNameString :: (Text -> Text) -> Name -> Name
mapNameString = ASetter Name Name Text Text -> (Text -> Text) -> Name -> Name
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Name Name Text Text
Lens' Name Text
nameText

-- | Apply a function to the string representation of a 'TyName'.
mapTyNameString :: (T.Text -> T.Text) -> TyName -> TyName
mapTyNameString :: (Text -> Text) -> TyName -> TyName
mapTyNameString = ((Text -> Text) -> Name -> Name)
-> (Text -> Text) -> TyName -> TyName
forall a b. Coercible a b => a -> b
coerce (Text -> Text) -> Name -> Name
mapNameString

-- | Types which have a textual name attached to them.
class HasText a where
  theText :: Lens' a Text

instance HasText Name where
  theText :: Lens' Name Text
theText = (Text -> f Text) -> Name -> f Name
Lens' Name Text
nameText

instance HasText TyName where
  theText :: Lens' TyName Text
theText = (Name -> f Name) -> TyName -> f TyName
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso TyName TyName Name Name
coerced ((Name -> f Name) -> TyName -> f TyName)
-> ((Text -> f Text) -> Name -> f Name)
-> (Text -> f Text)
-> TyName
-> f TyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasText a => Lens' a Text
theText @Name

-- | Types which have a 'Unique' attached to them, mostly names.
class Coercible unique Unique => HasUnique a unique | a -> unique where
  unique :: Lens' a unique

  -- | The default implementation of 'HasUnique' for newtypes.
  default unique
    :: (Wrapped a, HasUnique (Unwrapped a) unique', Coercible unique' unique)
    => Lens' a unique
  unique = (Unwrapped a -> f (Unwrapped a)) -> a -> f a
forall s. Wrapped s => Iso' s (Unwrapped s)
Iso' a (Unwrapped a)
_Wrapped' ((Unwrapped a -> f (Unwrapped a)) -> a -> f a)
-> ((unique -> f unique) -> Unwrapped a -> f (Unwrapped a))
-> (unique -> f unique)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (unique' -> f unique') -> Unwrapped a -> f (Unwrapped a)
forall a unique. HasUnique a unique => Lens' a unique
Lens' (Unwrapped a) unique'
unique ((unique' -> f unique') -> Unwrapped a -> f (Unwrapped a))
-> ((unique -> f unique) -> unique' -> f unique')
-> (unique -> f unique)
-> Unwrapped a
-> f (Unwrapped a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (unique -> f unique) -> unique' -> f unique'
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso unique' unique' unique unique
coerced

instance HasUnique Unique Unique where
  unique :: Lens' Unique Unique
unique = (Unique -> f Unique) -> Unique -> f Unique
forall a. a -> a
id

instance HasUnique Name TermUnique where
  unique :: Lens' Name TermUnique
unique = (Unique -> f Unique) -> Name -> f Name
Lens' Name Unique
nameUnique ((Unique -> f Unique) -> Name -> f Name)
-> ((TermUnique -> f TermUnique) -> Unique -> f Unique)
-> (TermUnique -> f TermUnique)
-> Name
-> f Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TermUnique -> f TermUnique) -> Unique -> f Unique
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso Unique Unique TermUnique TermUnique
coerced

instance HasUnique TyName TypeUnique

-- | A lens focused on the 'Unique' of a name.
theUnique :: HasUnique name unique => Lens' name Unique
theUnique :: forall name unique. HasUnique name unique => Lens' name Unique
theUnique = (unique -> f unique) -> name -> f name
forall a unique. HasUnique a unique => Lens' a unique
Lens' name unique
unique ((unique -> f unique) -> name -> f name)
-> ((Unique -> f Unique) -> unique -> f unique)
-> (Unique -> f Unique)
-> name
-> f name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unique -> f Unique) -> unique -> f unique
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso unique unique Unique Unique
coerced