feat: done!

This commit is contained in:
orion kindel 2023-11-27 15:41:12 -06:00
parent 8c3016e020
commit a9d690075e
Signed by: orion
GPG Key ID: 6D4165AE4C928719
2 changed files with 69 additions and 27 deletions

View File

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

View File

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