Cleanup

lib/GHup.hs

@@ -60,6 +60,8 @@ 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
@@ -200,9 +202,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 String m ()
+                  -> ExceptT Error m ()
 prepareRepoForPR' repoString mRepobase branch = do
-  UrlParseResult {..} <- liftEither $ parseURL repoString
+  UrlParseResult {..} <- (liftEither $ parseURL repoString) ?* uError
   repobase            <- case mRepobase of
     Just r  -> fmap Just $ liftIO $ toAbs r
     Nothing -> basePath
@@ -221,7 +223,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 String m ()
+                 -> ExceptT Error m ()
 prepareRepoForPR owner repo repobase branch = do
   repodest <- case repobase of
     Just rb ->
@@ -229,11 +231,11 @@ prepareRepoForPR owner repo repobase branch = do
         >>= 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
-    Just b  -> withExceptT show $ ExceptT $ createBranch b repodest
+    Just b  -> (ExceptT $ createBranch b repodest) ?* (uError . show)
     Nothing -> pure ()
   lift $ _info
     (  "To change to the repo dir, run:\n\tcd "
@@ -305,10 +307,10 @@ forkRepository owner repo = do
 -- and parses the owner/repo from the given repo url string.
 deleteFork' :: (MonadIO m, MonadReader Settings m)
             => ByteString
-            -> ExceptT String m ()
+            -> ExceptT Error m ()
 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)
@@ -318,7 +320,7 @@ deleteFork :: (MonadIO m, MonadReader Settings m)
 deleteFork owner repo = do
   github_ (repositoryR owner repo) >>= \case
     (Repo { repoFork = Just True }) -> pure ()
-    _ -> throwError (UserError $ T.pack "Not a fork")
+    _ -> throwError (uError "Not a fork")
   githubAuth (deleteRepoR owner repo)
 
 
@@ -326,14 +328,17 @@ getForks :: (MonadIO m, MonadReader Settings m)
          => Maybe UTCTime
          -> ExceptT Error m [Repo]
 getForks mtime = do
-  repos <- githubAuth (currentUserReposR RepoPublicityAll FetchAll)
+  user <- githubAuth userInfoCurrentR
+  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
     (\case
       Repo { repoFork = Just True, repoUpdatedAt = Just t } ->
         maybe True (t >=) mtime
       _ -> False
     )
-    (toList repos)
+    (toList $ searchResultResults repos)
 
 
 
@@ -448,3 +453,12 @@ 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