{-| Abstract names carry unique identifiers and stuff.
-}
module Agda.Syntax.Abstract.Name
  ( module Agda.Syntax.Abstract.Name
  , IsNoName(..)
  , FreshNameMode(..)
  ) where

import Prelude hiding (length)

import Control.DeepSeq

import Data.Foldable (length)
import Data.Function (on)
import Data.Hashable (Hashable(..))
import qualified Data.List as List
import Data.Maybe
import Data.Void

import Agda.Syntax.Position
import Agda.Syntax.Common
import Agda.Syntax.Concrete.Name (IsNoName(..), NumHoles(..), NameInScope(..), LensInScope(..), FreshNameMode(..))
import qualified Agda.Syntax.Concrete.Name as C

import Agda.Utils.Functor
import Agda.Utils.Lens
import qualified Agda.Utils.List as L
import Agda.Utils.List1 (List1, pattern (:|), (<|))
import qualified Agda.Utils.List1 as List1
import Agda.Syntax.Common.Pretty
import Agda.Utils.Size

import Agda.Utils.Impossible

-- | A name is a unique identifier and a suggestion for a concrete name. The
--   concrete name contains the source location (if any) of the name. The
--   source location of the binding site is also recorded.
data Name = Name
  { Name -> NameId
nameId           :: !NameId
  , Name -> Name
nameConcrete     :: C.Name  -- ^ The concrete name used for this instance
  , Name -> Name
nameCanonical    :: C.Name  -- ^ The concrete name in the original definition (needed by primShowQName, see #4735)
  , Name -> Range
nameBindingSite  :: Range
  , Name -> Fixity'
nameFixity       :: Fixity'
  , Name -> Bool
nameIsRecordName :: Bool
      -- ^ Is this the name of the invisible record variable `self`?
      --   Should not be printed or displayed in the context, see issue #3584.
  }

-- | Useful for debugging scoping problems
uglyShowName :: Name -> String
uglyShowName :: Name -> [Char]
uglyShowName Name
x = (NameId, Name) -> [Char]
forall a. Show a => a -> [Char]
show (Name -> NameId
nameId Name
x, Name -> Name
nameConcrete Name
x)

-- | Qualified names are non-empty lists of names. Equality on qualified names
--   are just equality on the last name, i.e. the module part is just
--   for show.
--
-- The 'SetRange' instance for qualified names sets all individual
-- ranges (including those of the module prefix) to the given one.
data QName = QName { QName -> ModuleName
qnameModule :: ModuleName
                   , QName -> Name
qnameName   :: Name
                   }

-- | Something preceeded by a qualified name.
data QNamed a = QNamed
  { forall a. QNamed a -> QName
qname  :: QName
  , forall a. QNamed a -> a
qnamed :: a
  }
  deriving ((forall a b. (a -> b) -> QNamed a -> QNamed b)
-> (forall a b. a -> QNamed b -> QNamed a) -> Functor QNamed
forall a b. a -> QNamed b -> QNamed a
forall a b. (a -> b) -> QNamed a -> QNamed 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) -> QNamed a -> QNamed b
fmap :: forall a b. (a -> b) -> QNamed a -> QNamed b
$c<$ :: forall a b. a -> QNamed b -> QNamed a
<$ :: forall a b. a -> QNamed b -> QNamed a
Functor, (forall m. Monoid m => QNamed m -> m)
-> (forall m a. Monoid m => (a -> m) -> QNamed a -> m)
-> (forall m a. Monoid m => (a -> m) -> QNamed a -> m)
-> (forall a b. (a -> b -> b) -> b -> QNamed a -> b)
-> (forall a b. (a -> b -> b) -> b -> QNamed a -> b)
-> (forall b a. (b -> a -> b) -> b -> QNamed a -> b)
-> (forall b a. (b -> a -> b) -> b -> QNamed a -> b)
-> (forall a. (a -> a -> a) -> QNamed a -> a)
-> (forall a. (a -> a -> a) -> QNamed a -> a)
-> (forall a. QNamed a -> [a])
-> (forall a. QNamed a -> Bool)
-> (forall a. QNamed a -> Int)
-> (forall a. Eq a => a -> QNamed a -> Bool)
-> (forall a. Ord a => QNamed a -> a)
-> (forall a. Ord a => QNamed a -> a)
-> (forall a. Num a => QNamed a -> a)
-> (forall a. Num a => QNamed a -> a)
-> Foldable QNamed
forall a. Eq a => a -> QNamed a -> Bool
forall a. Num a => QNamed a -> a
forall a. Ord a => QNamed a -> a
forall m. Monoid m => QNamed m -> m
forall a. QNamed a -> Bool
forall a. QNamed a -> Int
forall a. QNamed a -> [a]
forall a. (a -> a -> a) -> QNamed a -> a
forall m a. Monoid m => (a -> m) -> QNamed a -> m
forall b a. (b -> a -> b) -> b -> QNamed a -> b
forall a b. (a -> b -> b) -> b -> QNamed 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 => QNamed m -> m
fold :: forall m. Monoid m => QNamed m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> QNamed a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> QNamed a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> QNamed a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> QNamed a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> QNamed a -> b
foldr :: forall a b. (a -> b -> b) -> b -> QNamed a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> QNamed a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> QNamed a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> QNamed a -> b
foldl :: forall b a. (b -> a -> b) -> b -> QNamed a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> QNamed a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> QNamed a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> QNamed a -> a
foldr1 :: forall a. (a -> a -> a) -> QNamed a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> QNamed a -> a
foldl1 :: forall a. (a -> a -> a) -> QNamed a -> a
$ctoList :: forall a. QNamed a -> [a]
toList :: forall a. QNamed a -> [a]
$cnull :: forall a. QNamed a -> Bool
null :: forall a. QNamed a -> Bool
$clength :: forall a. QNamed a -> Int
length :: forall a. QNamed a -> Int
$celem :: forall a. Eq a => a -> QNamed a -> Bool
elem :: forall a. Eq a => a -> QNamed a -> Bool
$cmaximum :: forall a. Ord a => QNamed a -> a
maximum :: forall a. Ord a => QNamed a -> a
$cminimum :: forall a. Ord a => QNamed a -> a
minimum :: forall a. Ord a => QNamed a -> a
$csum :: forall a. Num a => QNamed a -> a
sum :: forall a. Num a => QNamed a -> a
$cproduct :: forall a. Num a => QNamed a -> a
product :: forall a. Num a => QNamed a -> a
Foldable, Functor QNamed
Foldable QNamed
(Functor QNamed, Foldable QNamed) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> QNamed a -> f (QNamed b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    QNamed (f a) -> f (QNamed a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> QNamed a -> m (QNamed b))
-> (forall (m :: * -> *) a.
    Monad m =>
    QNamed (m a) -> m (QNamed a))
-> Traversable QNamed
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 => QNamed (m a) -> m (QNamed a)
forall (f :: * -> *) a.
Applicative f =>
QNamed (f a) -> f (QNamed a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QNamed a -> m (QNamed b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QNamed a -> f (QNamed b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QNamed a -> f (QNamed b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QNamed a -> f (QNamed b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
QNamed (f a) -> f (QNamed a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
QNamed (f a) -> f (QNamed a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QNamed a -> m (QNamed b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QNamed a -> m (QNamed b)
$csequence :: forall (m :: * -> *) a. Monad m => QNamed (m a) -> m (QNamed a)
sequence :: forall (m :: * -> *) a. Monad m => QNamed (m a) -> m (QNamed a)
Traversable)

-- | A module name is just a qualified name.
--
-- The 'SetRange' instance for module names sets all individual ranges
-- to the given one.
newtype ModuleName = MName { ModuleName -> [Name]
mnameToList :: [Name] }
  deriving (ModuleName -> ModuleName -> Bool
(ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool) -> Eq ModuleName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleName -> ModuleName -> Bool
== :: ModuleName -> ModuleName -> Bool
$c/= :: ModuleName -> ModuleName -> Bool
/= :: ModuleName -> ModuleName -> Bool
Eq, Eq ModuleName
Eq ModuleName =>
(ModuleName -> ModuleName -> Ordering)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> ModuleName)
-> (ModuleName -> ModuleName -> ModuleName)
-> Ord ModuleName
ModuleName -> ModuleName -> Bool
ModuleName -> ModuleName -> Ordering
ModuleName -> ModuleName -> ModuleName
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 :: ModuleName -> ModuleName -> Ordering
compare :: ModuleName -> ModuleName -> Ordering
$c< :: ModuleName -> ModuleName -> Bool
< :: ModuleName -> ModuleName -> Bool
$c<= :: ModuleName -> ModuleName -> Bool
<= :: ModuleName -> ModuleName -> Bool
$c> :: ModuleName -> ModuleName -> Bool
> :: ModuleName -> ModuleName -> Bool
$c>= :: ModuleName -> ModuleName -> Bool
>= :: ModuleName -> ModuleName -> Bool
$cmax :: ModuleName -> ModuleName -> ModuleName
max :: ModuleName -> ModuleName -> ModuleName
$cmin :: ModuleName -> ModuleName -> ModuleName
min :: ModuleName -> ModuleName -> ModuleName
Ord)

-- | Ambiguous qualified names. Used for overloaded constructors.
--
-- Invariant: All the names in the list must have the same concrete,
-- unqualified name.  (This implies that they all have the same 'Range').
newtype AmbiguousQName = AmbQ { AmbiguousQName -> List1 QName
unAmbQ :: List1 QName }
  deriving (AmbiguousQName -> AmbiguousQName -> Bool
(AmbiguousQName -> AmbiguousQName -> Bool)
-> (AmbiguousQName -> AmbiguousQName -> Bool) -> Eq AmbiguousQName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AmbiguousQName -> AmbiguousQName -> Bool
== :: AmbiguousQName -> AmbiguousQName -> Bool
$c/= :: AmbiguousQName -> AmbiguousQName -> Bool
/= :: AmbiguousQName -> AmbiguousQName -> Bool
Eq, Eq AmbiguousQName
Eq AmbiguousQName =>
(AmbiguousQName -> AmbiguousQName -> Ordering)
-> (AmbiguousQName -> AmbiguousQName -> Bool)
-> (AmbiguousQName -> AmbiguousQName -> Bool)
-> (AmbiguousQName -> AmbiguousQName -> Bool)
-> (AmbiguousQName -> AmbiguousQName -> Bool)
-> (AmbiguousQName -> AmbiguousQName -> AmbiguousQName)
-> (AmbiguousQName -> AmbiguousQName -> AmbiguousQName)
-> Ord AmbiguousQName
AmbiguousQName -> AmbiguousQName -> Bool
AmbiguousQName -> AmbiguousQName -> Ordering
AmbiguousQName -> AmbiguousQName -> AmbiguousQName
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 :: AmbiguousQName -> AmbiguousQName -> Ordering
compare :: AmbiguousQName -> AmbiguousQName -> Ordering
$c< :: AmbiguousQName -> AmbiguousQName -> Bool
< :: AmbiguousQName -> AmbiguousQName -> Bool
$c<= :: AmbiguousQName -> AmbiguousQName -> Bool
<= :: AmbiguousQName -> AmbiguousQName -> Bool
$c> :: AmbiguousQName -> AmbiguousQName -> Bool
> :: AmbiguousQName -> AmbiguousQName -> Bool
$c>= :: AmbiguousQName -> AmbiguousQName -> Bool
>= :: AmbiguousQName -> AmbiguousQName -> Bool
$cmax :: AmbiguousQName -> AmbiguousQName -> AmbiguousQName
max :: AmbiguousQName -> AmbiguousQName -> AmbiguousQName
$cmin :: AmbiguousQName -> AmbiguousQName -> AmbiguousQName
min :: AmbiguousQName -> AmbiguousQName -> AmbiguousQName
Ord, AmbiguousQName -> ()
(AmbiguousQName -> ()) -> NFData AmbiguousQName
forall a. (a -> ()) -> NFData a
$crnf :: AmbiguousQName -> ()
rnf :: AmbiguousQName -> ()
NFData)

-- | A singleton "ambiguous" name.
unambiguous :: QName -> AmbiguousQName
unambiguous :: QName -> AmbiguousQName
unambiguous QName
x = List1 QName -> AmbiguousQName
AmbQ (QName
x QName -> [QName] -> List1 QName
forall a. a -> [a] -> NonEmpty a
:| [])

-- | Get the first of the ambiguous names.
headAmbQ :: AmbiguousQName -> QName
headAmbQ :: AmbiguousQName -> QName
headAmbQ (AmbQ List1 QName
xs) = List1 QName -> QName
forall a. NonEmpty a -> a
List1.head List1 QName
xs

-- | Is a name ambiguous.
isAmbiguous :: AmbiguousQName -> Bool
isAmbiguous :: AmbiguousQName -> Bool
isAmbiguous (AmbQ (QName
_ :| [QName]
xs)) = Bool -> Bool
not ([QName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [QName]
xs)

-- | Get the name if unambiguous.
getUnambiguous :: AmbiguousQName -> Maybe QName
getUnambiguous :: AmbiguousQName -> Maybe QName
getUnambiguous (AmbQ (QName
x :| [])) = QName -> Maybe QName
forall a. a -> Maybe a
Just QName
x
getUnambiguous AmbiguousQName
_                = Maybe QName
forall a. Maybe a
Nothing

-- | A name suffix
data Suffix
  = NoSuffix
  | Suffix !Integer
  deriving (Int -> Suffix -> ShowS
[Suffix] -> ShowS
Suffix -> [Char]
(Int -> Suffix -> ShowS)
-> (Suffix -> [Char]) -> ([Suffix] -> ShowS) -> Show Suffix
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Suffix -> ShowS
showsPrec :: Int -> Suffix -> ShowS
$cshow :: Suffix -> [Char]
show :: Suffix -> [Char]
$cshowList :: [Suffix] -> ShowS
showList :: [Suffix] -> ShowS
Show, Suffix -> Suffix -> Bool
(Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool) -> Eq Suffix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Suffix -> Suffix -> Bool
== :: Suffix -> Suffix -> Bool
$c/= :: Suffix -> Suffix -> Bool
/= :: Suffix -> Suffix -> Bool
Eq, Eq Suffix
Eq Suffix =>
(Suffix -> Suffix -> Ordering)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Suffix)
-> (Suffix -> Suffix -> Suffix)
-> Ord Suffix
Suffix -> Suffix -> Bool
Suffix -> Suffix -> Ordering
Suffix -> Suffix -> Suffix
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 :: Suffix -> Suffix -> Ordering
compare :: Suffix -> Suffix -> Ordering
$c< :: Suffix -> Suffix -> Bool
< :: Suffix -> Suffix -> Bool
$c<= :: Suffix -> Suffix -> Bool
<= :: Suffix -> Suffix -> Bool
$c> :: Suffix -> Suffix -> Bool
> :: Suffix -> Suffix -> Bool
$c>= :: Suffix -> Suffix -> Bool
>= :: Suffix -> Suffix -> Bool
$cmax :: Suffix -> Suffix -> Suffix
max :: Suffix -> Suffix -> Suffix
$cmin :: Suffix -> Suffix -> Suffix
min :: Suffix -> Suffix -> Suffix
Ord)

instance NFData Suffix where
  rnf :: Suffix -> ()
rnf Suffix
NoSuffix   = ()
  rnf (Suffix Integer
_) = ()

-- | Check whether we are a projection pattern.
class IsProjP a where
  isProjP :: a -> Maybe (ProjOrigin, AmbiguousQName)

instance IsProjP a => IsProjP (Arg a) where
  isProjP :: Arg a -> Maybe (ProjOrigin, AmbiguousQName)
isProjP Arg a
p = case a -> Maybe (ProjOrigin, AmbiguousQName)
forall a. IsProjP a => a -> Maybe (ProjOrigin, AmbiguousQName)
isProjP (a -> Maybe (ProjOrigin, AmbiguousQName))
-> a -> Maybe (ProjOrigin, AmbiguousQName)
forall a b. (a -> b) -> a -> b
$ Arg a -> a
forall e. Arg e -> e
unArg Arg a
p of
    Just (ProjOrigin
ProjPostfix , AmbiguousQName
f)
     | Arg a -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding Arg a
p Hiding -> Hiding -> Bool
forall a. Eq a => a -> a -> Bool
/= Hiding
NotHidden -> Maybe (ProjOrigin, AmbiguousQName)
forall a. Maybe a
Nothing
    Maybe (ProjOrigin, AmbiguousQName)
x -> Maybe (ProjOrigin, AmbiguousQName)
x

instance IsProjP a => IsProjP (Named n a) where
  isProjP :: Named n a -> Maybe (ProjOrigin, AmbiguousQName)
isProjP = a -> Maybe (ProjOrigin, AmbiguousQName)
forall a. IsProjP a => a -> Maybe (ProjOrigin, AmbiguousQName)
isProjP (a -> Maybe (ProjOrigin, AmbiguousQName))
-> (Named n a -> a)
-> Named n a
-> Maybe (ProjOrigin, AmbiguousQName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Named n a -> a
forall name a. Named name a -> a
namedThing

instance IsProjP Void where
  isProjP :: Void -> Maybe (ProjOrigin, AmbiguousQName)
isProjP Void
_ = Maybe (ProjOrigin, AmbiguousQName)
forall a. HasCallStack => a
__IMPOSSIBLE__

-- | A module is anonymous if the qualification path ends in an underscore.
isAnonymousModuleName :: ModuleName -> Bool
isAnonymousModuleName :: ModuleName -> Bool
isAnonymousModuleName (MName [Name]
mms) = Bool -> (Name -> Bool) -> Maybe Name -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Name -> Bool
forall a. IsNoName a => a -> Bool
isNoName (Maybe Name -> Bool) -> Maybe Name -> Bool
forall a b. (a -> b) -> a -> b
$ [Name] -> Maybe Name
forall a. [a] -> Maybe a
L.lastMaybe [Name]
mms

-- | Sets the ranges of the individual names in the module name to
-- match those of the corresponding concrete names. If the concrete
-- names are fewer than the number of module name name parts, then the
-- initial name parts get the range 'noRange'.
--
-- @C.D.E \`withRangesOf\` [A, B]@ returns @C.D.E@ but with ranges set
-- as follows:
--
-- * @C@: 'noRange'.
--
-- * @D@: the range of @A@.
--
-- * @E@: the range of @B@.
--
-- Precondition: The number of module name name parts has to be at
-- least as large as the length of the list.

withRangesOf :: ModuleName -> List1 C.Name -> ModuleName
MName [Name]
ms withRangesOf :: ModuleName -> List1 Name -> ModuleName
`withRangesOf` List1 Name
ns = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n then ModuleName
forall a. HasCallStack => a
__IMPOSSIBLE__ else [Name] -> ModuleName
MName ([Name] -> ModuleName) -> [Name] -> ModuleName
forall a b. (a -> b) -> a -> b
$
      (Range -> Name -> Name) -> [Range] -> [Name] -> [Name]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Range -> Name -> Name
forall a. SetRange a => Range -> a -> a
setRange (Int -> Range -> [Range]
forall a. Int -> a -> [a]
replicate (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Range
forall a. Range' a
noRange [Range] -> [Range] -> [Range]
forall a. [a] -> [a] -> [a]
++ (Name -> Range) -> [Name] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Range
forall a. HasRange a => a -> Range
getRange (List1 Name -> [Item (List1 Name)]
forall l. IsList l => l -> [Item l]
List1.toList List1 Name
ns)) [Name]
ms
  where
    m :: Int
m = [Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
ms
    n :: Int
n = List1 Name -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length List1 Name
ns

-- | Like 'withRangesOf', but uses the name parts (qualifier + name)
-- of the qualified name as the list of concrete names.

withRangesOfQ :: ModuleName -> C.QName -> ModuleName
ModuleName
m withRangesOfQ :: ModuleName -> QName -> ModuleName
`withRangesOfQ` QName
q = ModuleName
m ModuleName -> List1 Name -> ModuleName
`withRangesOf` QName -> List1 Name
C.qnameParts QName
q

mnameFromList :: [Name] -> ModuleName
mnameFromList :: [Name] -> ModuleName
mnameFromList = [Name] -> ModuleName
MName

mnameFromList1 :: List1 Name -> ModuleName
mnameFromList1 :: List1 Name -> ModuleName
mnameFromList1 = [Name] -> ModuleName
MName ([Name] -> ModuleName)
-> (List1 Name -> [Name]) -> List1 Name -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 Name -> [Item (List1 Name)]
List1 Name -> [Name]
forall l. IsList l => l -> [Item l]
List1.toList

mnameToList1 :: ModuleName -> List1 Name
mnameToList1 :: ModuleName -> List1 Name
mnameToList1 (MName [Name]
ns) = [Name] -> List1 Name -> (List1 Name -> List1 Name) -> List1 Name
forall a b. [a] -> b -> (List1 a -> b) -> b
List1.ifNull [Name]
ns List1 Name
forall a. HasCallStack => a
__IMPOSSIBLE__ List1 Name -> List1 Name
forall a. a -> a
id

noModuleName :: ModuleName
noModuleName :: ModuleName
noModuleName = [Name] -> ModuleName
mnameFromList []

commonParentModule :: ModuleName -> ModuleName -> ModuleName
commonParentModule :: ModuleName -> ModuleName -> ModuleName
commonParentModule ModuleName
m1 ModuleName
m2 =
  [Name] -> ModuleName
mnameFromList ([Name] -> ModuleName) -> [Name] -> ModuleName
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
L.commonPrefix (ModuleName -> [Name]
mnameToList ModuleName
m1) (ModuleName -> [Name]
mnameToList ModuleName
m2)

-- | Make a 'Name' from some kind of string.
class MkName a where
  -- | The 'Range' sets the /definition site/ of the name, not the use site.
  mkName :: Range -> NameId -> a -> Name

  mkName_ :: NameId -> a -> Name
  mkName_ = Range -> NameId -> a -> Name
forall a. MkName a => Range -> NameId -> a -> Name
mkName Range
forall a. Range' a
noRange

instance MkName String where
  mkName :: Range -> NameId -> [Char] -> Name
mkName Range
r NameId
i [Char]
s = NameId -> Name -> Range -> Fixity' -> Bool -> Name
makeName NameId
i (Range -> NameInScope -> NameParts -> Name
C.Name Range
forall a. Range' a
noRange NameInScope
InScope ([Char] -> NameParts
C.stringNameParts [Char]
s)) Range
r Fixity'
noFixity' Bool
False

makeName :: NameId -> C.Name -> Range -> Fixity' -> Bool -> Name
makeName :: NameId -> Name -> Range -> Fixity' -> Bool -> Name
makeName NameId
i Name
c Range
r Fixity'
f Bool
rec = NameId -> Name -> Name -> Range -> Fixity' -> Bool -> Name
Name NameId
i Name
c Name
c Range
r Fixity'
f Bool
rec

qnameToList0 :: QName -> [Name]
qnameToList0 :: QName -> [Name]
qnameToList0 = List1 Name -> [Item (List1 Name)]
List1 Name -> [Name]
forall l. IsList l => l -> [Item l]
List1.toList (List1 Name -> [Name]) -> (QName -> List1 Name) -> QName -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> List1 Name
qnameToList

qnameToList :: QName -> List1 Name
qnameToList :: QName -> List1 Name
qnameToList (QName ModuleName
m Name
x) = ModuleName -> [Name]
mnameToList ModuleName
m [Name] -> Name -> List1 Name
forall a. [a] -> a -> List1 a
`List1.snoc` Name
x

qnameFromList :: List1 Name -> QName
qnameFromList :: List1 Name -> QName
qnameFromList List1 Name
xs = ModuleName -> Name -> QName
QName ([Name] -> ModuleName
mnameFromList ([Name] -> ModuleName) -> [Name] -> ModuleName
forall a b. (a -> b) -> a -> b
$ List1 Name -> [Name]
forall a. NonEmpty a -> [a]
List1.init List1 Name
xs) (List1 Name -> Name
forall a. NonEmpty a -> a
List1.last List1 Name
xs)

qnameToMName :: QName -> ModuleName
qnameToMName :: QName -> ModuleName
qnameToMName = List1 Name -> ModuleName
mnameFromList1 (List1 Name -> ModuleName)
-> (QName -> List1 Name) -> QName -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> List1 Name
qnameToList

mnameToQName :: ModuleName -> QName
mnameToQName :: ModuleName -> QName
mnameToQName = List1 Name -> QName
qnameFromList (List1 Name -> QName)
-> (ModuleName -> List1 Name) -> ModuleName -> QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> List1 Name
mnameToList1

showQNameId :: QName -> String
showQNameId :: QName -> [Char]
showQNameId QName
q = NonEmpty Word64 -> [Char]
forall a. Show a => a -> [Char]
show NonEmpty Word64
ns [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"@" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleNameHash -> [Char]
forall a. Show a => a -> [Char]
show (NonEmpty ModuleNameHash -> ModuleNameHash
forall a. NonEmpty a -> a
List1.head NonEmpty ModuleNameHash
ms)
  where
    (NonEmpty Word64
ns, NonEmpty ModuleNameHash
ms) = NonEmpty (Word64, ModuleNameHash)
-> (NonEmpty Word64, NonEmpty ModuleNameHash)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
List1.unzip (NonEmpty (Word64, ModuleNameHash)
 -> (NonEmpty Word64, NonEmpty ModuleNameHash))
-> NonEmpty (Word64, ModuleNameHash)
-> (NonEmpty Word64, NonEmpty ModuleNameHash)
forall a b. (a -> b) -> a -> b
$ (Name -> (Word64, ModuleNameHash))
-> List1 Name -> NonEmpty (Word64, ModuleNameHash)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NameId -> (Word64, ModuleNameHash)
unNameId (NameId -> (Word64, ModuleNameHash))
-> (Name -> NameId) -> Name -> (Word64, ModuleNameHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NameId
nameId) (List1 Name -> NonEmpty (Word64, ModuleNameHash))
-> List1 Name -> NonEmpty (Word64, ModuleNameHash)
forall a b. (a -> b) -> a -> b
$ [Name] -> Name -> List1 Name
forall a. [a] -> a -> List1 a
List1.snoc (ModuleName -> [Name]
mnameToList (ModuleName -> [Name]) -> ModuleName -> [Name]
forall a b. (a -> b) -> a -> b
$ QName -> ModuleName
qnameModule QName
q) (QName -> Name
qnameName QName
q)
    unNameId :: NameId -> (Word64, ModuleNameHash)
unNameId (NameId Word64
n ModuleNameHash
m) = (Word64
n, ModuleNameHash
m)

-- | Turn a qualified name into a concrete name. This should only be used as a
--   fallback when looking up the right concrete name in the scope fails.
qnameToConcrete :: QName -> C.QName
qnameToConcrete :: QName -> QName
qnameToConcrete (QName ModuleName
m Name
x) =       -- Use the canonical name here (#5048)
   (Name -> QName -> QName) -> QName -> [Name] -> QName
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Name -> QName -> QName
C.Qual (Name -> QName -> QName)
-> (Name -> Name) -> Name -> QName -> QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
nameConcrete) (Name -> QName
C.QName (Name -> QName) -> Name -> QName
forall a b. (a -> b) -> a -> b
$ Name -> Name
nameCanonical Name
x) (ModuleName -> [Name]
mnameToList ModuleName
m)

mnameToConcrete :: ModuleName -> C.QName
mnameToConcrete :: ModuleName -> QName
mnameToConcrete (MName []) = QName
forall a. HasCallStack => a
__IMPOSSIBLE__ -- C.QName C.noName_  -- should never happen?
mnameToConcrete (MName (Name
x:[Name]
xs)) = (Name -> QName -> QName) -> QName -> [Name] -> QName
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Name -> QName -> QName
C.Qual (Name -> QName
C.QName (Name -> QName) -> Name -> QName
forall a b. (a -> b) -> a -> b
$ List1 Name -> Name
forall a. NonEmpty a -> a
List1.last List1 Name
cs) ([Name] -> QName) -> [Name] -> QName
forall a b. (a -> b) -> a -> b
$ List1 Name -> [Name]
forall a. NonEmpty a -> [a]
List1.init List1 Name
cs
  where
    cs :: List1 Name
cs = (Name -> Name) -> List1 Name -> List1 Name
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Name
nameConcrete (Name
x Name -> [Name] -> List1 Name
forall a. a -> [a] -> NonEmpty a
:| [Name]
xs)

qualifyM :: ModuleName -> ModuleName -> ModuleName
qualifyM :: ModuleName -> ModuleName -> ModuleName
qualifyM ModuleName
m1 ModuleName
m2 = [Name] -> ModuleName
mnameFromList ([Name] -> ModuleName) -> [Name] -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModuleName -> [Name]
mnameToList ModuleName
m1 [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ModuleName -> [Name]
mnameToList ModuleName
m2

qualifyQ :: ModuleName -> QName -> QName
qualifyQ :: ModuleName -> QName -> QName
qualifyQ ModuleName
m QName
x = List1 Name -> QName
qnameFromList (List1 Name -> QName) -> List1 Name -> QName
forall a b. (a -> b) -> a -> b
$ ModuleName -> [Name]
mnameToList ModuleName
m [Name] -> List1 Name -> List1 Name
forall a. [a] -> NonEmpty a -> NonEmpty a
`List1.prependList` QName -> List1 Name
qnameToList QName
x

qualify :: ModuleName -> Name -> QName
qualify :: ModuleName -> Name -> QName
qualify = ModuleName -> Name -> QName
QName

-- | Convert a 'Name' to a 'QName' (add no module name).
qualify_ :: Name -> QName
qualify_ :: Name -> QName
qualify_ = ModuleName -> Name -> QName
qualify ModuleName
noModuleName

-- | Is the name an operator?

isOperator :: QName -> Bool
isOperator :: QName -> Bool
isOperator = Name -> Bool
C.isOperator (Name -> Bool) -> (QName -> Name) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
nameConcrete (Name -> Name) -> (QName -> Name) -> QName -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Name
qnameName

-- | Is the first module a weak parent of the second?
isLeParentModuleOf :: ModuleName -> ModuleName -> Bool
isLeParentModuleOf :: ModuleName -> ModuleName -> Bool
isLeParentModuleOf = [Name] -> [Name] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isPrefixOf ([Name] -> [Name] -> Bool)
-> (ModuleName -> [Name]) -> ModuleName -> ModuleName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ModuleName -> [Name]
mnameToList

-- | Is the first module a proper parent of the second?
isLtParentModuleOf :: ModuleName -> ModuleName -> Bool
isLtParentModuleOf :: ModuleName -> ModuleName -> Bool
isLtParentModuleOf ModuleName
x ModuleName
y =
  Maybe [Name] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Name] -> Bool) -> Maybe [Name] -> Bool
forall a b. (a -> b) -> a -> b
$ ((Name -> Name -> Bool) -> [Name] -> [Name] -> Maybe [Name]
forall a.
(a -> a -> Bool) -> Prefix a -> Prefix a -> Maybe (Prefix a)
L.stripPrefixBy Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Name] -> [Name] -> Maybe [Name])
-> (ModuleName -> [Name])
-> ModuleName
-> ModuleName
-> Maybe [Name]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ModuleName -> [Name]
mnameToList) ModuleName
x ModuleName
y

-- | Is the first module a weak child of the second?
isLeChildModuleOf :: ModuleName -> ModuleName -> Bool
isLeChildModuleOf :: ModuleName -> ModuleName -> Bool
isLeChildModuleOf = (ModuleName -> ModuleName -> Bool)
-> ModuleName -> ModuleName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleName -> ModuleName -> Bool
isLeParentModuleOf

-- | Is the first module a proper child of the second?
isLtChildModuleOf :: ModuleName -> ModuleName -> Bool
isLtChildModuleOf :: ModuleName -> ModuleName -> Bool
isLtChildModuleOf = (ModuleName -> ModuleName -> Bool)
-> ModuleName -> ModuleName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleName -> ModuleName -> Bool
isLtParentModuleOf

isInModule :: QName -> ModuleName -> Bool
isInModule :: QName -> ModuleName -> Bool
isInModule QName
q ModuleName
m = ModuleName -> [Name]
mnameToList ModuleName
m [Name] -> [Name] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` QName -> [Name]
qnameToList0 QName
q

-- | Get the next version of the concrete name. For instance, @nextName "x" = "x₁"@.
--   The name must not be a 'NoName'.
nextName :: C.FreshNameMode -> Name -> Name
nextName :: FreshNameMode -> Name -> Name
nextName FreshNameMode
freshNameMode Name
x = Name
x { nameConcrete = C.nextName freshNameMode (nameConcrete x) }

sameRoot :: Name -> Name -> Bool
sameRoot :: Name -> Name -> Bool
sameRoot = Name -> Name -> Bool
C.sameRoot (Name -> Name -> Bool) -> (Name -> Name) -> Name -> Name -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> Name
nameConcrete

------------------------------------------------------------------------
-- * Important instances: Eq, Ord, Hashable
--
--   For the identity and comparing of names, only the 'NameId' matters!
------------------------------------------------------------------------

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

instance Ord Name where
  compare :: Name -> Name -> Ordering
compare = NameId -> NameId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (NameId -> NameId -> Ordering)
-> (Name -> NameId) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> NameId
nameId

instance Hashable Name where
  {-# INLINE hashWithSalt #-}
  hashWithSalt :: Int -> Name -> Int
hashWithSalt Int
salt = Int -> NameId -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (NameId -> Int) -> (Name -> NameId) -> Name -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NameId
nameId

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

instance Ord QName where
  compare :: QName -> QName -> Ordering
compare = Name -> Name -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Name -> Name -> Ordering)
-> (QName -> Name) -> QName -> QName -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` QName -> Name
qnameName

instance Hashable QName where
  {-# INLINE hashWithSalt #-}
  hashWithSalt :: Int -> QName -> Int
hashWithSalt Int
salt = Int -> Name -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Name -> Int) -> (QName -> Name) -> QName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Name
qnameName

------------------------------------------------------------------------
-- * IsNoName instances (checking for "_")
------------------------------------------------------------------------

-- | An abstract name is empty if its concrete name is empty.
instance IsNoName Name where
  isNoName :: Name -> Bool
isNoName = Name -> Bool
forall a. IsNoName a => a -> Bool
isNoName (Name -> Bool) -> (Name -> Name) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
nameConcrete

instance NumHoles Name where
  numHoles :: Name -> Int
numHoles = Name -> Int
forall a. NumHoles a => a -> Int
numHoles (Name -> Int) -> (Name -> Name) -> Name -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
nameConcrete

instance NumHoles QName where
  numHoles :: QName -> Int
numHoles = Name -> Int
forall a. NumHoles a => a -> Int
numHoles (Name -> Int) -> (QName -> Name) -> QName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Name
qnameName

-- | We can have an instance for ambiguous names as all share a common concrete name.
instance NumHoles AmbiguousQName where
  numHoles :: AmbiguousQName -> Int
numHoles = QName -> Int
forall a. NumHoles a => a -> Int
numHoles (QName -> Int)
-> (AmbiguousQName -> QName) -> AmbiguousQName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmbiguousQName -> QName
headAmbQ

------------------------------------------------------------------------
-- * name lenses
------------------------------------------------------------------------

lensQNameName :: Lens' QName Name
lensQNameName :: Lens' QName Name
lensQNameName Name -> f Name
f (QName ModuleName
m Name
n) = ModuleName -> Name -> QName
QName ModuleName
m (Name -> QName) -> f Name -> f QName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f Name
f Name
n

------------------------------------------------------------------------
-- * LensFixity' instances
------------------------------------------------------------------------

instance LensFixity' Name where
  lensFixity' :: Lens' Name Fixity'
lensFixity' Fixity' -> f Fixity'
f Name
n = Fixity' -> f Fixity'
f (Name -> Fixity'
nameFixity Name
n) f Fixity' -> (Fixity' -> Name) -> f Name
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> \ Fixity'
fix' -> Name
n { nameFixity = fix' }

instance LensFixity' QName where
  lensFixity' :: Lens' QName Fixity'
lensFixity' = (Name -> f Name) -> QName -> f QName
Lens' QName Name
lensQNameName ((Name -> f Name) -> QName -> f QName)
-> ((Fixity' -> f Fixity') -> Name -> f Name)
-> (Fixity' -> f Fixity')
-> QName
-> f QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fixity' -> f Fixity') -> Name -> f Name
forall a. LensFixity' a => Lens' a Fixity'
Lens' Name Fixity'
lensFixity'

------------------------------------------------------------------------
-- * LensFixity instances
------------------------------------------------------------------------

instance LensFixity Name where
  lensFixity :: Lens' Name Fixity
lensFixity = (Fixity' -> f Fixity') -> Name -> f Name
forall a. LensFixity' a => Lens' a Fixity'
Lens' Name Fixity'
lensFixity' ((Fixity' -> f Fixity') -> Name -> f Name)
-> ((Fixity -> f Fixity) -> Fixity' -> f Fixity')
-> (Fixity -> f Fixity)
-> Name
-> f Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fixity -> f Fixity) -> Fixity' -> f Fixity'
forall a. LensFixity a => Lens' a Fixity
Lens' Fixity' Fixity
lensFixity

instance LensFixity QName where
  lensFixity :: Lens' QName Fixity
lensFixity = (Fixity' -> f Fixity') -> QName -> f QName
forall a. LensFixity' a => Lens' a Fixity'
Lens' QName Fixity'
lensFixity' ((Fixity' -> f Fixity') -> QName -> f QName)
-> ((Fixity -> f Fixity) -> Fixity' -> f Fixity')
-> (Fixity -> f Fixity)
-> QName
-> f QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fixity -> f Fixity) -> Fixity' -> f Fixity'
forall a. LensFixity a => Lens' a Fixity
Lens' Fixity' Fixity
lensFixity

------------------------------------------------------------------------
-- * LensInScope instances
------------------------------------------------------------------------

instance LensInScope Name where
  lensInScope :: Lens' Name NameInScope
lensInScope NameInScope -> f NameInScope
f n :: Name
n@Name{ nameConcrete :: Name -> Name
nameConcrete = Name
x } =
    (\Name
y -> Name
n { nameConcrete = y }) (Name -> Name) -> f Name -> f Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NameInScope -> f NameInScope) -> Name -> f Name
forall a. LensInScope a => Lens' a NameInScope
Lens' Name NameInScope
lensInScope NameInScope -> f NameInScope
f Name
x

instance LensInScope QName where
  lensInScope :: Lens' QName NameInScope
lensInScope NameInScope -> f NameInScope
f q :: QName
q@QName{ qnameName :: QName -> Name
qnameName = Name
n } =
    (\Name
n' -> QName
q { qnameName = n' }) (Name -> QName) -> f Name -> f QName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NameInScope -> f NameInScope) -> Name -> f Name
forall a. LensInScope a => Lens' a NameInScope
Lens' Name NameInScope
lensInScope NameInScope -> f NameInScope
f Name
n

------------------------------------------------------------------------
-- * Show instances (only for debug printing!)
--
-- | Use 'prettyShow' to print names to the user.
------------------------------------------------------------------------

deriving instance Show Name
deriving instance Show ModuleName
deriving instance Show QName
deriving instance Show a => Show (QNamed a)
deriving instance Show AmbiguousQName

nameToArgName :: Name -> ArgName
nameToArgName :: Name -> [Char]
nameToArgName = ShowS
stringToArgName ShowS -> (Name -> [Char]) -> Name -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow

namedArgName :: NamedArg Name -> ArgName
namedArgName :: NamedArg Name -> [Char]
namedArgName NamedArg Name
x = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe (Name -> [Char]
nameToArgName (Name -> [Char]) -> Name -> [Char]
forall a b. (a -> b) -> a -> b
$ NamedArg Name -> Name
forall a. NamedArg a -> a
namedArg NamedArg Name
x) (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ NamedArg Name -> Maybe [Char]
forall a. (LensNamed a, NameOf a ~ NamedName) => a -> Maybe [Char]
bareNameOf NamedArg Name
x

------------------------------------------------------------------------
-- * Pretty instances
------------------------------------------------------------------------

instance Pretty Name where
  pretty :: Name -> Doc
pretty = Name -> Doc
forall a. Pretty a => a -> Doc
pretty (Name -> Doc) -> (Name -> Name) -> Name -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
nameConcrete

instance Pretty ModuleName where
  pretty :: ModuleName -> Doc
pretty = [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
hcat ([Doc] -> Doc) -> (ModuleName -> [Doc]) -> ModuleName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
"." ([Doc] -> [Doc]) -> (ModuleName -> [Doc]) -> ModuleName -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
forall a. Pretty a => a -> Doc
pretty ([Name] -> [Doc]) -> (ModuleName -> [Name]) -> ModuleName -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Name]
mnameToList

instance Pretty QName where
  pretty :: QName -> Doc
pretty = [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
hcat ([Doc] -> Doc) -> (QName -> [Doc]) -> QName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
"." ([Doc] -> [Doc]) -> (QName -> [Doc]) -> QName -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
forall a. Pretty a => a -> Doc
pretty ([Name] -> [Doc]) -> (QName -> [Name]) -> QName -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> [Name]
qnameToList0 (QName -> [Name]) -> (QName -> QName) -> QName -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> QName
useCanonical
    where
      -- #4735: When printing a fully qualified name (as done by primShowQName) we need to
      -- use the origincal concrete name, not the possibly renamed concrete name in 'nameConcrete'.
      useCanonical :: QName -> QName
useCanonical QName
q = QName
q { qnameName = (qnameName q) { nameConcrete = nameCanonical (qnameName q) } }

instance Pretty AmbiguousQName where
  pretty :: AmbiguousQName -> Doc
pretty (AmbQ List1 QName
qs) = [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
" | " ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (QName -> Doc) -> [QName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QName -> Doc
forall a. Pretty a => a -> Doc
pretty ([QName] -> [Doc]) -> [QName] -> [Doc]
forall a b. (a -> b) -> a -> b
$ List1 QName -> [Item (List1 QName)]
forall l. IsList l => l -> [Item l]
List1.toList List1 QName
qs

instance Pretty a => Pretty (QNamed a) where
  pretty :: QNamed a -> Doc
pretty (QNamed QName
a a
b) = QName -> Doc
forall a. Pretty a => a -> Doc
pretty QName
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
b

------------------------------------------------------------------------
-- * Range instances
------------------------------------------------------------------------

-- ** HasRange

instance HasRange Name where
  getRange :: Name -> Range
getRange = Name -> Range
forall a. HasRange a => a -> Range
getRange (Name -> Range) -> (Name -> Name) -> Name -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
nameConcrete

instance HasRange ModuleName where
  getRange :: ModuleName -> Range
getRange (MName []) = Range
forall a. Range' a
noRange
  getRange (MName [Name]
xs) = [Name] -> Range
forall a. HasRange a => a -> Range
getRange [Name]
xs

instance HasRange QName where
  getRange :: QName -> Range
getRange QName
q = (ModuleName, Name) -> Range
forall a. HasRange a => a -> Range
getRange (QName -> ModuleName
qnameModule QName
q, QName -> Name
qnameName QName
q)

-- | The range of an @AmbiguousQName@ is the range of any of its
--   disambiguations (they are the same concrete name).
instance HasRange AmbiguousQName where
  getRange :: AmbiguousQName -> Range
getRange (AmbQ (QName
c :| [QName]
_)) = QName -> Range
forall a. HasRange a => a -> Range
getRange QName
c

-- ** SetRange

instance SetRange Name where
  setRange :: Range -> Name -> Name
setRange Range
r Name
x = Name
x { nameConcrete = setRange r $ nameConcrete x }

instance SetRange QName where
  setRange :: Range -> QName -> QName
setRange Range
r QName
q = QName
q { qnameModule = setRange r $ qnameModule q
                   , qnameName   = setRange r $ qnameName   q
                   }

instance SetRange ModuleName where
  setRange :: Range -> ModuleName -> ModuleName
setRange Range
r (MName [Name]
ns) = [Name] -> ModuleName
MName ((Range -> Name -> Name) -> [Range] -> [Name] -> [Name]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Range -> Name -> Name
forall a. SetRange a => Range -> a -> a
setRange [Range]
rs [Name]
ns)
    where
      -- Put the range only on the last name. Otherwise
      -- we get overlapping jump-to-definition links for all
      -- the parts (See #2666).
      rs :: [Range]
rs = Int -> Range -> [Range]
forall a. Int -> a -> [a]
replicate ([Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Range
forall a. Range' a
noRange [Range] -> [Range] -> [Range]
forall a. [a] -> [a] -> [a]
++ [Range
r]

-- ** KillRange

instance KillRange Name where
  killRange :: Name -> Name
killRange (Name NameId
a Name
b Name
c Range
d Fixity'
e Bool
f) =
    ((NameId -> Name -> Name -> Range -> Fixity' -> Bool -> Name)
-> NameId -> Name -> Name -> Range -> Fixity' -> Bool -> Name
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN NameId -> Name -> Name -> Range -> Fixity' -> Bool -> Name
Name NameId
a Name
b Name
c Range
d Fixity'
e Bool
f) { nameBindingSite = d }
    -- Andreas, 2017-07-25, issue #2649
    -- Preserve the nameBindingSite for error message.
    --
    -- Older remarks:
    --
    -- Andreas, 2014-03-30
    -- An experiment: what happens if we preserve
    -- the range of the binding site, but kill all
    -- other ranges before serialization?
    --
    -- Andreas, Makoto, 2014-10-18 AIM XX
    -- Kill all ranges in signature, including nameBindingSite.

instance KillRange ModuleName where
  killRange :: ModuleName -> ModuleName
killRange (MName [Name]
xs) = [Name] -> ModuleName
MName ([Name] -> ModuleName) -> [Name] -> ModuleName
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
forall a. KillRange a => KillRangeT a
killRange [Name]
xs

instance KillRange QName where
  killRange :: QName -> QName
killRange (QName ModuleName
a Name
b) = (ModuleName -> Name -> QName) -> ModuleName -> Name -> QName
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN ModuleName -> Name -> QName
QName ModuleName
a Name
b
  -- killRange q = q { qnameModule = killRange $ qnameModule q
  --                 , qnameName   = killRange $ qnameName   q
  --                 }

instance KillRange AmbiguousQName where
  killRange :: AmbiguousQName -> AmbiguousQName
killRange (AmbQ List1 QName
xs) = List1 QName -> AmbiguousQName
AmbQ (List1 QName -> AmbiguousQName) -> List1 QName -> AmbiguousQName
forall a b. (a -> b) -> a -> b
$ List1 QName -> List1 QName
forall a. KillRange a => KillRangeT a
killRange List1 QName
xs

------------------------------------------------------------------------
-- * Sized instances
------------------------------------------------------------------------

instance Sized QName where
  size :: QName -> Int
size = List1 Name -> Int
forall a. Sized a => a -> Int
size (List1 Name -> Int) -> (QName -> List1 Name) -> QName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> List1 Name
qnameToList
  natSize :: QName -> Peano
natSize = List1 Name -> Peano
forall a. Sized a => a -> Peano
natSize (List1 Name -> Peano) -> (QName -> List1 Name) -> QName -> Peano
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> List1 Name
qnameToList

instance Sized ModuleName where
  size :: ModuleName -> Int
size = [Name] -> Int
forall a. Sized a => a -> Int
size ([Name] -> Int) -> (ModuleName -> [Name]) -> ModuleName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Name]
mnameToList
  natSize :: ModuleName -> Peano
natSize = [Name] -> Peano
forall a. Sized a => a -> Peano
natSize ([Name] -> Peano) -> (ModuleName -> [Name]) -> ModuleName -> Peano
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Name]
mnameToList

------------------------------------------------------------------------
-- * NFData instances
------------------------------------------------------------------------

-- | The range is not forced.

instance NFData Name where
  rnf :: Name -> ()
rnf (Name NameId
_ Name
a Name
b Range
_ Fixity'
c Bool
d) = (Name, Name, Fixity', Bool) -> ()
forall a. NFData a => a -> ()
rnf (Name
a, Name
b, Fixity'
c, Bool
d)

instance NFData QName where
  rnf :: QName -> ()
rnf (QName ModuleName
a Name
b) = ModuleName -> ()
forall a. NFData a => a -> ()
rnf ModuleName
a () -> () -> ()
forall a b. a -> b -> b
`seq` Name -> ()
forall a. NFData a => a -> ()
rnf Name
b

instance NFData ModuleName where
  rnf :: ModuleName -> ()
rnf (MName [Name]
a) = [Name] -> ()
forall a. NFData a => a -> ()
rnf [Name]
a