diff --git a/src/Gitea.Repo.purs b/src/Gitea.Repo.purs index 8a9c88e..52f3ed5 100644 --- a/src/Gitea.Repo.purs +++ b/src/Gitea.Repo.purs @@ -1,21 +1,18 @@ --- 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 Data.Array as Array import Data.Tuple.Nested ((/\)) -import Data.URL (URL, (/)) +import Data.URL (URL, (/), (?), (&)) import Effect.Aff.Class (class MonadAff) import Effect.Class (liftEffect) import Gitea.Auth as Auth import Gitea.Error as Error import Gitea.Trans (GiteaT) -import Gitea.Types (Repo, RepoName(..), Username(..), RepoUpdate) +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) @@ -25,15 +22,46 @@ 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 +listForOrg :: forall m. MonadAff m => MonadRec m => OrgName -> GiteaT m (Array (Record Repo)) +listForOrg o = + let + limit = 10 + + 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 } + rep <- HTTP.fetch $ HTTP.GET /\ url /\ Auth.headers auth + Error.tryGetRepJSON rep + in + tailRecM paginate ([] /\ 1) + update :: forall m patch . MonadAff m @@ -43,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.Monad.purs b/src/Gitea.Trans.purs similarity index 94% rename from src/Gitea.Monad.purs rename to src/Gitea.Trans.purs index 59e1c29..47419f3 100644 --- a/src/Gitea.Monad.purs +++ b/src/Gitea.Trans.purs @@ -6,6 +6,7 @@ import Control.Monad.Error.Class (class MonadError, class MonadThrow, throwError import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.Morph (class MFunctor, class MMonad, embed, hoist) import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT(..), ask, runReaderT) +import Control.Monad.Rec.Class (class MonadRec) import Control.Monad.Trans.Class (class MonadTrans, lift) import Data.Either (Either) import Data.Newtype (class Newtype, unwrap, wrap) @@ -39,6 +40,7 @@ derive newtype instance MonadEffect m => MonadEffect (GiteaT m) derive newtype instance MonadAff m => MonadAff (GiteaT m) derive newtype instance Monad m => MonadError Gitea.Error.Error (GiteaT m) derive newtype instance Monad m => MonadThrow Gitea.Error.Error (GiteaT m) +derive newtype instance MonadRec m => MonadRec (GiteaT m) derive newtype instance Monad m => Functor (GiteaT m) derive newtype instance Monad m => Apply (GiteaT m) diff --git a/src/Gitea.Model.purs b/src/Gitea.Types.purs similarity index 95% rename from src/Gitea.Model.purs rename to src/Gitea.Types.purs index 337badf..c23728e 100644 --- a/src/Gitea.Model.purs +++ b/src/Gitea.Types.purs @@ -17,6 +17,22 @@ 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 _ +derive newtype instance Eq OrgName +derive newtype instance Show OrgName +derive newtype instance WriteForeign OrgName +derive newtype instance ReadForeign OrgName + newtype TagName = TagName String derive instance Newtype TagName _