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