Add deprecation warning for import qualified syntax

garyb · garyb · commit 42702e84a8a3 · 2015-11-21T18:52:30.000Z
diff --git a/psci/PSCi.hs b/psci/PSCi.hs
@@ -242,7 +242,7 @@ createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =
     P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName (importDecl `map` imports) Nothing
 
 importDecl :: ImportedModule -> P.Declaration
-importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ
+importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ False
 
 indexFile :: FilePath
 indexFile = ".psci_modules" ++ pathSeparator : "index.js"
diff --git a/psci/Parser.hs b/psci/Parser.hs
@@ -106,7 +106,9 @@ psciLet = Decls <$> (P.reserved "let" *> P.indented *> manyDecls)
 -- | Imports must be handled separately from other declarations, so that
 -- :show import works, for example.
 psciImport :: P.TokenParser Command
-psciImport = Import <$> P.parseImportDeclaration'
+psciImport = do
+  (mn, declType, asQ, _) <- P.parseImportDeclaration'
+  return $ Import (mn, declType, asQ)
 
 -- | Any other declaration that we don't need a 'special case' parser for
 -- (like let or import declarations).
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
@@ -153,8 +153,9 @@ data Declaration
   | FixityDeclaration Fixity String
   -- |
   -- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name)
+  -- TODO: also a boolean specifying whether the old `qualified` syntax was used, so a warning can be raised in desugaring (remove for 0.9)
   --
-  | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName)
+  | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName) Bool
   -- |
   -- A type class declaration (name, argument, implies, member declarations)
   --
diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs
@@ -219,7 +219,7 @@ findQualModules decls =
 -- Desugars import declarations from AST to CoreFn representation.
 --
 importToCoreFn :: A.Declaration -> Maybe ModuleName
-importToCoreFn (A.ImportDeclaration name _ _) = Just name
+importToCoreFn (A.ImportDeclaration name _ _ _) = Just name
 importToCoreFn (A.PositionedDeclaration _ _ d) = importToCoreFn d
 importToCoreFn _ = Nothing
 
diff --git a/src/Language/PureScript/Docs/ParseAndDesugar.hs b/src/Language/PureScript/Docs/ParseAndDesugar.hs
@@ -108,9 +108,9 @@ fileInfoToString (FromDep _ fn) = fn
 addDefaultImport :: P.ModuleName -> P.Module -> P.Module
 addDefaultImport toImport m@(P.Module ss coms mn decls exps)  =
   if isExistingImport `any` decls || mn == toImport then m
-  else P.Module ss coms mn (P.ImportDeclaration toImport P.Implicit Nothing : decls) exps
+  else P.Module ss coms mn (P.ImportDeclaration toImport P.Implicit Nothing False : decls) exps
   where
