module Github.Data (module Github.Data.Definitions) where
import Data.Time
import Control.Applicative
import Control.Monad
import qualified Data.Text as T
import Data.Aeson.Types
import Data.Monoid
import System.Locale (defaultTimeLocale)
import qualified Data.Vector as V
import qualified Data.HashMap.Lazy as Map
import Data.Hashable (Hashable)
import Github.Data.Definitions
instance FromJSON GithubDate where
parseJSON (String t) =
case parseTime defaultTimeLocale "%FT%T%Z" (T.unpack t) of
Just d -> pure $ GithubDate d
_ -> fail "could not parse Github datetime"
parseJSON _ = fail "Given something besides a String"
instance FromJSON Commit where
parseJSON (Object o) =
Commit <$> o .: "sha"
<*> o .: "parents"
<*> o .: "url"
<*> o .: "commit"
<*> o .:? "committer"
<*> o .:? "author"
<*> o .:< "files"
<*> o .:? "stats"
parseJSON _ = fail "Could not build a Commit"
instance FromJSON Tree where
parseJSON (Object o) =
Tree <$> o .: "sha"
<*> o .: "url"
<*> o .:< "tree"
parseJSON _ = fail "Could not build a Tree"
instance FromJSON GitTree where
parseJSON (Object o) =
GitTree <$> o .: "type"
<*> o .: "sha"
<*> o .: "url"
<*> o .:? "size"
<*> o .: "path"
<*> o .: "mode"
parseJSON _ = fail "Could not build a GitTree"
instance FromJSON GitCommit where
parseJSON (Object o) =
GitCommit <$> o .: "message"
<*> o .: "url"
<*> o .: "committer"
<*> o .: "author"
<*> o .: "tree"
<*> o .:? "sha"
<*> o .:< "parents"
parseJSON _ = fail "Could not build a GitCommit"
instance FromJSON GithubOwner where
parseJSON (Object o)
| o `at` "gravatar_id" == Nothing =
GithubOrganization <$> o .: "avatar_url"
<*> o .: "login"
<*> o .: "url"
<*> o .: "id"
| otherwise =
GithubUser <$> o .: "avatar_url"
<*> o .: "login"
<*> o .: "url"
<*> o .: "id"
<*> o .: "gravatar_id"
parseJSON v = fail $ "Could not build a GithubOwner out of " ++ (show v)
instance FromJSON GitUser where
parseJSON (Object o) =
GitUser <$> o .: "name"
<*> o .: "email"
<*> o .: "date"
parseJSON _ = fail "Could not build a GitUser"
instance FromJSON File where
parseJSON (Object o) =
File <$> o .: "blob_url"
<*> o .: "status"
<*> o .: "raw_url"
<*> o .: "additions"
<*> o .: "sha"
<*> o .: "changes"
<*> o .: "patch"
<*> o .: "filename"
<*> o .: "deletions"
parseJSON _ = fail "Could not build a File"
instance FromJSON Stats where
parseJSON (Object o) =
Stats <$> o .: "additions"
<*> o .: "total"
<*> o .: "deletions"
parseJSON _ = fail "Could not build a Stats"
instance FromJSON Comment where
parseJSON (Object o) =
Comment <$> o .:? "position"
<*> o .:? "line"
<*> o .: "body"
<*> o .: "commit_id"
<*> o .: "updated_at"
<*> o .:? "html_url"
<*> o .: "url"
<*> o .: "created_at"
<*> o .: "path"
<*> o .: "user"
<*> o .: "id"
parseJSON _ = fail "Could not build a Comment"
instance ToJSON NewComment where
toJSON (NewComment b) = object [ "body" .= b ]
instance ToJSON EditComment where
toJSON (EditComment b) = object [ "body" .= b ]
instance FromJSON Diff where
parseJSON (Object o) =
Diff <$> o .: "status"
<*> o .: "behind_by"
<*> o .: "patch_url"
<*> o .: "url"
<*> o .: "base_commit"
<*> o .:< "commits"
<*> o .: "total_commits"
<*> o .: "html_url"
<*> o .:< "files"
<*> o .: "ahead_by"
<*> o .: "diff_url"
<*> o .: "permalink_url"
parseJSON _ = fail "Could not build a Diff"
instance FromJSON Gist where
parseJSON (Object o) =
Gist <$> o .: "user"
<*> o .: "git_push_url"
<*> o .: "url"
<*> o .:? "description"
<*> o .: "created_at"
<*> o .: "public"
<*> o .: "comments"
<*> o .: "updated_at"
<*> o .: "html_url"
<*> o .: "id"
<*> o `values` "files"
<*> o .: "git_push_url"
parseJSON _ = fail "Could not build a Gist"
instance FromJSON GistFile where
parseJSON (Object o) =
GistFile <$> o .: "type"
<*> o .: "raw_url"
<*> o .: "size"
<*> o .:? "language"
<*> o .: "filename"
<*> o .:? "content"
parseJSON _ = fail "Could not build a GistFile"
instance FromJSON GistComment where
parseJSON (Object o) =
GistComment <$> o .: "user"
<*> o .: "url"
<*> o .: "created_at"
<*> o .: "body"
<*> o .: "updated_at"
<*> o .: "id"
parseJSON _ = fail "Could not build a GistComment"
instance FromJSON Blob where
parseJSON (Object o) =
Blob <$> o .: "url"
<*> o .: "encoding"
<*> o .: "content"
<*> o .: "sha"
<*> o .: "size"
parseJSON _ = fail "Could not build a Blob"
instance FromJSON GitReference where
parseJSON (Object o) =
GitReference <$> o .: "object"
<*> o .: "url"
<*> o .: "ref"
parseJSON _ = fail "Could not build a GitReference"
instance FromJSON GitObject where
parseJSON (Object o) =
GitObject <$> o .: "type"
<*> o .: "sha"
<*> o .: "url"
parseJSON _ = fail "Could not build a GitObject"
instance FromJSON Issue where
parseJSON (Object o) =
Issue <$> o .:? "closed_at"
<*> o .: "updated_at"
<*> o .: "html_url"
<*> o .:? "closed_by"
<*> o .: "labels"
<*> o .: "number"
<*> o .:? "assignee"
<*> o .: "user"
<*> o .: "title"
<*> o .: "pull_request"
<*> o .: "url"
<*> o .: "created_at"
<*> o .: "body"
<*> o .: "state"
<*> o .: "id"
<*> o .: "comments"
<*> o .:? "milestone"
parseJSON _ = fail "Could not build an Issue"
instance ToJSON NewIssue where
toJSON (NewIssue t b a m ls) =
object
[ "title" .= t
, "body" .= b
, "assignee" .= a
, "milestone" .= m
, "labels" .= ls ]
instance ToJSON EditIssue where
toJSON (EditIssue t b a s m ls) =
object $ filter notNull $ [ "title" .= t
, "body" .= b
, "assignee" .= a
, "state" .= s
, "milestone" .= m
, "labels" .= ls ]
where notNull (_, Null) = False
notNull (_, _) = True
instance FromJSON Milestone where
parseJSON (Object o) =
Milestone <$> o .: "creator"
<*> o .: "due_on"
<*> o .: "open_issues"
<*> o .: "number"
<*> o .: "closed_issues"
<*> o .: "description"
<*> o .: "title"
<*> o .: "url"
<*> o .: "created_at"
<*> o .: "state"
parseJSON _ = fail "Could not build a Milestone"
instance FromJSON IssueLabel where
parseJSON (Object o) =
IssueLabel <$> o .: "color"
<*> o .: "url"
<*> o .: "name"
parseJSON _ = fail "Could not build a Milestone"
instance FromJSON PullRequestReference where
parseJSON (Object o) =
PullRequestReference <$> o .:? "html_url"
<*> o .:? "patch_url"
<*> o .:? "diff_url"
parseJSON _ = fail "Could not build a PullRequest"
instance FromJSON IssueComment where
parseJSON (Object o) =
IssueComment <$> o .: "updated_at"
<*> o .: "user"
<*> o .: "url"
<*> o .: "created_at"
<*> o .: "body"
<*> o .: "id"
parseJSON _ = fail "Could not build an IssueComment"
instance FromJSON Event where
parseJSON (Object o) =
Event <$> o .: "actor"
<*> o .: "event"
<*> o .:? "commit_id"
<*> o .: "url"
<*> o .: "created_at"
<*> o .: "id"
<*> o .:? "issue"
parseJSON _ = fail "Could not build an Event"
instance FromJSON EventType where
parseJSON (String "closed") = pure Closed
parseJSON (String "reopened") = pure Reopened
parseJSON (String "subscribed") = pure Subscribed
parseJSON (String "merged") = pure Merged
parseJSON (String "referenced") = pure Referenced
parseJSON (String "mentioned") = pure Mentioned
parseJSON (String "assigned") = pure Assigned
parseJSON (String "unsubscribed") = pure Unsubscribed
parseJSON _ = fail "Could not build an EventType"
instance FromJSON SimpleOrganization where
parseJSON (Object o) =
SimpleOrganization <$> o .: "url"
<*> o .: "avatar_url"
<*> o .: "id"
<*> o .: "login"
parseJSON _ = fail "Could not build a SimpleOrganization"
instance FromJSON Organization where
parseJSON (Object o) =
Organization <$> o .: "type"
<*> o .:? "blog"
<*> o .:? "location"
<*> o .: "login"
<*> o .: "followers"
<*> o .:? "company"
<*> o .: "avatar_url"
<*> o .: "public_gists"
<*> o .: "html_url"
<*> o .:? "email"
<*> o .: "following"
<*> o .: "public_repos"
<*> o .: "url"
<*> o .: "created_at"
<*> o .:? "name"
<*> o .: "id"
parseJSON _ = fail "Could not build an Organization"
instance FromJSON PullRequest where
parseJSON (Object o) =
PullRequest
<$> o .:? "closed_at"
<*> o .: "created_at"
<*> o .: "user"
<*> o .: "patch_url"
<*> o .: "state"
<*> o .: "number"
<*> o .: "html_url"
<*> o .: "updated_at"
<*> o .: "body"
<*> o .: "issue_url"
<*> o .: "diff_url"
<*> o .: "url"
<*> o .: "_links"
<*> o .:? "merged_at"
<*> o .: "title"
<*> o .: "id"
parseJSON _ = fail "Could not build a PullRequest"
instance FromJSON DetailedPullRequest where
parseJSON (Object o) =
DetailedPullRequest
<$> o .:? "closed_at"
<*> o .: "created_at"
<*> o .: "user"
<*> o .: "patch_url"
<*> o .: "state"
<*> o .: "number"
<*> o .: "html_url"
<*> o .: "updated_at"
<*> o .: "body"
<*> o .: "issue_url"
<*> o .: "diff_url"
<*> o .: "url"
<*> o .: "_links"
<*> o .:? "merged_at"
<*> o .: "title"
<*> o .: "id"
<*> o .:? "merged_by"
<*> o .: "changed_files"
<*> o .: "head"
<*> o .: "comments"
<*> o .: "deletions"
<*> o .: "additions"
<*> o .: "review_comments"
<*> o .: "base"
<*> o .: "commits"
<*> o .: "merged"
<*> o .: "mergeable"
parseJSON _ = fail "Could not build a DetailedPullRequest"
instance FromJSON PullRequestLinks where
parseJSON (Object o) =
PullRequestLinks <$> o <.:> ["review_comments", "href"]
<*> o <.:> ["comments", "href"]
<*> o <.:> ["html", "href"]
<*> o <.:> ["self", "href"]
parseJSON _ = fail "Could not build a PullRequestLinks"
instance FromJSON PullRequestCommit where
parseJSON (Object _) =
return PullRequestCommit
parseJSON _ = fail "Could not build a PullRequestCommit"
instance FromJSON SearchReposResult where
parseJSON (Object o) =
SearchReposResult <$> o .: "total_count"
<*> o .:< "items"
parseJSON _ = fail "Could not build a SearchReposResult"
instance FromJSON Repo where
parseJSON (Object o) =
Repo <$> o .: "ssh_url"
<*> o .: "description"
<*> o .: "created_at"
<*> o .: "html_url"
<*> o .: "svn_url"
<*> o .: "forks"
<*> o .:? "homepage"
<*> o .: "fork"
<*> o .: "git_url"
<*> o .: "private"
<*> o .: "clone_url"
<*> o .: "size"
<*> o .: "updated_at"
<*> o .: "watchers"
<*> o .: "owner"
<*> o .: "name"
<*> o .: "language"
<*> o .:? "master_branch"
<*> o .: "pushed_at"
<*> o .: "id"
<*> o .: "url"
<*> o .: "open_issues"
<*> o .:? "has_wiki"
<*> o .:? "has_issues"
<*> o .:? "has_downloads"
<*> o .:? "parent"
<*> o .:? "source"
parseJSON _ = fail "Could not build a Repo"
instance FromJSON RepoRef where
parseJSON (Object o) =
RepoRef <$> o .: "owner"
<*> o .: "name"
parseJSON _ = fail "Could not build a RepoRef"
instance FromJSON Contributor where
parseJSON (Object o)
| o `at` "type" == (Just "Anonymous") =
AnonymousContributor <$> o .: "contributions"
<*> o .: "name"
| otherwise =
KnownContributor <$> o .: "contributions"
<*> o .: "avatar_url"
<*> o .: "login"
<*> o .: "url"
<*> o .: "id"
<*> o .: "gravatar_id"
parseJSON _ = fail "Could not build a Contributor"
instance FromJSON Languages where
parseJSON (Object o) =
Languages <$>
mapM (\name -> Language (T.unpack name) <$> o .: name)
(Map.keys o)
parseJSON _ = fail "Could not build Languages"
instance FromJSON Tag where
parseJSON (Object o) =
Tag <$> o .: "name"
<*> o .: "zipball_url"
<*> o .: "tarball_url"
<*> o .: "commit"
parseJSON _ = fail "Could not build a Tag"
instance FromJSON Branch where
parseJSON (Object o) = Branch <$> o .: "name" <*> o .: "commit"
parseJSON _ = fail "Could not build a Branch"
instance FromJSON BranchCommit where
parseJSON (Object o) = BranchCommit <$> o .: "sha" <*> o .: "url"
parseJSON _ = fail "Could not build a BranchCommit"
instance FromJSON DetailedOwner where
parseJSON (Object o)
| o `at` "gravatar_id" == Nothing =
DetailedOrganization <$> o .: "created_at"
<*> o .: "type"
<*> o .: "public_gists"
<*> o .: "avatar_url"
<*> o .: "followers"
<*> o .: "following"
<*> o .:? "blog"
<*> o .:? "bio"
<*> o .: "public_repos"
<*> o .:? "name"
<*> o .:? "location"
<*> o .:? "company"
<*> o .: "url"
<*> o .: "id"
<*> o .: "html_url"
<*> o .: "login"
| otherwise =
DetailedUser <$> o .: "created_at"
<*> o .: "type"
<*> o .: "public_gists"
<*> o .: "avatar_url"
<*> o .: "followers"
<*> o .: "following"
<*> o .: "hireable"
<*> o .: "gravatar_id"
<*> o .:? "blog"
<*> o .:? "bio"
<*> o .: "public_repos"
<*> o .:? "name"
<*> o .:? "location"
<*> o .:? "company"
<*> o .: "email"
<*> o .: "url"
<*> o .: "id"
<*> o .: "html_url"
<*> o .: "login"
parseJSON _ = fail "Could not build a DetailedOwner"
(.:<) :: (FromJSON a) => Object -> T.Text -> Parser [a]
obj .:< key = case Map.lookup key obj of
Nothing -> pure mzero
Just v -> parseJSON v
values :: (Eq k, Hashable k, FromJSON v) => Map.HashMap k Value -> k -> Parser v
obj `values` key =
let (Object children) = findWithDefault (Object Map.empty) key obj in
parseJSON $ Array $ V.fromList $ Map.elems children
(<.:>) :: (FromJSON v) => Object -> [T.Text] -> Parser v
obj <.:> [key] = obj .: key
obj <.:> (key:keys) =
let (Object nextObj) = findWithDefault (Object Map.empty) key obj in
nextObj <.:> keys
at :: Object -> T.Text -> Maybe Value
obj `at` key = Map.lookup key obj
findWithDefault :: (Eq k, Hashable k) => v -> k -> Map.HashMap k v -> v
findWithDefault def k m =
case Map.lookup k m of
Nothing -> def
Just x -> x