From 7c6355b6dfe8bf75d530d49d73a753ff749cc774 Mon Sep 17 00:00:00 2001
From: Michael Peyton Jones <me@michaelpj.com>
Date: Mon, 8 Jul 2024 10:59:36 +0100
Subject: [PATCH] Format files in parallel

There is no explicit configuration for this, but it is possible for users to
override by changing the RTS options to the `ormolu` executable.
---
 CHANGELOG.md | 5 +++++
 app/Main.hs  | 4 +++-
 ormolu.cabal | 9 ++++++++-
 3 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 9a36e5e..4767b37 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,8 @@
+## Unreleased
+
+* Format multiple files in parallel. [Issue
+  1128](https://github.com/tweag/ormolu/issues/1128).
+
 ## Ormolu 0.7.7.0
 
 * Use single-line layout for parens around single-line content. [Issue
diff --git a/app/Main.hs b/app/Main.hs
index 2ef121e..5aaa5a4 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -33,6 +33,7 @@ import System.Directory
 import System.Exit (ExitCode (..), exitWith)
 import System.FilePath qualified as FP
 import System.IO (hPutStrLn, stderr)
+import UnliftIO.Async (pooledMapConcurrently)
 
 -- | Entry point of the program.
 main :: IO ()
@@ -53,7 +54,8 @@ main = do
             ExitSuccess -> Nothing
             ExitFailure n -> Just n
       errorCodes <-
-        mapMaybe selectFailure <$> mapM (formatOne' . Just) (sort xs)
+        mapMaybe selectFailure
+          <$> pooledMapConcurrently (formatOne' . Just) (sort xs)
       return $
         if null errorCodes
           then ExitSuccess
diff --git a/ormolu.cabal b/ormolu.cabal
index e8cbd2f..0423bb5 100644
--- a/ormolu.cabal
+++ b/ormolu.cabal
@@ -153,6 +153,14 @@ executable ormolu
     ormolu,
     text >=2.1 && <3,
     th-env >=0.1.1 && <0.2,
+    unliftio >=0.2.10 && <0.3,
+
+  -- We use parallelism so we need a threaded runtime to get any
+  -- benefit.
+  ghc-options:
+    -threaded
+    -rtsopts
+    -with-rtsopts=-N
 
   if flag(dev)
     ghc-options:
@@ -166,7 +174,6 @@ executable ormolu
     ghc-options:
       -O2
       -Wall
-      -rtsopts
 
 test-suite tests
   type: exitcode-stdio-1.0