-  isExistingImport (P.ImportDeclaration mn' _ _) | mn' == toImport = True
+  isExistingImport (P.ImportDeclaration mn' _ _ _) | mn' == toImport = True
   isExistingImport (P.PositionedDeclaration _ _ d) = isExistingImport d
   isExistingImport _ = False
 
diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs
@@ -141,6 +141,7 @@ data SimpleErrorMessage
   | UnusedExplicitImport ModuleName [String]
   | UnusedDctorImport ProperName
   | UnusedDctorExplicitImport ProperName [ProperName]
+  | DeprecatedQualifiedSyntax ModuleName ModuleName
   deriving (Show)
 
 -- | Error message hints, providing more detailed information about failure.
@@ -275,6 +276,7 @@ errorCode em = case unwrapErrorMessage em of
   UnusedExplicitImport{} -> "UnusedExplicitImport"
   UnusedDctorImport{} -> "UnusedDctorImport"
   UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"
+  DeprecatedQualifiedSyntax{} -> "DeprecatedQualifiedSyntax"
 
 
 -- |
@@ -692,6 +694,10 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
       paras [ line $ "The import of type " ++ runProperName name ++ " includes the following unused data constructors:"
             , indent $ paras $ map (line .runProperName) names ]
 
+    renderSimpleErrorMessage (DeprecatedQualifiedSyntax name qualName) =
+      paras [ line $ "The import of type " ++ runModuleName name ++ " as " ++ runModuleName qualName ++ " uses the deprecated 'import qualified' syntax."
+            , line $ "This syntax form will be removed in PureScript 0.9." ]
+
     renderHint :: ErrorMessageHint -> Box.Box -> Box.Box
     renderHint (ErrorUnifyingTypes t1 t2) detail =
       paras [ detail
diff --git a/src/Language/PureScript/Externs.hs b/src/Language/PureScript/Externs.hs
@@ -173,7 +173,7 @@ moduleToExternsFile (Module _ _ mn ds (Just exps)) env = ExternsFile{..}
   fixityDecl _ = Nothing
 
   importDecl :: Declaration -> Maybe ExternsImport
-  importDecl (ImportDeclaration m mt qmn) = Just (ExternsImport m mt qmn)
+  importDecl (ImportDeclaration m mt qmn _) = Just (ExternsImport m mt qmn)
   importDecl (PositionedDeclaration _ _ d) = importDecl d
   importDecl _ = Nothing
 
diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs
@@ -270,9 +270,9 @@ make MakeActions{..} ms = do
 addDefaultImport :: ModuleName -> Module -> Module
 addDefaultImport toImport m@(Module ss coms mn decls exps)  =
   if isExistingImport `any` decls || mn == toImport then m
-  else Module ss coms mn (ImportDeclaration toImport Implicit Nothing : decls) exps
+  else Module ss coms mn (ImportDeclaration toImport Implicit Nothing False : decls) exps
   where
-  isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True
+  isExistingImport (ImportDeclaration mn' _ _ _) | mn' == toImport = True
   isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d
   isExistingImport _ = False
 
diff --git a/src/Language/PureScript/ModuleDependencies.hs b/src/Language/PureScript/ModuleDependencies.hs
@@ -57,7 +57,7 @@ usedModules :: Declaration -> [ModuleName]
 usedModules = let (f, _, _, _, _) = everythingOnValues (++) forDecls forValues (const []) (const []) (const []) in nub . f
   where
   forDecls :: Declaration -> [ModuleName]
-  forDecls (ImportDeclaration mn _ _) = [mn]
+  forDecls (ImportDeclaration mn _ _ _) = [mn]
   forDecls _ = []
 
   forValues :: Expr -> [ModuleName]
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
@@ -141,10 +141,10 @@ parseFixityDeclaration = do
 
 parseImportDeclaration :: TokenParser Declaration
 parseImportDeclaration = do
-  (mn, declType, asQ) <- parseImportDeclaration'
-  return $ ImportDeclaration mn declType asQ
+  (mn, declType, asQ, isOldSyntax) <- parseImportDeclaration'
+  return $ ImportDeclaration mn declType asQ isOldSyntax
 
-parseImportDeclaration' :: TokenParser (ModuleName, ImportDeclarationType, Maybe ModuleName)
+parseImportDeclaration' :: TokenParser (ModuleName, ImportDeclarationType, Maybe ModuleName, Bool)
 parseImportDeclaration' = do
   reserved "import"
   indented
@@ -154,15 +154,15 @@ parseImportDeclaration' = do
     moduleName' <- moduleName
     declType <- reserved "hiding" *> qualifyingList Hiding <|> qualifyingList Explicit
     qName <- P.optionMaybe qualifiedName
-    return (moduleName', declType, qName)
+    return (moduleName', declType, qName, False)
   qualifiedName = reserved "as" *> moduleName
   qualImport = do
     reserved "qualified"
     indented
     moduleName' <- moduleName
     declType <- qualifyingList Explicit
     qName <- qualifiedName
-    return (moduleName', declType, Just qName)
+    return (moduleName', declType, Just qName, True)
   qualifyingList expectedType = do
     idents <- P.optionMaybe $ indented *> parens (commaSep parseDeclarationRef)
     return $ fromMaybe Implicit (expectedType <$> idents)
diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs
@@ -142,7 +142,7 @@ elaborateImports imps (Module ss coms mn decls exps) = Module ss coms mn decls'
   fqValues (Var (Qualified (Just mn') _)) | mn' `notElem` importedModules imps = [mn']
   fqValues _ = []
   mkImport :: ModuleName -> Declaration
-  mkImport mn' = ImportDeclaration mn' (Explicit []) Nothing
+  mkImport mn' = ImportDeclaration mn' (Explicit []) Nothing False
 
 -- |
 -- Replaces all local names with qualified names within a module and checks that all existing
diff --git a/src/Language/PureScript/Sugar/Names/Imports.hs b/src/Language/PureScript/Sugar/Names/Imports.hs
@@ -25,7 +25,7 @@ import Prelude ()
 import Prelude.Compat
 
 import Data.List (find)
-import Data.Maybe (fromMaybe, isNothing)
+import Data.Maybe (fromMaybe, isNothing, fromJust)
 import Data.Foldable (traverse_)
 
 import Control.Arrow (first)
@@ -48,7 +48,8 @@ import Language.PureScript.Sugar.Names.Env
 findImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => [Declaration] -> m (M.Map ModuleName [(Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)])
 findImports = foldM (go Nothing) M.empty
   where
-  go pos result (ImportDeclaration mn typ qual) = do
+  go pos result (ImportDeclaration mn typ qual isOldSyntax) = do
+    when isOldSyntax . tell . errorMessage $ DeprecatedQualifiedSyntax mn (fromJust qual)
     checkImportRefType typ
     let imp = (pos, typ, qual)
     return $ M.insert mn (maybe [imp] (imp :) (mn `M.lookup` result)) result
