{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Git.Stale.Core.MonadFindBranches
-- License     : BSD3
-- Maintainer  : tbidne@gmail.com
-- The MonadFindBranches class.
module Git.Stale.Core.MonadFindBranches
  ( MonadFindBranches (..),
    runFindBranches,
  )
where

import App
import Common.MonadLogger
import Common.RefinedUtils
import qualified Control.Concurrent.ParallelIO.Global as Par
import qualified Control.Monad.Reader as R
import qualified Data.Kind as K
import qualified Data.Text as T
import qualified Data.Time.Calendar as Cal
import Git.Stale.Core.IO
import Git.Stale.Core.Internal
import Git.Stale.Types.Branch
import Git.Stale.Types.Env
import Git.Stale.Types.Error
import Git.Stale.Types.Filtered
import Git.Stale.Types.Results
import Git.Stale.Types.ResultsWithErrs
import Git.Types.GitTypes

-- | The 'MonadFindBranches' class is used to describe various git
-- actions for finding stale branches.
class Monad m => MonadFindBranches m where
  -- | Adds custom handling to returned data (e.g. for error handling).
  type Handler (m :: K.Type -> K.Type) (a :: K.Type)

  -- | The type returned by `collectResults`.
  type FinalResults m :: K.Type

  -- | Returns a [`Name`] representing git branches.
  branchNamesByGrep ::
    Maybe FilePath ->
    BranchType ->
    Maybe T.Text ->
    m [Handler m Name]

  -- | Maps [`Name`] to [`NameAuthDay`], filtering out non-stale branches.
  getStaleLogs ::
    Maybe FilePath ->
    RNonNegative Int ->
    Cal.Day ->
    [Handler m Name] ->
    m (Filtered (Handler m NameAuthDay))

  -- | Maps [`NameAuthDay`] to [`AnyBranch`].
  toBranches ::
    Maybe FilePath ->
    T.Text ->
    Filtered (Handler m NameAuthDay) ->
    m [Handler m AnyBranch]

  -- | Collects [`AnyBranch`] into `FinalResults`.
  collectResults :: [Handler m AnyBranch] -> m (FinalResults m)

  -- | Displays results.
  display :: T.Text -> FinalResults m -> m ()

-- | `MonadFindBranches` instance `IO`. This means we can encounter
-- exceptions, but
--
--   * We do not want a single exception trying to parse one branch kill
--     the entire program.
--   * We do not want to ignore problems entirely.
--
-- We collect the results in `ResultsWithErrs`, which contains a list of errors
-- and two maps, one for merged branches and another for unmerged branches.
-- We opt to define `Handler` as (`ErrOr` a) -- an alias for
-- (`Either` `Err` a) -- as we do not want a single error to crash the app.
-- instance (MonadLogger m, R.MonadIO m) => MonadFindBranches (AppT Env m) where
instance MonadFindBranches IO where
  type Handler IO a = ErrOr a

  type FinalResults IO = ResultsWithErrs

  branchNamesByGrep ::
    Maybe FilePath ->
    BranchType ->
    Maybe T.Text ->
    IO [ErrOr Name]
  branchNamesByGrep :: Maybe FilePath -> BranchType -> Maybe Text -> IO [ErrOr Name]
branchNamesByGrep path :: Maybe FilePath
path branchType :: BranchType
branchType grepStr :: Maybe Text
grepStr = do
    let branchFn :: Text -> Bool
branchFn = case Maybe Text
grepStr of
          Nothing -> Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
badBranch
          Just s :: Text
s ->
            \t :: Text
t ->
              (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
badBranch) Text
t
                Bool -> Bool -> Bool
&& Text -> Text
T.toCaseFold Text
s Text -> Text -> Bool
`T.isInfixOf` Text -> Text
T.toCaseFold Text
t
        toNames' :: Text -> [ErrOr Name]
toNames' = (Text -> ErrOr Name) -> [Text] -> [ErrOr Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ErrOr Name
textToName ([Text] -> [ErrOr Name])
-> (Text -> [Text]) -> Text -> [ErrOr Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
branchFn ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
        cmd :: Text
cmd = "git branch " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (BranchType -> FilePath
branchTypeToArg BranchType
branchType)
    Text
res <- Text -> Maybe FilePath -> IO Text
sh Text
cmd Maybe FilePath
path
    IO [ErrOr Name] -> IO [ErrOr Name]
forall a. IO a -> IO a
logIfErr (IO [ErrOr Name] -> IO [ErrOr Name])
-> IO [ErrOr Name] -> IO [ErrOr Name]
forall a b. (a -> b) -> a -> b
$ [ErrOr Name] -> IO [ErrOr Name]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ErrOr Name] -> IO [ErrOr Name])
-> [ErrOr Name] -> IO [ErrOr Name]
forall a b. (a -> b) -> a -> b
$ Text -> [ErrOr Name]
toNames' Text
res

  getStaleLogs ::
    Maybe FilePath ->
    RNonNegative Int ->
    Cal.Day ->
    [ErrOr Name] ->
    IO (Filtered (ErrOr NameAuthDay))
  getStaleLogs :: Maybe FilePath
