Compare commits

..

No commits in common. "ee11c131ef809e3f6ab151098e19bea7cc12bcb4" and "fe9578c9d6cbc3b41f1479e9417d929cbd5967aa" have entirely different histories.

View File

@ -60,8 +60,6 @@ import GitHub.Data.Name
import GitHub.Data.URL import GitHub.Data.URL
import GitHub.Data.Request import GitHub.Data.Request
import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos
import GitHub.Endpoints.Search
import GitHub.Endpoints.Users
import GitHub.Request import GitHub.Request
import HPath import HPath
import HPath.IO import HPath.IO
@ -202,9 +200,9 @@ prepareRepoForPR' :: ( MonadIO m
=> ByteString -- ^ string that contains repo url => ByteString -- ^ string that contains repo url
-> Maybe (Path b) -- ^ base path where the repo should be cloned -> Maybe (Path b) -- ^ base path where the repo should be cloned
-> Maybe ByteString -- ^ PR branch name to switch to -> Maybe ByteString -- ^ PR branch name to switch to
-> ExceptT Error m () -> ExceptT String m ()
prepareRepoForPR' repoString mRepobase branch = do prepareRepoForPR' repoString mRepobase branch = do
UrlParseResult {..} <- (liftEither $ parseURL repoString) ?* uError UrlParseResult {..} <- liftEither $ parseURL repoString
repobase <- case mRepobase of repobase <- case mRepobase of
Just r -> fmap Just $ liftIO $ toAbs r Just r -> fmap Just $ liftIO $ toAbs r
Nothing -> basePath Nothing -> basePath
@ -223,7 +221,7 @@ prepareRepoForPR :: ( MonadIO m
-> Name Repo -> Name Repo
-> Maybe (Path b) -- ^ base path where the repo should be cloned -> Maybe (Path b) -- ^ base path where the repo should be cloned
-> Maybe ByteString -- ^ PR branch name to switch to -> Maybe ByteString -- ^ PR branch name to switch to
-> ExceptT Error m () -> ExceptT String m ()
prepareRepoForPR owner repo repobase branch = do prepareRepoForPR owner repo repobase branch = do
repodest <- case repobase of repodest <- case repobase of
Just rb -> Just rb ->
@ -231,11 +229,11 @@ prepareRepoForPR owner repo repobase branch = do
>>= liftIO >>= liftIO
. toAbs . toAbs
Nothing -> (parseRel $ E.encodeUtf8 $ untagName repo) >>= liftIO . toAbs Nothing -> (parseRel $ E.encodeUtf8 $ untagName repo) >>= liftIO . toAbs
ForkResult {..} <- (forkRepository owner repo) ?* (uError . show) ForkResult {..} <- withExceptT show $ forkRepository owner repo
(ExceptT $ cloneRepository CloneSSH downstream repodest) ?* (uError . show) withExceptT show $ ExceptT $ cloneRepository CloneSSH downstream repodest
(ExceptT $ setUpstream upstream repodest) ?* (uError . show) withExceptT show $ ExceptT $ setUpstream upstream repodest
case branch of case branch of
Just b -> (ExceptT $ createBranch b repodest) ?* (uError . show) Just b -> withExceptT show $ ExceptT $ createBranch b repodest
Nothing -> pure () Nothing -> pure ()
lift $ _info lift $ _info
( "To change to the repo dir, run:\n\tcd " ( "To change to the repo dir, run:\n\tcd "
@ -307,10 +305,10 @@ forkRepository owner repo = do
-- and parses the owner/repo from the given repo url string. -- and parses the owner/repo from the given repo url string.
deleteFork' :: (MonadIO m, MonadReader Settings m) deleteFork' :: (MonadIO m, MonadReader Settings m)
=> ByteString => ByteString
-> ExceptT Error m () -> ExceptT String m ()
deleteFork' repoString = do deleteFork' repoString = do
UrlParseResult {..} <- (liftEither $ parseURL repoString) ?* uError UrlParseResult {..} <- liftEither $ parseURL repoString
deleteFork owner repo withExceptT show $ deleteFork owner repo
deleteFork :: (MonadIO m, MonadReader Settings m) deleteFork :: (MonadIO m, MonadReader Settings m)
@ -320,7 +318,7 @@ deleteFork :: (MonadIO m, MonadReader Settings m)
deleteFork owner repo = do deleteFork owner repo = do
github_ (repositoryR owner repo) >>= \case github_ (repositoryR owner repo) >>= \case
(Repo { repoFork = Just True }) -> pure () (Repo { repoFork = Just True }) -> pure ()
_ -> throwError (uError "Not a fork") _ -> throwError (UserError $ T.pack "Not a fork")
githubAuth (deleteRepoR owner repo) githubAuth (deleteRepoR owner repo)
@ -328,17 +326,14 @@ getForks :: (MonadIO m, MonadReader Settings m)
=> Maybe UTCTime => Maybe UTCTime
-> ExceptT Error m [Repo] -> ExceptT Error m [Repo]
getForks mtime = do getForks mtime = do
user <- githubAuth userInfoCurrentR repos <- githubAuth (currentUserReposR RepoPublicityAll FetchAll)
let userName = untagName $ userLogin user
repos <- github_
(searchReposR $ mconcat [T.pack "user:", userName, T.pack " fork:only"])
pure $ sortBy (\x y -> compare (repoUpdatedAt y) (repoUpdatedAt x)) $ filter pure $ sortBy (\x y -> compare (repoUpdatedAt y) (repoUpdatedAt x)) $ filter
(\case (\case
Repo { repoFork = Just True, repoUpdatedAt = Just t } -> Repo { repoFork = Just True, repoUpdatedAt = Just t } ->
maybe True (t >=) mtime maybe True (t >=) mtime
_ -> False _ -> False
) )
(toList $ searchResultResults repos) (toList repos)
@ -453,12 +448,3 @@ github_ :: (MonadIO m, ParseResponse mt req, res ~ Either Error req, ro ~ 'RO)
-> ExceptT Error m req -> ExceptT Error m req
github_ req = do github_ req = do
ExceptT $ liftIO $ github' req ExceptT $ liftIO $ github' req
-- | Flipped 'withExceptT'.
(?*) :: Functor m => ExceptT e m a -> (e -> e') -> ExceptT e' m a
(?*) = flip withExceptT
uError :: String -> Error
uError = UserError . T.pack