Merge pull request #1481 from DavSanchez/plugin/ormolu_support

alanz · web-flow · commit 08e2bb0f3df9 · 2020-01-19T22:49:14.000Z
Ormolu formatter support
diff --git a/app/MainHie.hs b/app/MainHie.hs
@@ -45,6 +45,7 @@ import           Haskell.Ide.Engine.Plugin.Haddock
 import           Haskell.Ide.Engine.Plugin.HfaAlign
 import           Haskell.Ide.Engine.Plugin.HsImport
 import           Haskell.Ide.Engine.Plugin.Liquid
+import           Haskell.Ide.Engine.Plugin.Ormolu
 import           Haskell.Ide.Engine.Plugin.Package
 import           Haskell.Ide.Engine.Plugin.Pragmas
 
@@ -69,6 +70,7 @@ plugins includeExamples = pluginDescToIdePlugins allPlugins
       , floskellDescriptor    "floskell"
       , genericDescriptor     "generic"
       , ghcmodDescriptor      "ghcmod"
+      , ormoluDescriptor      "ormolu"
       ]
     examplePlugins =
       [example2Descriptor "eg2"
diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal
@@ -34,6 +34,7 @@ library
                        Haskell.Ide.Engine.Plugin.HfaAlign
                        Haskell.Ide.Engine.Plugin.HsImport
                        Haskell.Ide.Engine.Plugin.Liquid
+                       Haskell.Ide.Engine.Plugin.Ormolu
                        Haskell.Ide.Engine.Plugin.Package
                        Haskell.Ide.Engine.Plugin.Package.Compat
                        Haskell.Ide.Engine.Plugin.Pragmas
@@ -47,6 +48,7 @@ library
                        Haskell.Ide.Engine.Server
                        Haskell.Ide.Engine.Types
                        Haskell.Ide.Engine.Version
+
   other-modules:       Paths_haskell_ide_engine
   autogen-modules:     Paths_haskell_ide_engine
   build-depends:       Cabal >= 1.22
@@ -101,6 +103,8 @@ library
                      , bytestring-trie
                      , unliftio
                      , hlint >= 2.2.2
+  if impl(ghc >= 8.6)
+     build-depends: ormolu
 
   ghc-options:         -Wall -Wredundant-constraints
   if flag(pedantic)
diff --git a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+
+module Haskell.Ide.Engine.Plugin.Ormolu ( ormoluDescriptor ) where
+
+import Haskell.Ide.Engine.MonadTypes
+
+#if __GLASGOW_HASKELL__ >= 806
+import Control.Exception
+import Control.Monad.IO.Class ( liftIO , MonadIO(..) )
+import Data.Aeson ( Value ( Null ) )
+import Data.Text
+import Ormolu
+import Ormolu.Config (defaultConfig)
+import Ormolu.Exception (OrmoluException)
+import Haskell.Ide.Engine.PluginUtils
+#endif
+
+ormoluDescriptor :: PluginId -> PluginDescriptor
+ormoluDescriptor plId = PluginDescriptor
+  { pluginId                 = plId
+  , pluginName               = "Ormolu"
+  , pluginDesc               = "A formatter for Haskell source code."
+  , pluginCommands           = []
+  , pluginCodeActionProvider = Nothing
+  , pluginDiagnosticProvider = Nothing
+  , pluginHoverProvider      = Nothing
+  , pluginSymbolProvider     = Nothing
+  , pluginFormattingProvider = Just provider
+  }
+
+
+provider :: FormattingProvider
+provider _contents _uri _typ _opts =
+#if __GLASGOW_HASKELL__ >= 806
+  case _typ of 
+    FormatRange _ -> return $ IdeResultFail (IdeError PluginError (pack "Selection formatting for Ormolu is not currently supported.") Null)
+    FormatText -> pluginGetFile _contents _uri $ \file -> do
+        result <- liftIO $ try @OrmoluException (ormolu defaultConfig file (unpack _contents))
+        case result of
+          Left  err -> return $ IdeResultFail (IdeError PluginError (pack $  "ormoluCmd: " ++ show err) Null)
+          Right new -> return $ IdeResultOk [TextEdit (fullRange _contents) new]
+#else
+  return $ IdeResultOk [] -- NOP formatter
+#endif
diff --git a/stack-8.6.1.yaml b/stack-8.6.1.yaml
@@ -38,6 +38,7 @@ extra-deps:
 - monoid-subclasses-0.4.6.1
 - multistate-0.8.0.1
 - parser-combinators-1.2.1
+- ormolu-0.0.2.0
 - primes-0.2.1.0
 - resolv-0.1.1.2
 - rope-utf16-splay-0.3.1.0
diff --git a/stack-8.6.2.yaml b/stack-8.6.2.yaml
@@ -33,6 +33,7 @@ extra-deps:
 - monad-memo-0.4.1
 - multistate-0.8.0.1
 - parser-combinators-1.2.1
+- ormolu-0.0.2.0
 - rope-utf16-splay-0.3.1.0
 - strict-list-0.1.5
 - syz-0.2.0.0
diff --git a/stack-8.6.3.yaml b/stack-8.6.3.yaml
@@ -31,6 +31,7 @@ extra-deps:
 - multistate-0.8.0.1
 - optparse-simple-0.1.0
 - parser-combinators-1.2.1
+- ormolu-0.0.2.0
 - rope-utf16-splay-0.3.1.0
 - syz-0.2.0.0
 - temporary-1.2.1.1
diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml
@@ -29,6 +29,7 @@ extra-deps:
 - monad-memo-0.4.1
 - multistate-0.8.0.1
 - parser-combinators-1.2.1
+- ormolu-0.0.2.0
 - rope-utf16-splay-0.3.1.0
 - syz-0.2.0.0
 - temporary-1.2.1.1
diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml
@@ -27,6 +27,7 @@ extra-deps:
 - lsp-test-0.10.0.0
 - monad-dijkstra-0.1.1.2@rev:1
 - parser-combinators-1.2.1
+- ormolu-0.0.2.0
 - syz-0.2.0.0
 - temporary-1.2.1.1
 
diff --git a/stack.yaml b/stack.yaml
@@ -28,6 +28,7 @@ extra-deps:
 - lsp-test-0.10.0.0
 - monad-dijkstra-0.1.1.2@rev:1
 - parser-combinators-1.2.1
+- ormolu-0.0.2.0
 - syz-0.2.0.0
 - temporary-1.2.1.1
 - unix-compat-0.5.2
diff --git a/test/functional/FormatSpec.hs b/test/functional/FormatSpec.hs
@@ -92,6 +92,19 @@ spec = do
       liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0))
                                     "foo x y = do\n    print x\n    return 42\n"]
 