-> RNonNegative Int
-> Day
-> [ErrOr Name]
-> IO (Filtered (ErrOr NameAuthDay))
getStaleLogs path :: Maybe FilePath
path limit :: RNonNegative Int
limit today :: Day
today ns :: [ErrOr Name]
ns = do
    let staleFilter' :: [ErrOr NameAuthDay] -> Filtered (ErrOr NameAuthDay)
staleFilter' = (ErrOr NameAuthDay -> Bool)
-> [ErrOr NameAuthDay] -> Filtered (ErrOr NameAuthDay)
forall a. (a -> Bool) -> [a] -> Filtered a
mkFiltered ((ErrOr NameAuthDay -> Bool)
 -> [ErrOr NameAuthDay] -> Filtered (ErrOr NameAuthDay))
-> (ErrOr NameAuthDay -> Bool)
-> [ErrOr NameAuthDay]
-> Filtered (ErrOr NameAuthDay)
forall a b. (a -> b) -> a -> b
$ RNonNegative Int -> Day -> ErrOr NameAuthDay -> Bool
staleNonErr RNonNegative Int
limit Day
today
    [Either SomeException (ErrOr NameAuthDay)]
logs <- [IO (ErrOr NameAuthDay)]
-> IO [Either SomeException (ErrOr NameAuthDay)]
forall a. [IO a] -> IO [Either SomeException a]
Par.parallelE ((ErrOr Name -> IO (ErrOr NameAuthDay))
-> [ErrOr Name] -> [IO (ErrOr NameAuthDay)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe FilePath -> ErrOr Name -> IO (ErrOr NameAuthDay)
nameToLog Maybe FilePath
path) [ErrOr Name]
ns)
    Filtered (ErrOr NameAuthDay) -> IO (Filtered (ErrOr NameAuthDay))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Filtered (ErrOr NameAuthDay) -> IO (Filtered (ErrOr NameAuthDay)))
-> Filtered (ErrOr NameAuthDay)
-> IO (Filtered (ErrOr NameAuthDay))
forall a b. (a -> b) -> a -> b
$ ([ErrOr NameAuthDay] -> Filtered (ErrOr NameAuthDay)
staleFilter' ([ErrOr NameAuthDay] -> Filtered (ErrOr NameAuthDay))
-> ([Either SomeException (ErrOr NameAuthDay)]
    -> [ErrOr NameAuthDay])
-> [Either SomeException (ErrOr NameAuthDay)]
-> Filtered (ErrOr NameAuthDay)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either SomeException (ErrOr NameAuthDay) -> ErrOr NameAuthDay)
-> [Either SomeException (ErrOr NameAuthDay)]
-> [ErrOr NameAuthDay]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either SomeException (ErrOr NameAuthDay) -> ErrOr NameAuthDay
forall a b. Show a => Either a (Either Err b) -> Either Err b
exceptToErr) [Either SomeException (ErrOr NameAuthDay)]
logs

  toBranches ::
    Maybe FilePath ->
    T.Text ->
    Filtered (ErrOr NameAuthDay) ->
    IO [ErrOr AnyBranch]
  toBranches :: Maybe FilePath
-> Text -> Filtered (ErrOr NameAuthDay) -> IO [ErrOr AnyBranch]
toBranches path :: Maybe FilePath
path master :: Text
master ns :: Filtered (ErrOr NameAuthDay)
ns = do
    [Either SomeException (ErrOr AnyBranch)]
branches <-
      [IO (ErrOr AnyBranch)]
-> IO [Either SomeException (ErrOr AnyBranch)]
forall a. [IO a] -> IO [Either SomeException a]
Par.parallelE
        ((ErrOr NameAuthDay -> IO (ErrOr AnyBranch))
-> [ErrOr NameAuthDay] -> [IO (ErrOr AnyBranch)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe FilePath -> Text -> ErrOr NameAuthDay -> IO (ErrOr AnyBranch)
errTupleToBranch Maybe FilePath
path Text
master) (Filtered (ErrOr NameAuthDay) -> [ErrOr NameAuthDay]
forall a. Filtered a -> [a]
unFiltered Filtered (ErrOr NameAuthDay)
ns))
    [ErrOr AnyBranch] -> IO [ErrOr AnyBranch]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ErrOr AnyBranch] -> IO [ErrOr AnyBranch])
