hasufell/ghup
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Cleanup

Browse Source
This commit is contained in:
Julian Ospald 2020-02-01 16:43:46 +01:00
parent cfd1fc531b
commit ee11c131ef
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
1 changed files with 20 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
lib/GHup.hs
View File

@ -202,9 +202,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 String m () -> ExceptT Error m ()
prepareRepoForPR' repoString mRepobase branch = do prepareRepoForPR' repoString mRepobase branch = do
UrlParseResult {..} <- liftEither $ parseURL repoString UrlParseResult {..} <- (liftEither $ parseURL repoString) ?* uError
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 +223,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 String m () -> ExceptT Error 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 +231,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 {..} <- withExceptT show $ forkRepository owner repo ForkResult {..} <- (forkRepository owner repo) ?* (uError . show)
withExceptT show $ ExceptT $ cloneRepository CloneSSH downstream repodest (ExceptT $ cloneRepository CloneSSH downstream repodest) ?* (uError . show)
withExceptT show $ ExceptT $ setUpstream upstream repodest (ExceptT $ setUpstream upstream repodest) ?* (uError . show)
case branch of case branch of
Just b -> withExceptT show $ ExceptT $ createBranch b repodest Just b -> (ExceptT $ createBranch b repodest) ?* (uError . show)
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 +307,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 String m () -> ExceptT Error m ()
deleteFork' repoString = do deleteFork' repoString = do
UrlParseResult {..} <- liftEither $ parseURL repoString UrlParseResult {..} <- (liftEither $ parseURL repoString) ?* uError
withExceptT show $ deleteFork owner repo deleteFork owner repo
deleteFork :: (MonadIO m, MonadReader Settings m) deleteFork :: (MonadIO m, MonadReader Settings m)
@ -320,7 +320,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 (UserError $ T.pack "Not a fork") _ -> throwError (uError "Not a fork")
githubAuth (deleteRepoR owner repo) githubAuth (deleteRepoR owner repo)
@ -453,3 +453,12 @@ 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