From 807fc423105f013bd0cf00671e58b5c7a83d0a60 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Mon, 3 May 2021 20:25:49 +0100
Subject: [PATCH 1/2] Fix progress counting

---
 ghcide/src/Development/IDE/Core/ProgressReporting.hs | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/ghcide/src/Development/IDE/Core/ProgressReporting.hs b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
index c87fa182ec..232185568a 100644
--- a/ghcide/src/Development/IDE/Core/ProgressReporting.hs
+++ b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
@@ -18,7 +18,6 @@ import           Control.Monad.Trans.Class      (lift)
 import           Data.Foldable                  (for_)
 import           Data.Functor                   (($>))
 import qualified Data.HashMap.Strict            as HMap
-import           Data.Maybe                     (isJust)
 import qualified Data.Text                      as T
 import           Data.Unique
 import           Development.IDE.GHC.Orphans    ()
@@ -76,8 +75,14 @@ data InProgress = InProgress
 recordProgress :: NormalizedFilePath -> (Int -> Int) -> InProgress -> InProgress
 recordProgress file shift InProgress{..} = case HMap.alterF alter file current of
     ((prev, new), m') ->
-        let todo' = if isJust prev then todo else todo + 1
-            done' = if new == 0 then done+1 else done
+        let (done',todo') =
+                case (prev,new) of
+                    (Nothing,0) -> (done+1, todo+1)
+                    (Nothing,_) -> (done,   todo+1)
+                    (Just 0, 0) -> (done  , todo)
+                    (Just 0, _) -> (done-1, todo)
+                    (Just _, 0) -> (done+1, todo)
+                    (Just _, _) -> (done  , todo)
         in InProgress todo' done' m'
   where
     alter x = let x' = maybe (shift 0) shift x in ((x,x'), Just x')

From ea8332ccf5b4f7e7bf9526015f3d3c8680e651e9 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Mon, 3 May 2021 21:07:39 +0100
Subject: [PATCH 2/2] tests

---
 ghcide/ghcide.cabal                           |  4 ++-
 .../Development/IDE/Core/ProgressReporting.hs |  3 ++
 ghcide/test/exe/Main.hs                       |  2 ++
 ghcide/test/exe/Progress.hs                   | 28 +++++++++++++++++++
 4 files changed, 36 insertions(+), 1 deletion(-)
 create mode 100644 ghcide/test/exe/Progress.hs

diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal
index 7a47339e7f..fb1c792053 100644
--- a/ghcide/ghcide.cabal
+++ b/ghcide/ghcide.cabal
@@ -365,7 +365,8 @@ test-suite ghcide-tests
         tasty-hunit,
         tasty-quickcheck,
         tasty-rerun,
-        text
+        text,
+        unordered-containers,
     if (impl(ghc >= 8.6))
       build-depends:
           record-dot-preprocessor,
@@ -379,6 +380,7 @@ test-suite ghcide-tests
         Development.IDE.Test.Runfiles
         Experiments
         Experiments.Types
+        Progress
     default-extensions:
         BangPatterns
         DeriveFunctor
diff --git a/ghcide/src/Development/IDE/Core/ProgressReporting.hs b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
index 232185568a..2dc567ba33 100644
--- a/ghcide/src/Development/IDE/Core/ProgressReporting.hs
+++ b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
@@ -7,6 +7,9 @@ module Development.IDE.Core.ProgressReporting
   -- utilities, reexported for use in Core.Shake
   , mRunLspT
   , mRunLspTCallback
+  -- for tests
+  , recordProgress
+  , InProgress(..)
   )
    where
 
diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
index 7bf97280bc..bd2ded83cb 100644
--- a/ghcide/test/exe/Main.hs
+++ b/ghcide/test/exe/Main.hs
@@ -101,6 +101,7 @@ import qualified Language.LSP.Types                       as LSP
 import           Data.IORef.Extra                         (atomicModifyIORef_)
 import qualified Development.IDE.Plugin.HLS.GhcIde        as Ghcide
 import           Text.Regex.TDFA                          ((=~))
+import qualified Progress
 
 waitForProgressBegin :: Session ()
 waitForProgressBegin = skipManyTill anyMessage $ satisfyMaybe $ \case
@@ -5463,6 +5464,7 @@ unitTests = do
             actualOrder <- liftIO $ readIORef orderRef
 
             liftIO $ actualOrder @?= reverse [(1::Int)..20]
+     , Progress.tests
      ]
 
 testIde :: IDE.Arguments -> Session () -> IO ()
diff --git a/ghcide/test/exe/Progress.hs b/ghcide/test/exe/Progress.hs
new file mode 100644
index 0000000000..0a6044f48e
--- /dev/null
+++ b/ghcide/test/exe/Progress.hs
@@ -0,0 +1,28 @@
+module Progress (tests) where
+
+import Development.IDE.Core.ProgressReporting
+import           Test.Tasty
+import           Test.Tasty.HUnit
+import qualified Data.HashMap.Strict as Map
+
+tests :: TestTree
+tests = testGroup "Progress"
+    [ reportProgressTests
+    ]
+
+reportProgressTests :: TestTree
+reportProgressTests = testGroup "recordProgress"
+    [ test "addNew"   addNew
+    , test "increase" increase
+    , test "decrease" decrease
+    , test "done" done
+    ]
+    where
+        p0 = InProgress 0 0 mempty
+        addNew = recordProgress "A" succ p0
+        increase = recordProgress "A" succ addNew
+        decrease = recordProgress "A" succ increase
+        done = recordProgress "A" pred decrease
+        model InProgress{..} =
+            (done, todo) @?= (length (filter (==0) (Map.elems current)), Map.size current)
+        test name p = testCase name $ model p