module Language.PureScript.Sugar.Names
  ( desugarImports
  , Env
  , externsEnv
  , primEnv
  , ImportRecord(..)
  , ImportProvenance(..)
  , Imports(..)
  , Exports(..)
  ) where

import Prelude
import Protolude (sortOn, swap, foldl')

import Control.Arrow (first, second, (&&&))
import Control.Monad (foldM, when, (>=>))
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.State.Lazy (MonadState, StateT(..), gets, modify)
import Control.Monad.Writer (MonadWriter(..))

import Data.List.NonEmpty qualified as NEL
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Map qualified as M
import Data.Set qualified as S

import Language.PureScript.AST
import Language.PureScript.Crash (internalError)
import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage, errorMessage'', nonEmpty, parU, warnAndRethrow, warnAndRethrowWithPosition)
import Language.PureScript.Externs (ExternsDeclaration(..), ExternsFile(..), ExternsImport(..))
import Language.PureScript.Linter.Imports (Name(..), UsedImports)
import Language.PureScript.Names (pattern ByNullSourcePos, Ident, OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..))
import Language.PureScript.Sugar.Names.Env (Env, Exports(..), ImportProvenance(..), ImportRecord(..), Imports(..), checkImportConflicts, nullImports, primEnv)
import Language.PureScript.Sugar.Names.Exports (findExportable, resolveExports)
import Language.PureScript.Sugar.Names.Imports (resolveImports, resolveModuleImport)
import Language.PureScript.Traversals (defS, sndM)
import Language.PureScript.Types (Constraint(..), SourceConstraint, SourceType, Type(..), everywhereOnTypesM)

-- |
-- Replaces all local names with qualified names.
--
desugarImports
  :: forall m
   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadState (Env, UsedImports) m)
  => Module
  -> m Module
desugarImports :: forall (m :: * -> *).
(MonadError MultipleErrors m, MonadWriter MultipleErrors m,
 MonadState (Env, UsedImports) m) =>
Module -> m Module
desugarImports = Module -> m Module
updateEnv forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Module -> m Module
renameInModule'
  where
  updateEnv :: Module -> m Module
  updateEnv :: Module -> m Module
updateEnv m :: Module
m@(Module SourceSpan
ss [Comment]
_ ModuleName
mn [Declaration]
_ Maybe [DeclarationRef]
refs) = do
    Exports
members <- forall (m :: * -> *).
MonadError MultipleErrors m =>
Module -> m Exports
findExportable Module
m
    Env
env' <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ModuleName
mn (SourceSpan
ss, Imports
nullImports, Exports
members) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
    (Module
m', Imports
imps) <- forall (m :: * -> *).
MonadError MultipleErrors m =>
Env -> Module -> m (Module, Imports)
resolveImports Env
env' Module
m
    Exports
exps <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return Exports
members) (forall (m :: * -> *).
(MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
Env
-> SourceSpan
-> ModuleName
-> Imports
-> Exports
-> [DeclarationRef]
-> m Exports
resolveExports Env
env' SourceSpan
ss ModuleName
mn Imports
imps Exports
members) Maybe [DeclarationRef]
refs
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ModuleName
mn (SourceSpan
ss, Imports
imps, Exports
exps)
    forall (m :: * -> *) a. Monad m => a -> m a
return Module
m'

  renameInModule' :: Module -> m Module
  renameInModule' :: Module -> m Module
renameInModule' m :: Module
m@(Module SourceSpan
_ [Comment]
_ ModuleName
mn [Declaration]
_ Maybe [DeclarationRef]
_) =
    forall e (m :: * -> *) a.
(MonadError e m, MonadWriter e m) =>
(e -> e) -> m a -> m a
warnAndRethrow (ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (ModuleName -> ErrorMessageHint
ErrorInModule ModuleName
mn)) forall a b. (a -> b) -> a -> b
$ do
      Env
env <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a, b) -> a
fst
      let (SourceSpan
_, Imports
imps, Exports
exps) = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Module is missing in renameInModule'") forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ModuleName
mn Env
env
      (Module
m', UsedImports
used) <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall k a. Map k a
M.empty forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadError MultipleErrors m, MonadWriter MultipleErrors m,
 MonadState UsedImports m) =>
Imports -> Module -> m Module
renameInModule Imports
imps Module
m
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. Semigroup a => a -> a -> a
(<>) UsedImports
used
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exports -> Module -> Module
elaborateExports Exports
exps Module
m'

-- | Create an environment from a collection of externs files
externsEnv
  :: forall m
   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)
  => Env
  -> ExternsFile
  -> m Env
