generated from tpl/purs
feat: done!
This commit is contained in:
parent
8c3016e020
commit
a9d690075e
@ -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
|
||||
|
@ -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 _
|
||||
|
Loading…
Reference in New Issue
Block a user