Add a warning for empty enumerations; fixes #7881

We now give a warning about enumerations like [5 .. 3] :: Int8.

compiler/deSugar/DsExpr.lhs

@@ -60,6 +60,7 @@ import FastString
 
 import Control.Monad
 import Data.Int
+import Data.Traversable (traverse)
 import Data.Typeable (typeOf)
 import Data.Word
 \end{code}
@@ -718,11 +719,24 @@ dsArithSeq :: PostTcExpr -> (ArithSeqInfo Id) -> DsM CoreExpr
 dsArithSeq expr (From from)
   = App <$> dsExpr expr <*> dsLExpr from
 dsArithSeq expr (FromTo from to)
-  = mkApps <$> dsExpr expr <*> mapM dsLExpr [from, to]
+  = do expr' <- dsExpr expr
+       from' <- dsLExpr from
+       to'   <- dsLExpr to
+       warn_empty_enumerations <- woptM Opt_WarnEmptyEnumerations
+       when warn_empty_enumerations $
+           warnAboutEmptyEnumerations from' Nothing to'
+       return $ mkApps expr' [from', to']
 dsArithSeq expr (FromThen from thn)
   = mkApps <$> dsExpr expr <*> mapM dsLExpr [from, thn]
 dsArithSeq expr (FromThenTo from thn to)
-  = mkApps <$> dsExpr expr <*> mapM dsLExpr [from, thn, to]
+  = do expr' <- dsExpr expr
+       from' <- dsLExpr from
+       thn'  <- dsLExpr thn
+       to'   <- dsLExpr to
+       warn_empty_enumerations <- woptM Opt_WarnEmptyEnumerations
+       when warn_empty_enumerations $
+           warnAboutEmptyEnumerations from' (Just thn') to'
+       return $ mkApps expr' [from', thn', to']
 \end{code}
 
 Desugar 'do' and 'mdo' expressions (NOT list comprehensions, they're
@@ -869,6 +883,45 @@ warnAboutOverflowedLiterals (App (App (App (Var f) (Type t)) _) (Lit (LitInteger
 warnAboutOverflowedLiterals _ = return ()
 \end{code}
 
+\begin{code}
+warnAboutEmptyEnumerations :: CoreExpr -> Maybe CoreExpr -> CoreExpr -> DsM ()
+warnAboutEmptyEnumerations fromExpr mThnExpr toExpr
+ | Just from <- getVal fromExpr
+ , Just mThn <- traverse getVal mThnExpr
+ , Just to   <- getVal toExpr
+ , Just t    <- getType fromExpr
+    = let check proxy
+              = let enumeration
+                        = case mThn of
+                          Nothing  -> [(fromInteger from `asTypeOf` proxy) .. fromInteger to]
+                          Just thn -> [fromInteger from, fromInteger thn   .. fromInteger to]
+                in when (null enumeration) $
+                       warnDs (ptext (sLit "Enumeration is empty"))
+
+      in if t == intTyConName    then check (undefined :: Int)
+    else if t == int8TyConName   then check (undefined :: Int8)
+    else if t == int16TyConName  then check (undefined :: Int16)
+    else if t == int32TyConName  then check (undefined :: Int32)
+    else if t == int64TyConName  then check (undefined :: Int64)
+    else if t == wordTyConName   then check (undefined :: Word)
+    else if t == word8TyConName  then check (undefined :: Word8)
+    else if t == word16TyConName then check (undefined :: Word16)
+    else if t == word32TyConName then check (undefined :: Word32)
+    else if t == word64TyConName then check (undefined :: Word64)
+    else return ()
+
+    where getVal (App (App (App (Var f) (Type _)) _) (Lit (LitInteger i _)))
+           | idName f == fromIntegerName = Just i
+          getVal _ = Nothing
+
+          getType (App (App (App (Var f) (Type t)) _) (Lit (LitInteger _ _)))
+           | idName f == fromIntegerName,
+             Just tc <- tyConAppTyCon_maybe t = Just (tyConName tc)
+          getType _ = Nothing
+
+warnAboutEmptyEnumerations _ _ _ = return ()
+\end{code}
+
 %************************************************************************
 %*                                                                      *
 \subsection{Errors and contexts}

compiler/main/DynFlags.hs

@@ -414,6 +414,7 @@ data WarningFlag =
    | Opt_WarnIncompleteUniPatterns
    | Opt_WarnIncompletePatternsRecUpd
    | Opt_WarnOverflowedLiterals
+   | Opt_WarnEmptyEnumerations
    | Opt_WarnMissingFields
    | Opt_WarnMissingImportList
    | Opt_WarnMissingMethods
@@ -2435,6 +2436,7 @@ fWarningFlags = [
   ( "warn-dodgy-exports",               Opt_WarnDodgyExports, nop ),
   ( "warn-dodgy-imports",               Opt_WarnDodgyImports, nop ),
   ( "warn-overflowed-literals",         Opt_WarnOverflowedLiterals, nop ),
+  ( "warn-empty-enumerations",          Opt_WarnEmptyEnumerations, nop ),
   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, nop ),
   ( "warn-duplicate-constraints",       Opt_WarnDuplicateConstraints, nop ),
   ( "warn-hi-shadowing",                Opt_WarnHiShadows, nop ),
@@ -2866,6 +2868,7 @@ standardWarnings
         Opt_WarnDuplicateConstraints,
         Opt_WarnDuplicateExports,
         Opt_WarnOverflowedLiterals,
+        Opt_WarnEmptyEnumerations,
         Opt_WarnMissingFields,
         Opt_WarnMissingMethods,
         Opt_WarnLazyUnliftedBindings,

docs/users_guide/using.xml

@@ -967,6 +967,7 @@ test.hs:(5,4)-(6,7):
     <option>-fwarn-duplicate-constraints</option>,
     <option>-fwarn-duplicate-exports</option>,
     <option>-fwarn-overflowed-literals</option>,
+    <option>-fwarn-empty-enumerations</option>,
     <option>-fwarn-missing-fields</option>,
     <option>-fwarn-missing-methods</option>,
     <option>-fwarn-lazy-unlifted-bindings</option>,
@@ -1225,6 +1226,18 @@ foreign import "&amp;f" f :: FunPtr t
         </listitem>
       </varlistentry>
 
+      <varlistentry>
+        <term><option>-fwarn-empty-enumerations</option>:</term>
+        <listitem>
+          <indexterm><primary><option>-fwarn-empty-enumerations</option></primary>
+          </indexterm>
+          <para>
+              Causes a warning to be emitted if an enumeration is
+              empty, e.g. <literal>[5 .. 3]</literal>.
+          </para>
+        </listitem>
+      </varlistentry>
+
       <varlistentry>
         <term><option>-fwarn-lazy-unlifted-bindings</option>:</term>
         <listitem>