-> [ErrOr AnyBranch] -> IO [ErrOr AnyBranch]
forall a b. (a -> b) -> a -> b
$ (Either SomeException (ErrOr AnyBranch) -> ErrOr AnyBranch)
-> [Either SomeException (ErrOr AnyBranch)] -> [ErrOr AnyBranch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either SomeException (ErrOr AnyBranch) -> ErrOr AnyBranch
forall a b. Show a => Either a (Either Err b) -> Either Err b
exceptToErr [Either SomeException (ErrOr AnyBranch)]
branches

  collectResults :: [ErrOr AnyBranch] -> IO ResultsWithErrs
  collectResults :: [ErrOr AnyBranch] -> IO ResultsWithErrs
collectResults = ResultsWithErrs -> IO ResultsWithErrs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultsWithErrs -> IO ResultsWithErrs)
-> ([ErrOr AnyBranch] -> ResultsWithErrs)
-> [ErrOr AnyBranch]
-> IO ResultsWithErrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ErrOr AnyBranch] -> ResultsWithErrs
toResultsWithErrs

  display :: T.Text -> ResultsWithErrs -> IO ()
  display :: Text -> ResultsWithErrs -> IO ()
display remoteName :: Text
remoteName = ResultsWithErrsDisp -> IO ()
forall (m :: * -> *). MonadLogger m => ResultsWithErrsDisp -> m ()
logResultsWithErrs (ResultsWithErrsDisp -> IO ())
-> (ResultsWithErrs -> ResultsWithErrsDisp)
-> ResultsWithErrs
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ResultsWithErrs -> ResultsWithErrsDisp
toResultsErrDisp Text
remoteName

instance MonadFindBranches m => MonadFindBranches (AppT Env m) where
  type Handler (AppT Env m) a = Handler m a
  type FinalResults (AppT Env m) = FinalResults m

  branchNamesByGrep :: Maybe FilePath
