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
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.State.Lazy
import Control.Monad.Writer (MonadWriter(..))

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

import Language.PureScript.AST
import Language.PureScript.Crash
import Language.PureScript.Errors
import Language.PureScript.Externs
import Language.PureScript.Linter.Imports
import Language.PureScript.Names
import Language.PureScript.Sugar.Names.Env
import Language.PureScript.Sugar.Names.Exports
import Language.PureScript.Sugar.Names.Imports
import Language.PureScript.Traversals
import Language.PureScript.Types

-- |
-- 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