{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : Git.Stale.Core.IO
-- License     : BSD3
-- Maintainer  : tbidne@gmail.com
-- Exports functions to be used by "Git.Stale.Core.MonadFindBranches" for `IO`.
module Git.Stale.Core.IO
  ( errTupleToBranch,
    logIfErr,
    nameToLog,
    sh,
  )
where

import Common.IO
import qualified Control.Exception as Ex
import qualified Data.Text as T
import Git.Stale.Core.Internal
import Git.Stale.Types.Branch
import Git.Stale.Types.Error
import Git.Types.GitTypes

-- | Retrieves the log information for a given branch `Name`
-- on `FilePath`. Returns `Left` `Err` if any errors occur,
-- `Right` `NameAuthDay` otherwise.
nameToLog :: Maybe FilePath -> ErrOr Name -> IO (ErrOr NameAuthDay)
nameToLog :: Maybe FilePath -> ErrOr Name -> IO (ErrOr NameAuthDay)
nameToLog _ (Left err :: Err
err) = ErrOr NameAuthDay -> IO (ErrOr NameAuthDay)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrOr NameAuthDay -> IO (ErrOr NameAuthDay))
-> ErrOr NameAuthDay -> IO (ErrOr NameAuthDay)
forall a b. (a -> b) -> a -> b
$ Err -> ErrOr NameAuthDay
forall a b. a -> Either a b
Left Err
err
nameToLog path :: Maybe FilePath
path (Right name :: Name
name) = NameLog -> ErrOr NameAuthDay
parseLog (NameLog -> ErrOr NameAuthDay)
-> IO NameLog -> IO (ErrOr NameAuthDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath -> Name -> IO NameLog
getNameLog Maybe FilePath
path Name
name

-- | Maps a `NameAuthDay` on `FilePath` to `AnyBranch`. Returns `Left` `Err`
-- if any errors occur, `Right` `NameAuthDay` otherwise.
errTupleToBranch :: Maybe FilePath -> T.Text -> ErrOr NameAuthDay -> IO (ErrOr AnyBranch)
errTupleToBranch :: Maybe FilePath -> Text -> ErrOr NameAuthDay -> IO (ErrOr AnyBranch)
errTupleToBranch _ _ (Left x :: Err
x) = 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
$ Err -> ErrOr AnyBranch
forall a b. a -> Either a b
Left Err
x
errTupleToBranch path :: Maybe FilePath
path master :: Text
master (Right (n :: Name
n, a :: Author
a, d :: Day
d)) = do
  Bool
res <- Maybe FilePath -> Text -> Name -> IO Bool
isMerged Maybe FilePath
path Text
master Name
n
  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
$ AnyBranch -> ErrOr AnyBranch
forall a b. b -> Either a b
Right (AnyBranch -> ErrOr AnyBranch) -> AnyBranch -> ErrOr AnyBranch
forall a b. (a -> b) -> a -> b
$ Name -> Author -> Day -> Bool -> AnyBranch
mkAnyBranch Name
n Author
a Day
d Bool
res

getNameLog :: Maybe FilePath -> Name -> IO NameLog
getNameLog :: Maybe FilePath -> Name -> IO NameLog
getNameLog p :: Maybe FilePath
p nm :: Name
nm@(Name n :: Text
n) = (Name, IO Text) -> IO NameLog
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Name
nm, Text -> Maybe FilePath -> IO Text
sh Text
cmd Maybe FilePath
p)
  where
    cmd :: Text
cmd =
      [Text] -> Text
T.concat
        ["git log ", "\"", Text
n, "\"", " --pretty=format:\"%an|%ad\" --date=short -n1"]

isMerged :: Maybe FilePath -> T.Text -> Name -> IO Bool
isMerged :: Maybe FilePath -> Text -> Name -> IO Bool
isMerged path :: Maybe FilePath
path master :: Text
master (Name n :: Text
n) = do
  Text
res <-
    Text -> Maybe FilePath -> IO Text
sh
      ([Text] -> Text
T.concat ["git rev-list --count " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
master Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "..", "\"", Text
n, "\""])
      Maybe FilePath
path
  (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> (Text -> Bool) -> Text -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
unsafeToInt) Text
res

-- | Runs an `IO` action and logs the error if any occur.
logIfErr :: forall a. IO a -> IO a
logIfErr :: IO a -> IO a
logIfErr io :: IO a
io = do
  Either SomeException a
res <- IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
Ex.try IO a
io :: IO (Either Ex.SomeException a)
  case Either SomeException a
res of
    Left ex :: SomeException
ex -> do
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Died with error: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> SomeException -> FilePath
forall a. Show a => a -> FilePath
show SomeException
ex
      IO a
io
    Right r :: a
r -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r