+  describe "ormolu" $ do
+    let formatLspConfig provider =
+          object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ]
+        
+    it "formats correctly" $ runSession hieCommand fullCaps "test/testdata" $ do
+      sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu"))
+      doc <- openDoc "Format.hs" "haskell"
+      formatDoc doc (FormattingOptions 2 True)
+      docContent <- documentContents doc
+      case ghcVersion of
+        GHC86 -> liftIO $ docContent `shouldBe` formattedOrmolu
+        _ -> liftIO $ docContent `shouldBe` unchangedOrmolu
+
 
 formattedDocTabSize2 :: T.Text
 formattedDocTabSize2 =
@@ -165,3 +178,28 @@ formattedBrittanyPostFloskell =
   \bar s = do\n\
   \  x <- return \"hello\"\n\
   \  return \"asdf\"\n\n"
+
+formattedOrmolu :: T.Text
+formattedOrmolu =
+  "module Format where\n\
+  \\n\
+  \foo :: Int -> Int\n\
+  \foo 3 = 2\n\
+  \foo x = x\n\
+  \\n\
+  \bar :: String -> IO String\n\
+  \bar s = do\n\
+  \  x <- return \"hello\"\n\
+  \  return \"asdf\"\n"
+
+unchangedOrmolu :: T.Text
+unchangedOrmolu = 
+  "module    Format where\n\
+  \foo   :: Int ->  Int\n\
+  \foo  3 = 2\n\
+  \foo    x  = x\n\
+  \bar   :: String ->   IO String\n\
+  \bar s =  do\n\
+  \      x <- return \"hello\"\n\
+  \      return \"asdf\"\n\
+  \      \n"
diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs
@@ -218,6 +218,50 @@ spec = describe "code actions" $ do
         , "        $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
         ]
       ]
+    describe "formats with ormolu" $ 
+      case ghcVersion of
+        GHC86 -> hsImportSpec "ormolu"
+          [ -- Expected output for simple format.
+            [ "import Control.Monad"
+            , "import qualified Data.Maybe"
+            , "main :: IO ()"
+            , "main = when True $ putStrLn \"hello\""
+            ]
+          , -- Use an import list and format the output.
+            [ "import Control.Monad (when)"
+            , "import qualified Data.Maybe"
+            , "main :: IO ()"
+            , "main = when True $ putStrLn \"hello\""
+            ]
+          , -- Multiple import lists, should not introduce multiple newlines.
+            [ "import System.IO (hPutStrLn, stdout)"
+            , "import Control.Monad (when)"
+            , "import Data.Maybe (fromMaybe)"
+            , "-- | Main entry point to the program"
+            , "main :: IO ()"
+            , "main ="
+            , "    when True"
+            , "        $ hPutStrLn stdout"
+            , "        $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
+            ]
+          ,  -- Complex imports for Constructos and functions
+            [ "{-# LANGUAGE NoImplicitPrelude #-}"
+            , "import System.IO (IO, hPutStrLn, stderr)"
+            , "import Prelude (Bool (..))"
+            , "import Control.Monad (when)"
+            , "import Data.Function (($))"
+            , "import Data.Maybe (Maybe (Just), fromMaybe)"
+            , "-- | Main entry point to the program"
+            , "main :: IO ()"
+            , "main ="
+            , "    when True"
+            , "        $ hPutStrLn stderr"
+            , "        $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
+            ]
+          ]
+        _ -> it "is NOP formatter" $
+          pendingWith "Ormolu only supported by GHC >= 8.6. Need to restore this."
+          
   describe "add package suggestions" $ do
     it "adds to .cabal files" $ do
       flushStackEnvironment
