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)
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'
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
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
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)
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
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
(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)
(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
(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
(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
:: (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
(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
(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''
(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