feat: topics and list for org #1

Merged
zacheryprenovost merged 3 commits from topics-and-list-for-org into main 2023-11-27 22:00:56 +00:00
3 changed files with 97 additions and 19 deletions

View File

@ -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

View File

@ -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)

View File

@ -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 _