module Main where import Control.Error.Util import Control.Monad import Control.Monad.Except import Control.Monad.Reader import Data.ByteString ( ByteString ) import qualified Data.ByteString.UTF8 as UTF8 import Data.Dates ( getCurrentDateTime , parseDate , DateTime(..) ) import Data.Functor ( (<&>) ) import Data.List import Data.Semigroup ( (<>) ) import qualified Data.Text as T import Data.Time.Clock import Data.Time.Clock.POSIX import Data.Time.Format import GHup import GitHub.Auth import GitHub.Data.Definitions import GitHub.Data.Name import GitHub.Data.Repos import GitHub.Data.URL import HPath import Options.Applicative import Safe import System.Console.Pretty import System.Exit data Options = Options { optCommand :: Command } data Command = Fork ForkOptions | Config ConfigOptions | Del DelOptions | ListForks ListForkOptions data ForkOptions = ForkOptions { repo :: ByteString , newBranch :: Maybe ByteString , repoBasePath :: Maybe ByteString } data ListForkOptions = ListForkOptions { lSince :: Maybe ByteString } data ConfigOptions = ConfigOptions { oAuth :: ByteString , bPath :: Maybe ByteString } data DelOptions = DelOptions { del :: ByteString } opts :: Parser Command opts = subparser ( command "fork" (Fork <$> (info (forkOpts <**> helper) idm)) <> command "config" (Config <$> (info (configOpts <**> helper) idm)) <> command "delete" (Del <$> (info (delOpts <**> helper) idm)) <> command "list-forks" (ListForks <$> (info (lForkOpts <**> helper) idm)) ) configOpts :: Parser ConfigOptions configOpts = ConfigOptions <$> strOption (short 'o' <> long "oauth" <> metavar "OAUTH" <> help "The OAUTH token" ) <*> optional (strOption ((short 'p') <> long "base-path" <> metavar "BASE_PATH" <> help "The base path to clone into" ) ) forkOpts :: Parser ForkOptions forkOpts = ForkOptions <$> strOption (short 'r' <> long "repo" <> metavar "REPO" <> help "The repository to fork" ) <*> optional (strOption (short 'b' <> long "branch" <> metavar "BRANCH" <> help "The branch to create after cloning the fork" ) ) <*> optional (strOption (short 'p' <> long "repo-path" <> metavar "REPO_PATH" <> help "The base path where to clone the repository to" ) ) delOpts :: Parser DelOptions delOpts = DelOptions <$> strOption (short 'r' <> long "repo" <> metavar "REPO" <> help "The REPO fork to delete") lForkOpts :: Parser ListForkOptions lForkOpts = ListForkOptions <$> optional (strOption (short 's' <> long "since" <> metavar "SINCE" <> help "The repository to fork" ) ) main :: IO () main = do let run e = do settings <- exceptT ( const die . color Red $ "Could not get settings, make sure to run 'ghup config' first" ) pure $ getSettings (flip runReaderT) settings . runExceptT . withExceptT show $ e e <- execParser (info (opts <**> helper) idm) >>= \case Fork (ForkOptions {..}) -> run $ do case repoBasePath of Just rbp -> case parseAbs rbp of Just p -> prepareRepoForPR' repo (Just p) newBranch Nothing -> liftIO $ die (color Red $ "Repo path must be absolute") Nothing -> prepareRepoForPR' repo Nothing newBranch Config (ConfigOptions {..}) -> do p <- maybe (pure Nothing) (fmap Just . parseAbs) bPath writeSettings (Settings (OAuth oAuth) p) <&> Right Del (DelOptions {..} ) -> run $ deleteFork' del ListForks (ListForkOptions {..}) -> run $ do mtime <- liftIO $ case lSince of Just t -> do dt <- getCurrentDateTime let mt = either (const Nothing) Just . parseDate dt . UTF8.toString $ t pure $ mt >>= \t -> (parseTimeM True defaultTimeLocale "%Y-%-m-%-d" (show (year t) <> "-" <> show (month t) <> "-" <> show (day t)) :: Maybe UTCTime ) Nothing -> pure Nothing forks <- withExceptT show $ getForks mtime let formatted = intercalate "\n" $ fmap (\Repo {..} -> T.unpack . getUrl $ repoHtmlUrl) forks liftIO $ putStrLn $ formatted pure () case e of Right () -> pure () Left t -> die (color Red $ t)