[ #331 ] Haskell/Abs: no redundant imports, compiles with -Wall

BNFC · Jan 31, 2021 · a351053 · a351053
1 parent 97d335c
commit a351053
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 17 deletions.
diff --git a/source/src/BNFC/Backend/Haskell/CFtoAbstract.hs b/source/src/BNFC/Backend/Haskell/CFtoAbstract.hs
@@ -63,9 +63,12 @@ cf2Abstract Options{ lang, tokenText, generic, functor } name cf = vsep . concat
 
     -- Imports
     , [ vcat . concat $
-        [ [ text $ "import Prelude (" ++ typeImports ++ ")" ]
-        , [ text $ "import qualified Prelude as C (Eq, Ord, Show, Read" ++ functorImportsQual ++ intImport ++ maybeImports ++ ")" ]
-        , [ "import qualified Data.String" | hasIdentLike ] -- for IsString
+        [ [ text $ "import Prelude (" ++ List.intercalate ", " typeImports ++ ")"
+            | not $ null typeImports ]
+        , [ prettyList 2 "import qualified Prelude as C" "(" ")" "," $ qualifiedPreludeImports
+            | not $ null qualifiedPreludeImports ]
+        , [ "import qualified Data.String"
+            | hasIdentLike ] -- for IsString
         ]
       ]
     , [ vcat . concat $
@@ -133,25 +136,28 @@ cf2Abstract Options{ lang, tokenText, generic, functor } name cf = vsep . concat
     gen   = generic && hasData
     fun   = functor && hasData
 
+    stdClasses = [ "Eq", "Ord", "Show", "Read" ]
+    funClasses = [ "Functor", "Foldable", "Traversable" ]
+    genClasses = [ "Data", "Typeable", "Generic" ]
     derivingClasses functor = map ("C." ++) $ concat
-      [ [ "Eq", "Ord", "Show", "Read" ]
-      , when functor [ "Functor", "Foldable", "Traversable" ]
-      , when generic [ "Data", "Typeable", "Generic" ]
+      [ stdClasses
+      , when functor funClasses
+      , when generic genClasses
       ]
     derivingClassesTokenType hasPos = concat
       [ derivingClasses False
       , [ "Data.String.IsString" | not hasPos ]
       ]
-    typeImports = List.intercalate ", " [ "Char", "Double", "Integer", "String" ]
-    functorImportsQual
-      | fun       = ", Functor, Foldable, Traversable"
-      | otherwise = ""
-    intImport
-      | defPosition  = ", Int"
-      | otherwise    = ""
-    maybeImports
-      | defPosition  = ", Maybe(..)"
-      | otherwise    = ""
+    -- import Prelude (Char, Double, Integer, String)
+    typeImports =
+      filter (\ s -> hasData      && s `elem` cfgLiterals cf
+                  || hasIdentLike && tokenText == StringToken)
+        baseTokenCatNames
+    qualifiedPreludeImports = concat
+      [ [ text $ List.intercalate ", " stdClasses | hasIdentLike || hasData ]
+      , [ text $ List.intercalate ", " funClasses | fun ]
+      , [ text $ "Int, Maybe(..)" | defPosition ]
+      ]
 
 -- |
 --

diff --git a/testing/src/ParameterizedTests.hs b/testing/src/ParameterizedTests.hs
@@ -272,7 +272,8 @@ haskellParameters = baseParameters
         "-i" "Use fmap"
         -- "-i" "Unused LANGUAGE pragma"
         "."
-      tpMake
+      cmd "ghc" "-XNoImplicitPrelude" "-Wall" . (:[]) =<< findFileRegex "Abs.*\\.hs$"
+      tpMake [ "GHC_OPTS=-XNoImplicitPrelude" ]
       cmd "ghc" "-XNoImplicitPrelude" . (:[]) =<< findFileRegex "Skel.*\\.hs$"
 
   , tpRunTestProg = haskellRunTestProg