-> BranchType
-> Maybe Text
-> AppT Env m [Handler (AppT Env m) Name]
branchNamesByGrep path :: Maybe FilePath
path branchType :: BranchType
branchType = m [Handler m Name] -> AppT Env m [Handler m Name]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift (m [Handler m Name] -> AppT Env m [Handler m Name])
-> (Maybe Text -> m [Handler m Name])
-> Maybe Text
-> AppT Env m [Handler m Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> BranchType -> Maybe Text -> m [Handler m Name]
forall (m :: * -> *).
MonadFindBranches m =>
Maybe FilePath -> BranchType -> Maybe Text -> m [Handler m Name]
branchNamesByGrep Maybe FilePath
path BranchType
branchType
  getStaleLogs :: Maybe FilePath
-> RNonNegative Int
-> Day
-> [Handler (AppT Env m) Name]
-> AppT Env m (Filtered (Handler (AppT Env m) NameAuthDay))
getStaleLogs path :: Maybe FilePath
path nat :: RNonNegative Int
nat day :: Day
day = m (Filtered (Handler m NameAuthDay))
-> AppT Env m (Filtered (Handler m NameAuthDay))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift (m (Filtered (Handler m NameAuthDay))
 -> AppT Env m (Filtered (Handler m NameAuthDay)))
-> ([Handler m Name] -> m (Filtered (Handler m NameAuthDay)))
-> [Handler m Name]
-> AppT Env m (Filtered (Handler m NameAuthDay))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath
-> RNonNegative Int
-> Day
-> [Handler m Name]
-> m (Filtered (Handler m NameAuthDay))
forall (m :: * -> *).
MonadFindBranches m =>
Maybe FilePath
-> RNonNegative Int
-> Day
-> [Handler m Name]
-> m (Filtered (Handler m NameAuthDay))
getStaleLogs Maybe FilePath
path RNonNegative Int
nat Day
day
  toBranches :: Maybe FilePath
-> Text
-> Filtered (Handler (AppT Env m) NameAuthDay)
-> AppT Env m [Handler (AppT Env m) AnyBranch]
toBranches path :: Maybe FilePath
path master :: Text
master = m [Handler m AnyBranch] -> AppT Env m [Handler m AnyBranch]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift (m [Handler m AnyBranch] -> AppT Env m [Handler m AnyBranch])
-> (Filtered (Handler m NameAuthDay) -> m [Handler m AnyBranch])
-> Filtered (Handler m NameAuthDay)
-> AppT Env m [Handler m AnyBranch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath
-> Text
-> Filtered (Handler m NameAuthDay)
-> m [Handler m AnyBranch]
forall (m :: * -> *).
MonadFindBranches m =>
Maybe FilePath
-> Text
-> Filtered (Handler m NameAuthDay)
-> m [Handler m AnyBranch]
toBranches Maybe FilePath
path Text
master
  collectResults :: [Handler (AppT Env m) AnyBranch]
-> AppT Env m (FinalResults (AppT Env m))
collectResults = m (FinalResults m) -> AppT Env m (FinalResults m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift (m (FinalResults m) -> AppT Env m (FinalResults m))
-> ([Handler m AnyBranch] -> m (FinalResults m))
-> [Handler m AnyBranch]
-> AppT Env m (FinalResults m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Handler m AnyBranch] -> m (FinalResults m)
forall (m :: * -> *).
MonadFindBranches m =>
[Handler m AnyBranch] -> m (FinalResults m)
collectResults
  display :: Text -> FinalResults (AppT Env m) -> AppT Env m ()
display remoteName :: Text
remoteName = m () -> AppT Env m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift (m () -> AppT Env m ())
-> (FinalResults m -> m ()) -> FinalResults m -> AppT Env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FinalResults m -> m ()
forall (m :: * -> *).
MonadFindBranches m =>
Text -> FinalResults m -> m ()
display Text
remoteName

-- | High level logic of `MonadFindBranches` usage. This function is the
-- entrypoint for any `MonadFindBranches` instance.
runFindBranches :: (R.MonadReader Env m, MonadFindBranches m) => m ()
runFindBranches :: m ()
runFindBranches = do
  Env {Maybe FilePath
path :: Env -> Maybe FilePath
path :: Maybe FilePath
path, BranchType
branchType :: Env -> BranchType
branchType :: BranchType
branchType, Maybe Text
grepStr :: Env -> Maybe Text
grepStr :: Maybe Text
grepStr, RNonNegative Int
limit :: Env -> RNonNegative Int
limit :: RNonNegative Int
limit, Text
remoteName :: Env -> Text
remoteName :: Text
remoteName, Text
master :: Env -> Text
master :: Text
master, Day
today :: Env -> Day
today :: Day
today} <- m Env
forall r (m :: * -> *). MonadReader r m => m r
R.ask
  [Handler m Name]
branchNames <- Maybe FilePath -> BranchType -> Maybe Text -> m [Handler m Name]
forall (m :: * -> *).
MonadFindBranches m =>
Maybe FilePath -> BranchType -> Maybe Text -> m [Handler m Name]
branchNamesByGrep Maybe FilePath
path BranchType
branchType Maybe Text
grepStr
  Filtered (Handler m NameAuthDay)
staleLogs <- Maybe FilePath
-> RNonNegative Int
-> Day
-> [Handler m Name]
-> m (Filtered (Handler m NameAuthDay))
forall (m :: * -> *).
MonadFindBranches m =>
Maybe FilePath
-> RNonNegative Int
-> Day
-> [Handler m Name]
-> m (Filtered (Handler m NameAuthDay))
getStaleLogs Maybe FilePath
path RNonNegative Int
limit Day
today [Handler m Name]
branchNames
  [Handler m AnyBranch]
staleBranches <- Maybe FilePath
-> Text
-> Filtered (Handler m NameAuthDay)
-> m [Handler m AnyBranch]
forall (m :: * -> *).
MonadFindBranches m =>
Maybe FilePath
-> Text
-> Filtered (Handler m NameAuthDay)
-> m [Handler m AnyBranch]
toBranches Maybe FilePath
path Text
master Filtered (Handler m NameAuthDay)
staleLogs
  FinalResults m
res <- [Handler m AnyBranch] -> m (FinalResults m)
forall (m :: * -> *).
MonadFindBranches m =>
[Handler m AnyBranch] -> m (FinalResults m)
collectResults [Handler m AnyBranch]
staleBranches
  Text -> FinalResults m -> m ()
forall (m :: * -> *).
MonadFindBranches m =>
Text -> FinalResults m -> m ()
display Text
remoteName FinalResults m
res

logResultsWithErrs :: MonadLogger m => ResultsWithErrsDisp -> m ()
logResultsWithErrs :: ResultsWithErrsDisp -> m ()
logResultsWithErrs (ResultsWithErrsDisp (errDisp :: ErrDisp
errDisp, resultsDisp :: ResultsDisp
resultsDisp)) = do
  let (ErrDisp (errs :: Text
errs, numErrs :: Int
numErrs)) = ErrDisp
errDisp
  Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
    "\n\nERRORS: "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
numErrs)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n------\n"
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
errs
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"
  let (ResultsDisp (MergedDisp (ms :: Text
ms, numMs :: Int
numMs), UnMergedDisp (unms :: Text
unms, numUnMs :: Int
numUnMs))) = ResultsDisp
resultsDisp
  Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logInfoSuccess (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
    "\n\nMERGED: "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
numMs)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n------\n"
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ms
  Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logInfoCyan (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
    "\n\nUNMERGED: "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
numUnMs)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n--------\n"
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
unms