externsEnv :: forall (m :: * -> *).
(MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
Env -> ExternsFile -> m Env
externsEnv Env
env ExternsFile{[DeclarationRef]
[ExternsDeclaration]
[ExternsTypeFixity]
[ExternsFixity]
[ExternsImport]
Text
SourceSpan
ModuleName
efSourceSpan :: ExternsFile -> SourceSpan
efDeclarations :: ExternsFile -> [ExternsDeclaration]
efTypeFixities :: ExternsFile -> [ExternsTypeFixity]
efFixities :: ExternsFile -> [ExternsFixity]
efImports :: ExternsFile -> [ExternsImport]
efExports :: ExternsFile -> [DeclarationRef]
efModuleName :: ExternsFile -> ModuleName
efVersion :: ExternsFile -> Text
efSourceSpan :: SourceSpan
efDeclarations :: [ExternsDeclaration]
efTypeFixities :: [ExternsTypeFixity]
efFixities :: [ExternsFixity]
efImports :: [ExternsImport]
efExports :: [DeclarationRef]
efModuleName :: ModuleName
efVersion :: Text
..} = do
  let members :: Exports
members = Exports{Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
Map (ProperName 'ClassName) ExportSource
Map (OpName 'ValueOpName) ExportSource
Map (OpName 'TypeOpName) ExportSource
Map Ident ExportSource
exportedValueOps :: Map (OpName 'ValueOpName) ExportSource
exportedValues :: Map Ident ExportSource
exportedTypeClasses :: Map (ProperName 'ClassName) ExportSource
exportedTypeOps :: Map (OpName 'TypeOpName) ExportSource
exportedTypes :: Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exportedValueOps :: Map (OpName 'ValueOpName) ExportSource
exportedValues :: Map Ident ExportSource
exportedTypeClasses :: Map (ProperName 'ClassName) ExportSource
exportedTypeOps :: Map (OpName 'TypeOpName) ExportSource
exportedTypes :: Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
..}
      env' :: Env
env' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ModuleName
efModuleName (SourceSpan
efSourceSpan, Imports
nullImports, Exports
members) Env
env
      fromEFImport :: ExternsImport
-> (ModuleName,
    [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)])
fromEFImport (ExternsImport ModuleName
mn ImportDeclarationType
mt Maybe ModuleName
qmn) = (ModuleName
mn, [(SourceSpan
efSourceSpan, forall a. a -> Maybe a
Just ImportDeclarationType
mt, Maybe ModuleName
qmn)])
  Imports
imps <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall (m :: * -> *).
MonadError MultipleErrors m =>
Env
-> Imports
-> (ModuleName,
    [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)])
-> m Imports
resolveModuleImport Env
env') Imports
nullImports (forall a b. (a -> b) -> [a] -> [b]
map ExternsImport
-> (ModuleName,
    [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)])
fromEFImport [ExternsImport]
efImports)
  Exports
exps <- forall (m :: * -> *).
(MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
Env
-> SourceSpan
-> ModuleName
-> Imports
-> Exports
-> [DeclarationRef]
-> m Exports
resolveExports Env
env' SourceSpan
efSourceSpan ModuleName
efModuleName Imports
imps Exports
members [DeclarationRef]
efExports
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ModuleName
efModuleName (SourceSpan
efSourceSpan, Imports
imps, Exports
exps) Env
env
  where

  -- An ExportSource for declarations local to the module which the given
  -- ExternsFile corresponds to.
  localExportSource :: ExportSource
localExportSource =
    ExportSource { exportSourceDefinedIn :: ModuleName
exportSourceDefinedIn = ModuleName
efModuleName
                  , exportSourceImportedFrom :: Maybe ModuleName
exportSourceImportedFrom = forall a. Maybe a
Nothing
                  }

  exportedTypes :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ExportSource)
  exportedTypes :: Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exportedTypes = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef
-> Maybe
     (ProperName 'TypeName,
      ([ProperName 'ConstructorName], ExportSource))
toExportedType [DeclarationRef]
efExports
    where
    toExportedType :: DeclarationRef
-> Maybe
     (ProperName 'TypeName,
      ([ProperName 'ConstructorName], ExportSource))
toExportedType (TypeRef SourceSpan
_ ProperName 'TypeName
tyCon Maybe [ProperName 'ConstructorName]
dctors) = forall a. a -> Maybe a
Just (ProperName 'TypeName
tyCon, (forall a. a -> Maybe a -> a
fromMaybe (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ExternsDeclaration -> Maybe (ProperName 'ConstructorName)
forTyCon [ExternsDeclaration]
efDeclarations) Maybe [ProperName 'ConstructorName]
dctors, ExportSource
localExportSource))
      where
      forTyCon :: ExternsDeclaration -> Maybe (ProperName 'ConstructorName)
      forTyCon :: ExternsDeclaration -> Maybe (ProperName 'ConstructorName)
forTyCon (EDDataConstructor ProperName 'ConstructorName
pn DataDeclType
_ ProperName 'TypeName
tNm SourceType
_ [Ident]
_) | ProperName 'TypeName
tNm forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
tyCon = forall a. a -> Maybe a
Just ProperName 'ConstructorName
pn
      forTyCon ExternsDeclaration
_ = forall a. Maybe a
Nothing
    toExportedType DeclarationRef
_ = forall a. Maybe a
Nothing

  exportedTypeOps :: M.Map (OpName 'TypeOpName) ExportSource
  exportedTypeOps :: Map (OpName 'TypeOpName) ExportSource
exportedTypeOps = forall a.
Ord a =>
(DeclarationRef -> Maybe a) -> Map a ExportSource
exportedRefs DeclarationRef -> Maybe (OpName 'TypeOpName)
getTypeOpRef

  exportedTypeClasses :: M.Map (ProperName 'ClassName) ExportSource
  exportedTypeClasses :: Map (ProperName 'ClassName) ExportSource
exportedTypeClasses = forall a.
Ord a =>
(DeclarationRef -> Maybe a) -> Map a ExportSource
exportedRefs DeclarationRef -> Maybe (ProperName 'ClassName)
getTypeClassRef

  exportedValues :: M.Map Ident ExportSource
  exportedValues :: Map Ident ExportSource
exportedValues = forall a.
Ord a =>
(DeclarationRef -> Maybe a) -> Map a ExportSource
exportedRefs DeclarationRef -> Maybe Ident
getValueRef

  exportedValueOps :: M.Map (OpName 'ValueOpName) ExportSource
  exportedValueOps :: Map (OpName 'ValueOpName) ExportSource
exportedValueOps = forall a.
Ord a =>
(DeclarationRef -> Maybe a) -> Map a ExportSource
exportedRefs DeclarationRef -> Maybe (OpName 'ValueOpName)
getValueOpRef

  exportedRefs :: Ord a => (DeclarationRef -> Maybe a) -> M.Map a ExportSource
  exportedRefs :: forall a.
Ord a =>
(DeclarationRef -> Maybe a) -> Map a ExportSource
exportedRefs DeclarationRef -> Maybe a
f =
    forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ (, ExportSource
localExportSource) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef -> Maybe a
f [DeclarationRef]
efExports

-- |
-- Make all exports for a module explicit. This may still affect modules that
-- have an exports list, as it will also make all data constructor exports
-- explicit.
--
-- The exports will appear in the same order as they do in the existing exports
-- list, or if there is no export list, declarations are order based on their
-- order of appearance in the module.
--
elaborateExports :: Exports -> Module -> Module
elaborateExports :: Exports -> Module -> Module
elaborateExports Exports
exps (Module SourceSpan
ss [Comment]
coms ModuleName
mn [Declaration]
decls Maybe [DeclarationRef]
refs) =
  SourceSpan
-> [Comment]
-> ModuleName
-> [Declaration]
-> Maybe [DeclarationRef]
-> Module
Module SourceSpan
ss [Comment]
coms ModuleName
mn [Declaration]
decls forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Declaration]
-> Maybe [DeclarationRef] -> [DeclarationRef] -> [DeclarationRef]
reorderExports [Declaration]
decls Maybe [DeclarationRef]
refs
    forall a b. (a -> b) -> a -> b
$ [DeclarationRef]
elaboratedTypeRefs
    forall a. [a] -> [a] -> [a]
++ forall a.
(a -> DeclarationRef)
-> (Exports -> Map a ExportSource) -> [DeclarationRef]
go (SourceSpan -> OpName 'TypeOpName -> DeclarationRef
TypeOpRef SourceSpan
ss) Exports -> Map (OpName 'TypeOpName) ExportSource
exportedTypeOps
    forall a. [a] -> [a] -> [a]
++ forall a.
(a -> DeclarationRef)
-> (Exports -> Map a ExportSource) -> [DeclarationRef]
go (SourceSpan -> ProperName 'ClassName -> DeclarationRef
TypeClassRef SourceSpan
ss) Exports -> Map (ProperName 'ClassName) ExportSource
exportedTypeClasses
    forall a. [a] -> [a] -> [a]
++ forall a.
(a -> DeclarationRef)
-> (Exports -> Map a ExportSource) -> [DeclarationRef]
go (SourceSpan -> Ident -> DeclarationRef
ValueRef SourceSpan
ss) Exports -> Map Ident ExportSource
exportedValues
    forall a. [a] -> [a] -> [a]
++ forall a.
(a -> DeclarationRef)
-> (Exports -> Map a ExportSource) -> [DeclarationRef]
go (SourceSpan -> OpName 'ValueOpName -> DeclarationRef
ValueOpRef SourceSpan
ss) Exports -> Map (OpName 'ValueOpName) ExportSource
exportedValueOps
    forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. (a -> Bool) -> [a] -> [a]
filter DeclarationRef -> Bool
isModuleRef) Maybe [DeclarationRef]
refs
  where

  elaboratedTypeRefs :: [DeclarationRef]
  elaboratedTypeRefs :: [DeclarationRef]
elaboratedTypeRefs =
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall k a. Map k a -> [(k, a)]
M.toList (Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes Exports
exps)) forall a b. (a -> b) -> a -> b
$ \(ProperName 'TypeName
tctor, ([ProperName 'ConstructorName]
dctors, ExportSource
src)) ->
      let ref :: DeclarationRef
ref = SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
TypeRef SourceSpan
ss ProperName 'TypeName
tctor (forall a. a -> Maybe a
Just [ProperName 'ConstructorName]
dctors)
      in if ModuleName
mn forall a. Eq a => a -> a -> Bool
== ExportSource -> ModuleName
exportSourceDefinedIn ExportSource
src then DeclarationRef
ref else SourceSpan -> ExportSource -> DeclarationRef -> DeclarationRef
ReExportRef SourceSpan
ss ExportSource
src DeclarationRef
ref

  go :: (a -> DeclarationRef) -> (Exports -> M.Map a ExportSource) -> [DeclarationRef]
  go :: forall a.
(a -> DeclarationRef)
-> (Exports -> Map a ExportSource) -> [DeclarationRef]
go a -> DeclarationRef
toRef Exports -> Map a ExportSource
select =
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall k a. Map k a -> [(k, a)]
M.toList (Exports -> Map a ExportSource
select Exports
exps)) forall a b. (a -> b) -> a -> b
$ \(a
export, ExportSource
src) ->
      if ModuleName
mn forall a. Eq a => a -> a -> Bool
== ExportSource -> ModuleName
exportSourceDefinedIn ExportSource
src then a -> DeclarationRef
toRef a
export else SourceSpan -> ExportSource -> DeclarationRef -> DeclarationRef
ReExportRef SourceSpan
ss ExportSource
src (a -> DeclarationRef
toRef a
export)

-- |
-- Given a list of declarations, an original exports list, and an elaborated
-- exports list, reorder the elaborated list so that it matches the original
-- order. If there is no original exports list, reorder declarations based on
-- their order in the source file.
reorderExports :: [Declaration] -> Maybe [DeclarationRef] -> [DeclarationRef] -> [DeclarationRef]
reorderExports :: [Declaration]
-> Maybe [DeclarationRef] -> [DeclarationRef] -> [DeclarationRef]
reorderExports [Declaration]
decls Maybe [DeclarationRef]
originalRefs =
  forall o a. Ord o => (a -> o) -> [a] -> [a]
sortOn DeclarationRef -> Maybe Int
originalIndex
  where
  names :: [Name]
names =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Declaration -> Maybe Name
declName [Declaration]
decls) (forall a b. (a -> b) -> [a] -> [b]
map DeclarationRef -> Name
declRefName) Maybe [DeclarationRef]
originalRefs
  namesMap :: Map Name Int
namesMap =
    forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
names [(Int
0::Int)..]
  originalIndex :: DeclarationRef -> Maybe Int
originalIndex DeclarationRef
ref =
    forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (DeclarationRef -> Name
declRefName DeclarationRef
ref) Map Name Int
namesMap

-- |
-- Replaces all local names with qualified names within a module and checks that all existing
-- qualified names are valid.
--
renameInModule
  :: forall m
   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadState UsedImports m)
  => Imports
  -> Module
  -> m Module
renameInModule :: forall (m :: * -> *).
(MonadError MultipleErrors m, MonadWriter MultipleErrors m,
 MonadState UsedImports m) =>
Imports -> Module -> m Module
renameInModule Imports
imports (Module SourceSpan
modSS [Comment]
coms ModuleName
mn [Declaration]
decls Maybe [DeclarationRef]
exps) =
  SourceSpan
-> [Comment]
-> ModuleName
-> [Declaration]
-> Maybe [DeclarationRef]
-> Module
Module SourceSpan
modSS [Comment]
coms ModuleName
mn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
MonadError MultipleErrors m =>
[a] -> (a -> m b) -> m [b]
parU [Declaration]
decls Declaration -> m Declaration
go forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [DeclarationRef]
exps
  where

  (Declaration -> m Declaration
go, Expr -> m Expr
_, Binder -> m Binder
_, CaseAlternative -> m CaseAlternative
_, DoNotationElement -> m DoNotationElement
_, Guard -> m Guard
_) =
    forall (m :: * -> *) s.
Monad m =>
s
-> (s -> Declaration -> m (s, Declaration))
-> (s -> Expr -> m (s, Expr))
-> (s -> Binder -> m (s, Binder))
-> (s -> CaseAlternative -> m (s, CaseAlternative))
-> (s -> DoNotationElement -> m (s, DoNotationElement))
-> (s -> Guard -> m (s, Guard))
-> (Declaration -> m Declaration, Expr -> m Expr,
    Binder -> m Binder, CaseAlternative -> m CaseAlternative,
    DoNotationElement -> m DoNotationElement, Guard -> m Guard)
everywhereWithContextOnValuesM
      (SourceSpan
modSS, forall k a. Map k a
M.empty)
      (\(SourceSpan
_, Map Ident SourcePos
bound) Declaration
d -> (\(Map Ident SourcePos
bound', Declaration
d') -> ((Declaration -> SourceSpan
declSourceSpan Declaration
d', Map Ident SourcePos
bound'), Declaration
d')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Ident SourcePos
-> Declaration -> m (Map Ident SourcePos, Declaration)
updateDecl Map Ident SourcePos
bound Declaration
d)
      (SourceSpan, Map Ident SourcePos)
-> Expr -> m ((SourceSpan, Map Ident SourcePos), Expr)
updateValue
      (SourceSpan, Map Ident SourcePos)
-> Binder -> m ((SourceSpan, Map Ident SourcePos), Binder)
updateBinder
      (SourceSpan, Map Ident SourcePos)
-> CaseAlternative
-> m ((SourceSpan, Map Ident SourcePos), CaseAlternative)
updateCase
      forall (m :: * -> *) st val. Monad m => st -> val -> m (st, val)
defS
      (SourceSpan, Map Ident SourcePos)
-> Guard -> m ((SourceSpan, Map Ident SourcePos), Guard)
updateGuard

  updateDecl
    :: M.Map Ident SourcePos
    -> Declaration
    -> m (M.Map Ident SourcePos, Declaration)
  updateDecl :: Map Ident SourcePos
-> Declaration -> m (Map Ident SourcePos, Declaration)
updateDecl Map Ident SourcePos
bound (DataDeclaration SourceAnn
sa DataDeclType
dtype ProperName 'TypeName
name [(Text, Maybe SourceType)]
args [DataConstructorDeclaration]
dctors) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Ident SourcePos
bound,) forall a b. (a -> b) -> a -> b
$
      SourceAnn
-> DataDeclType
-> ProperName 'TypeName
-> [(Text, Maybe SourceType)]
-> [DataConstructorDeclaration]
-> Declaration
DataDeclaration SourceAnn
sa DataDeclType
dtype ProperName 'TypeName
name
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (g :: * -> *) a.
(Traversable f, Traversable g) =>
f (a, g SourceType) -> m (f (a, g SourceType))
updateTypeArguments [(Text, Maybe SourceType)]
args
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
Monad m =>
([(Ident, SourceType)] -> m [(Ident, SourceType)])
-> DataConstructorDeclaration -> m DataConstructorDeclaration
traverseDataCtorFields (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) b c a.
Functor f =>
(b -> f c) -> (a, b) -> f (a, c)
sndM SourceType -> m SourceType
updateTypesEverywhere))) [DataConstructorDeclaration]
dctors
  updateDecl Map Ident SourcePos
bound (TypeSynonymDeclaration SourceAnn
sa ProperName 'TypeName
name [(Text, Maybe SourceType)]
ps SourceType
ty) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Ident SourcePos
bound,) forall a b. (a -> b) -> a -> b
$
      SourceAnn
-> ProperName 'TypeName
-> [(Text, Maybe SourceType)]
-> SourceType
-> Declaration
TypeSynonymDeclaration SourceAnn
sa ProperName 'TypeName
name
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (g :: * -> *) a.
(Traversable f, Traversable g) =>
f (a, g SourceType) -> m (f (a, g SourceType))
updateTypeArguments [(Text, Maybe SourceType)]
ps
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SourceType -> m SourceType
updateTypesEverywhere SourceType
ty
  updateDecl Map Ident SourcePos
bound (TypeClassDeclaration SourceAnn
sa ProperName 'ClassName
className [(Text, Maybe SourceType)]
args [SourceConstraint]
implies [FunctionalDependency]
deps [Declaration]
ds) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Ident SourcePos
bound,) forall a b. (a -> b) -> a -> b
$
      SourceAnn
-> ProperName 'ClassName
-> [(Text, Maybe SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> [Declaration]
-> Declaration
TypeClassDeclaration SourceAnn
sa ProperName 'ClassName
className
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (g :: * -> *) a.
(Traversable f, Traversable g) =>
f (a, g SourceType) -> m (f (a, g SourceType))
updateTypeArguments [(Text, Maybe SourceType)]
args
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [SourceConstraint] -> m [SourceConstraint]
updateConstraints [SourceConstraint]
implies
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [FunctionalDependency]
deps
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Declaration]
ds
  updateDecl Map Ident SourcePos
bound (TypeInstanceDeclaration SourceAnn
sa na :: SourceAnn
na@(SourceSpan
ss, [Comment]
_) ChainId
ch Integer
idx Either Text Ident
name [SourceConstraint]
cs Qualified (ProperName 'ClassName)
cn [SourceType]
ts TypeInstanceBody
ds) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Ident SourcePos
bound,) forall a b. (a -> b) -> a -> b
$
      SourceAnn
-> SourceAnn
-> ChainId
-> Integer
-> Either Text Ident
-> [SourceConstraint]
-> Qualified (ProperName 'ClassName)
-> [SourceType]
-> TypeInstanceBody
-> Declaration
TypeInstanceDeclaration SourceAnn
sa SourceAnn
na ChainId
ch Integer
idx Either Text Ident
name
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SourceConstraint] -> m [SourceConstraint]
updateConstraints [SourceConstraint]
cs
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Qualified (ProperName 'ClassName)
-> SourceSpan -> m (Qualified (ProperName 'ClassName))
updateClassName Qualified (ProperName 'ClassName)
cn SourceSpan
ss
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SourceType -> m SourceType
updateTypesEverywhere [SourceType]
ts
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeInstanceBody
ds
  updateDecl Map Ident SourcePos
bound (KindDeclaration SourceAnn
sa KindSignatureFor
kindFor ProperName 'TypeName
name SourceType
ty) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Ident SourcePos
bound,) forall a b. (a -> b) -> a -> b
$
      SourceAnn
-> KindSignatureFor
-> ProperName 'TypeName
-> SourceType
-> Declaration
KindDeclaration SourceAnn
sa KindSignatureFor
kindFor ProperName 'TypeName
name
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceType -> m SourceType
updateTypesEverywhere SourceType
ty
  updateDecl Map Ident SourcePos
bound (TypeDeclaration (TypeDeclarationData SourceAnn
sa Ident
name SourceType
ty)) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Ident SourcePos
bound,) forall a b. (a -> b) -> a -> b
$
      TypeDeclarationData -> Declaration
TypeDeclaration forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceAnn -> Ident -> SourceType -> TypeDeclarationData
TypeDeclarationData SourceAnn
sa Ident
name
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceType -> m SourceType
updateTypesEverywhere SourceType
ty
  updateDecl Map Ident SourcePos
bound (ExternDeclaration SourceAnn
sa Ident
name SourceType
ty) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Ident
name (SourceSpan -> SourcePos
spanStart forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst SourceAnn
sa) Map Ident SourcePos
bound,) forall a b. (a -> b) -> a -> b
$
      SourceAnn -> Ident -> SourceType -> Declaration
ExternDeclaration SourceAnn
sa Ident
name
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceType -> m SourceType
updateTypesEverywhere SourceType
ty
  updateDecl Map Ident SourcePos
bound (ExternDataDeclaration SourceAnn
sa ProperName 'TypeName
name SourceType
ki) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Ident SourcePos
bound,) forall a b. (a -> b) -> a -> b
$
      SourceAnn -> ProperName 'TypeName -> SourceType -> Declaration
ExternDataDeclaration SourceAnn
sa ProperName 'TypeName
name
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceType -> m SourceType
updateTypesEverywhere SourceType
ki
  updateDecl Map Ident SourcePos
bound (TypeFixityDeclaration sa :: SourceAnn
sa@(SourceSpan
ss, [Comment]
_) Fixity
fixity Qualified (ProperName 'TypeName)
alias OpName 'TypeOpName
op) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Ident SourcePos
bound,) forall a b. (a -> b) -> a -> b
$
      SourceAnn
-> Fixity
-> Qualified (ProperName 'TypeName)
-> OpName 'TypeOpName
-> Declaration
TypeFixityDeclaration SourceAnn
sa Fixity
fixity
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'TypeName)
-> SourceSpan -> m (Qualified (ProperName 'TypeName))
updateTypeName Qualified (ProperName 'TypeName)
alias SourceSpan
ss
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure OpName 'TypeOpName
op
  updateDecl Map Ident SourcePos
bound (ValueFixityDeclaration sa :: SourceAnn
sa@(SourceSpan
ss, [Comment]
_) Fixity
fixity (Qualified QualifiedBy
mn' (Left Ident
alias)) OpName 'ValueOpName
op) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Ident SourcePos
bound,) forall a b. (a -> b) -> a -> b
$
      SourceAnn
-> Fixity
-> Qualified (Either Ident (ProperName 'ConstructorName))
-> OpName 'ValueOpName
-> Declaration
ValueFixityDeclaration SourceAnn
sa Fixity
fixity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified Ident -> SourceSpan -> m (Qualified Ident)
updateValueName (forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
mn' Ident
alias) SourceSpan
ss
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure OpName 'ValueOpName
op
  updateDecl Map Ident SourcePos
bound (ValueFixityDeclaration sa :: SourceAnn
sa@(SourceSpan
ss, [Comment]
_) Fixity
fixity (Qualified QualifiedBy
mn' (Right ProperName 'ConstructorName
alias)) OpName 'ValueOpName
op) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Ident SourcePos
bound,) forall a b. (a -> b) -> a -> b
$
      SourceAnn
-> Fixity
-> Qualified (Either Ident (ProperName 'ConstructorName))
-> OpName 'ValueOpName
-> Declaration
ValueFixityDeclaration SourceAnn
sa Fixity
fixity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'ConstructorName)
-> SourceSpan -> m (Qualified (ProperName 'ConstructorName))
updateDataConstructorName (forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
mn' ProperName 'ConstructorName
alias) SourceSpan
ss
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure OpName 'ValueOpName
op
  updateDecl Map Ident SourcePos
b Declaration
d =
    forall (m :: * -> *) a. Monad m => a -> m a
return (Map Ident SourcePos
b, Declaration
d)

  updateValue
    :: (SourceSpan, M.Map Ident SourcePos)
    -> Expr
    -> m ((SourceSpan, M.Map Ident SourcePos), Expr)
  updateValue :: (SourceSpan, Map Ident SourcePos)
-> Expr -> m ((SourceSpan, Map Ident SourcePos), Expr)
updateValue (SourceSpan
_, Map Ident SourcePos
bound) v :: Expr
v@(PositionedValue SourceSpan
pos' [Comment]
_ Expr
_) =
    forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan
pos', Map Ident SourcePos
bound), Expr
v)
  updateValue (SourceSpan
pos, Map Ident SourcePos
bound) (Abs (VarBinder SourceSpan
ss Ident
arg) Expr
val') =
    forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan
pos, forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Ident
arg (SourceSpan -> SourcePos
spanStart SourceSpan
ss) Map Ident SourcePos
bound), Binder -> Expr -> Expr
Abs (SourceSpan -> Ident -> Binder
VarBinder SourceSpan
ss Ident
arg) Expr
val')
  updateValue (SourceSpan
pos, Map Ident SourcePos
bound) (Let WhereProvenance
w [Declaration]
ds Expr
val') = do
    let
      args :: [(Ident, SourceSpan)]
args = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Declaration -> Maybe (Ident, SourceSpan)
letBoundVariable [Declaration]
ds
      groupByFst :: [(Ident, b)] -> [(Ident, NonEmpty b)]
groupByFst = forall a b. (a -> b) -> [a] -> [b]
map (\NonEmpty (Ident, b)
ts -> (forall a b. (a, b) -> a
fst (forall a. NonEmpty a -> a
NEL.head NonEmpty (Ident, b)
ts), forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Ident, b)
ts)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
NEL.groupAllWith forall a b. (a, b) -> a
fst
      duplicateArgsErrs :: MultipleErrors
duplicateArgsErrs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Ident, NonEmpty SourceSpan) -> MultipleErrors
mkArgError forall a b. (a -> b) -> a -> b
$ forall {b}. [(Ident, b)] -> [(Ident, NonEmpty b)]
groupByFst [(Ident, SourceSpan)]
args
      mkArgError :: (Ident, NonEmpty SourceSpan) -> MultipleErrors
mkArgError (Ident
ident, NonEmpty SourceSpan
poses)
        | forall a. NonEmpty a -> Int
NEL.length NonEmpty SourceSpan
poses forall a. Ord a => a -> a -> Bool
< Int
2 = forall a. Monoid a => a
mempty
        | Bool
otherwise = NonEmpty SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage'' (forall a. NonEmpty a -> NonEmpty a
NEL.reverse NonEmpty SourceSpan
poses) (Ident -> SimpleErrorMessage
OverlappingNamesInLet Ident
ident)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MultipleErrors -> Bool
nonEmpty MultipleErrors
duplicateArgsErrs) forall a b. (a -> b) -> a -> b
$
      forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MultipleErrors
duplicateArgsErrs
    forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan
pos, [Declaration] -> Map Ident SourcePos
declarationsToMap [Declaration]
ds forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map Ident SourcePos
bound), WhereProvenance -> [Declaration] -> Expr -> Expr
Let WhereProvenance
w [Declaration]
ds Expr
val')
  updateValue (SourceSpan
_, Map Ident SourcePos
bound) (Var SourceSpan
ss name' :: Qualified Ident
name'@(Qualified QualifiedBy
qualifiedBy Ident
ident)) =
    ((SourceSpan
ss, Map Ident SourcePos
bound), ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Ident
ident Map Ident SourcePos
bound, QualifiedBy
qualifiedBy) of
      -- bound idents that have yet to be locally qualified.
      (Just SourcePos
sourcePos, QualifiedBy
ByNullSourcePos) ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SourceSpan -> Qualified Ident -> Expr
Var SourceSpan
ss (forall a. QualifiedBy -> a -> Qualified a
Qualified (SourcePos -> QualifiedBy
BySourcePos SourcePos
sourcePos) Ident
ident)
      -- unbound idents are likely import unqualified imports, so we
      -- handle them through updateValueName if they don't exist as a
      -- local binding.
      (Maybe SourcePos
Nothing, QualifiedBy
ByNullSourcePos) ->
        SourceSpan -> Qualified Ident -> Expr
Var SourceSpan
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified Ident -> SourceSpan -> m (Qualified Ident)
updateValueName Qualified Ident
name' SourceSpan
ss
      -- bound/unbound idents with explicit qualification is still
      -- handled through updateValueName, as it fully resolves the
      -- ModuleName.
      (Maybe SourcePos
_, ByModuleName ModuleName
_) ->
        SourceSpan -> Qualified Ident -> Expr
Var SourceSpan
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified Ident -> SourceSpan -> m (Qualified Ident)
updateValueName Qualified Ident
name' SourceSpan
ss
      -- encountering non-null source spans may be a bug in previous
      -- desugaring steps or with the AST traversals.
      (Maybe SourcePos
_, BySourcePos SourcePos
_) ->
        forall a. HasCallStack => String -> a
internalError String
"updateValue: ident is locally-qualified by a non-null source position"
  updateValue (SourceSpan
_, Map Ident SourcePos
bound) (Op SourceSpan
ss Qualified (OpName 'ValueOpName)
op) =
    ((SourceSpan
ss, Map Ident SourcePos
bound), ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SourceSpan -> Qualified (OpName 'ValueOpName) -> Expr
Op SourceSpan
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (OpName 'ValueOpName)
-> SourceSpan -> m (Qualified (OpName 'ValueOpName))
updateValueOpName Qualified (OpName 'ValueOpName)
op SourceSpan
ss)
  updateValue (SourceSpan
_, Map Ident SourcePos
bound) (Constructor SourceSpan
ss Qualified (ProperName 'ConstructorName)
name) =
    ((SourceSpan
ss, Map Ident SourcePos
bound), ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SourceSpan -> Qualified (ProperName 'ConstructorName) -> Expr
Constructor SourceSpan
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'ConstructorName)
-> SourceSpan -> m (Qualified (ProperName 'ConstructorName))
updateDataConstructorName Qualified (ProperName 'ConstructorName)
name SourceSpan
ss)
  updateValue (SourceSpan, Map Ident SourcePos)
s (TypedValue Bool
check Expr
val SourceType
ty) =
    ((SourceSpan, Map Ident SourcePos)
s, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Expr -> SourceType -> Expr
TypedValue Bool
check Expr
val forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceType -> m SourceType
updateTypesEverywhere SourceType
ty)
  updateValue (SourceSpan, Map Ident SourcePos)
s Expr
v = forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan, Map Ident SourcePos)
s, Expr
v)

  updateBinder
    :: (SourceSpan, M.Map Ident SourcePos)
    -> Binder
    -> m ((SourceSpan, M.Map Ident SourcePos), Binder)
  updateBinder :: (SourceSpan, Map Ident SourcePos)
-> Binder -> m ((SourceSpan, Map Ident SourcePos), Binder)
updateBinder (SourceSpan
_, Map Ident SourcePos
bound) v :: Binder
v@(PositionedBinder SourceSpan
pos [Comment]
_ Binder
_) =
    forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan
pos, Map Ident SourcePos
bound), Binder
v)
  updateBinder (SourceSpan
_, Map Ident SourcePos
bound) (ConstructorBinder SourceSpan
ss Qualified (ProperName 'ConstructorName)
name [Binder]
b) =
    ((SourceSpan
ss, Map Ident SourcePos
bound), ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SourceSpan
-> Qualified (ProperName 'ConstructorName) -> [Binder] -> Binder
ConstructorBinder SourceSpan
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'ConstructorName)
-> SourceSpan -> m (Qualified (ProperName 'ConstructorName))
updateDataConstructorName Qualified (ProperName 'ConstructorName)
name SourceSpan
ss forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Binder]
b)
  updateBinder (SourceSpan
_, Map Ident SourcePos
bound) (OpBinder SourceSpan
ss Qualified (OpName 'ValueOpName)
op) =
    ((SourceSpan
ss, Map Ident SourcePos
bound), ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SourceSpan -> Qualified (OpName 'ValueOpName) -> Binder
OpBinder SourceSpan
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (OpName 'ValueOpName)
-> SourceSpan -> m (Qualified (OpName 'ValueOpName))
updateValueOpName Qualified (OpName 'ValueOpName)
op SourceSpan
ss)
  updateBinder (SourceSpan, Map Ident SourcePos)
s (TypedBinder SourceType
t Binder
b) = do
    SourceType
t' <- SourceType -> m SourceType
updateTypesEverywhere SourceType
t
    forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan, Map Ident SourcePos)
s, SourceType -> Binder -> Binder
TypedBinder SourceType
t' Binder
b)
  updateBinder (SourceSpan, Map Ident SourcePos)
s Binder
v =
    forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan, Map Ident SourcePos)
s, Binder
v)

  updateCase
    :: (SourceSpan, M.Map Ident SourcePos)
    -> CaseAlternative
    -> m ((SourceSpan, M.Map Ident SourcePos), CaseAlternative)
  updateCase :: (SourceSpan, Map Ident SourcePos)
-> CaseAlternative
-> m ((SourceSpan, Map Ident SourcePos), CaseAlternative)
updateCase (SourceSpan
pos, Map Ident SourcePos
bound) c :: CaseAlternative
c@(CaseAlternative [Binder]
bs [GuardedExpr]
_) =
    forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan
pos, forall {t :: * -> *} {k} {a} {a}.
(Foldable t, Ord k) =>
(a -> Map k a) -> t a -> Map k a
rUnionMap Binder -> Map Ident SourcePos
binderNamesWithSpans' [Binder]
bs forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map Ident SourcePos
bound), CaseAlternative
c)
    where
    rUnionMap :: (a -> Map k a) -> t a -> Map k a
rUnionMap a -> Map k a
f = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Map k a
f)) forall k a. Map k a
M.empty

  updateGuard
    :: (SourceSpan, M.Map Ident SourcePos)
    -> Guard
    -> m ((SourceSpan, M.Map Ident SourcePos), Guard)
  updateGuard :: (SourceSpan, Map Ident SourcePos)
-> Guard -> m ((SourceSpan, Map Ident SourcePos), Guard)
updateGuard (SourceSpan
pos, Map Ident SourcePos
bound) g :: Guard
g@(ConditionGuard Expr
_) =
    forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan
pos, Map Ident SourcePos
bound), Guard
g)
  updateGuard (SourceSpan
pos, Map Ident SourcePos
bound) g :: Guard
g@(PatternGuard Binder
b Expr
_) =
    forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceSpan
pos, Binder -> Map Ident SourcePos
binderNamesWithSpans' Binder
b forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map Ident SourcePos
bound), Guard
g)

  binderNamesWithSpans' :: Binder -> M.Map Ident SourcePos
  binderNamesWithSpans' :: Binder -> Map Ident SourcePos
binderNamesWithSpans'
    = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SourceSpan -> SourcePos
spanStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> (b, a)
swap)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binder -> [(SourceSpan, Ident)]
binderNamesWithSpans

  letBoundVariable :: Declaration -> Maybe (Ident, SourceSpan)
  letBoundVariable :: Declaration -> Maybe (Ident, SourceSpan)
letBoundVariable = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ValueDeclarationData a -> Ident
valdeclIdent forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ValueDeclarationData a -> SourceAnn
valdeclSourceAnn)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Maybe (ValueDeclarationData [GuardedExpr])
getValueDeclaration

  declarationsToMap :: [Declaration] -> M.Map Ident SourcePos
  declarationsToMap :: [Declaration] -> Map Ident SourcePos
declarationsToMap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map Ident SourcePos -> Declaration -> Map Ident SourcePos
goDTM forall k a. Map k a
M.empty
    where
      goDTM :: Map Ident SourcePos -> Declaration -> Map Ident SourcePos
goDTM Map Ident SourcePos
a (ValueDeclaration ValueDeclarationData {[Binder]
[GuardedExpr]
SourceAnn
Ident
NameKind
valdeclExpression :: forall a. ValueDeclarationData a -> a
valdeclBinders :: forall a. ValueDeclarationData a -> [Binder]
valdeclName :: forall a. ValueDeclarationData a -> NameKind
valdeclExpression :: [GuardedExpr]
valdeclBinders :: [Binder]
valdeclName :: NameKind
valdeclIdent :: Ident
valdeclSourceAnn :: SourceAnn
valdeclSourceAnn :: forall a. ValueDeclarationData a -> SourceAnn
valdeclIdent :: forall a. ValueDeclarationData a -> Ident
..}) =
        forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Ident
valdeclIdent (SourceSpan -> SourcePos
spanStart forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst SourceAnn
valdeclSourceAnn) Map Ident SourcePos
a
      goDTM Map Ident SourcePos
a Declaration
_ =
        Map Ident SourcePos
a

  updateTypeArguments
    :: (Traversable f, Traversable g)
    => f (a, g SourceType) -> m (f (a, g SourceType))
  updateTypeArguments :: forall (f :: * -> *) (g :: * -> *) a.
(Traversable f, Traversable g) =>
f (a, g SourceType) -> m (f (a, g SourceType))
updateTypeArguments = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) b c a.
Functor f =>
(b -> f c) -> (a, b) -> f (a, c)
sndM (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SourceType -> m SourceType
updateTypesEverywhere))

  updateTypesEverywhere :: SourceType -> m SourceType
  updateTypesEverywhere :: SourceType -> m SourceType
updateTypesEverywhere = forall (m :: * -> *) a.
Monad m =>
(Type a -> m (Type a)) -> Type a -> m (Type a)
everywhereOnTypesM SourceType -> m SourceType
updateType
    where
    updateType :: SourceType -> m SourceType
    updateType :: SourceType -> m SourceType
updateType (TypeOp ann :: SourceAnn
ann@(SourceSpan
ss, [Comment]
_) Qualified (OpName 'TypeOpName)
name) = forall a. a -> Qualified (OpName 'TypeOpName) -> Type a
TypeOp SourceAnn
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (OpName 'TypeOpName)
-> SourceSpan -> m (Qualified (OpName 'TypeOpName))
updateTypeOpName Qualified (OpName 'TypeOpName)
name SourceSpan
ss
    updateType (TypeConstructor ann :: SourceAnn
ann@(SourceSpan
ss, [Comment]
_) Qualified (ProperName 'TypeName)
name) = forall a. a -> Qualified (ProperName 'TypeName) -> Type a
TypeConstructor SourceAnn
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'TypeName)
-> SourceSpan -> m (Qualified (ProperName 'TypeName))
updateTypeName Qualified (ProperName 'TypeName)
name SourceSpan
ss
    updateType (ConstrainedType SourceAnn
ann SourceConstraint
c SourceType
t) = forall a. a -> Constraint a -> Type a -> Type a
ConstrainedType SourceAnn
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceConstraint -> m SourceConstraint
updateInConstraint SourceConstraint
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceType
t
    updateType SourceType
t = forall (m :: * -> *) a. Monad m => a -> m a
return SourceType
t
    updateInConstraint :: SourceConstraint -> m SourceConstraint
    updateInConstraint :: SourceConstraint -> m SourceConstraint
updateInConstraint (Constraint ann :: SourceAnn
ann@(SourceSpan
ss, [Comment]
_) Qualified (ProperName 'ClassName)
name [SourceType]
ks [SourceType]
ts Maybe ConstraintData
info) =
      forall a.
a
-> Qualified (ProperName 'ClassName)
-> [Type a]
-> [Type a]
-> Maybe ConstraintData
-> Constraint a
Constraint SourceAnn
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'ClassName)
-> SourceSpan -> m (Qualified (ProperName 'ClassName))
updateClassName Qualified (ProperName 'ClassName)
name SourceSpan
ss forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [SourceType]
ks forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [SourceType]
ts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ConstraintData
info

  updateConstraints :: [SourceConstraint] -> m [SourceConstraint]
  updateConstraints :: [SourceConstraint] -> m [SourceConstraint]
updateConstraints = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b. (a -> b) -> a -> b
$ \(Constraint ann :: SourceAnn
ann@(SourceSpan
pos, [Comment]
_) Qualified (ProperName 'ClassName)
name [SourceType]
ks [SourceType]
ts Maybe ConstraintData
info) ->
    forall a.
a
-> Qualified (ProperName 'ClassName)
-> [Type a]
-> [Type a]
-> Maybe ConstraintData
-> Constraint a
Constraint SourceAnn
ann
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'ClassName)
-> SourceSpan -> m (Qualified (ProperName 'ClassName))
updateClassName Qualified (ProperName 'ClassName)
name SourceSpan
pos
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SourceType -> m SourceType
updateTypesEverywhere [SourceType]
ks
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SourceType -> m SourceType
updateTypesEverywhere [SourceType]
ts
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ConstraintData
info

  updateTypeName
    :: Qualified (ProperName 'TypeName)
    -> SourceSpan
    -> m (Qualified (ProperName 'TypeName))
  updateTypeName :: Qualified (ProperName 'TypeName)
-> SourceSpan -> m (Qualified (ProperName 'TypeName))
updateTypeName = forall a.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> (a -> Name) -> Qualified a -> SourceSpan -> m (Qualified a)
update (Imports -> ImportMap (ProperName 'TypeName)
importedTypes Imports
imports) ProperName 'TypeName -> Name
TyName

  updateTypeOpName
    :: Qualified (OpName 'TypeOpName)
    -> SourceSpan
    -> m (Qualified (OpName 'TypeOpName))
  updateTypeOpName :: Qualified (OpName 'TypeOpName)
-> SourceSpan -> m (Qualified (OpName 'TypeOpName))
updateTypeOpName = forall a.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> (a -> Name) -> Qualified a -> SourceSpan -> m (Qualified a)
update (Imports -> ImportMap (OpName 'TypeOpName)
importedTypeOps Imports
imports) OpName 'TypeOpName -> Name
TyOpName

  updateDataConstructorName
    :: Qualified (ProperName 'ConstructorName)
    -> SourceSpan
    -> m (Qualified (ProperName 'ConstructorName))
  updateDataConstructorName :: Qualified (ProperName 'ConstructorName)
-> SourceSpan -> m (Qualified (ProperName 'ConstructorName))
updateDataConstructorName = forall a.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> (a -> Name) -> Qualified a -> SourceSpan -> m (Qualified a)
update (Imports -> ImportMap (ProperName 'ConstructorName)
importedDataConstructors Imports
imports) ProperName 'ConstructorName -> Name
DctorName

  updateClassName
    :: Qualified (ProperName 'ClassName)
    -> SourceSpan
    -> m (Qualified (ProperName 'ClassName))
  updateClassName :: Qualified (ProperName 'ClassName)
-> SourceSpan -> m (Qualified (ProperName 'ClassName))
updateClassName = forall a.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> (a -> Name) -> Qualified a -> SourceSpan -> m (Qualified a)
update (Imports -> ImportMap (ProperName 'ClassName)
importedTypeClasses Imports
imports) ProperName 'ClassName -> Name
TyClassName

  updateValueName :: Qualified Ident -> SourceSpan -> m (Qualified Ident)
  updateValueName :: Qualified Ident -> SourceSpan -> m (Qualified Ident)
updateValueName = forall a.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> (a -> Name) -> Qualified a -> SourceSpan -> m (Qualified a)
update (Imports -> ImportMap Ident
importedValues Imports
imports) Ident -> Name
IdentName

  updateValueOpName
    :: Qualified (OpName 'ValueOpName)
    -> SourceSpan
    -> m (Qualified (OpName 'ValueOpName))
  updateValueOpName :: Qualified (OpName 'ValueOpName)
-> SourceSpan -> m (Qualified (OpName 'ValueOpName))
updateValueOpName = forall a.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> (a -> Name) -> Qualified a -> SourceSpan -> m (Qualified a)
update (Imports -> ImportMap (OpName 'ValueOpName)
importedValueOps Imports
imports) OpName 'ValueOpName -> Name
ValOpName

  -- Update names so unqualified references become qualified, and locally
  -- qualified references are replaced with their canonical qualified names
  -- (e.g. M.Map -> Data.Map.Map).
  update
    :: (Ord a)
    => M.Map (Qualified a) [ImportRecord a]
    -> (a -> Name)
    -> Qualified a
    -> SourceSpan
    -> m (Qualified a)
  update :: forall a.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> (a -> Name) -> Qualified a -> SourceSpan -> m (Qualified a)
update Map (Qualified a) [ImportRecord a]
imps a -> Name
toName qname :: Qualified a
qname@(Qualified QualifiedBy
mn' a
name) SourceSpan
pos = forall (m :: * -> *) a.
(MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
SourceSpan -> m a -> m a
warnAndRethrowWithPosition SourceSpan
pos forall a b. (a -> b) -> a -> b
$
    case (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Qualified a
qname Map (Qualified a) [ImportRecord a]
imps, QualifiedBy
mn') of

      -- We found the name in our imports, so we return the name for it,
      -- qualifying with the name of the module it was originally defined in
      -- rather than the module we're importing from, to handle the case of
      -- re-exports. If there are multiple options for the name to resolve to
      -- in scope, we throw an error.
      (Just [ImportRecord a]
options, QualifiedBy
_) -> do
        (ModuleName
mnNew, ModuleName
mnOrig) <- forall (m :: * -> *) a.
(MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
SourceSpan
-> ModuleName
-> (a -> Name)
-> [ImportRecord a]
-> m (ModuleName, ModuleName)
checkImportConflicts SourceSpan
pos ModuleName
mn a -> Name
toName [ImportRecord a]
options
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \UsedImports
usedImports ->
          forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. [a] -> [a] -> [a]
(++) ModuleName
mnNew [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Name
toName Qualified a
qname] UsedImports
usedImports
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mnOrig) a
name

      -- If the name wasn't found in our imports but was qualified then we need
      -- to check whether it's a failed import from a "pseudo" module (created
      -- by qualified importing). If that's not the case, then we just need to
      -- check it refers to a symbol in another module.
      (Maybe [ImportRecord a]
Nothing, ByModuleName ModuleName
mn'') ->
        if ModuleName
mn'' forall a. Ord a => a -> Set a -> Bool
`S.member` Imports -> Set ModuleName
importedQualModules Imports
imports Bool -> Bool -> Bool
|| ModuleName
mn'' forall a. Ord a => a -> Set a -> Bool
`S.member` Imports -> Set ModuleName
importedModules Imports
imports
        then m (Qualified a)
throwUnknown
        else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleErrorMessage -> MultipleErrors
errorMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified Name -> SimpleErrorMessage
UnknownName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos forall a b. (a -> b) -> a -> b
$ ModuleName -> Name
ModName ModuleName
mn''

      -- If neither of the above cases are true then it's an undefined or
      -- unimported symbol.
      (Maybe [ImportRecord a], QualifiedBy)
_ -> m (Qualified a)
throwUnknown

    where
    throwUnknown :: m (Qualified a)
throwUnknown = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleErrorMessage -> MultipleErrors
errorMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified Name -> SimpleErrorMessage
UnknownName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Name
toName forall a b. (a -> b) -> a -> b
$ Qualified a
qname