From a9d690075ed42d80d2b92694c5acbfe5f047f943 Mon Sep 17 00:00:00 2001 From: Orion Kindel Date: Mon, 27 Nov 2023 15:41:12 -0600 Subject: [PATCH] feat: done! --- src/Gitea.Repo.purs | 88 ++++++++++++++++++++++++++++++-------------- src/Gitea.Types.purs | 8 ++++ 2 files changed, 69 insertions(+), 27 deletions(-) diff --git a/src/Gitea.Repo.purs b/src/Gitea.Repo.purs index cb7107d..52f3ed5 100644 --- a/src/Gitea.Repo.purs +++ b/src/Gitea.Repo.purs @@ -1,15 +1,9 @@ --- GET /orgs/{org}/repos --- GET /repos/{owner}/{repo}/topics --- PUT /repos/{owner}/{repo}/topics/{topic} --- DELETE /repos/{owner}/{repo}/topics/{topic} - module Gitea.Repo where import Prelude hiding ((/)) import Control.Monad.Reader (ask) import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM) -import Control.Plus (empty) import Data.Array as Array import Data.Tuple.Nested ((/\)) import Data.URL (URL, (/), (?), (&)) @@ -18,7 +12,7 @@ import Effect.Class (liftEffect) import Gitea.Auth as Auth import Gitea.Error as Error import Gitea.Trans (GiteaT) -import Gitea.Types (OrgName(..), Repo, RepoName(..), RepoUpdate, Username(..)) +import Gitea.Types (OrgName(..), Repo, RepoName(..), RepoUpdate, TopicName(..), Username(..)) import HTTP (Method(..), fetch) as HTTP import HTTP.Request (json) as HTTP import Node.Buffer (Buffer) @@ -28,15 +22,25 @@ import Simple.JSON (class WriteForeign) import Type.Row.Subset (class Subset) reposURL :: forall m. Monad m => Username -> RepoName -> GiteaT m URL -reposURL (Username owner) (RepoName repo) = (\{ baseURI } -> baseURI / "repos" / owner / repo) <$> ask +reposURL (Username owner) (RepoName repo) = + let + build { baseURI } = baseURI / "repos" / owner / repo + in + build <$> ask + +repoTopicsPageURL :: forall m. Monad m => Username -> RepoName -> { page :: Int, limit :: Int } -> GiteaT m URL +repoTopicsPageURL o repo {page, limit} = (\repos -> repos / "topics" ? "limit" /\ show limit & "page" /\ show page) <$> reposURL o repo + +repoTopicsOneURL :: forall m. Monad m => Username -> RepoName -> TopicName -> GiteaT m URL +repoTopicsOneURL o repo (TopicName topic) = (\repos -> repos / "topics" / topic) <$> reposURL o repo orgReposURL :: forall m. Monad m => OrgName -> { page :: Int, limit :: Int } -> GiteaT m URL orgReposURL (OrgName org) { page, limit } = (\{ baseURI } -> baseURI / "orgs" / org / "repos" ? "limit" /\ show limit & "page" /\ show page) <$> ask get :: forall m. MonadAff m => Username -> RepoName -> GiteaT m (Record Repo) -get u r = do +get owner repo = do { auth } <- ask - url <- reposURL u r + url <- reposURL owner repo rep <- HTTP.fetch $ HTTP.GET /\ url /\ Auth.headers auth Error.tryGetRepJSON rep @@ -44,14 +48,12 @@ listForOrg :: forall m. MonadAff m => MonadRec m => OrgName -> GiteaT m (Array ( listForOrg o = let limit = 10 - paginate (repos /\ pageN) = - do - newRepos <- getPage pageN - pure - if Array.length newRepos < limit then - Done $ repos <> newRepos - else - Loop $ (repos <> newRepos) /\ (pageN + 1) + + maybeFetchMore repos n newRepos + | Array.length newRepos < limit = Done $ repos <> newRepos + | otherwise = Loop $ (repos <> newRepos) /\ (n + 1) + paginate (repos /\ n) = maybeFetchMore repos n <$> getPage n + getPage n = do { auth } <- ask url <- orgReposURL o { limit, page: n } @@ -69,30 +71,62 @@ update -> RepoName -> Record patch -> GiteaT m (Record Repo) -update u r patch = do +update owner repo patch = do { auth } <- ask - url <- reposURL u r + url <- reposURL owner repo rep <- HTTP.fetch $ HTTP.PATCH /\ url /\ HTTP.json patch /\ Auth.headers auth Error.tryGetRepJSON rep delete :: forall m. MonadAff m => Username -> RepoName -> GiteaT m Unit -delete u r = do +delete owner repo = do { auth } <- ask - url <- reposURL u r + url <- reposURL owner repo rep <- HTTP.fetch $ HTTP.DELETE /\ url /\ Auth.headers auth Error.guardStatusOk rep updateAvatar :: forall m. MonadAff m => Username -> RepoName -> Buffer -> GiteaT m Unit -updateAvatar u r av = do +updateAvatar owner repo avatar = do { auth } <- ask - url <- map (_ / "avatar") $ reposURL u r - b64 <- liftEffect $ Buffer.toString Base64 av + url <- map (_ / "avatar") $ reposURL owner repo + b64 <- liftEffect $ Buffer.toString Base64 avatar rep <- HTTP.fetch $ HTTP.POST /\ url /\ HTTP.json { image: b64 } /\ Auth.headers auth Error.guardStatusOk rep removeAvatar :: forall m. MonadAff m => Username -> RepoName -> GiteaT m Unit -removeAvatar u r = do +removeAvatar owner repo = do { auth } <- ask - url <- map (_ / "avatar") $ reposURL u r + url <- map (_ / "avatar") $ reposURL owner repo + rep <- HTTP.fetch $ HTTP.DELETE /\ url /\ Auth.headers auth + Error.guardStatusOk rep + +addTopic :: forall m. MonadAff m => Username -> RepoName -> TopicName -> GiteaT m Unit +addTopic owner repo topic = do + { auth } <- ask + url <- repoTopicsOneURL owner repo topic + rep <- HTTP.fetch $ HTTP.PUT /\ url /\ Auth.headers auth + Error.guardStatusOk rep + +getTopics :: forall m. MonadAff m => MonadRec m => Username -> RepoName -> GiteaT m (Array TopicName) +getTopics owner repo = + let + limit = 10 + + maybeFetchMore topics n newTopics + | Array.length newTopics < limit = Done $ topics <> newTopics + | otherwise = Loop $ (topics <> newTopics) /\ (n + 1) + paginate (topics /\ n) = maybeFetchMore topics n <$> getPage n + + getPage n = do + { auth } <- ask + url <- repoTopicsPageURL owner repo { limit, page: n } + rep <- HTTP.fetch $ HTTP.GET /\ url /\ Auth.headers auth + Error.tryGetRepJSON rep + in + tailRecM paginate ([] /\ 1) + +removeTopic :: forall m. MonadAff m => Username -> RepoName -> TopicName -> GiteaT m Unit +removeTopic owner repo topic = do + { auth } <- ask + url <- repoTopicsOneURL owner repo topic rep <- HTTP.fetch $ HTTP.DELETE /\ url /\ Auth.headers auth Error.guardStatusOk rep diff --git a/src/Gitea.Types.purs b/src/Gitea.Types.purs index a2ca0c9..c23728e 100644 --- a/src/Gitea.Types.purs +++ b/src/Gitea.Types.purs @@ -17,6 +17,14 @@ derive newtype instance Show RepoName derive newtype instance WriteForeign RepoName derive newtype instance ReadForeign RepoName +newtype TopicName = TopicName String + +derive instance Newtype TopicName _ +derive newtype instance Eq TopicName +derive newtype instance Show TopicName +derive newtype instance WriteForeign TopicName +derive newtype instance ReadForeign TopicName + newtype OrgName = OrgName String derive instance Newtype OrgName _