Merge pull request #519 from haskell/mpj/formatting

Format with fourmolu
haskell · Aug 27, 2023 · 9b1d6ba · 9b1d6ba
2 parents f0c62df + e062a55
commit 9b1d6ba
Show file tree

Hide file tree

Showing 453 changed files with 5,891 additions and 4,599 deletions.
diff --git a/.github/workflows/format.yaml b/.github/workflows/format.yaml
@@ -0,0 +1,18 @@
+name: Format
+
+on: 
+  push:
+    branches:
+      - master
+  pull_request:
+
+jobs:
+  check-formatting:
+    runs-on: ubuntu-latest
+
+    steps:
+      - uses: actions/checkout@v3
+      - uses: cachix/install-nix-action@v22
+        with:
+          nix_path: nixpkgs=channel:nixos-unstable
+      - run: nix-shell --run "fourmolu -m check ."
diff --git a/.github/workflows/nix.yaml b/.github/workflows/nix.yaml
@@ -17,8 +17,6 @@ jobs:
 
     steps:
       - uses: actions/checkout@v3
-        with:
-          submodules: true
       - uses: cachix/install-nix-action@v22
         with:
           nix_path: nixpkgs=channel:nixos-unstable

diff --git a/fourmolu.yaml b/fourmolu.yaml
@@ -0,0 +1 @@
+indentation: 2
diff --git a/lsp-test/bench/SimpleBench.hs b/lsp-test/bench/SimpleBench.hs
@@ -1,46 +1,49 @@
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE RankNTypes #-}
+
 module Main where
 
-import Language.LSP.Server
-import qualified Language.LSP.Test as Test
-import Language.LSP.Protocol.Types
-import Language.LSP.Protocol.Message
-import Control.Monad.IO.Class
+import Control.Concurrent
 import Control.Monad
-import System.Process hiding (env)
+import Control.Monad.IO.Class
+import Data.IORef
+import Language.LSP.Protocol.Message
+import Language.LSP.Protocol.Types
+import Language.LSP.Server
+import Language.LSP.Test qualified as Test
 import System.Environment
+import System.Process hiding (env)
 import System.Time.Extra
-import Control.Concurrent
-import Data.IORef
 
 handlers :: Handlers (LspM ())
-handlers = mconcat
-  [ requestHandler SMethod_TextDocumentHover $ \req responder -> do
-      let TRequestMessage _ _ _ (HoverParams _doc pos _workDone) = req
-          Position _l _c' = pos
-          rsp = Hover ms (Just range)
-          ms = InL $ mkMarkdown "Hello world"
-          range = Range pos pos
-      responder (Right $ InL rsp)
-  , requestHandler SMethod_TextDocumentDefinition $ \req responder -> do
-      let TRequestMessage _ _ _ (DefinitionParams (TextDocumentIdentifier doc) pos _ _) = req
-      responder (Right $ InL $ Definition $ InL $ Location doc $ Range pos pos)
-  ]
+handlers =
+  mconcat
+    [ requestHandler SMethod_TextDocumentHover $ \req responder -> do
+        let TRequestMessage _ _ _ (HoverParams _doc pos _workDone) = req
+            Position _l _c' = pos
+            rsp = Hover ms (Just range)
+            ms = InL $ mkMarkdown "Hello world"
+            range = Range pos pos
+        responder (Right $ InL rsp)
+    , requestHandler SMethod_TextDocumentDefinition $ \req responder -> do
+        let TRequestMessage _ _ _ (DefinitionParams (TextDocumentIdentifier doc) pos _ _) = req
+        responder (Right $ InL $ Definition $ InL $ Location doc $ Range pos pos)
+    ]
 
 server :: ServerDefinition ()
-server = ServerDefinition
-  { parseConfig = const $ const $ Right ()
-  , onConfigChange = const  $ pure ()
-  , defaultConfig = ()
-  , configSection = "demo"
-  , doInitialize = \env _req -> pure $ Right env
-  , staticHandlers = \_caps -> handlers
-  , interpretHandler = \env -> Iso (runLspT env) liftIO
-  , options = defaultOptions
-  }
+server =
+  ServerDefinition
+    { parseConfig = const $ const $ Right ()
+    , onConfigChange = const $ pure ()
+    , defaultConfig = ()
+    , configSection = "demo"
+    , doInitialize = \env _req -> pure $ Right env
+    , staticHandlers = \_caps -> handlers
+    , interpretHandler = \env -> Iso (runLspT env) liftIO
+    , options = defaultOptions
+    }
 
 main :: IO ()
 main = do
@@ -59,13 +62,14 @@ main = do
     replicateM_ n $ do
       v <- liftIO $ readIORef i
       liftIO $ when (v `mod` 1000 == 0) $ putStrLn $ show v
