{-# LANGUAGE OverloadedStrings #-}

module DeleteMerged
  ( deleteDone,
  )
where

import qualified Data.Text.IO as T
import qualified GH
import qualified Git
import GitHub.Data (Name, Owner)
import OurPrelude

deleteDone :: Bool -> Text -> Name Owner -> IO ()
deleteDone :: Bool -> Text -> Name Owner -> IO ()
deleteDone Bool
delete Text
githubToken Name Owner
ghUser = do
  Either Text ()
result <-
    ExceptT Text IO () -> IO (Either Text ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO () -> IO (Either Text ()))
-> ExceptT Text IO () -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ do
      ExceptT Text IO ()
forall (m :: * -> *). MonadIO m => ExceptT Text m ()
Git.fetch
      Text -> ExceptT Text IO ()
forall (m :: * -> *). MonadIO m => Text -> ExceptT Text m ()
Git.cleanAndResetTo Text
"master"
      Vector Text
refs <- IO (Either Text (Vector Text)) -> ExceptT Text IO (Vector Text)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Text (Vector Text)) -> ExceptT Text IO (Vector Text))
-> IO (Either Text (Vector Text)) -> ExceptT Text IO (Vector Text)
forall a b. (a -> b) -> a -> b
$ Auth -> Name Owner -> IO (Either Text (Vector Text))
GH.closedAutoUpdateRefs (Text -> Auth
GH.authFromToken Text
githubToken) Name Owner
ghUser
      let branches :: Vector Text
branches = (Text -> Text) -> Vector Text -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
r -> (Text
"auto-update/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r)) Vector Text
refs
      if Bool
delete
        then IO () -> ExceptT Text IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text IO ()) -> IO () -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ Vector Text -> IO ()
Git.deleteBranchesEverywhere Vector Text
branches
        else IO () -> ExceptT Text IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text IO ()) -> IO () -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ do
          Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Would delete these branches for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Owner -> Text
forall a. Show a => a -> Text
tshow Name Owner
ghUser Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
          (Text -> IO ()) -> Vector Text -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> IO ()
T.putStrLn (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. Show a => a -> Text
tshow) Vector Text
branches
  case Either Text ()
result of
    Left Text
e -> Text -> IO ()
T.putStrLn Text
e
    Either Text ()
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()