diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index edeef245..b45ec202 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -71,6 +71,25 @@ data GitTree = GitTree instance NFData GitTree where rnf = genericRnf instance Binary GitTree +data NewTree = NewTree + { newBaseTree :: !(Name Tree) + , newTreeGitTrees :: !(Vector NewGitTree) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewTree where rnf = genericRnf +instance Binary NewTree + +data NewGitTree = NewGitTree + { newGitTreePath :: !Text + , newGitTreeMode :: !Text + , newGitTreeContent :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewGitTree where rnf = genericRnf +instance Binary NewGitTree + data GitCommit = GitCommit { gitCommitMessage :: !Text , gitCommitUrl :: !URL @@ -85,6 +104,16 @@ data GitCommit = GitCommit instance NFData GitCommit where rnf = genericRnf instance Binary GitCommit +data NewGitCommit = NewGitCommit + { newGitCommitMessage :: !Text + , newGitCommitTree :: !(Name Tree) + , newGitCommitParents :: !(Vector (Name GitCommit)) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewGitCommit where rnf = genericRnf +instance Binary NewGitCommit + data Blob = Blob { blobUrl :: !URL , blobEncoding :: !Text @@ -218,6 +247,9 @@ instance FromJSON Commit where <*> o .:? "files" .!= V.empty <*> o .:? "stats" +instance ToJSON NewGitCommit where + toJSON (NewGitCommit message tree parents) = object [ "message" .= message, "tree" .= tree, "parents" .= parents ] + instance FromJSON Tree where parseJSON = withObject "Tree" $ \o -> Tree <$> o .: "sha" @@ -233,6 +265,12 @@ instance FromJSON GitTree where <*> o .: "path" <*> o .: "mode" +instance ToJSON NewTree where + toJSON (NewTree b tree) = object [ "base_tree" .= b, "tree" .= tree ] + +instance ToJSON NewGitTree where + toJSON (NewGitTree path mode content) = object [ "path" .= path, "mode" .= mode, "content" .= content ] + instance FromJSON GitCommit where parseJSON = withObject "GitCommit" $ \o -> GitCommit <$> o .: "message" diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index 1d8ced18..ae4af165 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -7,7 +7,10 @@ -- . module GitHub.Endpoints.GitData.Commits ( commit, + commit', gitCommitR, + createCommit, + createCommitR, module GitHub.Data, ) where @@ -18,13 +21,30 @@ import Prelude () -- | A single commit, by SHA1. -- + +-- > reference' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "heads/master" +commit' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) +commit' auth user repo sha = + executeRequestMaybe auth $ gitCommitR user repo sha + -- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" commit :: Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) -commit user repo sha = - executeRequest' $ gitCommitR user repo sha +commit = + commit' Nothing -- | Query a commit. -- See gitCommitR :: Name Owner -> Name Repo -> Name GitCommit -> Request k GitCommit gitCommitR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] [] + +-- | Create a tree. +createCommit :: Auth -> Name Owner -> Name Repo -> NewGitCommit -> IO (Either Error GitCommit) +createCommit auth user repo newTree = + executeRequest auth $ createCommitR user repo newTree + +-- | Create a commit. +-- See +createCommitR :: Name Owner -> Name Repo -> NewGitCommit -> Request 'RW GitCommit +createCommitR user repo newCommit = + command Post ["repos", toPathPart user, toPathPart repo , "git", "commits"] (encode newCommit) \ No newline at end of file diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index b6bc550a..89ba9487 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -12,6 +12,8 @@ module GitHub.Endpoints.GitData.Trees ( nestedTree, nestedTree', nestedTreeR, + createTree, + createTreeR, module GitHub.Data, ) where @@ -57,3 +59,14 @@ nestedTree = nestedTree' Nothing nestedTreeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree nestedTreeR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")] + +-- | Create a tree. +createTree :: Auth -> Name Owner -> Name Repo -> NewTree -> IO (Either Error Tree) +createTree auth user repo newTree = + executeRequest auth $ createTreeR user repo newTree + +-- | Create a tree. +-- See +createTreeR :: Name Owner -> Name Repo -> NewTree -> Request 'RW Tree +createTreeR user repo newTree = + command Post ["repos", toPathPart user, toPathPart repo , "git", "trees"] (encode newTree) \ No newline at end of file