From 9aa8917c81d662678b4cf812b5eaffa7cf461189 Mon Sep 17 00:00:00 2001
From: Connor James <connor@fossa.com>
Date: Sun, 23 May 2021 17:24:40 -0700
Subject: [PATCH] Rename Fresh to AtomicCounter

---
 spectrometer.cabal                            |  4 +--
 src/App/Fossa/Analyze.hs                      |  6 ++--
 src/App/Fossa/ListTargets.hs                  |  4 +--
 src/App/Pathfinder/Scan.hs                    |  4 +--
 .../Carrier/Diagnostics/StickyContext.hs      |  4 +--
 src/Control/Carrier/Fresh.hs                  | 29 -------------------
 src/Control/Effect/Fresh.hs                   | 16 ----------
 src/Discovery/Projects.hs                     |  4 +--
 8 files changed, 13 insertions(+), 58 deletions(-)
 delete mode 100644 src/Control/Carrier/Fresh.hs
 delete mode 100644 src/Control/Effect/Fresh.hs

diff --git a/spectrometer.cabal b/spectrometer.cabal
index 2e71764b6..76cd6ee09 100644
--- a/spectrometer.cabal
+++ b/spectrometer.cabal
@@ -164,7 +164,7 @@ library
     Control.Carrier.Diagnostics
     Control.Carrier.Diagnostics.StickyContext
     Control.Carrier.Finally
-    Control.Carrier.Fresh
+    Control.Carrier.AtomicCounter
     Control.Carrier.Output.IO
     Control.Carrier.StickyLogger
     Control.Carrier.TaskPool
@@ -173,7 +173,7 @@ library
     Control.Effect.ConsoleRegion
     Control.Effect.Diagnostics
     Control.Effect.Finally
-    Control.Effect.Fresh
+    Control.Effect.AtomicCounter
     Control.Effect.Output
     Control.Effect.Path
     Control.Effect.Record
diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs
index a5bd13afb..797ed38ae 100644
--- a/src/App/Fossa/Analyze.hs
+++ b/src/App/Fossa/Analyze.hs
@@ -83,7 +83,7 @@ import System.Exit (die, exitFailure)
 import Types
 import VCS.Git (fetchGitContributors)
 import Control.Carrier.Diagnostics.StickyContext
-import Control.Carrier.Fresh (Fresh, runFresh)
+import Control.Carrier.AtomicCounter (AtomicCounter, runAtomicCounter)
 
 data ScanDestination
   = UploadScan ApiOpts ProjectMetadata -- ^ upload to fossa with provided api key and base url
@@ -171,7 +171,7 @@ discoverFuncs =
   ]
 
 runDependencyAnalysis ::
-  (Has (Lift IO) sig m, Has Fresh sig m, Has Logger sig m, Has (Output ProjectResult) sig m) =>
+  (Has (Lift IO) sig m, Has AtomicCounter sig m, Has Logger sig m, Has (Output ProjectResult) sig m) =>
   -- | Analysis base directory
   BaseDir ->
   [BuildTargetFilter] ->
@@ -216,7 +216,7 @@ analyze (BaseDir basedir) destination override unpackArchives filters = do
       . runStickyLogger
       . runFinally
       . withTaskPool capabilities updateProgress
-      . runFresh
+      . runAtomicCounter
       $ withDiscoveredProjects discoverFuncs (fromFlag UnpackArchives unpackArchives) basedir (runDependencyAnalysis (BaseDir basedir) filters)
 
   let filteredProjects = filterProjects (BaseDir basedir) projectResults
diff --git a/src/App/Fossa/ListTargets.hs b/src/App/Fossa/ListTargets.hs
index d8e1e35e8..b1f9045c6 100644
--- a/src/App/Fossa/ListTargets.hs
+++ b/src/App/Fossa/ListTargets.hs
@@ -9,7 +9,7 @@ import App.Fossa.Analyze (discoverFuncs)
 import App.Types (BaseDir (..))
 import Control.Carrier.Diagnostics qualified as Diag
 import Control.Carrier.Finally
