Parenthesize operators when exporting (haskell/ghcide#906)

* Parenthesize operators when exporting * Add tests * Only consider if the head is an operator letter
pepeiborra · Nov 13, 2020 · 81394a8 · 81394a8
1 parent d3806a3
commit 81394a8
Show file tree

Hide file tree

Showing 2 changed files with 88 additions and 2 deletions.
diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
@@ -377,6 +377,14 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul
         _ -> False
     needsComma _ _ = False
 
+    opLetter :: String
+    opLetter = ":!#$%&*+./<=>?@\\^|-~"
+
+    parenthesizeIfNeeds :: Bool -> T.Text -> T.Text
+    parenthesizeIfNeeds needsTypeKeyword x 
+      | T.head x `elem` opLetter = (if needsTypeKeyword then "type " else "") <> "(" <> x <>")"
+      | otherwise = x
+
     getLocatedRange :: Located a -> Maybe Range
     getLocatedRange = srcSpanToRange . getLoc
 
@@ -386,9 +394,9 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul
        in loc >= Just l && loc <= Just r
 
     printExport :: ExportsAs -> T.Text -> T.Text
-    printExport ExportName x = x
+    printExport ExportName x = parenthesizeIfNeeds False x
     printExport ExportPattern x = "pattern " <> x
-    printExport ExportAll x = x <> "(..)"
+    printExport ExportAll x = parenthesizeIfNeeds True x <> "(..)"
 
     isTopLevel :: Range -> Bool
     isTopLevel l = (_character . _start) l == 0

diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
@@ -2075,6 +2075,84 @@ exportUnusedTests = testGroup "export unused actions"
               [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
               , "module A (f) where"
               , "a `f` b = ()"])
+   , testSession "function operator" $ template
+        (T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "module A () where"
+              , "(<|) = ($)"])
+        (R 2 0 2 9)
+        "Export ‘<|’"
+        (Just $ T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "module A ((<|)) where"
+              , "(<|) = ($)"])
+    , testSession "type synonym operator" $ template
+        (T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "{-# LANGUAGE TypeOperators #-}"
+              , "module A () where"
+              , "type (:<) = ()"])
+        (R 3 0 3 13)
+        "Export ‘:<’"
+        (Just $ T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "{-# LANGUAGE TypeOperators #-}"
+              , "module A ((:<)) where"
+              , "type (:<) = ()"])    
+    , testSession "type family operator" $ template
+        (T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "{-# LANGUAGE TypeFamilies #-}"
+              , "{-# LANGUAGE TypeOperators #-}"
+              , "module A () where"
+              , "type family (:<)"])
+        (R 4 0 4 15)
+        "Export ‘:<’"
+        (Just $ T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "{-# LANGUAGE TypeFamilies #-}"
+              , "{-# LANGUAGE TypeOperators #-}"
+              , "module A (type (:<)(..)) where"
+              , "type family (:<)"])
+    , testSession "typeclass operator" $ template
+        (T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "{-# LANGUAGE TypeOperators #-}"
+              , "module A () where"
+              , "class (:<) a"])
+        (R 3 0 3 11)
+        "Export ‘:<’"
+        (Just $ T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "{-# LANGUAGE TypeOperators #-}"
+              , "module A (type (:<)(..)) where"
+              , "class (:<) a"])
+    , testSession "newtype operator" $ template
+        (T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "{-# LANGUAGE TypeOperators #-}"
+              , "module A () where"
+              , "newtype (:<) = Foo ()"])
+        (R 3 0 3 20)
+        "Export ‘:<’"
+        (Just $ T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "{-# LANGUAGE TypeOperators #-}"
+              , "module A (type (:<)(..)) where"
+              , "newtype (:<) = Foo ()"])
+    , testSession "data type operator" $ template
+        (T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "{-# LANGUAGE TypeOperators #-}"
+              , "module A () where"
+              , "data (:<) = Foo ()"])
+        (R 3 0 3 17)
+        "Export ‘:<’"
+        (Just $ T.unlines
+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
+              , "{-# LANGUAGE TypeOperators #-}"
+              , "module A (type (:<)(..)) where"
+              , "data (:<) = Foo ()"])
     ]
   ]
     where