@@ -185,13 +185,19 @@ renameInModule :: ImportEnvironment -> ExportEnvironment -> Module -> Either Str
185185renameInModule imports exports (Module mn decls exps) =
186186 Module mn <$> mapM go decls <*> pure exps
187187 where
188+ go (DataDeclaration name args dctors) =
189+ rethrowFor "data declaration" name $ DataDeclaration <$> pure name <*> pure args <*> updateAll dctors
190+ go (DataBindingGroupDeclaration decls') =
191+ DataBindingGroupDeclaration <$> mapM go decls'
192+ go (TypeSynonymDeclaration name ps ty) =
193+ rethrowFor "type synonym" name $ TypeSynonymDeclaration <$> pure name <*> pure ps <*> updateType' ty
188194 go (TypeInstanceDeclaration name cs cn ts ds) =
189− TypeInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> everywhereM (mkM updateType) ts <*> mapM go ds
195+ TypeInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> updateType' ts <*> mapM go ds
190196 go (ExternInstanceDeclaration name cs cn ts) =
191− ExternInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> everywhereM (mkM updateType) ts
197+ ExternInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> updateType' ts
192198 go (ValueDeclaration name nameKind [] Nothing val) = do
193199 val' <- everywhereWithContextM' [] (mkS bindFunctionArgs `extS` bindBinders) val
194− rethrowForDecl name $ ValueDeclaration name nameKind [] Nothing <$> updateAll val'
200+ rethrowFor "declaration" name $ ValueDeclaration name nameKind [] Nothing <$> updateAll val'
195201 where
196202 bindFunctionArgs bound (Abs (Left arg) val') = return (arg : bound, Abs (Left arg) val')
197203 bindFunctionArgs bound (Let ds val') = let args = map letBoundVariable ds in
@@ -212,10 +218,15 @@ renameInModule imports exports (Module mn decls exps) =
212218 letBoundVariable (ValueDeclaration ident _ _ _ _) = ident
213219 letBoundVariable _ = error "Invalid argument to letBoundVariable"
214220 go (ValueDeclaration name _ _ _ _) = error $ "Binders should have been desugared in " ++ show name
221+ go (ExternDeclaration fit name js ty) =
222+ rethrowFor "declaration" name $ ExternDeclaration <$> pure fit <*> pure name <*> pure js <*> updateType' ty
223+ go (BindingGroupDeclaration decls') = do
224+ BindingGroupDeclaration <$> mapM go' decls'
225+ where go' = \(name, nk, value) -> rethrowFor "declaration" name $ (,,) <$> pure name <*> pure nk <*> updateAll value
215226 go d = updateAll d
216227
217− rethrowForDecl :: Ident -> Either String a -> Either String a
218− rethrowForDecl name = rethrow $ "Error in declaration '" ++ show name ++ "'"
228+ rethrowFor :: (Show a) => String -> a -> Either String b -> Either String b
229+ rethrowFor what name = rethrow $ "Error in " ++ what ++ " '" ++ show name ++ "'"
219230
220231 updateAll :: Data d => d -> Either String d
221232 updateAll = everywhereM (mkM updateType `extM` updateValue `extM` updateBinder)
@@ -230,6 +241,8 @@ renameInModule imports exports (Module mn decls exps) =
230241 updateType (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym <$> updateTypeName name <*> mapM updateType tys
231242 updateType (ConstrainedType cs t) = ConstrainedType <$> updateConstraints cs <*> pure t
232243 updateType t = return t
244+ updateType' :: Data d => d -> Either String d
245+ updateType' = everywhereM (mkM updateType)
233246
234247 updateConstraints = mapM (\(name, ts) -> (,) <$> updateClassName name <*> pure ts)
235248