Move git contrib functions to new module

spectrometer.cabal

@@ -184,6 +184,7 @@ library
     Strategy.Ruby.BundleShow
     Strategy.Ruby.GemfileLock
     Types
+    VCS.Git
 
   hs-source-dirs:  src
 

src/App/Fossa/Analyze.hs

@@ -13,21 +13,15 @@ import Control.Carrier.Output.IO
 import Control.Concurrent
 import Path.IO
 
-import App.Fossa.CliTypes
-import App.Fossa.FossaAPIV1 (ProjectMetadata, uploadAnalysis, UploadResponse(..), Contributors(..), uploadContributors)
 import App.Fossa.Analyze.Project (Project, mkProjects)
+import App.Fossa.CliTypes
+import App.Fossa.FossaAPIV1 (ProjectMetadata, uploadAnalysis, UploadResponse(..), uploadContributors)
 import App.Fossa.ProjectInference (mergeOverride, inferProject)
 import Control.Carrier.Finally
 import Control.Carrier.TaskPool
-import Data.ByteString.Lazy (toStrict)
-import Data.Maybe (mapMaybe)
-import qualified Data.Map as M
-import qualified Data.Text as T
 import Data.Text.Lazy.Encoding (decodeUtf8)
 import Data.Text.Prettyprint.Doc
 import Data.Text.Prettyprint.Doc.Render.Terminal
-import Data.Time
-import Data.Time.Format.ISO8601 (iso8601Show)
 import Effect.Exec
 import Effect.Logger
 import Network.HTTP.Types (urlEncode)
@@ -68,23 +62,13 @@ import Text.URI (URI)
 import qualified Text.URI as URI
 import Types
 import qualified Data.Text.Encoding as TE
+import VCS.Git (fetchGitContributors)
 
 data ScanDestination
   = UploadScan URI ApiKey ProjectMetadata -- ^ upload to fossa with provided api key and base url
   | OutputStdout
   deriving (Generic)
 
-gitLogCmd :: UTCTime -> Command
-gitLogCmd now = Command
-  { cmdName = "git",
-    cmdArgs = ["log", "--since", sinceArg, "--date=short", "--format=%ae|%cd"],
-    cmdAllowErr = Never
-  }
-  where
-    sinceArg = iso8601Show $ utctDay wayBack
-    delta = nominalDay * (-90)
-    wayBack = addUTCTime delta now
-
 analyzeMain :: Severity -> ScanDestination -> OverrideProject -> Bool -> IO ()
 analyzeMain logSeverity destination project unpackArchives = do
   basedir <- getCurrentDir
@@ -147,47 +131,20 @@ analyze basedir destination override unpackArchives = runFinally $ do
             Right _ -> pure ()
 
 tryUploadContributors ::
-  ( Has Diag.Diagnostics sig m
-  , Has Exec sig m
-  , MonadIO m
-  ) => Path x Dir
-  -> URI
-  -> ApiKey
-  -> Text -- ^ Locator
-  -> m ()
+  ( Has Diag.Diagnostics sig m,
+    Has Exec sig m,
+    MonadIO m
+  ) =>
+  Path x Dir ->
+  URI ->
+  ApiKey ->
+  -- | Locator
+  Text ->
+  m ()
 tryUploadContributors baseDir baseUrl apiKey locator = do
   contributors <- fetchGitContributors baseDir
   uploadContributors baseUrl apiKey locator contributors
 
-
-fetchGitContributors :: 
-  ( Has Diag.Diagnostics sig m
-  , Has Exec sig m
-  , MonadIO m
-  ) => Path x Dir -> m Contributors
-fetchGitContributors basedir = do
-  now <- liftIO getCurrentTime
-  rawContrib <- execThrow basedir $ gitLogCmd now
-  textContrib <- Diag.fromEitherShow . TE.decodeUtf8' $ toStrict rawContrib
-  pure . Contributors
-    . M.map (T.pack . iso8601Show)
-    . M.fromListWith max
-    . mapMaybe readLine
-    $ T.lines textContrib
-  where
-    readLine :: Text -> Maybe (Text, Day)
-    readLine entry = do
-      let (email, textDate) = splitOnceOn "|" entry
-      date <- parseTimeM True defaultTimeLocale "%Y-%-m-%-d" $ T.unpack textDate
-      Just (email, date)
-
-splitOnceOn :: Text -> Text -> (Text, Text)
-splitOnceOn needle haystack = (head, strippedTail)
-  where
-    len = T.length needle
-    (head, tail) = T.breakOn needle haystack
-    strippedTail = T.drop len tail
-
 fossaProjectUrl :: URI -> Text -> Text -> Text
 fossaProjectUrl baseUrl rawLocator branch = URI.render baseUrl <> "projects/" <> encodedProject <> "/refs/branch/" <> branch <> "/" <> encodedRevision
   where

src/VCS/Git.hs

@@ -0,0 +1,59 @@
+module VCS.Git
+  ( gitLogCmd,
+    fetchGitContributors,
+  )
+where
+
+import App.Fossa.FossaAPIV1 (Contributors (..))
+import qualified Control.Carrier.Diagnostics as Diag
+import Data.ByteString.Lazy (toStrict)
+import qualified Data.Map as M
+import Data.Maybe (mapMaybe)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Data.Time
+import Data.Time.Format.ISO8601 (iso8601Show)
+import Effect.Exec
+import Prologue
+
+gitLogCmd :: UTCTime -> Command
+gitLogCmd now =
+  Command
+    { cmdName = "git",
+      cmdArgs = ["log", "--since", sinceArg, "--date=short", "--format=%ae|%cd"],
+      cmdAllowErr = Never
+    }
+  where
+    sinceArg = iso8601Show $ utctDay wayBack
+    delta = nominalDay * (-90)
+    wayBack = addUTCTime delta now
+
+fetchGitContributors ::
+  ( Has Diag.Diagnostics sig m,
+    Has Exec sig m,
+    MonadIO m
+  ) =>
+  Path x Dir ->
+  m Contributors
+fetchGitContributors basedir = do
+  now <- liftIO getCurrentTime
+  rawContrib <- execThrow basedir $ gitLogCmd now
+  textContrib <- Diag.fromEitherShow . TE.decodeUtf8' $ toStrict rawContrib
+  pure . Contributors
+    . M.map (T.pack . iso8601Show)
+    . M.fromListWith max
+    . mapMaybe readLine
+    $ T.lines textContrib
+  where
+    readLine :: Text -> Maybe (Text, Day)
+    readLine entry = do
+      let (email, textDate) = splitOnceOn "|" entry
+      date <- parseTimeM True defaultTimeLocale "%Y-%-m-%-d" $ T.unpack textDate
+      Just (email, date)
+
+splitOnceOn :: Text -> Text -> (Text, Text)
+splitOnceOn needle haystack = (head, strippedTail)
+  where
+    len = T.length needle
+    (head, tail) = T.breakOn needle haystack
+    strippedTail = T.drop len tail