-      TResponseMessage{_result=Right (InL _)} <- Test.request SMethod_TextDocumentHover $
-                                                              HoverParams (TextDocumentIdentifier $ Uri "test") (Position 1 100) Nothing
-      TResponseMessage{_result=Right (InL _)} <- Test.request SMethod_TextDocumentDefinition $
-                                                              DefinitionParams (TextDocumentIdentifier $ Uri "test") (Position 1000 100) Nothing Nothing
+      TResponseMessage{_result = Right (InL _)} <-
+        Test.request SMethod_TextDocumentHover $
+          HoverParams (TextDocumentIdentifier $ Uri "test") (Position 1 100) Nothing
+      TResponseMessage{_result = Right (InL _)} <-
+        Test.request SMethod_TextDocumentDefinition $
+          DefinitionParams (TextDocumentIdentifier $ Uri "test") (Position 1000 100) Nothing Nothing
 
-      liftIO $ modifyIORef' i (+1)
+      liftIO $ modifyIORef' i (+ 1)
       pure ()
     end <- liftIO start
     liftIO $ putStrLn $ "Completed " <> show n <> " rounds in " <> showDuration end
-
diff --git a/lsp-test/example/Test.hs b/lsp-test/example/Test.hs
@@ -1,21 +1,22 @@
 {-# LANGUAGE OverloadedStrings #-}
+
 import Control.Applicative.Combinators
 import Control.Monad.IO.Class
-import Language.LSP.Test
-import Language.LSP.Protocol.Types
 import Language.LSP.Protocol.Message
+import Language.LSP.Protocol.Types
+import Language.LSP.Test
 
 main = runSession "lsp-demo-reactor-server" fullCaps "test/data/" $ do
   doc <- openDoc "Rename.hs" "haskell"
-  
+
   -- Use your favourite favourite combinators.
   skipManyTill loggingNotification (count 1 publishDiagnosticsNotification)
 
   -- Send requests and notifications and receive responses
-  rsp <- request SMethod_TextDocumentDocumentSymbol $
-          DocumentSymbolParams Nothing Nothing doc
+  rsp <-
+    request SMethod_TextDocumentDocumentSymbol $
+      DocumentSymbolParams Nothing Nothing doc
   liftIO $ print rsp
 
   -- Or use one of the helper functions
   getDocumentSymbols doc >>= liftIO . print
-
diff --git a/lsp-test/func-test/FuncTest.hs b/lsp-test/func-test/FuncTest.hs
@@ -1,25 +1,27 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE GADTs, OverloadedStrings #-}
+
 module Main where
 
-import Language.LSP.Server
-import qualified Language.LSP.Test as Test
-import Language.LSP.Protocol.Types
-import qualified Language.LSP.Protocol.Lens as L
-import Language.LSP.Protocol.Message 
+import Colog.Core qualified as L
+import Control.Applicative.Combinators
+import Control.Exception
+import Control.Lens hiding (Iso, List)
+import Control.Monad
 import Control.Monad.IO.Class
+import Data.Maybe
+import Language.LSP.Protocol.Lens qualified as L
+import Language.LSP.Protocol.Message
+import Language.LSP.Protocol.Types
+import Language.LSP.Server
+import Language.LSP.Test qualified as Test
+import System.Exit
 import System.IO
-import Control.Monad
 import System.Process
-import Control.Applicative.Combinators
-import Control.Lens hiding (List, Iso)
 import Test.Hspec
-import Data.Maybe
 import UnliftIO
 import UnliftIO.Concurrent
-import Control.Exception
-import System.Exit
-import qualified Colog.Core as L
 
 main :: IO ()
 main = hspec $ do
@@ -28,42 +30,44 @@ main = hspec $ do
     it "sends end notification if thread is killed" $ do
       (hinRead, hinWrite) <- createPipe
       (houtRead, houtWrite) <- createPipe
-      
+
       killVar <- newEmptyMVar
 
-      let definition = ServerDefinition
-            { parseConfig = const $ const $ Right ()
-            , onConfigChange = const $ pure ()
-            , defaultConfig = ()
-            , configSection = "demo"
-            , doInitialize = \env _req -> pure $ Right env
-            , staticHandlers = \_caps -> handlers killVar
-            , interpretHandler = \env -> Iso (runLspT env) liftIO
-            , options = defaultOptions
-            }
+      let definition =
+            ServerDefinition
+              { parseConfig = const $ const $ Right ()
+              , onConfigChange = const $ pure ()
+              , defaultConfig = ()
+              , configSection = "demo"
+              , doInitialize = \env _req -> pure $ Right env
+              , staticHandlers = \_caps -> handlers killVar
+              , interpretHandler = \env -> Iso (runLspT env) liftIO
+              , options = defaultOptions
+              }
 
           handlers :: MVar () -> Handlers (LspM ())
           handlers killVar =
             notificationHandler SMethod_Initialized $ \noti -> do
               tid <- withRunInIO $ \runInIO ->
-                forkIO $ runInIO $
-                  withProgress "Doing something" NotCancellable $ \updater ->
-                    liftIO $ threadDelay (1 * 1000000)
+                forkIO $
+                  runInIO $
+                    withProgress "Doing something" NotCancellable $ \updater ->
+                      liftIO $ threadDelay (1 * 1000000)
               liftIO $ void $ forkIO $ do
                 takeMVar killVar
                 killThread tid
-      
+
       forkIO $ void $ runServerWithHandles logger (L.hoistLogAction liftIO logger) hinRead houtWrite definition
-      
+
       Test.runSessionWithHandles hinWrite houtRead Test.defaultConfig Test.fullCaps "." $ do
         -- First make sure that we get a $/progress begin notification
         skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_Progress
           guard $ has (L.params . L.value . _workDoneProgressBegin) x
-          
+
         -- Then kill the thread
         liftIO $ putMVar killVar ()
-        
+
         -- Then make sure we still get a $/progress end notification
         skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_Progress
@@ -73,58 +77,60 @@ main = hspec $ do
     it "keeps track of open workspace folders" $ do
       (hinRead, hinWrite) <- createPipe
       (houtRead, houtWrite) <- createPipe
-      
+
       countVar <- newMVar 0
 
       let wf0 = WorkspaceFolder (filePathToUri "one") "Starter workspace"
           wf1 = WorkspaceFolder (filePathToUri "/foo/bar") "My workspace"
           wf2 = WorkspaceFolder (filePathToUri "/foo/baz") "My other workspace"
-
-          definition = ServerDefinition
-            { parseConfig = const $ const $ Right ()
-            , onConfigChange = const $ pure ()
-            , defaultConfig = ()
-            , configSection = "demo"
-            , doInitialize = \env _req -> pure $ Right env
-            , staticHandlers = \_caps -> handlers
-            , interpretHandler = \env -> Iso (runLspT env) liftIO
-            , options = defaultOptions
-            }
+
+          definition =
+            ServerDefinition
+              { parseConfig = const $ const $ Right ()
+              , onConfigChange = const $ pure ()
+              , defaultConfig = ()
+              , configSection = "demo"
+              , doInitialize = \env _req -> pure $ Right env
+              , staticHandlers = \_caps -> handlers
+              , interpretHandler = \env -> Iso (runLspT env) liftIO
+              , options = defaultOptions
+              }
 
           handlers :: Handlers (LspM ())
-          handlers = mconcat
-            [ notificationHandler SMethod_Initialized $ \noti -> do
-                wfs <- fromJust <$> getWorkspaceFolders
-                liftIO $ wfs `shouldContain` [wf0]
-            , notificationHandler SMethod_WorkspaceDidChangeWorkspaceFolders $ \noti -> do
-                i <- liftIO $ modifyMVar countVar (\i -> pure (i + 1, i))
-                wfs <- fromJust <$> getWorkspaceFolders
-                liftIO $ case i of
-                  0 -> do
-                    wfs `shouldContain` [wf1]
-                    wfs `shouldContain` [wf0]
-                  1 -> do
-                    wfs `shouldNotContain` [wf1]
-                    wfs `shouldContain` [wf0]
-                    wfs `shouldContain` [wf2]
-                  _ -> error "Shouldn't be here"
-            ]
-
+          handlers =
+            mconcat
+              [ notificationHandler SMethod_Initialized $ \noti -> do
+                  wfs <- fromJust <$> getWorkspaceFolders
+                  liftIO $ wfs `shouldContain` [wf0]
+              , notificationHandler SMethod_WorkspaceDidChangeWorkspaceFolders $ \noti -> do
+                  i <- liftIO $ modifyMVar countVar (\i -> pure (i + 1, i))
+                  wfs <- fromJust <$> getWorkspaceFolders
+                  liftIO $ case i of
+                    0 -> do
+                      wfs `shouldContain` [wf1]
+                      wfs `shouldContain` [wf0]
+                    1 -> do
+                      wfs `shouldNotContain` [wf1]
+                      wfs `shouldContain` [wf0]
+                      wfs `shouldContain` [wf2]
+                    _ -> error "Shouldn't be here"
+              ]
+
       server <- async $ void $ runServerWithHandles logger (L.hoistLogAction liftIO logger) hinRead houtWrite definition
-
-      let config = Test.defaultConfig
-            { Test.initialWorkspaceFolders = Just [wf0]
-            }
-
+
+      let config =
+            Test.defaultConfig
+              { Test.initialWorkspaceFolders = Just [wf0]
+              }
+
           changeFolders add rmv =
             let ev = WorkspaceFoldersChangeEvent add rmv
                 ps = DidChangeWorkspaceFoldersParams ev
-            in Test.sendNotification SMethod_WorkspaceDidChangeWorkspaceFolders ps
+             in Test.sendNotification SMethod_WorkspaceDidChangeWorkspaceFolders ps
 
       Test.runSessionWithHandles hinWrite houtRead config Test.fullCaps "." $ do
         changeFolders [wf1] []
         changeFolders [wf2] [wf1]
 
       Left e <- waitCatch server
       fromException e `shouldBe` Just ExitSuccess
-