-import Control.Carrier.Fresh
+import Control.Carrier.AtomicCounter
 import Control.Carrier.StickyLogger (runStickyLogger, logSticky', StickyLogger)
 import Control.Carrier.TaskPool
 import Control.Concurrent (getNumCapabilities)
@@ -34,7 +34,7 @@ listTargetsMain (BaseDir basedir) = do
     . withTaskPool capabilities updateProgress
     . runReadFSIO
     . runExecIO
-    . runFresh
+    . runAtomicCounter
     $ do
       withDiscoveredProjects discoverFuncs False basedir $ \(project :: DiscoveredProject DummyM) -> do
         let maybeRel = makeRelative basedir (projectPath project)
diff --git a/src/App/Pathfinder/Scan.hs b/src/App/Pathfinder/Scan.hs
index 6846a18ef..b36deec9f 100644
--- a/src/App/Pathfinder/Scan.hs
+++ b/src/App/Pathfinder/Scan.hs
@@ -5,6 +5,7 @@ module App.Pathfinder.Scan
   ( scanMain
   ) where
 
+import Control.Carrier.AtomicCounter (runAtomicCounter)
 import Control.Carrier.Diagnostics qualified as Diag
 import Control.Carrier.Error.Either
 import Control.Carrier.Finally
@@ -14,7 +15,6 @@ import Control.Carrier.TaskPool
 import Control.Concurrent
 import Control.Effect.Exception as Exc
 import Control.Effect.Lift (sendIO)
-import Control.Carrier.Fresh (runFresh)
 import Control.Monad (unless)
 import Control.Monad.IO.Class (MonadIO)
 import Data.Aeson
@@ -68,7 +68,7 @@ scan basedir = runFinally $ do
       . runReadFSIO
       . runFinally
       . withTaskPool capabilities updateProgress
-      . runFresh
+      . runAtomicCounter
       $ withDiscoveredProjects discoverFuncs False basedir runLicenseAnalysis
 
   sendIO (BL.putStr (encode projectResults))
diff --git a/src/Control/Carrier/Diagnostics/StickyContext.hs b/src/Control/Carrier/Diagnostics/StickyContext.hs
index 0eed363fb..423ea66dc 100644
--- a/src/Control/Carrier/Diagnostics/StickyContext.hs
+++ b/src/Control/Carrier/Diagnostics/StickyContext.hs
@@ -15,9 +15,9 @@ import Control.Monad.Trans.Class (MonadTrans (..))
 import Data.List (intersperse)
 import Data.Text qualified as T
 import Effect.Logger
-import Control.Effect.Fresh
+import Control.Effect.AtomicCounter
 
-stickyDiag :: (Has Fresh sig m, Has (Lift IO) sig m) => StickyDiagC m a -> m a
+stickyDiag :: (Has AtomicCounter sig m, Has (Lift IO) sig m) => StickyDiagC m a -> m a
 stickyDiag act = do
   taskId <- generateId
   Sticky.withStickyRegion $ \region ->
diff --git a/src/Control/Carrier/Fresh.hs b/src/Control/Carrier/Fresh.hs
deleted file mode 100644
index 5fe0060f4..000000000
--- a/src/Control/Carrier/Fresh.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-module Control.Carrier.Fresh (
-  FreshC,
-  runFresh,
-
-  -- * Re-exports
-  module X,
-) where
-
-import Control.Carrier.AtomicState
-import Control.Effect.Fresh as X
-import Control.Effect.Lift
-import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.Trans.Class (MonadTrans)
-
-runFresh :: Has (Lift IO) sig m => FreshC m a -> m a
-runFresh = fmap snd . runAtomicState 1 . runFreshC
-
-newtype FreshC m a = FreshC {runFreshC :: AtomicStateC Int m a}
-  deriving (Functor, Applicative, Monad, MonadIO, MonadTrans)
-
-instance Has (Lift IO) sig m => Algebra (Fresh :+: sig) (FreshC m) where
-  alg hdl sig ctx = FreshC $ case sig of
-    L GenerateId -> do
-      generated <- getSet @Int (\old -> (old+1, old))
-      pure (generated <$ ctx)
-    R other -> alg (runFreshC . hdl) (R other) ctx
diff --git a/src/Control/Effect/Fresh.hs b/src/Control/Effect/Fresh.hs
deleted file mode 100644
index ed0449ab8..000000000
--- a/src/Control/Effect/Fresh.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-
-{-# LANGUAGE GADTs #-}
-
-module Control.Effect.Fresh
-  ( Fresh(..)
-  , generateId
-  , module X
-  ) where
-
-import Control.Algebra as X
-
-data Fresh m a where
-  GenerateId :: Fresh m Int
-
-generateId :: Has Fresh sig m => m Int
-generateId = send GenerateId
diff --git a/src/Discovery/Projects.hs b/src/Discovery/Projects.hs
index 676589268..5e8639145 100644
--- a/src/Discovery/Projects.hs
+++ b/src/Discovery/Projects.hs
@@ -6,8 +6,8 @@ module Discovery.Projects (
 
 import Control.Carrier.Diagnostics qualified as Diag
 import Control.Carrier.Diagnostics.StickyContext
+import Control.Effect.AtomicCounter (AtomicCounter)
 import Control.Effect.Finally
-import Control.Effect.Fresh
 import Control.Effect.Lift
 import Control.Effect.TaskPool
 import Control.Monad (when)
@@ -23,7 +23,7 @@ import Types (DiscoveredProject)
 -- on each discovered project. Note that the provided function is also run in
 -- parallel.
 withDiscoveredProjects ::
-  (Has Fresh sig m, Has ReadFS sig m, Has (Lift IO) sig m, Has TaskPool sig m, Has Logger sig m, Has Finally sig m) =>
+  (Has AtomicCounter sig m, Has ReadFS sig m, Has (Lift IO) sig m, Has TaskPool sig m, Has Logger sig m, Has Finally sig m) =>
   -- | Discover functions
   [Path Abs Dir -> StickyDiagC (Diag.DiagnosticsC m) [DiscoveredProject run]] ->
   -- | whether to unpack archives