Skip to content

Commit c6c91a9

Browse files
mike-burnsmike-burns
committed
Update the Commits code to match the actual API instead of what the docs say. This introduces a ton more data structures and nesting, which means I'll absolutely need to add a convenience module.
1 parent e74907d commit c6c91a9

File tree

5 files changed

+102
-79
lines changed

5 files changed

+102
-79
lines changed

‎Github/Data.hs‎

Lines changed: 41 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -1,72 +1,60 @@
11
{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
22

3-
module Github.Data (
4-
Commit(..)
5-
, Author(..)
6-
, GithubDate(..)
7-
) where
3+
module Github.Data (module Github.Data.Definitions) where
84

95
import Data.Time
10-
import Data.Typeable
11-
import Data.Data
12-
import Data.Aeson
136
import Control.Applicative
147
import Control.Monad
15-
import Data.List
168
import qualified Data.Map as Map
179
import qualified Data.Text as T
1810
import Data.Aeson.Types
1911
import System.Locale (defaultTimeLocale)
2012

21-
newtype GithubDate = GithubDate { fromGithubDate :: UTCTime }
22-
deriving (Show, Data, Typeable)
23-
24-
data Commit = Commit {
25-
commitSha :: String
26-
,commitAuthor :: Author
27-
,commitMessage :: String
28-
} deriving (Show, Data, Typeable)
29-
30-
data Author = Author {
31-
authorName :: String
32-
,authorEmail :: String
33-
,authorDate :: GithubDate
34-
} deriving (Show, Data, Typeable)
35-
36-
instance FromJSON Commit where
37-
parseJSON (Object o) =
38-
Commit <$> o .: "sha"
39-
<*> o .:/ ["commit","author"]
40-
<*> o .:/ ["commit", "message"]
41-
parseJSON _ = mzero
42-
43-
instance FromJSON Author where
44-
parseJSON (Object o) =
45-
Author <$> o .: "name"
46-
<*> o .: "email"
47-
<*> o .: "date"
48-
parseJSON _ = mzero
13+
import Github.Data.Definitions
4914

5015
instance FromJSON GithubDate where
5116
parseJSON (String t) =
5217
case parseTime defaultTimeLocale "%FT%T%Z" (T.unpack t) of
5318
Just d -> pure $ GithubDate d
5419
_ -> fail "could not parse Github datetime"
55-
parseJSON v = mzero
56-
57-
(.:/) :: (FromJSON a) => Object -> [T.Text] -> Parser a
58-
o .:/ [] = fail "could not find the unknown key in the JSON"
59-
o .:/ xs = l (Object o) xs
60-
where
61-
l result [] = parseJSON result
62-
l (Object o') (key:keys) =
63-
case Map.lookup key o' of
64-
Nothing -> fail $ "could not find " ++ (show xs) ++ " in the JSON"
65-
(Just v) -> l v keys
66-
67-
20+
parseJSON v = fail "Given something besides a String"
6821

22+
instance FromJSON Commit where
23+
parseJSON (Object o) =
24+
Commit <$> o .: "sha"
25+
<*> o .: "parents"
26+
<*> o .: "url"
27+
<*> o .: "commit"
28+
<*> o .:? "committer"
29+
<*> o .:? "author"
30+
parseJSON _ = fail "Could not build a Commit"
31+
32+
instance FromJSON Tree where
33+
parseJSON (Object o) =
34+
Tree <$> o .: "sha" <*> o .: "url"
35+
parseJSON _ = fail "Could not build a Tree"
6936

70-
-- obj .: key = case M.lookup key obj of
71-
-- Nothing -> fail $ "key " ++ show key ++ " not present"
72-
-- Just v -> parseJSON v
37+
instance FromJSON GitCommit where
38+
parseJSON (Object o) =
39+
GitCommit <$> o .: "message"
40+
<*> o .: "url"
41+
<*> o .: "committer"
42+
<*> o .: "author"
43+
<*> o .: "tree"
44+
parseJSON _ = fail "Could not build a GitCommit"
45+
46+
instance FromJSON GithubUser where
47+
parseJSON (Object o) =
48+
GithubUser <$> o .: "avatar_url"
49+
<*> o .: "login"
50+
<*> o .: "url"
51+
<*> o .: "id"
52+
<*> o .: "gravatar_id"
53+
parseJSON v = fail $ "Could not build a GithubUser out of " ++ (show v)
54+
55+
instance FromJSON GitUser where
56+
parseJSON (Object o) =
57+
GitUser <$> o .: "name"
58+
<*> o .: "email"
59+
<*> o .: "date"
60+
parseJSON _ = fail "Could not build a GitUser"

‎Github/Data/Definitions.hs‎

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
{-# LANGUAGE DeriveDataTypeable #-}
2+
3+
module Github.Data.Definitions (
4+
GithubDate(..)
5+
, Commit(..)
6+
, Tree(..)
7+
, GitCommit(..)
8+
, GithubUser(..)
9+
, GitUser(..)
10+
) where
11+
12+
import Data.Time
13+
import Data.Data
14+
15+
newtype GithubDate = GithubDate { fromGithubDate :: UTCTime }
16+
deriving (Show, Data, Typeable)
17+
18+
data Commit = Commit {
19+
commitSha :: String
20+
,commitParents :: [Tree]
21+
,commitUrl :: String
22+
,commitGitCommit :: GitCommit
23+
,commitCommitter :: Maybe GithubUser
24+
,commitAuthor :: Maybe GithubUser
25+
} deriving (Show, Data, Typeable)
26+
27+
data Tree = Tree {
28+
treeSha :: String
29+
,treeUrl :: String
30+
} deriving (Show, Data, Typeable)
31+
32+
data GitCommit = GitCommit {
33+
gitCommitMessage :: String
34+
,gitCommitUrl :: String
35+
,gitCommitCommitter :: GitUser
36+
,gitCommitAuthor :: GitUser
37+
,gitCommitTree :: Tree
38+
} deriving (Show, Data, Typeable)
39+
40+
data GithubUser = GithubUser {
41+
githubUserAvatarUrl :: String
42+
,githubUserLogin :: String
43+
,githubUserUrl :: String
44+
,githubUserId :: Int
45+
,githubUserGravatarId :: String
46+
} deriving (Show, Data, Typeable)
47+
48+
data GitUser = GitUser {
49+
gitUserName :: String
50+
,gitUserEmail :: String
51+
,gitUserDate :: GithubDate
52+
} deriving (Show, Data, Typeable)

‎README.md‎

Lines changed: 2 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -18,30 +18,12 @@ Or from the command line:
1818
Example Usage
1919
=============
2020

21-
import qualified Github.Repos.Commits as Github
22-
23-
main = do
24-
possibleCommits ← Github.commitsFor "thoughtbot" "paperclip"
25-
case possibleCommits of
26-
(Left error) -> putStrLn $ "Error: " ++ (show error)
27-
(Right commits) -> putStrLn $ intercalate "\n\n" $ map formatCommit commits
28-
29-
formatCommit :: Github.Commit -> String
30-
formatCommit commit =
31-
"commit " ++ (Github.commitSha commit) ++
32-
"\nAuthor: " ++ (formatAuthor author) ++
33-
"\nDate: " ++ (show $ Github.fromGithubDate $ Github.authorDate author) ++
34-
"\n\n\t" ++ (Github.commitMessage commit)
35-
where author = Github.commitAuthor commit
36-
37-
formatAuthor :: Github.Author -> String
38-
formatAuthor author =
39-
(Github.authorName author) ++ " <" ++ (Github.authorEmail author) ++ ">"
21+
See the file Sample.hs .
4022

4123
Documentation
4224
=============
4325

44-
For details see the reference documentation on Hackage.
26+
For details see the reference documentation on Hackage. Later.
4527

4628
Copyright
4729
=========

‎Sample.hs‎

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -13,10 +13,11 @@ formatCommit :: Github.Commit -> String
1313
formatCommit commit =
1414
"commit " ++ (Github.commitSha commit) ++
1515
"\nAuthor: " ++ (formatAuthor author) ++
16-
"\nDate: " ++ (show $ Github.fromGithubDate $ Github.authorDate author) ++
17-
"\n\n\t" ++ (Github.commitMessage commit)
18-
where author = Github.commitAuthor commit
16+
"\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++
17+
"\n\n\t" ++ (Github.gitCommitMessage gitCommit)
18+
where author = Github.gitCommitAuthor gitCommit
19+
gitCommit = Github.commitGitCommit commit
1920

20-
formatAuthor :: Github.Author -> String
21+
formatAuthor :: Github.GitUser -> String
2122
formatAuthor author =
22-
(Github.authorName author) ++ " <" ++ (Github.authorEmail author) ++ ">"
23+
(Github.gitUserName author) ++ " <" ++ (Github.gitUserEmail author) ++ ">"

‎github.cabal‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ Cabal-version: >=1.2
4545

4646
Library
4747
-- Modules exported by the library.
48-
Exposed-modules: Github.Repos.Commits, Github.Data
48+
Exposed-modules: Github.Repos.Commits, Github.Data, Github.Data.Definitions
4949

5050
-- Packages needed in order to build this package.
5151
Build-depends: base,

0 commit comments

Comments
 (0)