diff --git a/app/Main.hs b/app/Main.hs index 821ffca..6b2ed56 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,13 +1,28 @@ module Main where import Control.Monad +import Control.Monad.Except 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 HPath import Options.Applicative +import Safe import System.Console.Pretty import System.Exit @@ -21,6 +36,7 @@ data Command = Fork ForkOptions | Config ConfigOptions | Del DelOptions + | ListForks ListForkOptions data ForkOptions = ForkOptions { @@ -29,6 +45,11 @@ data ForkOptions = ForkOptions , repoBasePath :: Maybe ByteString } +data ListForkOptions = ListForkOptions + { + lSince :: Maybe ByteString + } + data ConfigOptions = ConfigOptions { oAuth :: ByteString , bPath :: Maybe ByteString @@ -41,9 +62,10 @@ data DelOptions = DelOptions { 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 "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 @@ -84,6 +106,14 @@ 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 @@ -97,7 +127,33 @@ main = do Config (ConfigOptions {..}) -> do p <- maybe (pure Nothing) (fmap Just . parseAbs) bPath writeSettings (Settings (OAuth oAuth) p) <&> Right - Del (DelOptions {..}) -> deleteFork' del + Del (DelOptions {..} ) -> deleteFork' del + ListForks (ListForkOptions {..}) -> runExceptT $ do + mtime <- lift $ 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 <- ExceptT $ getForks' mtime + let formatted = intercalate "\n" $ fmap + (\Repo {..} -> + T.unpack (untagName $ simpleOwnerLogin repoOwner) + <> "/" + <> T.unpack (untagName repoName) + ) + forks + lift $ putStrLn $ formatted + pure () case e of Right () -> _info "success!" Left t -> die (color Red $ t) diff --git a/ghup.cabal b/ghup.cabal index 61098be..f014377 100644 --- a/ghup.cabal +++ b/ghup.cabal @@ -30,8 +30,10 @@ library , safe-exceptions ^>= 0.1 , streamly ^>= 0.7 , text ^>= 1.2 + , time ^>= 1.8 , unix ^>= 2.7 , utf8-string ^>= 1.0 + , vector ^>= 0.12 , word8 ^>= 0.1 hs-source-dirs: lib ghc-options: -Wall @@ -44,11 +46,17 @@ executable ghup -- other-extensions: build-depends: base ^>= 4.12 , bytestring ^>= 0.10 + , dates ^>= 0.2 , ghup , github ^>= 0.24 , hpath ^>= 0.11 + , mtl ^>= 2.2 , optparse-applicative ^>= 0.15 , pretty-terminal ^>= 0.1 + , safe ^>= 0.3 + , text ^>= 1.2 + , time ^>= 1.8 + , utf8-string ^>= 1.0 hs-source-dirs: app default-language: Haskell2010 default-extensions: LambdaCase, MultiWayIf, RecordWildCards, TupleSections diff --git a/lib/GHup.hs b/lib/GHup.hs index 34f47bf..3636ab5 100644 --- a/lib/GHup.hs +++ b/lib/GHup.hs @@ -23,6 +23,8 @@ module GHup , createBranch , deleteFork' , deleteFork + , getForks' + , getForks -- * Parsers , parseURL , ghURLParser @@ -43,10 +45,13 @@ import qualified Data.ByteString.Lazy.UTF8 as LUTF8 import Data.Functor ( (<&>) ) import Data.Proxy import qualified Data.Text.Encoding as E +import Data.Time.Clock import Data.Word8 +import GHC.Exts ( toList ) import GitHub.Auth import GitHub.Data.Name import GitHub.Data.URL +import GitHub.Data.Request import GitHub.Endpoints.Repos import GitHub.Request import HPath @@ -284,6 +289,22 @@ deleteFork am owner repo = runExceptT $ do withExceptT show $ ExceptT $ github am (deleteRepoR owner repo) +getForks' :: Maybe UTCTime -> IO (Either String [Repo]) +getForks' mtime = runExceptT $ do + Settings {..} <- ExceptT getSettings + withExceptT show $ ExceptT $ getForks auth mtime + + +getForks :: AuthMethod am => am -> Maybe UTCTime -> IO (Either Error [Repo]) +getForks am mtime = runExceptT $ do + repos <- + ExceptT $ github am (currentUserReposR RepoPublicityAll FetchAll) + pure $ filter + (\case + Repo { repoFork = Just True, repoUpdatedAt = Just t } -> + maybe True (t >=) mtime + _ -> False + ) (toList repos)