lib/GHup.hs

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