github-data (empty) → 0.18
raw patch · 29 files changed
+4072/−0 lines, 29 filesdep +aesondep +aeson-compatdep +aeson-extra
Dependencies added: aeson, aeson-compat, aeson-extra, base, base-compat, base16-bytestring, binary, binary-orphans, bytestring, containers, deepseq, deepseq-generics, exceptions, hashable, http-client, http-types, iso8601-time, network-uri, text, time, tls, transformers, transformers-compat, unordered-containers, vector, vector-instances
Files
- LICENSE +30/−0
- github-data.cabal +117/−0
- src/GitHub/Auth.hs +26/−0
- src/GitHub/Data.hs +131/−0
- src/GitHub/Data/Activities.hs +26/−0
- src/GitHub/Data/Comments.hs +66/−0
- src/GitHub/Data/Content.hs +208/−0
- src/GitHub/Data/Definitions.hs +258/−0
- src/GitHub/Data/DeployKeys.hs +52/−0
- src/GitHub/Data/Email.hs +39/−0
- src/GitHub/Data/Events.hs +33/−0
- src/GitHub/Data/Gists.hs +91/−0
- src/GitHub/Data/GitData.hs +317/−0
- src/GitHub/Data/Id.hs +36/−0
- src/GitHub/Data/Issues.hs +203/−0
- src/GitHub/Data/Milestone.hs +42/−0
- src/GitHub/Data/Name.hs +54/−0
- src/GitHub/Data/Options.hs +604/−0
- src/GitHub/Data/PullRequests.hs +328/−0
- src/GitHub/Data/Releases.hs +85/−0
- src/GitHub/Data/Repos.hs +270/−0
- src/GitHub/Data/Request.hs +258/−0
- src/GitHub/Data/Reviews.hs +97/−0
- src/GitHub/Data/Search.hs +51/−0
- src/GitHub/Data/Statuses.hs +110/−0
- src/GitHub/Data/Teams.hs +249/−0
- src/GitHub/Data/URL.hs +30/−0
- src/GitHub/Data/Webhooks.hs +201/−0
- src/GitHub/Internal/Prelude.hs +60/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Mike Burns++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Mike Burns nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ github-data.cabal view
@@ -0,0 +1,117 @@+name: github-data+version: 0.18+synopsis: Access to the GitHub API, v3.+description:+ The GitHub API provides programmatic access to the full+ GitHub Web site, from Issues to Gists to repos down to the underlying git data+ like references and trees. This library wraps all of that, exposing a basic but+ Haskell-friendly set of functions and data structures.+ .+ For supported endpoints see "GitHub" module.+ .+ > import qualified GitHub as GH+ >+ > main :: IO ()+ > main = do+ > possibleUser <- GH.executeRequest' $ GH.userInfoR "phadej"+ > print possibleUser+ .+ For more of an overview please see the README: <https://github.com/phadej/github/blob/master/README.md>+license: BSD3+license-file: LICENSE+author: Mike Burns, John Wiegley, Oleg Grenrus+maintainer: M Farkas-Dyck <strake888@gmail.com>+homepage: https://github.com/strake/github.hs+copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus+category: Network+build-type: Simple+tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1+cabal-version: >=1.10++flag aeson-compat+ description: Whether to use aeson-compat or aeson-extra+ default: True+ manual: False++source-repository head+ type: git+ location: git://github.com/phadej/github.git++Library+ default-language: Haskell2010+ ghc-options: -Wall+ hs-source-dirs: src+ default-extensions:+ DataKinds+ DeriveDataTypeable+ DeriveGeneric+ OverloadedStrings+ ScopedTypeVariables+ other-extensions:+ CPP+ FlexibleContexts+ FlexibleInstances+ GADTs+ KindSignatures+ StandaloneDeriving+ exposed-modules:+ GitHub.Auth+ GitHub.Data+ GitHub.Data.Activities+ GitHub.Data.Comments+ GitHub.Data.Content+ GitHub.Data.Definitions+ GitHub.Data.DeployKeys+ GitHub.Data.Email+ GitHub.Data.Events+ GitHub.Data.Gists+ GitHub.Data.GitData+ GitHub.Data.Id+ GitHub.Data.Issues+ GitHub.Data.Milestone+ GitHub.Data.Name+ GitHub.Data.Options+ GitHub.Data.PullRequests+ GitHub.Data.Releases+ GitHub.Data.Repos+ GitHub.Data.Request+ GitHub.Data.Reviews+ GitHub.Data.Search+ GitHub.Data.Statuses+ GitHub.Data.Teams+ GitHub.Data.URL+ GitHub.Data.Webhooks+ other-modules:+ GitHub.Internal.Prelude++ -- Packages needed in order to build this package.+ build-depends: base >=4.7 && <4.11,+ aeson >=0.7.0.6 && <1.3,+ base-compat >=0.9.1 && <0.10,+ base16-bytestring >=0.1.1.6 && <0.2,+ binary >=0.7.1.0 && <0.10,+ binary-orphans >=0.1.0.0 && <0.2,+ bytestring >=0.10.4.0 && <0.11,+ containers >=0.5.5.1 && <0.6,+ deepseq >=1.3.0.2 && <1.5,+ deepseq-generics >=0.1.1.2 && <0.3,+ exceptions >=0.8.0.2 && <0.9,+ hashable >=1.2.3.3 && <1.3,+ http-client >=0.4.8.1 && <0.6,+ http-types >=0.8.6 && <0.12,+ iso8601-time >=0.1.4 && <0.2,+ network-uri >=2.6.0.3 && <2.7,+ text >=1.2.0.6 && <1.3,+ time >=1.4 && <1.9,+ transformers >=0.3.0.0 && <0.6,+ transformers-compat >=0.4.0.3 && <0.6,+ unordered-containers >=0.2 && <0.3,+ vector >=0.10.12.3 && <0.13,+ vector-instances >=3.3.0.1 && <3.5,++ tls >=1.3.5++ if flag(aeson-compat)+ build-depends: aeson-compat >=0.3.0.0 && <0.4+ else+ build-depends: aeson-extra >=0.2.0.0 && <0.3
+ src/GitHub/Auth.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Auth where++import GitHub.Internal.Prelude+import Prelude ()++import qualified Data.ByteString as BS++type Token = BS.ByteString++-- | The Github auth data type+data Auth+ = BasicAuth BS.ByteString BS.ByteString+ | OAuth Token -- ^ token+ | EnterpriseOAuth Text -- custom API endpoint without+ -- trailing slash+ Token -- token+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Auth where rnf = genericRnf+instance Binary Auth+instance Hashable Auth
+ src/GitHub/Data.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- This module re-exports the @GitHub.Data.@ and "Github.Auth" submodules.+module GitHub.Data (+ -- * Tagged types+ -- ** Name+ Name,+ mkName,+ untagName,+ mkOwnerName,+ mkUserName,+ mkTeamName,+ mkOrganizationName,+ mkRepoName,+ mkCommitName,+ fromUserName,+ fromOrganizationName,+ -- ** Id+ Id,+ mkId,+ untagId,+ mkOwnerId,+ mkUserId,+ mkTeamId,+ mkOrganizationId,+ mkRepoId,+ fromUserId,+ fromOrganizationId,+ -- * Module re-exports+ module GitHub.Auth,+ module GitHub.Data.Activities,+ module GitHub.Data.Comments,+ module GitHub.Data.Content,+ module GitHub.Data.Definitions,+ module GitHub.Data.DeployKeys,+ module GitHub.Data.Email,+ module GitHub.Data.Events,+ module GitHub.Data.Gists,+ module GitHub.Data.GitData,+ module GitHub.Data.Issues,+ module GitHub.Data.Milestone,+ module GitHub.Data.Options,+ module GitHub.Data.PullRequests,+ module GitHub.Data.Releases,+ module GitHub.Data.Repos,+ module GitHub.Data.Request,+ module GitHub.Data.Reviews,+ module GitHub.Data.Search,+ module GitHub.Data.Statuses,+ module GitHub.Data.Teams,+ module GitHub.Data.URL,+ module GitHub.Data.Webhooks+ ) where++import GitHub.Internal.Prelude+import Prelude ()++import GitHub.Auth+import GitHub.Data.Activities+import GitHub.Data.Comments+import GitHub.Data.Content+import GitHub.Data.Definitions+import GitHub.Data.DeployKeys+import GitHub.Data.Email+import GitHub.Data.Events+import GitHub.Data.Gists+import GitHub.Data.GitData+import GitHub.Data.Id+import GitHub.Data.Issues+import GitHub.Data.Milestone+import GitHub.Data.Name+import GitHub.Data.Options+import GitHub.Data.PullRequests+import GitHub.Data.Releases+import GitHub.Data.Repos+import GitHub.Data.Request+import GitHub.Data.Reviews+import GitHub.Data.Search+import GitHub.Data.Statuses+import GitHub.Data.Teams+import GitHub.Data.URL+import GitHub.Data.Webhooks++mkOwnerId :: Int -> Id Owner+mkOwnerId = Id++mkOwnerName :: Text -> Name Owner+mkOwnerName = N++mkUserId :: Int -> Id User+mkUserId = Id++mkUserName :: Text -> Name User+mkUserName = N++mkTeamId :: Int -> Id Team+mkTeamId = Id++mkTeamName :: Text -> Name Team+mkTeamName = N++mkOrganizationId :: Int -> Id Organization+mkOrganizationId = Id++mkOrganizationName :: Text -> Name Organization+mkOrganizationName = N++mkRepoId :: Int -> Id Repo+mkRepoId = Id++mkRepoName :: Text -> Name Repo+mkRepoName = N++mkCommitName :: Text -> Name Commit+mkCommitName = N++fromOrganizationName :: Name Organization -> Name Owner+fromOrganizationName = N . untagName++fromUserName :: Name User -> Name Owner+fromUserName = N . untagName++fromOrganizationId :: Id Organization -> Id Owner+fromOrganizationId = Id . untagId++fromUserId :: Id User -> Id Owner+fromUserId = Id . untagId
+ src/GitHub/Data/Activities.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Activities where++import GitHub.Data.Repos (Repo)+import GitHub.Internal.Prelude+import Prelude ()++data RepoStarred = RepoStarred+ { repoStarredStarredAt :: !UTCTime+ , repoStarredRepo :: !Repo+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData RepoStarred where rnf = genericRnf+instance Binary RepoStarred++-- JSON Instances+instance FromJSON RepoStarred where+ parseJSON = withObject "RepoStarred" $ \o -> RepoStarred+ <$> o .: "starred_at"+ <*> o .: "repo"+
+ src/GitHub/Data/Comments.hs view
@@ -0,0 +1,66 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Comments where++import GitHub.Data.Definitions+import GitHub.Data.Id (Id)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++data Comment = Comment+ { commentPosition :: !(Maybe Int)+ , commentLine :: !(Maybe Int)+ , commentBody :: !Text+ , commentCommitId :: !(Maybe Text)+ , commentUpdatedAt :: !UTCTime+ , commentHtmlUrl :: !(Maybe URL)+ , commentUrl :: !URL+ , commentCreatedAt :: !(Maybe UTCTime)+ , commentPath :: !(Maybe Text)+ , commentUser :: !SimpleUser+ , commentId :: !(Id Comment)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Comment where rnf = genericRnf+instance Binary Comment++instance FromJSON Comment where+ parseJSON = withObject "Comment" $ \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"++data NewComment = NewComment+ { newCommentBody :: !Text+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData NewComment where rnf = genericRnf+instance Binary NewComment++instance ToJSON NewComment where+ toJSON (NewComment b) = object [ "body" .= b ]++data EditComment = EditComment+ { editCommentBody :: !Text+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData EditComment where rnf = genericRnf+instance Binary EditComment++instance ToJSON EditComment where+ toJSON (EditComment b) = object [ "body" .= b ]
+ src/GitHub/Data/Content.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE RecordWildCards #-}+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Content where++import Data.Aeson.Types (Pair)+import Data.Maybe (maybe)+import GitHub.Data.GitData+import GitHub.Data.URL+import GitHub.Internal.Prelude+import Prelude ()++data Content+ = ContentFile !ContentFileData+ | ContentDirectory !(Vector ContentItem)+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Content where rnf = genericRnf+instance Binary Content++data ContentFileData = ContentFileData {+ contentFileInfo :: !ContentInfo+ ,contentFileEncoding :: !Text+ ,contentFileSize :: !Int+ ,contentFileContent :: !Text+} deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData ContentFileData where rnf = genericRnf+instance Binary ContentFileData++-- | An item in a directory listing.+data ContentItem = ContentItem {+ contentItemType :: !ContentItemType+ ,contentItemInfo :: !ContentInfo+} deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData ContentItem where rnf = genericRnf+instance Binary ContentItem++data ContentItemType = ItemFile | ItemDir+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData ContentItemType where rnf = genericRnf+instance Binary ContentItemType++-- | Information common to both kinds of Content: files and directories.+data ContentInfo = ContentInfo {+ contentName :: !Text+ ,contentPath :: !Text+ ,contentSha :: !Text+ ,contentUrl :: !URL+ ,contentGitUrl :: !URL+ ,contentHtmlUrl :: !URL+} deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData ContentInfo where rnf = genericRnf+instance Binary ContentInfo++data ContentResultInfo = ContentResultInfo+ { contentResultInfo :: !ContentInfo+ , contentResultSize :: !Int+ } deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData ContentResultInfo where rnf = genericRnf+instance Binary ContentResultInfo++data ContentResult = ContentResult+ { contentResultContent :: !ContentResultInfo+ , contentResultCommit :: !GitCommit+ } deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData ContentResult where rnf = genericRnf+instance Binary ContentResult++data Author = Author+ { authorName :: !Text+ , authorEmail :: !Text+ }+ deriving (Eq, Ord, Show, Data, Typeable, Generic)++instance NFData Author where rnf = genericRnf+instance Binary Author++data CreateFile = CreateFile+ { createFilePath :: !Text+ , createFileMessage :: !Text+ , createFileContent :: !Text+ , createFileBranch :: !(Maybe Text)+ , createFileAuthor :: !(Maybe Author)+ , createFileCommitter :: !(Maybe Author)+ }+ deriving (Eq, Ord, Show, Data, Typeable, Generic)++instance NFData CreateFile where rnf = genericRnf+instance Binary CreateFile++data UpdateFile = UpdateFile+ { updateFilePath :: !Text+ , updateFileMessage :: !Text+ , updateFileContent :: !Text+ , updateFileSHA :: !Text+ , updateFileBranch :: !(Maybe Text)+ , updateFileAuthor :: !(Maybe Author)+ , updateFileCommitter :: !(Maybe Author)+ }+ deriving (Eq, Ord, Show, Data, Typeable, Generic)++instance NFData UpdateFile where rnf = genericRnf+instance Binary UpdateFile++data DeleteFile = DeleteFile+ { deleteFilePath :: !Text+ , deleteFileMessage :: !Text+ , deleteFileSHA :: !Text+ , deleteFileBranch :: !(Maybe Text)+ , deleteFileAuthor :: !(Maybe Author)+ , deleteFileCommitter :: !(Maybe Author)+ }+ deriving (Eq, Ord, Show, Data, Typeable, Generic)++instance NFData DeleteFile where rnf = genericRnf+instance Binary DeleteFile++instance FromJSON Content where+ parseJSON o@(Object _) = ContentFile <$> parseJSON o+ parseJSON (Array os) = ContentDirectory <$> traverse parseJSON os+ parseJSON _ = fail "Could not build a Content"++instance FromJSON ContentFileData where+ parseJSON = withObject "ContentFileData" $ \o ->+ ContentFileData <$> parseJSON (Object o)+ <*> o .: "encoding"+ <*> o .: "size"+ <*> o .: "content"++instance FromJSON ContentItem where+ parseJSON = withObject "ContentItem" $ \o ->+ ContentItem <$> o .: "type"+ <*> parseJSON (Object o)++instance FromJSON ContentItemType where+ parseJSON = withText "ContentItemType" $ \t ->+ case t of+ "file" -> return ItemFile+ "dir" -> return ItemDir+ _ -> fail $ "Invalid ContentItemType: " ++ unpack t++instance FromJSON ContentInfo where+ parseJSON = withObject "ContentInfo" $ \o ->+ ContentInfo <$> o .: "name"+ <*> o .: "path"+ <*> o .: "sha"+ <*> o .: "url"+ <*> o .: "git_url"+ <*> o .: "html_url"++instance FromJSON ContentResultInfo where+ parseJSON = withObject "ContentResultInfo" $ \o ->+ ContentResultInfo <$> parseJSON (Object o)+ <*> o .: "size"++instance FromJSON ContentResult where+ parseJSON = withObject "ContentResult" $ \o ->+ ContentResult <$> o .: "content"+ <*> o .: "commit"++instance ToJSON Author where+ toJSON Author {..} = object+ [ "name" .= authorName+ , "email" .= authorEmail+ ]++instance ToJSON CreateFile where+ toJSON CreateFile {..} = object $+ [ "path" .= createFilePath+ , "message" .= createFileMessage+ , "content" .= createFileContent+ ]+ ++ "branch" .=? createFileBranch+ ++ "author" .=? createFileAuthor+ ++ "committer" .=? createFileCommitter++instance ToJSON UpdateFile where+ toJSON UpdateFile {..} = object $+ [ "path" .= updateFilePath+ , "message" .= updateFileMessage+ , "content" .= updateFileContent+ , "sha" .= updateFileSHA+ ]+ ++ "branch" .=? updateFileBranch+ ++ "author" .=? updateFileAuthor+ ++ "committer" .=? updateFileCommitter++instance ToJSON DeleteFile where+ toJSON DeleteFile {..} = object $+ [ "path" .= deleteFilePath+ , "message" .= deleteFileMessage+ , "sha" .= deleteFileSHA+ ]+ ++ "branch" .=? deleteFileBranch+ ++ "author" .=? deleteFileAuthor+ ++ "committer" .=? deleteFileCommitter++(.=?) :: ToJSON v => Text -> Maybe v -> [Pair]+name .=? value = maybe [] (pure . (name .=)) value
+ src/GitHub/Data/Definitions.hs view
@@ -0,0 +1,258 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Definitions where++import GitHub.Internal.Prelude+import Prelude ()++import Control.Monad (mfilter)+import Data.Aeson.Types (Parser)+import Network.HTTP.Client (HttpException)++import qualified Control.Exception as E+import qualified Data.ByteString as BS+import qualified Data.Text as T++import GitHub.Data.Id (Id)+import GitHub.Data.Name (Name)+import GitHub.Data.URL (URL)++-- | Errors have been tagged according to their source, so you can more easily+-- dispatch and handle them.+data Error+ = HTTPError !HttpException -- ^ A HTTP error occurred. The actual caught error is included.+ | ParseError !Text -- ^ An error in the parser itself.+ | JsonError !Text -- ^ The JSON is malformed or unexpected.+ | UserError !Text -- ^ Incorrect input.+ deriving (Show, Typeable)++instance E.Exception Error++-- | Type of the repository owners.+data OwnerType = OwnerUser | OwnerOrganization+ deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data)++instance NFData OwnerType+instance Binary OwnerType++data SimpleUser = SimpleUser+ { simpleUserId :: !(Id User)+ , simpleUserLogin :: !(Name User)+ , simpleUserAvatarUrl :: !URL+ , simpleUserUrl :: !URL+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData SimpleUser where rnf = genericRnf+instance Binary SimpleUser++data SimpleOrganization = SimpleOrganization+ { simpleOrganizationId :: !(Id Organization)+ , simpleOrganizationLogin :: !(Name Organization)+ , simpleOrganizationUrl :: !URL+ , simpleOrganizationAvatarUrl :: !URL+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData SimpleOrganization where rnf = genericRnf+instance Binary SimpleOrganization++-- | Sometimes we don't know the type of the owner, e.g. in 'Repo'+data SimpleOwner = SimpleOwner+ { simpleOwnerId :: !(Id Owner)+ , simpleOwnerLogin :: !(Name Owner)+ , simpleOwnerUrl :: !URL+ , simpleOwnerAvatarUrl :: !URL+ , simpleOwnerType :: !OwnerType+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData SimpleOwner where rnf = genericRnf+instance Binary SimpleOwner++data User = User+ { userId :: !(Id User)+ , userLogin :: !(Name User)+ , userName :: !(Maybe Text)+ , userType :: !OwnerType -- ^ Should always be 'OwnerUser'+ , userCreatedAt :: !UTCTime+ , userPublicGists :: !Int+ , userAvatarUrl :: !URL+ , userFollowers :: !Int+ , userFollowing :: !Int+ , userHireable :: !(Maybe Bool)+ , userBlog :: !(Maybe Text)+ , userBio :: !(Maybe Text)+ , userPublicRepos :: !Int+ , userLocation :: !(Maybe Text)+ , userCompany :: !(Maybe Text)+ , userEmail :: !(Maybe Text)+ , userUrl :: !URL+ , userHtmlUrl :: !URL+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData User where rnf = genericRnf+instance Binary User++data Organization = Organization+ { organizationId :: !(Id Organization)+ , organizationLogin :: !(Name Organization)+ , organizationName :: !(Maybe Text)+ , organizationType :: !OwnerType -- ^ Should always be 'OwnerOrganization'+ , organizationBlog :: !(Maybe Text)+ , organizationLocation :: !(Maybe Text)+ , organizationFollowers :: !Int+ , organizationCompany :: !(Maybe Text)+ , organizationAvatarUrl :: !URL+ , organizationPublicGists :: !Int+ , organizationHtmlUrl :: !URL+ , organizationEmail :: !(Maybe Text)+ , organizationFollowing :: !Int+ , organizationPublicRepos :: !Int+ , organizationUrl :: !URL+ , organizationCreatedAt :: !UTCTime+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Organization where rnf = genericRnf+instance Binary Organization++-- | In practic, you cam't have concrete values of 'Owner'.+newtype Owner = Owner (Either User Organization)+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Owner where rnf = genericRnf+instance Binary Owner++fromOwner :: Owner -> Either User Organization+fromOwner (Owner owner) = owner++-- JSON instances++instance FromJSON OwnerType where+ parseJSON = withText "Owner type" $ \t ->+ case t of+ "User" -> pure $ OwnerUser+ "Organization" -> pure $ OwnerOrganization+ _ -> fail $ "Unknown owner type: " ++ T.unpack t++instance FromJSON SimpleUser where+ parseJSON = withObject "SimpleUser" $ \obj -> do+ SimpleUser+ <$> obj .: "id"+ <*> obj .: "login"+ <*> obj .: "avatar_url"+ <*> obj .: "url"++instance FromJSON SimpleOrganization where+ parseJSON = withObject "SimpleOrganization" $ \obj ->+ SimpleOrganization+ <$> obj .: "id"+ <*> obj .: "login"+ <*> obj .: "url"+ <*> obj .: "avatar_url"++instance FromJSON SimpleOwner where+ parseJSON = withObject "SimpleOwner" $ \obj -> do+ SimpleOwner+ <$> obj .: "id"+ <*> obj .: "login"+ <*> obj .: "url"+ <*> obj .: "avatar_url"+ <*> obj .: "type"++parseUser :: Object -> Parser User+parseUser obj = User+ <$> obj .: "id"+ <*> obj .: "login"+ <*> obj .:? "name"+ <*> obj .: "type"+ <*> obj .: "created_at"+ <*> obj .: "public_gists"+ <*> obj .: "avatar_url"+ <*> obj .: "followers"+ <*> obj .: "following"+ <*> obj .:? "hireable"+ <*> obj .:? "blog"+ <*> obj .:? "bio"+ <*> obj .: "public_repos"+ <*> obj .:? "location"+ <*> obj .:? "company"+ <*> obj .:? "email"+ <*> obj .: "url"+ <*> obj .: "html_url"++parseOrganization :: Object -> Parser Organization+parseOrganization obj = Organization+ <$> obj .: "id"+ <*> obj .: "login"+ <*> obj .:? "name"+ <*> obj .: "type"+ <*> obj .:? "blog"+ <*> obj .:? "location"+ <*> obj .: "followers"+ <*> obj .:? "company"+ <*> obj .: "avatar_url"+ <*> obj .: "public_gists"+ <*> obj .: "html_url"+ <*> obj .:? "email"+ <*> obj .: "following"+ <*> obj .: "public_repos"+ <*> obj .: "url"+ <*> obj .: "created_at"++instance FromJSON User where+ parseJSON = mfilter ((== OwnerUser) . userType) . withObject "User" parseUser++instance FromJSON Organization where+ parseJSON = withObject "Organization" parseOrganization++instance FromJSON Owner where+ parseJSON = withObject "Owner" $ \obj -> do+ t <- obj .: "type"+ case t of+ OwnerUser -> Owner . Left <$> parseUser obj+ OwnerOrganization -> Owner . Right <$> parseOrganization obj++-- | Filter members returned in the list.+data OrgMemberFilter+ = OrgMemberFilter2faDisabled -- ^ Members without two-factor authentication enabled. Available for organization owners.+ | OrgMemberFilterAll -- ^ All members the authenticated user can see.+ deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic)++-- | Filter members returned by their role.+data OrgMemberRole+ = OrgMemberRoleAll -- ^ All members of the organization, regardless of role.+ | OrgMemberRoleAdmin -- ^ Organization owners.+ | OrgMemberRoleMember -- ^ Non-owner organization members.+ deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic)++-- | Request query string+type QueryString = [(BS.ByteString, Maybe BS.ByteString)]++-- | Count of elements+type Count = Int++-------------------------------------------------------------------------------+-- IssueLabel+-------------------------------------------------------------------------------++data IssueLabel = IssueLabel+ { labelColor :: !Text+ , labelUrl :: !URL+ , labelName :: !(Name IssueLabel)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData IssueLabel where rnf = genericRnf+instance Binary IssueLabel++instance FromJSON IssueLabel where+ parseJSON = withObject "IssueLabel" $ \o -> IssueLabel+ <$> o .: "color"+ <*> o .: "url"+ <*> o .: "name"
+ src/GitHub/Data/DeployKeys.hs view
@@ -0,0 +1,52 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Todd Mohney <toddmohney@gmail.com>+--+module GitHub.Data.DeployKeys where++import GitHub.Data.Id (Id)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++data RepoDeployKey = RepoDeployKey+ { repoDeployKeyId :: !(Id RepoDeployKey)+ , repoDeployKeyKey :: !Text+ , repoDeployKeyUrl :: !URL+ , repoDeployKeyTitle :: !Text+ , repoDeployKeyVerified :: !Bool+ , repoDeployKeyCreatedAt :: !UTCTime+ , repoDeployKeyReadOnly :: !Bool+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance FromJSON RepoDeployKey where+ parseJSON = withObject "RepoDeployKey" $ \o -> RepoDeployKey+ <$> o .: "id"+ <*> o .: "key"+ <*> o .: "url"+ <*> o .: "title"+ <*> o .: "verified"+ <*> o .: "created_at"+ <*> o .: "read_only"++data NewRepoDeployKey = NewRepoDeployKey+ { newRepoDeployKeyKey :: !Text+ , newRepoDeployKeyTitle :: !Text+ , newRepoDeployKeyReadOnly :: !Bool+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance ToJSON NewRepoDeployKey where+ toJSON (NewRepoDeployKey key title readOnly) = object+ [ "key" .= key+ , "title" .= title+ , "read_only" .= readOnly+ ]++instance FromJSON NewRepoDeployKey where+ parseJSON = withObject "RepoDeployKey" $ \o -> NewRepoDeployKey+ <$> o .: "key"+ <*> o .: "title"+ <*> o .: "read_only"
+ src/GitHub/Data/Email.hs view
@@ -0,0 +1,39 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Email where++import GitHub.Internal.Prelude+import Prelude ()++data EmailVisibility+ = EmailVisibilityPrivate+ | EmailVisibilityPublic+ deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic)++instance NFData EmailVisibility where rnf = genericRnf+instance Binary EmailVisibility++instance FromJSON EmailVisibility where+ parseJSON (String "private") = pure EmailVisibilityPrivate+ parseJSON (String "public") = pure EmailVisibilityPublic+ parseJSON _ = fail "Could not build an EmailVisibility"++data Email = Email+ { emailAddress :: !Text+ , emailVerified :: !Bool+ , emailPrimary :: !Bool+ , emailVisibility :: !(Maybe EmailVisibility)+ } deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Email where rnf = genericRnf+instance Binary Email++instance FromJSON Email where+ parseJSON = withObject "Email" $ \o -> Email+ <$> o .: "email"+ <*> o .: "verified"+ <*> o .: "primary"+ <*> o .:? "visibility"
+ src/GitHub/Data/Events.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Events where++import GitHub.Data.Definitions+import GitHub.Internal.Prelude+import Prelude ()++-- | Events.+--+-- /TODO:/+--+-- * missing repo, org, payload, id+data Event = Event+ -- { eventId :: !(Id Event) -- id can be encoded as string.+ { eventActor :: !SimpleUser+ , eventCreatedAt :: !UTCTime+ , eventPublic :: !Bool+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Event where rnf = genericRnf+instance Binary Event ++instance FromJSON Event where+ parseJSON = withObject "Event" $ \obj -> Event + -- <$> obj .: "id"+ <$> obj .: "actor"+ <*> obj .: "created_at"+ <*> obj .: "public"
+ src/GitHub/Data/Gists.hs view
@@ -0,0 +1,91 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Gists where++import GitHub.Data.Definitions+import GitHub.Data.Id (Id)+import GitHub.Data.Name (Name)+import GitHub.Data.Repos (Language)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++data Gist = Gist+ { gistUser :: !SimpleUser+ , gistGitPushUrl :: !URL+ , gistUrl :: !URL+ , gistDescription :: !(Maybe Text)+ , gistCreatedAt :: !UTCTime+ , gistPublic :: !Bool+ , gistComments :: !Int+ , gistUpdatedAt :: !UTCTime+ , gistHtmlUrl :: !URL+ , gistId :: !(Name Gist)+ , gistFiles :: !(HashMap Text GistFile)+ , gistGitPullUrl :: !URL+ } deriving (Show, Data, Typeable, Eq, Generic)++instance NFData Gist where rnf = genericRnf+instance Binary Gist++instance FromJSON Gist where+ parseJSON = withObject "Gist" $ \o -> Gist+ <$> o .: "owner"+ <*> o .: "git_push_url"+ <*> o .: "url"+ <*> o .:? "description"+ <*> o .: "created_at"+ <*> o .: "public"+ <*> o .: "comments"+ <*> o .: "updated_at"+ <*> o .: "html_url"+ <*> o .: "id"+ <*> o .: "files"+ <*> o .: "git_push_url"++data GistFile = GistFile+ { gistFileType :: !Text+ , gistFileRawUrl :: !URL+ , gistFileSize :: !Int+ , gistFileLanguage :: !(Maybe Language)+ , gistFileFilename :: !Text+ , gistFileContent :: !(Maybe Text)+ }+ deriving (Show, Data, Typeable, Eq, Generic)++instance NFData GistFile where rnf = genericRnf+instance Binary GistFile++instance FromJSON GistFile where+ parseJSON = withObject "GistFile" $ \o -> GistFile+ <$> o .: "type"+ <*> o .: "raw_url"+ <*> o .: "size"+ <*> o .:? "language"+ <*> o .: "filename"+ <*> o .:? "content"++data GistComment = GistComment+ { gistCommentUser :: !SimpleUser+ , gistCommentUrl :: !URL+ , gistCommentCreatedAt :: !UTCTime+ , gistCommentBody :: !Text+ , gistCommentUpdatedAt :: !UTCTime+ , gistCommentId :: !(Id GistComment)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData GistComment where rnf = genericRnf+instance Binary GistComment++instance FromJSON GistComment where+ parseJSON = withObject "GistComment" $ \o -> GistComment+ <$> o .: "user"+ <*> o .: "url"+ <*> o .: "created_at"+ <*> o .: "body"+ <*> o .: "updated_at"+ <*> o .: "id"
+ src/GitHub/Data/GitData.hs view
@@ -0,0 +1,317 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.GitData where++import GitHub.Data.Definitions+import GitHub.Data.Name (Name)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++import qualified Data.Vector as V++-- | The options for querying commits.+data CommitQueryOption+ = CommitQuerySha !Text+ | CommitQueryPath !Text+ | CommitQueryAuthor !Text+ | CommitQuerySince !UTCTime+ | CommitQueryUntil !UTCTime+ deriving (Show, Eq, Ord, Generic, Typeable, Data)++data Stats = Stats+ { statsAdditions :: !Int+ , statsTotal :: !Int+ , statsDeletions :: !Int+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Stats where rnf = genericRnf+instance Binary Stats++data Commit = Commit+ { commitSha :: !(Name Commit)+ , commitParents :: !(Vector Tree)+ , commitUrl :: !URL+ , commitGitCommit :: !GitCommit+ , commitCommitter :: !(Maybe SimpleUser)+ , commitAuthor :: !(Maybe SimpleUser)+ , commitFiles :: !(Vector File)+ , commitStats :: !(Maybe Stats)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Commit where rnf = genericRnf+instance Binary Commit++data Tree = Tree+ { treeSha :: !(Name Tree)+ , treeUrl :: !URL+ , treeGitTrees :: !(Vector GitTree)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Tree where rnf = genericRnf+instance Binary Tree++data GitTree = GitTree+ { gitTreeType :: !Text+ , gitTreeSha :: !(Name GitTree)+ -- Can be empty for submodule+ , gitTreeUrl :: !(Maybe URL)+ , gitTreeSize :: !(Maybe Int)+ , gitTreePath :: !Text+ , gitTreeMode :: !Text+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData GitTree where rnf = genericRnf+instance Binary GitTree++data GitCommit = GitCommit+ { gitCommitMessage :: !Text+ , gitCommitUrl :: !URL+ , gitCommitCommitter :: !GitUser+ , gitCommitAuthor :: !GitUser+ , gitCommitTree :: !Tree+ , gitCommitSha :: !(Maybe (Name GitCommit))+ , gitCommitParents :: !(Vector Tree)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData GitCommit where rnf = genericRnf+instance Binary GitCommit++data Blob = Blob+ { blobUrl :: !URL+ , blobEncoding :: !Text+ , blobContent :: !Text+ , blobSha :: !(Name Blob)+ , blobSize :: !Int+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Blob where rnf = genericRnf+instance Binary Blob++data Tag = Tag+ { tagName :: !Text+ , tagZipballUrl :: !URL+ , tagTarballUrl :: !URL+ , tagCommit :: !BranchCommit+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Tag where rnf = genericRnf+instance Binary Tag++data Branch = Branch+ { branchName :: !Text+ , branchCommit :: !BranchCommit+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Branch where rnf = genericRnf++data BranchCommit = BranchCommit+ { branchCommitSha :: !Text+ , branchCommitUrl :: !URL+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData BranchCommit where rnf = genericRnf+instance Binary BranchCommit++data Diff = Diff+ { diffStatus :: !Text+ , diffBehindBy :: !Int+ , diffPatchUrl :: !URL+ , diffUrl :: !URL+ , diffBaseCommit :: !Commit+ , diffCommits :: !(Vector Commit)+ , diffTotalCommits :: !Int+ , diffHtmlUrl :: !URL+ , diffFiles :: !(Vector File)+ , diffAheadBy :: !Int+ , diffDiffUrl :: !URL+ , diffPermalinkUrl :: !URL+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Diff where rnf = genericRnf+instance Binary Diff++data NewGitReference = NewGitReference+ { newGitReferenceRef :: !Text+ , newGitReferenceSha :: !Text+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData NewGitReference where rnf = genericRnf+instance Binary NewGitReference++data GitReference = GitReference+ { gitReferenceObject :: !GitObject+ , gitReferenceUrl :: !URL+ , gitReferenceRef :: !Text+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData GitReference where rnf = genericRnf+instance Binary GitReference++data GitObject = GitObject+ { gitObjectType :: !Text+ , gitObjectSha :: !Text+ , gitObjectUrl :: !URL+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData GitObject where rnf = genericRnf+instance Binary GitObject++data GitUser = GitUser+ { gitUserName :: !Text+ , gitUserEmail :: !Text+ , gitUserDate :: !UTCTime+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData GitUser where rnf = genericRnf+instance Binary GitUser++data File = File+ { fileBlobUrl :: !URL+ , fileStatus :: !Text+ , fileRawUrl :: !URL+ , fileAdditions :: !Int+ , fileSha :: !Text+ , fileChanges :: !Int+ , filePatch :: !(Maybe Text)+ , fileFilename :: !Text+ , fileDeletions :: !Int+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData File where rnf = genericRnf+instance Binary File++-- JSON instances++instance FromJSON Stats where+ parseJSON = withObject "Stats" $ \o -> Stats+ <$> o .: "additions"+ <*> o .: "total"+ <*> o .: "deletions"++instance FromJSON Commit where+ parseJSON = withObject "Commit" $ \o -> Commit+ <$> o .: "sha"+ <*> o .: "parents"+ <*> o .: "url"+ <*> o .: "commit"+ <*> o .:? "committer"+ <*> o .:? "author"+ <*> o .:? "files" .!= V.empty+ <*> o .:? "stats"++instance FromJSON Tree where+ parseJSON = withObject "Tree" $ \o -> Tree+ <$> o .: "sha"+ <*> o .: "url"+ <*> o .:? "tree" .!= V.empty++instance FromJSON GitTree where+ parseJSON = withObject "GitTree" $ \o -> GitTree+ <$> o .: "type"+ <*> o .: "sha"+ <*> o .:? "url"+ <*> o .:? "size"+ <*> o .: "path"+ <*> o .: "mode"++instance FromJSON GitCommit where+ parseJSON = withObject "GitCommit" $ \o -> GitCommit+ <$> o .: "message"+ <*> o .: "url"+ <*> o .: "committer"+ <*> o .: "author"+ <*> o .: "tree"+ <*> o .:? "sha"+ <*> o .:? "parents" .!= V.empty++instance FromJSON GitUser where+ parseJSON = withObject "GitUser" $ \o -> GitUser+ <$> o .: "name"+ <*> o .: "email"+ <*> o .: "date"++instance FromJSON File where+ parseJSON = withObject "File" $ \o -> File+ <$> o .: "blob_url"+ <*> o .: "status"+ <*> o .: "raw_url"+ <*> o .: "additions"+ <*> o .: "sha"+ <*> o .: "changes"+ <*> o .:? "patch"+ <*> o .: "filename"+ <*> o .: "deletions"++instance ToJSON NewGitReference where+ toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ]++instance FromJSON GitReference where+ parseJSON = withObject "GitReference" $ \o -> GitReference+ <$> o .: "object"+ <*> o .: "url"+ <*> o .: "ref"++instance FromJSON GitObject where+ parseJSON = withObject "GitObject" $ \o -> GitObject+ <$> o .: "type"+ <*> o .: "sha"+ <*> o .: "url"++instance FromJSON Diff where+ parseJSON = withObject "Diff" $ \o -> Diff+ <$> o .: "status"+ <*> o .: "behind_by"+ <*> o .: "patch_url"+ <*> o .: "url"+ <*> o .: "base_commit"+ <*> o .:? "commits" .!= V.empty+ <*> o .: "total_commits"+ <*> o .: "html_url"+ <*> o .:? "files" .!= V.empty+ <*> o .: "ahead_by"+ <*> o .: "diff_url"+ <*> o .: "permalink_url"++instance FromJSON Blob where+ parseJSON = withObject "Blob" $ \o -> Blob+ <$> o .: "url"+ <*> o .: "encoding"+ <*> o .: "content"+ <*> o .: "sha"+ <*> o .: "size"++instance FromJSON Tag where+ parseJSON = withObject "Tag" $ \o -> Tag+ <$> o .: "name"+ <*> o .: "zipball_url"+ <*> o .: "tarball_url"+ <*> o .: "commit"++instance FromJSON Branch where+ parseJSON = withObject "Branch" $ \o -> Branch+ <$> o .: "name"+ <*> o .: "commit"++instance FromJSON BranchCommit where+ parseJSON = withObject "BranchCommit" $ \o -> BranchCommit+ <$> o .: "sha"+ <*> o .: "url"
+ src/GitHub/Data/Id.hs view
@@ -0,0 +1,36 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Id (+ Id(..),+ mkId,+ untagId,+ ) where++import GitHub.Internal.Prelude+import Prelude ()++-- | Numeric identifier.+newtype Id entity = Id Int+ deriving (Eq, Ord, Show, Generic, Typeable, Data)++-- | Smart constructor for 'Id'.+mkId :: proxy entity -> Int -> Id entity+mkId _ = Id++untagId :: Id entity -> Int+untagId (Id name) = name++instance Hashable (Id entity)+instance Binary (Id entity)++instance NFData (Id entity) where+ rnf (Id s) = rnf s++instance FromJSON (Id entity) where+ parseJSON = fmap Id . parseJSON++instance ToJSON (Id entity) where+ toJSON = toJSON . untagId
+ src/GitHub/Data/Issues.hs view
@@ -0,0 +1,203 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Issues where++import GitHub.Data.Definitions+import GitHub.Data.Id (Id)+import GitHub.Data.Milestone (Milestone)+import GitHub.Data.Name (Name)+import GitHub.Data.Options (IssueState)+import GitHub.Data.PullRequests+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++data Issue = Issue+ { issueClosedAt :: !(Maybe UTCTime)+ , issueUpdatedAt :: !UTCTime+ , issueEventsUrl :: !URL+ , issueHtmlUrl :: !(Maybe URL)+ , issueClosedBy :: !(Maybe SimpleUser)+ , issueLabels :: (Vector IssueLabel)+ , issueNumber :: !Int+ , issueAssignees :: !(Vector SimpleUser)+ , issueUser :: !SimpleUser+ , issueTitle :: !Text+ , issuePullRequest :: !(Maybe PullRequestReference)+ , issueUrl :: !URL+ , issueCreatedAt :: !UTCTime+ , issueBody :: !(Maybe Text)+ , issueState :: !IssueState+ , issueId :: !(Id Issue)+ , issueComments :: !Int+ , issueMilestone :: !(Maybe Milestone)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Issue where rnf = genericRnf+instance Binary Issue++data NewIssue = NewIssue+ { newIssueTitle :: !Text+ , newIssueBody :: !(Maybe Text)+ , newIssueAssignee :: !(Maybe Text)+ , newIssueMilestone :: !(Maybe (Id Milestone))+ , newIssueLabels :: !(Maybe (Vector (Name IssueLabel)))+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData NewIssue where rnf = genericRnf+instance Binary NewIssue++data EditIssue = EditIssue+ { editIssueTitle :: !(Maybe Text)+ , editIssueBody :: !(Maybe Text)+ , editIssueAssignee :: !(Maybe (Name User))+ , editIssueState :: !(Maybe IssueState)+ , editIssueMilestone :: !(Maybe (Id Milestone))+ , editIssueLabels :: !(Maybe (Vector (Name IssueLabel)))+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData EditIssue where rnf = genericRnf+instance Binary EditIssue++data IssueComment = IssueComment+ { issueCommentUpdatedAt :: !UTCTime+ , issueCommentUser :: !SimpleUser+ , issueCommentUrl :: !URL+ , issueCommentHtmlUrl :: !URL+ , issueCommentCreatedAt :: !UTCTime+ , issueCommentBody :: !Text+ , issueCommentId :: !Int+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData IssueComment where rnf = genericRnf+instance Binary IssueComment++data EventType+ = Mentioned -- ^ The actor was @mentioned in an issue body.+ | Subscribed -- ^ The actor subscribed to receive notifications for an issue.+ | Unsubscribed -- ^ The issue was unsubscribed from by the actor.+ | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened.+ | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged.+ | Assigned -- ^ The issue was assigned to the actor.+ | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax.+ | Reopened -- ^ The issue was reopened by the actor.+ | ActorUnassigned -- ^ The issue was unassigned to the actor+ | Labeled -- ^ A label was added to the issue.+ | Unlabeled -- ^ A label was removed from the issue.+ | Milestoned -- ^ The issue was added to a milestone.+ | Demilestoned -- ^ The issue was removed from a milestone.+ | Renamed -- ^ The issue title was changed.+ | Locked -- ^ The issue was locked by the actor.+ | Unlocked -- ^ The issue was unlocked by the actor.+ | HeadRefDeleted -- ^ The pull request’s branch was deleted.+ | HeadRefRestored -- ^ The pull request’s branch was restored.+ deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic)++instance NFData EventType where rnf = genericRnf+instance Binary EventType++-- | Issue event+data IssueEvent = IssueEvent+ { issueEventActor :: !SimpleUser+ , issueEventType :: !EventType+ , issueEventCommitId :: !(Maybe Text)+ , issueEventUrl :: !URL+ , issueEventCreatedAt :: !UTCTime+ , issueEventId :: !Int+ , issueEventIssue :: !(Maybe Issue)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData IssueEvent where rnf = genericRnf+instance Binary IssueEvent ++instance FromJSON IssueEvent where+ parseJSON = withObject "Event" $ \o -> IssueEvent+ <$> o .: "actor"+ <*> o .: "event"+ <*> o .:? "commit_id"+ <*> o .: "url"+ <*> o .: "created_at"+ <*> o .: "id"+ <*> o .:? "issue"++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 (String "unassigned") = pure ActorUnassigned+ parseJSON (String "labeled") = pure Labeled+ parseJSON (String "unlabeled") = pure Unlabeled+ parseJSON (String "milestoned") = pure Milestoned+ parseJSON (String "demilestoned") = pure Demilestoned+ parseJSON (String "renamed") = pure Renamed+ parseJSON (String "locked") = pure Locked+ parseJSON (String "unlocked") = pure Unlocked+ parseJSON (String "head_ref_deleted") = pure HeadRefDeleted+ parseJSON (String "head_ref_restored") = pure HeadRefRestored+ parseJSON _ = fail "Could not build an EventType"++instance FromJSON IssueComment where+ parseJSON = withObject "IssueComment" $ \o -> IssueComment+ <$> o .: "updated_at"+ <*> o .: "user"+ <*> o .: "url"+ <*> o .: "html_url"+ <*> o .: "created_at"+ <*> o .: "body"+ <*> o .: "id"++instance FromJSON Issue where+ parseJSON = withObject "Issue" $ \o -> Issue+ <$> o .:? "closed_at"+ <*> o .: "updated_at"+ <*> o .: "events_url"+ <*> o .: "html_url"+ <*> o .:? "closed_by"+ <*> o .: "labels"+ <*> o .: "number"+ <*> o .: "assignees"+ <*> o .: "user"+ <*> o .: "title"+ <*> o .:? "pull_request"+ <*> o .: "url"+ <*> o .: "created_at"+ <*> o .: "body"+ <*> o .: "state"+ <*> o .: "id"+ <*> o .: "comments"+ <*> o .:? "milestone"++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
+ src/GitHub/Data/Milestone.hs view
@@ -0,0 +1,42 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Milestone where++import GitHub.Data.Definitions+import GitHub.Data.Id (Id)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++data Milestone = Milestone+ { milestoneCreator :: !SimpleUser+ , milestoneDueOn :: !(Maybe UTCTime)+ , milestoneOpenIssues :: !Int+ , milestoneNumber :: !(Id Milestone)+ , milestoneClosedIssues :: !Int+ , milestoneDescription :: !(Maybe Text)+ , milestoneTitle :: !Text+ , milestoneUrl :: !URL+ , milestoneCreatedAt :: !UTCTime+ , milestoneState :: !Text+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Milestone where rnf = genericRnf+instance Binary Milestone++instance FromJSON Milestone where+ parseJSON = withObject "Milestone" $ \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"
+ src/GitHub/Data/Name.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Name (+ Name(..),+ mkName,+ untagName,+ ) where++import Prelude ()+import GitHub.Internal.Prelude++#if MIN_VERSION_aeson(1,0,0)+import Data.Aeson.Types+ (FromJSONKey (..), ToJSONKey (..), fromJSONKeyCoerce, toJSONKeyText)+#endif++newtype Name entity = N Text+ deriving (Eq, Ord, Show, Generic, Typeable, Data)++-- | Smart constructor for 'Name'+mkName :: proxy entity -> Text -> Name entity+mkName _ = N++untagName :: Name entity -> Text+untagName (N name) = name++instance Hashable (Name entity)+instance Binary (Name entity)++instance NFData (Name entity) where+ rnf (N s) = rnf s++instance FromJSON (Name entity) where+ parseJSON = fmap N . parseJSON++instance ToJSON (Name entity) where+ toJSON = toJSON . untagName++instance IsString (Name entity) where+ fromString = N . fromString++#if MIN_VERSION_aeson(1,0,0)+-- | @since 0.15.0.0+instance ToJSONKey (Name entity) where+ toJSONKey = toJSONKeyText untagName++-- | @since 0.15.0.0+instance FromJSONKey (Name entity) where+ fromJSONKey = fromJSONKeyCoerce+#endif
+ src/GitHub/Data/Options.hs view
@@ -0,0 +1,604 @@+{-# LANGUAGE RecordWildCards #-}+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- Module with modifiers for pull requests' and issues' listings.+module GitHub.Data.Options (+ -- * Common modifiers+ stateOpen,+ stateClosed,+ stateAll,+ sortAscending,+ sortDescending,+ sortByCreated,+ sortByUpdated,+ -- * Pull Requests+ PullRequestMod,+ prModToQueryString,+ optionsBase,+ optionsNoBase,+ optionsHead,+ optionsNoHead,+ sortByPopularity,+ sortByLongRunning,+ -- * Issues+ IssueMod,+ issueModToQueryString,+ sortByComments,+ optionsLabels,+ optionsSince,+ optionsSinceAll,+ optionsAssignedIssues,+ optionsCreatedIssues,+ optionsMentionedIssues,+ optionsSubscribedIssues,+ optionsAllIssues,+ -- * Repo issues+ IssueRepoMod,+ issueRepoModToQueryString,+ optionsIrrelevantMilestone,+ optionsAnyMilestone,+ optionsNoMilestone,+ optionsIrrelevantAssignee,+ optionsAnyAssignee,+ optionsNoAssignee,+ -- * Data+ IssueState (..),+ MergeableState (..),+ -- * Internal+ HasState,+ HasDirection,+ HasCreatedUpdated,+ HasComments,+ HasLabels,+ HasSince,+ ) where++import GitHub.Data.Definitions+import GitHub.Data.Id (Id, untagId)+import GitHub.Data.Milestone (Milestone)+import GitHub.Data.Name (Name, untagName)+import GitHub.Internal.Prelude+import Prelude ()++import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++-------------------------------------------------------------------------------+-- Data+-------------------------------------------------------------------------------++-- | 'GitHub.Data.Issues.Issue' or 'GitHub.Data.PullRequests.PullRequest' state+data IssueState+ = StateOpen+ | StateClosed+ deriving+ (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data)++instance ToJSON IssueState where+ toJSON StateOpen = String "open"+ toJSON StateClosed = String "closed"++instance FromJSON IssueState where+ parseJSON (String "open") = pure StateOpen+ parseJSON (String "closed") = pure StateClosed+ parseJSON v = typeMismatch "IssueState" v++instance NFData IssueState where rnf = genericRnf+instance Binary IssueState++-- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state+data MergeableState+ = StateUnknown+ | StateClean+ | StateDirty+ | StateUnstable+ | StateBlocked+ | StateBehind+ deriving+ (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data)++instance ToJSON MergeableState where+ toJSON StateUnknown = String "unknown"+ toJSON StateClean = String "clean"+ toJSON StateDirty = String "dirty"+ toJSON StateUnstable = String "unstable"+ toJSON StateBlocked = String "blocked"+ toJSON StateBehind = String "behind"++instance FromJSON MergeableState where+ parseJSON (String "unknown") = pure StateUnknown+ parseJSON (String "clean") = pure StateClean+ parseJSON (String "dirty") = pure StateDirty+ parseJSON (String "unstable") = pure StateUnstable+ parseJSON (String "blocked") = pure StateBlocked+ parseJSON (String "behind") = pure StateBehind+ parseJSON v = typeMismatch "MergeableState" v++instance NFData MergeableState where rnf = genericRnf+instance Binary MergeableState++data SortDirection+ = SortAscending+ | SortDescending+ deriving+ (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data)++instance NFData SortDirection where rnf = genericRnf+instance Binary SortDirection++-- PR++data SortPR+ = SortPRCreated+ | SortPRUpdated+ | SortPRPopularity+ | SortPRLongRunning+ deriving+ (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data)++instance NFData SortPR where rnf = genericRnf+instance Binary SortPR++-- Issue+data IssueFilter+ = IssueFilterAssigned+ | IssueFilterCreated+ | IssueFilterMentioned+ | IssueFilterSubscribed+ | IssueFilterAll+ deriving+ (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data)++instance NFData IssueFilter where rnf = genericRnf+instance Binary IssueFilter++data SortIssue+ = SortIssueCreated+ | SortIssueUpdated+ | SortIssueComments+ deriving+ (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data)++instance NFData SortIssue where rnf = genericRnf+instance Binary SortIssue++data FilterBy a+ = FilterAny+ | FilterNone+ | FilterBy a+ | FilterNotSpecified+ -- ^ e.g. for milestones "any" means "any milestone".+ -- I.e. won't show issues without mileston specified+ deriving+ (Eq, Ord, Show, Generic, Typeable, Data)++-------------------------------------------------------------------------------+-- Classes+-------------------------------------------------------------------------------++class HasState mod where+ state :: Maybe IssueState -> mod++stateOpen :: HasState mod => mod+stateOpen = state (Just StateOpen)++stateClosed :: HasState mod => mod+stateClosed = state (Just StateClosed)++stateAll :: HasState mod => mod+stateAll = state Nothing++instance HasState PullRequestMod where+ state s = PRMod $ \opts ->+ opts { pullRequestOptionsState = s }++instance HasState IssueMod where+ state s = IssueMod $ \opts ->+ opts { issueOptionsState = s }++instance HasState IssueRepoMod where+ state s = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsState = s }+++class HasDirection mod where+ sortDir :: SortDirection -> mod++sortAscending :: HasDirection mod => mod+sortAscending = sortDir SortAscending++sortDescending :: HasDirection mod => mod+sortDescending = sortDir SortDescending++instance HasDirection PullRequestMod where+ sortDir x = PRMod $ \opts ->+ opts { pullRequestOptionsDirection = x }++instance HasDirection IssueMod where+ sortDir x = IssueMod $ \opts ->+ opts { issueOptionsDirection = x }++instance HasDirection IssueRepoMod where+ sortDir x = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsDirection = x }+++class HasCreatedUpdated mod where+ sortByCreated :: mod+ sortByUpdated :: mod++instance HasCreatedUpdated PullRequestMod where+ sortByCreated = PRMod $ \opts ->+ opts { pullRequestOptionsSort = SortPRCreated }+ sortByUpdated = PRMod $ \opts ->+ opts { pullRequestOptionsSort = SortPRUpdated }++instance HasCreatedUpdated IssueMod where+ sortByCreated = IssueMod $ \opts ->+ opts { issueOptionsSort = SortIssueCreated }+ sortByUpdated = IssueMod $ \opts ->+ opts { issueOptionsSort = SortIssueUpdated }++instance HasCreatedUpdated IssueRepoMod where+ sortByCreated = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsSort = SortIssueCreated }+ sortByUpdated = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsSort = SortIssueUpdated }++-------------------------------------------------------------------------------+-- Pull Request+-------------------------------------------------------------------------------++-- | See <https://developer.github.com/v3/pulls/#parameters>.+data PullRequestOptions = PullRequestOptions+ { pullRequestOptionsState :: !(Maybe IssueState)+ , pullRequestOptionsHead :: !(Maybe Text)+ , pullRequestOptionsBase :: !(Maybe Text)+ , pullRequestOptionsSort :: !SortPR+ , pullRequestOptionsDirection :: !SortDirection+ }+ deriving+ (Eq, Ord, Show, Generic, Typeable, Data)++defaultPullRequestOptions :: PullRequestOptions+defaultPullRequestOptions = PullRequestOptions+ { pullRequestOptionsState = Just StateOpen+ , pullRequestOptionsHead = Nothing+ , pullRequestOptionsBase = Nothing+ , pullRequestOptionsSort = SortPRCreated+ , pullRequestOptionsDirection = SortDescending+ }++-- | See <https://developer.github.com/v3/pulls/#parameters>.+newtype PullRequestMod = PRMod (PullRequestOptions -> PullRequestOptions)++instance Semigroup PullRequestMod where+ PRMod f <> PRMod g = PRMod (g . f)++instance Monoid PullRequestMod where+ mempty = PRMod id+ mappend = (<>)++toPullRequestOptions :: PullRequestMod -> PullRequestOptions+toPullRequestOptions (PRMod f) = f defaultPullRequestOptions++prModToQueryString :: PullRequestMod -> QueryString+prModToQueryString = pullRequestOptionsToQueryString . toPullRequestOptions++pullRequestOptionsToQueryString :: PullRequestOptions -> QueryString+pullRequestOptionsToQueryString (PullRequestOptions st head_ base sort dir) =+ [ mk "state" state'+ , mk "sort" sort'+ , mk "direction" direction'+ ] ++ catMaybes+ [ mk "head" <$> head'+ , mk "base" <$> base'+ ]+ where+ mk k v = (k, Just v)+ state' = case st of+ Nothing -> "all"+ Just StateOpen -> "open"+ Just StateClosed -> "closed"+ sort' = case sort of+ SortPRCreated -> "created"+ SortPRUpdated -> "updated"+ SortPRPopularity -> "popularity"+ SortPRLongRunning -> "long-running"+ direction' = case dir of+ SortDescending -> "desc"+ SortAscending -> "asc"+ head' = fmap TE.encodeUtf8 head_+ base' = fmap TE.encodeUtf8 base++-------------------------------------------------------------------------------+-- Pull request modifiers+-------------------------------------------------------------------------------++optionsBase :: Text -> PullRequestMod+optionsBase x = PRMod $ \opts ->+ opts { pullRequestOptionsBase = Just x }++optionsNoBase :: PullRequestMod+optionsNoBase = PRMod $ \opts ->+ opts { pullRequestOptionsBase = Nothing }++optionsHead :: Text -> PullRequestMod+optionsHead x = PRMod $ \opts ->+ opts { pullRequestOptionsHead = Just x }++optionsNoHead :: PullRequestMod+optionsNoHead = PRMod $ \opts ->+ opts { pullRequestOptionsHead = Nothing }++sortByPopularity :: PullRequestMod+sortByPopularity = PRMod $ \opts ->+ opts { pullRequestOptionsSort = SortPRPopularity }++sortByLongRunning :: PullRequestMod+sortByLongRunning = PRMod $ \opts ->+ opts { pullRequestOptionsSort = SortPRLongRunning }++-------------------------------------------------------------------------------+-- Issues+-------------------------------------------------------------------------------++-- | See <https://developer.github.com/v3/issues/#parameters>.+data IssueOptions = IssueOptions+ { issueOptionsFilter :: !IssueFilter+ , issueOptionsState :: !(Maybe IssueState)+ , issueOptionsLabels :: ![Name IssueLabel] -- TODO: change to newtype+ , issueOptionsSort :: !SortIssue+ , issueOptionsDirection :: !SortDirection+ , issueOptionsSince :: !(Maybe UTCTime)+ }+ deriving+ (Eq, Ord, Show, Generic, Typeable, Data)++defaultIssueOptions :: IssueOptions+defaultIssueOptions = IssueOptions+ { issueOptionsFilter = IssueFilterAssigned+ , issueOptionsState = Just StateOpen+ , issueOptionsLabels = []+ , issueOptionsSort = SortIssueCreated+ , issueOptionsDirection = SortDescending+ , issueOptionsSince = Nothing+ }++-- | See <https://developer.github.com/v3/issues/#parameters>.+newtype IssueMod = IssueMod (IssueOptions -> IssueOptions)++instance Semigroup IssueMod where+ IssueMod f <> IssueMod g = IssueMod (g . f)++instance Monoid IssueMod where+ mempty = IssueMod id+ mappend = (<>)++toIssueOptions :: IssueMod -> IssueOptions+toIssueOptions (IssueMod f) = f defaultIssueOptions++issueModToQueryString :: IssueMod -> QueryString+issueModToQueryString = issueOptionsToQueryString . toIssueOptions++issueOptionsToQueryString :: IssueOptions -> QueryString+issueOptionsToQueryString (IssueOptions filt st labels sort dir since) =+ [ mk "state" state'+ , mk "sort" sort'+ , mk "direction" direction'+ , mk "filter" filt'+ ] ++ catMaybes+ [ mk "labels" <$> labels'+ , mk "since" <$> since'+ ]+ where+ mk k v = (k, Just v)+ filt' = case filt of+ IssueFilterAssigned -> "assigned"+ IssueFilterCreated -> "created"+ IssueFilterMentioned -> "mentioned"+ IssueFilterSubscribed -> "subscribed"+ IssueFilterAll -> "all"+ state' = case st of+ Nothing -> "all"+ Just StateOpen -> "open"+ Just StateClosed -> "closed"+ sort' = case sort of+ SortIssueCreated -> "created"+ SortIssueUpdated -> "updated"+ SortIssueComments -> "comments"+ direction' = case dir of+ SortDescending -> "desc"+ SortAscending -> "asc"++ since' = fmap (TE.encodeUtf8 . T.pack . show) since+ labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing labels++nullToNothing :: Foldable f => f a -> Maybe (f a)+nullToNothing xs+ | null xs = Nothing+ | otherwise = Just xs++-------------------------------------------------------------------------------+-- Issues modifiers+-------------------------------------------------------------------------------++class HasComments mod where+ sortByComments :: mod++instance HasComments IssueMod where+ sortByComments = IssueMod $ \opts ->+ opts { issueOptionsSort = SortIssueComments }++instance HasComments IssueRepoMod where+ sortByComments = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsSort = SortIssueComments }+++class HasLabels mod where+ optionsLabels :: Foldable f => f (Name IssueLabel) -> mod++instance HasLabels IssueMod where+ optionsLabels lbls = IssueMod $ \opts ->+ opts { issueOptionsLabels = toList lbls }++instance HasLabels IssueRepoMod where+ optionsLabels lbls = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsLabels = toList lbls }+++class HasSince mod where+ optionsSince :: UTCTime -> mod+ optionsSinceAll :: mod++instance HasSince IssueMod where+ optionsSince since = IssueMod $ \opts ->+ opts { issueOptionsSince = Just since }+ optionsSinceAll = IssueMod $ \opts ->+ opts { issueOptionsSince = Nothing }++instance HasSince IssueRepoMod where+ optionsSince since = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsSince = Just since }+ optionsSinceAll = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsSince = Nothing }++-------------------------------------------------------------------------------+-- Only issues modifiers+-------------------------------------------------------------------------------++optionsAssignedIssues, optionsCreatedIssues, optionsMentionedIssues,+ optionsSubscribedIssues, optionsAllIssues :: IssueMod+optionsAssignedIssues = issueFilter IssueFilterAssigned+optionsCreatedIssues = issueFilter IssueFilterCreated+optionsMentionedIssues = issueFilter IssueFilterMentioned+optionsSubscribedIssues = issueFilter IssueFilterSubscribed+optionsAllIssues = issueFilter IssueFilterAll++issueFilter :: IssueFilter -> IssueMod+issueFilter f = IssueMod $ \opts ->+ opts { issueOptionsFilter = f }++-------------------------------------------------------------------------------+-- Issues repo+-------------------------------------------------------------------------------++data IssueRepoOptions = IssueRepoOptions+ { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone))+ , issueRepoOptionsState :: !(Maybe IssueState)+ , issueRepoOptionsAssignee :: !(FilterBy (Name User))+ , issueRepoOptionsCreator :: !(Maybe (Name User))+ , issueRepoOptionsMentioned :: !(Maybe (Name User))+ , issueRepoOptionsLabels :: ![Name IssueLabel]+ , issueRepoOptionsSort :: !SortIssue+ , issueRepoOptionsDirection :: !SortDirection+ , issueRepoOptionsSince :: !(Maybe UTCTime)+ }+ deriving+ (Eq, Ord, Show, Generic, Typeable, Data)++defaultIssueRepoOptions :: IssueRepoOptions+defaultIssueRepoOptions = IssueRepoOptions+ { issueRepoOptionsMilestone = FilterNotSpecified+ , issueRepoOptionsState = (Just StateOpen)+ , issueRepoOptionsAssignee = FilterNotSpecified+ , issueRepoOptionsCreator = Nothing+ , issueRepoOptionsMentioned = Nothing+ , issueRepoOptionsLabels = []+ , issueRepoOptionsSort = SortIssueCreated+ , issueRepoOptionsDirection = SortDescending+ , issueRepoOptionsSince = Nothing+ }++-- | See <https://developer.github.com/v3/issues/#parameters-1>.+newtype IssueRepoMod = IssueRepoMod (IssueRepoOptions -> IssueRepoOptions)++instance Semigroup IssueRepoMod where+ IssueRepoMod f <> IssueRepoMod g = IssueRepoMod (g . f)++instance Monoid IssueRepoMod where+ mempty = IssueRepoMod id+ mappend = (<>)++toIssueRepoOptions :: IssueRepoMod -> IssueRepoOptions+toIssueRepoOptions (IssueRepoMod f) = f defaultIssueRepoOptions++issueRepoModToQueryString :: IssueRepoMod -> QueryString+issueRepoModToQueryString = issueRepoOptionsToQueryString . toIssueRepoOptions++issueRepoOptionsToQueryString :: IssueRepoOptions -> QueryString+issueRepoOptionsToQueryString IssueRepoOptions {..} =+ [ mk "state" state'+ , mk "sort" sort'+ , mk "direction" direction'+ ] ++ catMaybes+ [ mk "milestone" <$> milestone'+ , mk "assignee" <$> assignee'+ , mk "labels" <$> labels'+ , mk "since" <$> since'+ , mk "creator" <$> creator'+ , mk "mentioned" <$> mentioned'+ ]+ where+ mk k v = (k, Just v)+ filt f x = case x of+ FilterAny -> Just "*"+ FilterNone -> Just "none"+ FilterBy x' -> Just $ TE.encodeUtf8 $ f x'+ FilterNotSpecified -> Nothing++ milestone' = filt (T.pack . show . untagId) issueRepoOptionsMilestone+ assignee' = filt untagName issueRepoOptionsAssignee++ state' = case issueRepoOptionsState of+ Nothing -> "all"+ Just StateOpen -> "open"+ Just StateClosed -> "closed"+ sort' = case issueRepoOptionsSort of+ SortIssueCreated -> "created"+ SortIssueUpdated -> "updated"+ SortIssueComments -> "comments"+ direction' = case issueRepoOptionsDirection of+ SortDescending -> "desc"+ SortAscending -> "asc"++ since' = TE.encodeUtf8 . T.pack . show <$> issueRepoOptionsSince+ labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing issueRepoOptionsLabels+ creator' = TE.encodeUtf8 . untagName <$> issueRepoOptionsCreator+ mentioned' = TE.encodeUtf8 . untagName <$> issueRepoOptionsMentioned++-------------------------------------------------------------------------------+-- Issues repo modifiers+-------------------------------------------------------------------------------++-- | Don't care about milestones.+--+-- 'optionsAnyMilestone' means there should be some milestone, but it can be any.+--+-- See <https://developer.github.com/v3/issues/#list-issues-for-a-repository>+optionsIrrelevantMilestone :: IssueRepoMod+optionsIrrelevantMilestone = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsMilestone = FilterNotSpecified }++optionsAnyMilestone :: IssueRepoMod+optionsAnyMilestone = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsMilestone = FilterAny }++optionsNoMilestone :: IssueRepoMod+optionsNoMilestone = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsMilestone = FilterNone }++optionsIrrelevantAssignee :: IssueRepoMod+optionsIrrelevantAssignee = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsAssignee = FilterNotSpecified }++optionsAnyAssignee :: IssueRepoMod+optionsAnyAssignee = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsAssignee = FilterAny }++optionsNoAssignee :: IssueRepoMod+optionsNoAssignee = IssueRepoMod $ \opts ->+ opts { issueRepoOptionsAssignee = FilterNone }
+ src/GitHub/Data/PullRequests.hs view
@@ -0,0 +1,328 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.PullRequests (+ SimplePullRequest(..),+ PullRequest(..),+ EditPullRequest(..),+ CreatePullRequest(..),+ PullRequestLinks(..),+ PullRequestCommit(..),+ PullRequestEvent(..),+ PullRequestEventType(..),+ PullRequestReference(..),+ MergeResult(..),+ statusMerge,+ ) where++import GitHub.Data.Definitions+import GitHub.Data.Id (Id)+import GitHub.Data.Options (IssueState (..), MergeableState (..))+import GitHub.Data.Repos (Repo)+import GitHub.Data.Request (StatusMap)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++import qualified Data.Text as T++data SimplePullRequest = SimplePullRequest+ { simplePullRequestClosedAt :: !(Maybe UTCTime)+ , simplePullRequestCreatedAt :: !UTCTime+ , simplePullRequestUser :: !SimpleUser+ , simplePullRequestPatchUrl :: !URL+ , simplePullRequestState :: !IssueState+ , simplePullRequestNumber :: !Int+ , simplePullRequestHtmlUrl :: !URL+ , simplePullRequestUpdatedAt :: !UTCTime+ , simplePullRequestBody :: !(Maybe Text)+ , simplePullRequestAssignees :: (Vector SimpleUser)+ , simplePullRequestRequestedReviewers :: (Vector SimpleUser)+ , simplePullRequestIssueUrl :: !URL+ , simplePullRequestDiffUrl :: !URL+ , simplePullRequestUrl :: !URL+ , simplePullRequestLinks :: !PullRequestLinks+ , simplePullRequestMergedAt :: !(Maybe UTCTime)+ , simplePullRequestTitle :: !Text+ , simplePullRequestId :: !(Id PullRequest)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData SimplePullRequest where rnf = genericRnf+instance Binary SimplePullRequest++data PullRequest = PullRequest+ { pullRequestClosedAt :: !(Maybe UTCTime)+ , pullRequestCreatedAt :: !UTCTime+ , pullRequestUser :: !SimpleUser+ , pullRequestPatchUrl :: !URL+ , pullRequestState :: !IssueState+ , pullRequestNumber :: !Int+ , pullRequestHtmlUrl :: !URL+ , pullRequestUpdatedAt :: !UTCTime+ , pullRequestBody :: !(Maybe Text)+ , pullRequestAssignees :: (Vector SimpleUser)+ , pullRequestRequestedReviewers :: (Vector SimpleUser)+ , pullRequestIssueUrl :: !URL+ , pullRequestDiffUrl :: !URL+ , pullRequestUrl :: !URL+ , pullRequestLinks :: !PullRequestLinks+ , pullRequestMergedAt :: !(Maybe UTCTime)+ , pullRequestTitle :: !Text+ , pullRequestId :: !(Id PullRequest)+ , pullRequestMergedBy :: !(Maybe SimpleUser)+ , pullRequestChangedFiles :: !Int+ , pullRequestHead :: !PullRequestCommit+ , pullRequestComments :: !Count+ , pullRequestDeletions :: !Count+ , pullRequestAdditions :: !Count+ , pullRequestReviewComments :: !Count+ , pullRequestBase :: !PullRequestCommit+ , pullRequestCommits :: !Count+ , pullRequestMerged :: !Bool+ , pullRequestMergeable :: !(Maybe Bool)+ , pullRequestMergeableState :: !MergeableState+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData PullRequest where rnf = genericRnf+instance Binary PullRequest++data EditPullRequest = EditPullRequest+ { editPullRequestTitle :: !(Maybe Text)+ , editPullRequestBody :: !(Maybe Text)+ , editPullRequestState :: !(Maybe IssueState)+ , editPullRequestBase :: !(Maybe Text)+ , editPullRequestMaintainerCanModify+ :: !(Maybe Bool)+ }+ deriving (Show, Generic)++instance NFData EditPullRequest where rnf = genericRnf+instance Binary EditPullRequest++data CreatePullRequest+ = CreatePullRequest+ { createPullRequestTitle :: !Text+ , createPullRequestBody :: !Text+ , createPullRequestHead :: !Text+ , createPullRequestBase :: !Text+ }+ | CreatePullRequestIssue+ { createPullRequestIssueNum :: !Int+ , createPullRequestHead :: !Text+ , createPullRequestBase :: !Text+ }+ deriving (Show, Generic)++instance NFData CreatePullRequest where rnf = genericRnf+instance Binary CreatePullRequest++data PullRequestLinks = PullRequestLinks+ { pullRequestLinksReviewComments :: !URL+ , pullRequestLinksComments :: !URL+ , pullRequestLinksHtml :: !URL+ , pullRequestLinksSelf :: !URL+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData PullRequestLinks where rnf = genericRnf+instance Binary PullRequestLinks++data PullRequestCommit = PullRequestCommit+ { pullRequestCommitLabel :: !Text+ , pullRequestCommitRef :: !Text+ , pullRequestCommitSha :: !Text+ , pullRequestCommitUser :: !SimpleUser+ , pullRequestCommitRepo :: !(Maybe Repo)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData PullRequestCommit where rnf = genericRnf+instance Binary PullRequestCommit++data PullRequestEvent = PullRequestEvent+ { pullRequestEventAction :: !PullRequestEventType+ , pullRequestEventNumber :: !Int+ , pullRequestEventPullRequest :: !PullRequest+ , pullRequestRepository :: !Repo+ , pullRequestSender :: !SimpleUser+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData PullRequestEvent where rnf = genericRnf+instance Binary PullRequestEvent++data PullRequestEventType+ = PullRequestOpened+ | PullRequestClosed+ | PullRequestSynchronized+ | PullRequestReopened+ | PullRequestAssigned+ | PullRequestUnassigned+ | PullRequestLabeled+ | PullRequestUnlabeled+ | PullRequestReviewRequested+ | PullRequestReviewRequestRemoved+ | PullRequestEdited+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData PullRequestEventType where rnf = genericRnf+instance Binary PullRequestEventType++data PullRequestReference = PullRequestReference+ { pullRequestReferenceHtmlUrl :: !(Maybe URL)+ , pullRequestReferencePatchUrl :: !(Maybe URL)+ , pullRequestReferenceDiffUrl :: !(Maybe URL)+ }+ deriving (Eq, Ord, Show, Generic, Typeable, Data)++instance NFData PullRequestReference where rnf = genericRnf+instance Binary PullRequestReference+++-------------------------------------------------------------------------------+-- JSON instances+-------------------------------------------------------------------------------++instance FromJSON SimplePullRequest where+ parseJSON = withObject "SimplePullRequest" $ \o -> SimplePullRequest+ <$> o .:? "closed_at"+ <*> o .: "created_at"+ <*> o .: "user"+ <*> o .: "patch_url"+ <*> o .: "state"+ <*> o .: "number"+ <*> o .: "html_url"+ <*> o .: "updated_at"+ <*> o .:? "body"+ <*> o .: "assignees"+ <*> o .:? "requested_reviewers" .!= mempty+ <*> o .: "issue_url"+ <*> o .: "diff_url"+ <*> o .: "url"+ <*> o .: "_links"+ <*> o .:? "merged_at"+ <*> o .: "title"+ <*> o .: "id"++instance ToJSON EditPullRequest where+ toJSON (EditPullRequest t b s base mcm) =+ object $ filter notNull+ [ "title" .= t+ , "body" .= b+ , "state" .= s+ , "base" .= base+ , "maintainer_can_modify"+ .= mcm+ ]+ where+ notNull (_, Null) = False+ notNull (_, _) = True++instance ToJSON CreatePullRequest where+ toJSON (CreatePullRequest t b headPR basePR) =+ object [ "title" .= t, "body" .= b, "head" .= headPR, "base" .= basePR ]+ toJSON (CreatePullRequestIssue issueNum headPR basePR) =+ object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR]++instance FromJSON PullRequest where+ parseJSON = withObject "PullRequest" $ \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 .: "assignees"+ <*> o .:? "requested_reviewers" .!= mempty+ <*> 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"+ <*> o .: "mergeable_state"++instance FromJSON PullRequestLinks where+ parseJSON = withObject "PullRequestLinks" $ \o -> PullRequestLinks+ <$> fmap getHref (o .: "review_comments")+ <*> fmap getHref (o .: "comments")+ <*> fmap getHref (o .: "html")+ <*> fmap getHref (o .: "self")++instance FromJSON PullRequestCommit where+ parseJSON = withObject "PullRequestCommit" $ \o -> PullRequestCommit+ <$> o .: "label"+ <*> o .: "ref"+ <*> o .: "sha"+ <*> o .: "user"+ <*> o .: "repo"++instance FromJSON PullRequestEvent where+ parseJSON = withObject "PullRequestEvent" $ \o -> PullRequestEvent+ <$> o .: "action"+ <*> o .: "number"+ <*> o .: "pull_request"+ <*> o .: "repository"+ <*> o .: "sender"++instance FromJSON PullRequestEventType where+ parseJSON (String "opened") = pure PullRequestOpened+ parseJSON (String "closed") = pure PullRequestClosed+ parseJSON (String "synchronize") = pure PullRequestSynchronized+ parseJSON (String "reopened") = pure PullRequestReopened+ parseJSON (String "assigned") = pure PullRequestAssigned+ parseJSON (String "unassigned") = pure PullRequestUnassigned+ parseJSON (String "labeled") = pure PullRequestLabeled+ parseJSON (String "unlabeled") = pure PullRequestUnlabeled+ parseJSON (String "review_requested") = pure PullRequestReviewRequested+ parseJSON (String "review_request_removed") = pure PullRequestReviewRequestRemoved+ parseJSON (String "edited") = pure PullRequestEdited+ parseJSON (String s) = fail $ "Unknown action type " <> T.unpack s+ parseJSON v = typeMismatch "Could not build a PullRequestEventType" v++instance FromJSON PullRequestReference where+ parseJSON = withObject "PullRequestReference" $ \o -> PullRequestReference+ <$> o .:? "html_url"+ <*> o .:? "patch_url"+ <*> o .:? "diff_url"++-- Helpers++newtype Href a = Href { getHref :: a }++instance FromJSON a => FromJSON (Href a) where+ parseJSON = withObject "href object" $+ \obj -> Href <$> obj .: "href"++-- | Pull request merge results+data MergeResult+ = MergeSuccessful+ | MergeCannotPerform+ | MergeConflict+ deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)++statusMerge :: StatusMap MergeResult+statusMerge =+ [ (200, MergeSuccessful)+ , (405, MergeCannotPerform)+ , (409, MergeConflict)+ ]
+ src/GitHub/Data/Releases.hs view
@@ -0,0 +1,85 @@+module GitHub.Data.Releases where++import GitHub.Data.Definitions+import GitHub.Data.Id (Id)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++data Release = Release+ { releaseUrl :: !URL+ , releaseHtmlUrl :: !URL+ , releaseAssetsurl :: !URL+ , releaseUploadUrl :: !URL+ , releaseTarballUrl :: !URL+ , releaseZipballUrl :: !URL+ , releaseId :: !(Id Release)+ , releaseTagName :: !Text+ , releaseTargetCommitish :: !Text+ , releaseName :: !Text+ , releaseBody :: !Text+ , releaseDraft :: !Bool+ , releasePrerelease :: !Bool+ , releaseCreatedAt :: !UTCTime+ , releasePublishedAt :: !(Maybe UTCTime)+ , releaseAuthor :: !SimpleUser+ , releaseAssets :: !(Vector ReleaseAsset)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance FromJSON Release where+ parseJSON = withObject "Event" $ \o -> Release+ <$> o .: "url"+ <*> o .: "html_url"+ <*> o .: "assets_url"+ <*> o .: "upload_url"+ <*> o .: "tarball_url"+ <*> o .: "zipball_url"+ <*> o .: "id"+ <*> o .: "tag_name"+ <*> o .: "target_commitish"+ <*> o .: "name"+ <*> o .: "body"+ <*> o .: "draft"+ <*> o .: "prerelease"+ <*> o .: "created_at"+ <*> o .:? "published_at"+ <*> o .: "author"+ <*> o .: "assets"++instance NFData Release where rnf = genericRnf+instance Binary Release++data ReleaseAsset = ReleaseAsset+ { releaseAssetUrl :: !URL+ , releaseAssetBrowserDownloadUrl :: !Text+ , releaseAssetId :: !(Id ReleaseAsset)+ , releaseAssetName :: !Text+ , releaseAssetLabel :: !(Maybe Text)+ , releaseAssetState :: !Text+ , releaseAssetContentType :: !Text+ , releaseAssetSize :: !Int+ , releaseAssetDownloadCount :: !Int+ , releaseAssetCreatedAt :: !UTCTime+ , releaseAssetUpdatedAt :: !UTCTime+ , releaseAssetUploader :: !SimpleUser+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance FromJSON ReleaseAsset where+ parseJSON = withObject "Event" $ \o -> ReleaseAsset+ <$> o .: "url"+ <*> o .: "browser_download_url"+ <*> o .: "id"+ <*> o .: "name"+ <*> o .:? "label"+ <*> o .: "state"+ <*> o .: "content_type"+ <*> o .: "size"+ <*> o .: "download_count"+ <*> o .: "created_at"+ <*> o .: "updated_at"+ <*> o .: "uploader"++instance NFData ReleaseAsset where rnf = genericRnf+instance Binary ReleaseAsset
+ src/GitHub/Data/Repos.hs view
@@ -0,0 +1,270 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+#define UNSAFE 1+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- This module also exports+-- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@+-- orphan-ish instance for @aeson < 1@+module GitHub.Data.Repos where++import GitHub.Data.Definitions+import GitHub.Data.Id (Id)+import GitHub.Data.Name (Name)+import GitHub.Data.Request (IsPathPart (..))+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++import qualified Data.HashMap.Strict as HM+#if MIN_VERSION_aeson(1,0,0)+import Data.Aeson.Types (FromJSONKey (..), fromJSONKeyCoerce)+#else+#ifdef UNSAFE+import Unsafe.Coerce (unsafeCoerce)+#endif+#endif++data Repo = Repo+ { repoSshUrl :: !(Maybe URL)+ , repoDescription :: !(Maybe Text)+ , repoCreatedAt :: !(Maybe UTCTime)+ , repoHtmlUrl :: !URL+ , repoSvnUrl :: !(Maybe URL)+ , repoForks :: !(Maybe Int)+ , repoHomepage :: !(Maybe Text)+ , repoFork :: !(Maybe Bool)+ , repoGitUrl :: !(Maybe URL)+ , repoPrivate :: !Bool+ , repoArchived :: !Bool+ , repoCloneUrl :: !(Maybe URL)+ , repoSize :: !(Maybe Int)+ , repoUpdatedAt :: !(Maybe UTCTime)+ , repoWatchers :: !(Maybe Int)+ , repoOwner :: !SimpleOwner+ , repoName :: !(Name Repo)+ , repoLanguage :: !(Maybe Language)+ , repoDefaultBranch :: !(Maybe Text)+ , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories+ , repoId :: !(Id Repo)+ , repoUrl :: !URL+ , repoOpenIssues :: !(Maybe Int)+ , repoHasWiki :: !(Maybe Bool)+ , repoHasIssues :: !(Maybe Bool)+ , repoHasDownloads :: !(Maybe Bool)+ , repoParent :: !(Maybe RepoRef)+ , repoSource :: !(Maybe RepoRef)+ , repoHooksUrl :: !URL+ , repoStargazersCount :: !Int+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Repo where rnf = genericRnf+instance Binary Repo++data RepoRef = RepoRef+ { repoRefOwner :: !SimpleOwner+ , repoRefRepo :: !(Name Repo)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData RepoRef where rnf = genericRnf+instance Binary RepoRef++data NewRepo = NewRepo+ { newRepoName :: !(Name Repo)+ , newRepoDescription :: !(Maybe Text)+ , newRepoHomepage :: !(Maybe Text)+ , newRepoPrivate :: !(Maybe Bool)+ , newRepoHasIssues :: !(Maybe Bool)+ , newRepoHasWiki :: !(Maybe Bool)+ , newRepoAutoInit :: !(Maybe Bool)+ } deriving (Eq, Ord, Show, Data, Typeable, Generic)++instance NFData NewRepo where rnf = genericRnf+instance Binary NewRepo++newRepo :: Name Repo -> NewRepo+newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing++data EditRepo = EditRepo+ { editName :: !(Maybe (Name Repo))+ , editDescription :: !(Maybe Text)+ , editHomepage :: !(Maybe Text)+ , editPublic :: !(Maybe Bool)+ , editHasIssues :: !(Maybe Bool)+ , editHasWiki :: !(Maybe Bool)+ , editHasDownloads :: !(Maybe Bool)+ }+ deriving (Eq, Ord, Show, Data, Typeable, Generic)++instance NFData EditRepo where rnf = genericRnf+instance Binary EditRepo++-- | Filter the list of the user's repos using any of these constructors.+data RepoPublicity+ = RepoPublicityAll -- ^ All repos accessible to the user.+ | RepoPublicityOwner -- ^ Only repos owned by the user.+ | RepoPublicityPublic -- ^ Only public repos.+ | RepoPublicityPrivate -- ^ Only private repos.+ | RepoPublicityMember -- ^ Only repos to which the user is a member but not an owner.+ deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic)++-- | The value is the number of bytes of code written in that language.+type Languages = HM.HashMap Language Int++-- | A programming language.+newtype Language = Language Text+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++getLanguage :: Language -> Text+getLanguage (Language l) = l++instance NFData Language where rnf = genericRnf+instance Binary Language+instance Hashable Language where+ hashWithSalt salt (Language l) = hashWithSalt salt l+instance IsString Language where+ fromString = Language . fromString++data Contributor+ -- | An existing Github user, with their number of contributions, avatar+ -- URL, login, URL, ID, and Gravatar ID.+ = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text+ -- | An unknown Github user with their number of contributions and recorded name.+ | AnonymousContributor !Int !Text+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Contributor where rnf = genericRnf+instance Binary Contributor++contributorToSimpleUser :: Contributor -> Maybe SimpleUser+contributorToSimpleUser (AnonymousContributor _ _) = Nothing+contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid _gravatarid) =+ Just $ SimpleUser uid name avatarUrl url++-- JSON instances++instance FromJSON Repo where+ parseJSON = withObject "Repo" $ \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 .:? "archived" .!= False+ <*> o .:? "clone_url"+ <*> o .:? "size"+ <*> o .:? "updated_at"+ <*> o .:? "watchers"+ <*> o .: "owner"+ <*> o .: "name"+ <*> o .:? "language"+ <*> o .:? "default_branch"+ <*> o .:? "pushed_at"+ <*> o .: "id"+ <*> o .: "url"+ <*> o .:? "open_issues"+ <*> o .:? "has_wiki"+ <*> o .:? "has_issues"+ <*> o .:? "has_downloads"+ <*> o .:? "parent"+ <*> o .:? "source"+ <*> o .: "hooks_url"+ <*> o .: "stargazers_count"++instance ToJSON NewRepo where+ toJSON (NewRepo { newRepoName = name+ , newRepoDescription = description+ , newRepoHomepage = homepage+ , newRepoPrivate = private+ , newRepoHasIssues = hasIssues+ , newRepoHasWiki = hasWiki+ , newRepoAutoInit = autoInit+ }) = object+ [ "name" .= name+ , "description" .= description+ , "homepage" .= homepage+ , "private" .= private+ , "has_issues" .= hasIssues+ , "has_wiki" .= hasWiki+ , "auto_init" .= autoInit+ ]++instance ToJSON EditRepo where+ toJSON (EditRepo { editName = name+ , editDescription = description+ , editHomepage = homepage+ , editPublic = public+ , editHasIssues = hasIssues+ , editHasWiki = hasWiki+ , editHasDownloads = hasDownloads+ }) = object+ [ "name" .= name+ , "description" .= description+ , "homepage" .= homepage+ , "public" .= public+ , "has_issues" .= hasIssues+ , "has_wiki" .= hasWiki+ , "has_downloads" .= hasDownloads+ ]++instance FromJSON RepoRef where+ parseJSON = withObject "RepoRef" $ \o -> RepoRef+ <$> o .: "owner"+ <*> o .: "name"++instance FromJSON Contributor where+ parseJSON = withObject "Contributor" $ \o -> do+ t <- o .: "type"+ case (t :: Text) of+ "Anonymous" -> AnonymousContributor+ <$> o .: "contributions"+ <*> o .: "name"+ _ -> KnownContributor+ <$> o .: "contributions"+ <*> o .: "avatar_url"+ <*> o .: "login"+ <*> o .: "url"+ <*> o .: "id"+ <*> o .: "gravatar_id"++instance FromJSON Language where+ parseJSON = withText "Language" (pure . Language)++instance ToJSON Language where+ toJSON = toJSON . getLanguage++#if MIN_VERSION_aeson(1,0,0)+instance FromJSONKey Language where+ fromJSONKey = fromJSONKeyCoerce+#else+instance FromJSON a => FromJSON (HM.HashMap Language a) where+ parseJSON = fmap mapKeyLanguage . parseJSON+ where+ mapKeyLanguage :: HM.HashMap Text a -> HM.HashMap Language a+#ifdef UNSAFE+ mapKeyLanguage = unsafeCoerce+#else+ mapKeyLanguage = mapKey Language+ mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a+ mapKey f = HM.fromList . map (first f) . HM.toList+#endif+#endif++data ArchiveFormat+ = ArchiveFormatTarball -- ^ ".tar.gz" format+ | ArchiveFormatZipball -- ^ ".zip" format+ deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic)++instance IsPathPart ArchiveFormat where+ toPathPart af = case af of+ ArchiveFormatTarball -> "tarball"+ ArchiveFormatZipball -> "zipball"
+ src/GitHub/Data/Request.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE StandaloneDeriving #-}+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Request (+ -- * Request+ Request (..),+ SimpleRequest (..),+ -- * Smart constructors+ query, pagedQuery, command,+ -- * Auxiliary types+ RW(..),+ StatusMap,+ statusOnlyOk,+ CommandMethod(..),+ toMethod,+ FetchCount(..),+ Paths,+ IsPathPart(..),+ QueryString,+ Count,+ ) where++import GitHub.Data.Definitions (Count, QueryString)+import GitHub.Data.Id (Id, untagId)+import GitHub.Data.Name (Name, untagName)+import GitHub.Internal.Prelude++import qualified Data.ByteString.Lazy as LBS+import qualified Data.Text as T+import qualified Network.HTTP.Types as Types+import qualified Network.HTTP.Types.Method as Method+import Network.URI (URI)+------------------------------------------------------------------------------+-- Auxillary types+------------------------------------------------------------------------------++type Paths = [Text]++class IsPathPart a where+ toPathPart :: a -> Text++instance IsPathPart (Name a) where+ toPathPart = untagName++instance IsPathPart (Id a) where+ toPathPart = T.pack . show . untagId++-- | Http method of requests with body.+data CommandMethod a where+ Post :: CommandMethod a+ Patch :: CommandMethod a+ Put :: CommandMethod a+ Put' :: CommandMethod ()+ Delete :: CommandMethod ()+ deriving (Typeable)++deriving instance Eq (CommandMethod a)+deriving instance Ord (CommandMethod a)++instance Show (CommandMethod a) where+ showsPrec _ Post = showString "Post"+ showsPrec _ Patch = showString "Patch"+ showsPrec _ Put = showString "Put"+ showsPrec _ Put' = showString "Put'"+ showsPrec _ Delete = showString "Delete"++instance Hashable (CommandMethod a) where+ hashWithSalt salt Post = hashWithSalt salt (0 :: Int)+ hashWithSalt salt Patch = hashWithSalt salt (1 :: Int)+ hashWithSalt salt Put = hashWithSalt salt (2 :: Int)+ hashWithSalt salt Put' = hashWithSalt salt (3 :: Int)+ hashWithSalt salt Delete = hashWithSalt salt (4 :: Int)++toMethod :: CommandMethod a -> Method.Method+toMethod Post = Method.methodPost+toMethod Patch = Method.methodPatch+toMethod Put = Method.methodPut+toMethod Put' = Method.methodPut+toMethod Delete = Method.methodDelete++-- | 'PagedQuery' returns just some results, using this data we can specify how+-- many pages we want to fetch.+data FetchCount = FetchAtLeast !Word | FetchAll+ deriving (Eq, Ord, Read, Show, Generic, Typeable)+++-- | This instance is there mostly for 'fromInteger'.+instance Num FetchCount where+ fromInteger = FetchAtLeast . fromInteger++ FetchAtLeast a + FetchAtLeast b = FetchAtLeast (a * b)+ _ + _ = FetchAll++ FetchAtLeast a * FetchAtLeast b = FetchAtLeast (a * b)+ _ * _ = FetchAll++ abs = error "abs @FetchCount: not implemented"+ signum = error "signum @FetchCount: not implemented"+ negate = error "negate @FetchCount: not implemented"++instance Hashable FetchCount+instance Binary FetchCount+instance NFData FetchCount where rnf = genericRnf++------------------------------------------------------------------------------+-- Github request+------------------------------------------------------------------------------++-- | Type used as with @DataKinds@ to tag whether requests need authentication+-- or aren't read-only.+data RW+ = RO -- ^ /Read-only/, doesn't necessarily requires authentication+ | RA -- ^ /Read autenticated/+ | RW -- ^ /Read-write/, requires authentication+ deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic)++{-+data SRO (rw :: RW) where+ ROO :: SRO 'RO+ ROA :: SRO 'RA++-- | This class is used to describe read-only (but pontentially+class IReadOnly (rw :: RW) where iro :: SRO rw+instance IReadOnly 'RO where iro = ROO+instance IReadOnly 'RA where iro = ROA+-}++-- | Github request data type.+--+-- * @k@ describes whether authentication is required. It's required for non-@GET@ requests.+-- * @a@ is the result type+--+-- /Note:/ 'Request' is not 'Functor' on purpose.+data Request (k :: RW) a where+ SimpleQuery :: FromJSON a => SimpleRequest k a -> Request k a+ StatusQuery :: StatusMap a -> SimpleRequest k () -> Request k a+ HeaderQuery :: FromJSON a => Types.RequestHeaders -> SimpleRequest k a -> Request k a+ RedirectQuery :: SimpleRequest k () -> Request k URI+ deriving (Typeable)++data SimpleRequest (k :: RW) a where+ Query :: Paths -> QueryString -> SimpleRequest k a+ PagedQuery :: Paths -> QueryString -> FetchCount -> SimpleRequest k (Vector a)+ Command :: CommandMethod a -> Paths -> LBS.ByteString -> SimpleRequest 'RW a+ deriving (Typeable)++-------------------------------------------------------------------------------+-- Status Map+-------------------------------------------------------------------------------++-- TODO: Change to 'Map' ?+type StatusMap a = [(Int, a)]++statusOnlyOk :: StatusMap Bool+statusOnlyOk =+ [ (204, True)+ , (404, False)+ ]++-------------------------------------------------------------------------------+-- Smart constructors+-------------------------------------------------------------------------------++query :: FromJSON a => Paths -> QueryString -> Request k a+query ps qs = SimpleQuery (Query ps qs)++pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request k (Vector a)+pagedQuery ps qs fc = SimpleQuery (PagedQuery ps qs fc)++command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'RW a+command m ps body = SimpleQuery (Command m ps body)++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++deriving instance Eq a => Eq (Request k a)+deriving instance Eq a => Eq (SimpleRequest k a)++deriving instance Ord a => Ord (Request k a)+deriving instance Ord a => Ord (SimpleRequest k a)++instance Show (SimpleRequest k a) where+ showsPrec d r = showParen (d > appPrec) $ case r of+ Query ps qs -> showString "Query "+ . showsPrec (appPrec + 1) ps+ . showString " "+ . showsPrec (appPrec + 1) qs+ PagedQuery ps qs l -> showString "PagedQuery "+ . showsPrec (appPrec + 1) ps+ . showString " "+ . showsPrec (appPrec + 1) qs+ . showString " "+ . showsPrec (appPrec + 1) l+ Command m ps body -> showString "Command "+ . showsPrec (appPrec + 1) m+ . showString " "+ . showsPrec (appPrec + 1) ps+ . showString " "+ . showsPrec (appPrec + 1) body+ where+ appPrec = 10 :: Int++instance Show (Request k a) where+ showsPrec d r = showParen (d > appPrec) $ case r of+ SimpleQuery req -> showString "SimpleQuery "+ . showsPrec (appPrec + 1) req+ StatusQuery m req -> showString "Status "+ . showsPrec (appPrec + 1) (map fst m) -- !!! printing only keys+ . showString " "+ . showsPrec (appPrec + 1) req+ HeaderQuery m req -> showString "Header "+ . showsPrec (appPrec + 1) m+ . showString " "+ . showsPrec (appPrec + 1) req+ RedirectQuery req -> showString "Redirect "+ . showsPrec (appPrec + 1) req+ where+ appPrec = 10 :: Int++instance Hashable (SimpleRequest k a) where+ hashWithSalt salt (Query ps qs) =+ salt `hashWithSalt` (0 :: Int)+ `hashWithSalt` ps+ `hashWithSalt` qs+ hashWithSalt salt (PagedQuery ps qs l) =+ salt `hashWithSalt` (1 :: Int)+ `hashWithSalt` ps+ `hashWithSalt` qs+ `hashWithSalt` l+ hashWithSalt salt (Command m ps body) =+ salt `hashWithSalt` (2 :: Int)+ `hashWithSalt` m+ `hashWithSalt` ps+ `hashWithSalt` body++instance Hashable (Request k a) where+ hashWithSalt salt (SimpleQuery req) =+ salt `hashWithSalt` (0 :: Int)+ `hashWithSalt` req+ hashWithSalt salt (StatusQuery sm req) =+ salt `hashWithSalt` (1 :: Int)+ `hashWithSalt` map fst sm+ `hashWithSalt` req+ hashWithSalt salt (HeaderQuery h req) =+ salt `hashWithSalt` (2 :: Int)+ `hashWithSalt` h+ `hashWithSalt` req+ hashWithSalt salt (RedirectQuery req) =+ salt `hashWithSalt` (3 :: Int)+ `hashWithSalt` req
+ src/GitHub/Data/Reviews.hs view
@@ -0,0 +1,97 @@+module GitHub.Data.Reviews where++import Data.Text (Text)+import GitHub.Data.Definitions (SimpleUser)+import GitHub.Data.Id (Id)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++data ReviewState+ = ReviewStatePending+ | ReviewStateApproved+ | ReviewStateDismissed+ | ReviewStateCommented+ | ReviewStateChangesRequested+ deriving (Show, Enum, Bounded, Eq, Ord, Generic)++instance NFData ReviewState where+ rnf = genericRnf++instance Binary ReviewState++instance FromJSON ReviewState where+ parseJSON (String "APPROVED") = pure ReviewStateApproved+ parseJSON (String "PENDING") = pure ReviewStatePending+ parseJSON (String "DISMISSED") = pure ReviewStateDismissed+ parseJSON (String "COMMENTED") = pure ReviewStateCommented+ parseJSON (String "CHANGES_REQUESTED") = pure ReviewStateChangesRequested+ parseJSON _ = fail "Unexpected ReviewState"++data Review = Review+ { reviewBody :: !Text+ , reviewCommitId :: !Text+ , reviewState :: ReviewState+ , reviewSubmittedAt :: !UTCTime+ , reviewPullRequestUrl :: !URL+ , reviewHtmlUrl :: !Text+ , reviewUser :: !SimpleUser+ , reviewId :: !(Id Review)+ } deriving (Show, Generic)++instance NFData Review where+ rnf = genericRnf++instance Binary Review++instance FromJSON Review where+ parseJSON =+ withObject "Review" $ \o ->+ Review <$> o .: "body" <*> o .: "commit_id" <*> o .: "state" <*>+ o .: "submitted_at" <*>+ o .: "pull_request_url" <*>+ o .: "html_url" <*>+ o .: "user" <*>+ o .: "id"++data ReviewComment = ReviewComment+ { reviewCommentId :: !(Id ReviewComment)+ , reviewCommentUser :: !SimpleUser+ , reviewCommentBody :: !Text+ , reviewCommentUrl :: !URL+ , reviewCommentPullRequestReviewId :: !(Id Review)+ , reviewCommentDiffHunk :: !Text+ , reviewCommentPath :: !Text+ , reviewCommentPosition :: !Int+ , reviewCommentOriginalPosition :: !Int+ , reviewCommentCommitId :: !Text+ , reviewCommentOriginalCommitId :: !Text+ , reviewCommentCreatedAt :: !UTCTime+ , reviewCommentUpdatedAt :: !UTCTime+ , reviewCommentHtmlUrl :: !URL+ , reviewCommentPullRequestUrl :: !URL+ } deriving (Show, Generic)++instance NFData ReviewComment where+ rnf = genericRnf++instance Binary ReviewComment++instance FromJSON ReviewComment where+ parseJSON =+ withObject "ReviewComment" $ \o -> ReviewComment+ <$> o .: "id"+ <*> o .: "user"+ <*> o .: "body"+ <*> o .: "url"+ <*> o .: "pull_request_review_id"+ <*> o .: "diff_hunk"+ <*> o .: "path"+ <*> o .: "position"+ <*> o .: "original_position"+ <*> o .: "commit_id"+ <*> o .: "original_commit_id"+ <*> o .: "created_at"+ <*> o .: "updated_at"+ <*> o .: "html_url"+ <*> o .: "pull_request_url"
+ src/GitHub/Data/Search.hs view
@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Search where++import GitHub.Data.Repos (Repo)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++import qualified Data.Vector as V++data SearchResult entity = SearchResult+ { searchResultTotalCount :: !Int+ , searchResultResults :: !(Vector entity)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData entity => NFData (SearchResult entity) where rnf = genericRnf+instance Binary entity => Binary (SearchResult entity)++instance FromJSON entity => FromJSON (SearchResult entity) where+ parseJSON = withObject "SearchResult" $ \o -> SearchResult+ <$> o .: "total_count"+ <*> o .:? "items" .!= V.empty++data Code = Code+ { codeName :: !Text+ , codePath :: !Text+ , codeSha :: !Text+ , codeUrl :: !URL+ , codeGitUrl :: !URL+ , codeHtmlUrl :: !URL+ , codeRepo :: !Repo+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Code where rnf = genericRnf+instance Binary Code++instance FromJSON Code where+ parseJSON = withObject "Code" $ \o -> Code+ <$> o .: "name"+ <*> o .: "path"+ <*> o .: "sha"+ <*> o .: "url"+ <*> o .: "git_url"+ <*> o .: "html_url"+ <*> o .: "repository"
+ src/GitHub/Data/Statuses.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module GitHub.Data.Statuses where++import GitHub.Data.Definitions+import GitHub.Data.Name (Name)+import GitHub.Data.Id (Id)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++import GitHub.Data.GitData (Commit)+import GitHub.Data.Repos (RepoRef)+++data StatusState+ = StatusPending+ | StatusSuccess+ | StatusError+ | StatusFailure+ deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic)++instance NFData StatusState where rnf = genericRnf+instance Binary StatusState++instance FromJSON StatusState where+ parseJSON (String "pending") = pure StatusPending+ parseJSON (String "success") = pure StatusSuccess+ parseJSON (String "error") = pure StatusError+ parseJSON (String "failure") = pure StatusFailure+ parseJSON _ = fail "Could not build a StatusState"++instance ToJSON StatusState where+ toJSON StatusPending = String "pending"+ toJSON StatusSuccess = String "success"+ toJSON StatusError = String "error"+ toJSON StatusFailure = String "failure"+++data Status = Status+ { statusCreatedAt :: !UTCTime+ , statusUpdatedAt :: !UTCTime+ , statusState :: !StatusState+ , statusTargetUrl :: !(Maybe URL)+ , statusDescription :: !(Maybe Text)+ , statusId :: !(Id Status)+ , statusUrl :: !URL+ , statusContext :: !(Maybe Text)+ , statusCreator :: !(Maybe SimpleUser)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance FromJSON Status where+ parseJSON = withObject "Status" $ \o -> Status+ <$> o .: "created_at"+ <*> o .: "updated_at"+ <*> o .: "state"+ <*> o .:? "target_url"+ <*> o .:? "description"+ <*> o .: "id"+ <*> o .: "url"+ <*> o .:? "context"+ <*> o .:? "creator"+++data NewStatus = NewStatus+ { newStatusState :: !StatusState+ , newStatusTargetUrl :: !(Maybe URL)+ , newStatusDescription :: !(Maybe Text)+ , newStatusContext :: !(Maybe Text)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData NewStatus where rnf = genericRnf+instance Binary NewStatus++instance ToJSON NewStatus where+ toJSON (NewStatus s t d c) = object $ filter notNull $+ [ "state" .= s+ , "target_url" .= t+ , "description" .= d+ , "context" .= c+ ]+ where+ notNull (_, Null) = False+ notNull (_, _) = True+++data CombinedStatus = CombinedStatus+ { combinedStatusState :: !StatusState+ , combinedStatusSha :: !(Name Commit)+ , combinedStatusTotalCount :: !Int+ , combinedStatusStatuses :: !(Vector Status)+ , combinedStatusRepository :: !RepoRef+ , combinedStatusCommitUrl :: !URL+ , combinedStatusUrl :: !URL+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance FromJSON CombinedStatus where+ parseJSON = withObject "CombinedStatus" $ \o -> CombinedStatus+ <$> o .: "state"+ <*> o .: "sha"+ <*> o .: "total_count"+ <*> o .: "statuses"+ <*> o .: "repository"+ <*> o .: "commit_url"+ <*> o .: "url"
+ src/GitHub/Data/Teams.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Teams where++import GitHub.Data.Definitions+import GitHub.Data.Id (Id)+import GitHub.Data.Name (Name)+import GitHub.Data.Repos (Repo)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++data Privacy+ = PrivacyClosed+ | PrivacySecret+ deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic)++instance NFData Privacy where rnf = genericRnf+instance Binary Privacy++data Permission+ = PermissionPull+ | PermissionPush+ | PermissionAdmin+ deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic)++instance NFData Permission where rnf = genericRnf+instance Binary Permission++data AddTeamRepoPermission = AddTeamRepoPermission+ { addTeamRepoPermission :: !Permission+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData AddTeamRepoPermission where rnf = genericRnf+instance Binary AddTeamRepoPermission++data SimpleTeam = SimpleTeam+ { simpleTeamId :: !(Id Team)+ , simpleTeamUrl :: !URL+ , simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'.+ , simpleTeamSlug :: !(Name Team)+ , simpleTeamDescription :: !(Maybe Text)+ , simpleTeamPrivacy :: !(Maybe Privacy)+ , simpleTeamPermission :: !Permission+ , simpleTeamMembersUrl :: !URL+ , simpleTeamRepositoriesUrl :: !URL+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData SimpleTeam where rnf = genericRnf+instance Binary SimpleTeam++data Team = Team+ { teamId :: !(Id Team)+ , teamUrl :: !URL+ , teamName :: !Text+ , teamSlug :: !(Name Team)+ , teamDescription :: !(Maybe Text)+ , teamPrivacy :: !(Maybe Privacy)+ , teamPermission :: !Permission+ , teamMembersUrl :: !URL+ , teamRepositoriesUrl :: !URL+ , teamMembersCount :: !Int+ , teamReposCount :: !Int+ , teamOrganization :: !SimpleOrganization+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Team where rnf = genericRnf+instance Binary Team++data CreateTeam = CreateTeam+ { createTeamName :: !(Name Team)+ , createTeamDescription :: !(Maybe Text)+ , createTeamRepoNames :: !(Vector (Name Repo))+ -- , createTeamPrivacy :: Privacy+ , createTeamPermission :: Permission+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData CreateTeam where rnf = genericRnf+instance Binary CreateTeam++data EditTeam = EditTeam+ { editTeamName :: !(Name Team)+ , editTeamDescription :: !(Maybe Text)+ -- , editTeamPrivacy :: Privacy+ , editTeamPermission :: !Permission+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData EditTeam where rnf = genericRnf+instance Binary EditTeam++data Role+ = RoleMaintainer+ | RoleMember+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData Role+instance Binary Role++data ReqState+ = StatePending+ | StateActive+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData ReqState where rnf = genericRnf+instance Binary ReqState++data TeamMembership = TeamMembership+ { teamMembershipUrl :: !URL+ , teamMembershipRole :: !Role+ , teamMembershipReqState :: !ReqState+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData TeamMembership where rnf = genericRnf+instance Binary TeamMembership++data CreateTeamMembership = CreateTeamMembership {+ createTeamMembershipRole :: !Role+} deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData CreateTeamMembership where rnf = genericRnf+instance Binary CreateTeamMembership++-- JSON Instances++instance FromJSON SimpleTeam where+ parseJSON = withObject "SimpleTeam" $ \o -> SimpleTeam+ <$> o .: "id"+ <*> o .: "url"+ <*> o .: "name"+ <*> o .: "slug"+ <*> o .:?"description" .!= Nothing+ <*> o .:?"privacy" .!= Nothing+ <*> o .: "permission"+ <*> o .: "members_url"+ <*> o .: "repositories_url"++instance FromJSON Team where+ parseJSON = withObject "Team" $ \o -> Team+ <$> o .: "id"+ <*> o .: "url"+ <*> o .: "name"+ <*> o .: "slug"+ <*> o .:?"description" .!= Nothing+ <*> o .:?"privacy" .!= Nothing+ <*> o .: "permission"+ <*> o .: "members_url"+ <*> o .: "repositories_url"+ <*> o .: "members_count"+ <*> o .: "repos_count"+ <*> o .: "organization"++instance ToJSON CreateTeam where+ toJSON (CreateTeam name desc repo_names {-privacy-} permissions) =+ object [ "name" .= name+ , "description" .= desc+ , "repo_names" .= repo_names+ {-, "privacy" .= privacy-}+ , "permissions" .= permissions ]++instance ToJSON EditTeam where+ toJSON (EditTeam name desc {-privacy-} permissions) =+ object [ "name" .= name+ , "description" .= desc+ {-, "privacy" .= privacy-}+ , "permissions" .= permissions ]++instance FromJSON TeamMembership where+ parseJSON = withObject "TeamMembership" $ \o -> TeamMembership+ <$> o .: "url"+ <*> o .: "role"+ <*> o .: "state"++instance FromJSON CreateTeamMembership where+ parseJSON = withObject "CreateTeamMembership" $ \o -> CreateTeamMembership+ <$> o .: "role"++instance ToJSON CreateTeamMembership where+ toJSON (CreateTeamMembership { createTeamMembershipRole = role }) =+ object [ "role" .= role ]++instance FromJSON AddTeamRepoPermission where+ parseJSON = withObject "AddTeamRepoPermission" $ \o -> AddTeamRepoPermission+ <$> o .: "permission"++instance ToJSON AddTeamRepoPermission where+ toJSON (AddTeamRepoPermission { addTeamRepoPermission = permission}) =+ object [ "permission" .= permission ]++instance FromJSON Role where+ parseJSON = withText "Attribute" $ \attr -> case attr of+ "maintainer" -> return RoleMaintainer+ "member" -> return RoleMember+ _ -> fail $ "Unknown Role: " ++ show attr++instance ToJSON Role where+ toJSON RoleMaintainer = String "maintainer"+ toJSON RoleMember = String "member"++instance ToJSON Permission where+ toJSON PermissionPull = "pull"+ toJSON PermissionPush = "push"+ toJSON PermissionAdmin = "admin"++instance FromJSON Permission where+ parseJSON = withText "Permission Attribute" $ \attr -> case attr of + "pull" -> return PermissionPull+ "push" -> return PermissionPush+ "admin" -> return PermissionAdmin+ _ -> fail $ "Unknown Permission Attribute: " ++ show attr++instance FromJSON Privacy where+ parseJSON = withText "Privacy Attribute" $ \attr -> case attr of+ "secret" -> return PrivacySecret+ "closed" -> return PrivacyClosed+ _ -> fail $ "Unknown Privacy Attribute: " ++ show attr++instance ToJSON Privacy where+ toJSON PrivacySecret = String "secret"+ toJSON PrivacyClosed = String "closed"++instance FromJSON ReqState where+ parseJSON = withText "ReqState" $ \attr -> case attr of+ "active" -> return StateActive+ "pending" -> return StatePending+ _ -> fail $ "Unknown ReqState: " ++ show attr++instance ToJSON ReqState where+ toJSON StateActive = String "active"+ toJSON StatePending = String "pending"++-- | Filters members returned by their role in the team.+data TeamMemberRole+ = TeamMemberRoleAll -- ^ all members of the team.+ | TeamMemberRoleMaintainer -- ^ team maintainers+ | TeamMemberRoleMember -- ^ normal members of the team.+ deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic)
+ src/GitHub/Data/URL.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.URL (+ URL(..),+ getUrl,+ ) where++import GitHub.Internal.Prelude+import Prelude ()++-- | Data representing URLs in responses.+--+-- /N.B./ syntactical validity is not verified.+newtype URL = URL Text+ deriving (Eq, Ord, Show, Generic, Typeable, Data)++getUrl :: URL -> Text+getUrl (URL url) = url++instance NFData URL where rnf = genericRnf+instance Binary URL++instance ToJSON URL where+ toJSON (URL url) = toJSON url++instance FromJSON URL where+ parseJSON = withText "URL" (pure . URL)
+ src/GitHub/Data/Webhooks.hs view
@@ -0,0 +1,201 @@+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module GitHub.Data.Webhooks where++import GitHub.Data.Id (Id)+import GitHub.Data.URL (URL)+import GitHub.Internal.Prelude+import Prelude ()++import qualified Data.Map as M++data RepoWebhook = RepoWebhook+ { repoWebhookUrl :: !URL+ , repoWebhookTestUrl :: !URL+ , repoWebhookId :: !(Id RepoWebhook)+ , repoWebhookName :: !Text+ , repoWebhookActive :: !Bool+ , repoWebhookEvents :: !(Vector RepoWebhookEvent)+ , repoWebhookConfig :: !(M.Map Text Text)+ , repoWebhookLastResponse :: !RepoWebhookResponse+ , repoWebhookUpdatedAt :: !UTCTime+ , repoWebhookCreatedAt :: !UTCTime+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData RepoWebhook where rnf = genericRnf+instance Binary RepoWebhook++data RepoWebhookEvent+ = WebhookWildcardEvent+ | WebhookCommitCommentEvent+ | WebhookCreateEvent+ | WebhookDeleteEvent+ | WebhookDeploymentEvent+ | WebhookDeploymentStatusEvent+ | WebhookForkEvent+ | WebhookGollumEvent+ | WebhookIssueCommentEvent+ | WebhookIssuesEvent+ | WebhookMemberEvent+ | WebhookPageBuildEvent+ | WebhookPingEvent+ | WebhookPublicEvent+ | WebhookPullRequestReviewCommentEvent+ | WebhookPullRequestEvent+ | WebhookPushEvent+ | WebhookReleaseEvent+ | WebhookStatusEvent+ | WebhookTeamAddEvent+ | WebhookWatchEvent+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData RepoWebhookEvent where rnf = genericRnf+instance Binary RepoWebhookEvent++data RepoWebhookResponse = RepoWebhookResponse+ { repoWebhookResponseCode :: !(Maybe Int)+ , repoWebhookResponseStatus :: !Text+ , repoWebhookResponseMessage :: !(Maybe Text)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData RepoWebhookResponse where rnf = genericRnf+instance Binary RepoWebhookResponse++data PingEvent = PingEvent+ { pingEventZen :: !Text+ , pingEventHook :: !RepoWebhook+ , pingEventHookId :: !(Id RepoWebhook)+ }+ deriving (Show, Data, Typeable, Eq, Ord, Generic)++instance NFData PingEvent where rnf = genericRnf+instance Binary PingEvent++data NewRepoWebhook = NewRepoWebhook+ { newRepoWebhookName :: !Text+ , newRepoWebhookConfig :: !(M.Map Text Text)+ , newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent))+ , newRepoWebhookActive :: !(Maybe Bool)+ }+ deriving (Eq, Ord, Show, Typeable, Data, Generic)++instance NFData NewRepoWebhook where rnf = genericRnf+instance Binary NewRepoWebhook++data EditRepoWebhook = EditRepoWebhook+ { editRepoWebhookConfig :: !(Maybe (M.Map Text Text))+ , editRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent))+ , editRepoWebhookAddEvents :: !(Maybe (Vector RepoWebhookEvent))+ , editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent))+ , editRepoWebhookActive :: !(Maybe Bool)+ }+ deriving (Eq, Ord, Show, Typeable, Data, Generic)++instance NFData EditRepoWebhook where rnf = genericRnf+instance Binary EditRepoWebhook++-- JSON instances++instance FromJSON RepoWebhookEvent where+ parseJSON (String "*") = pure WebhookWildcardEvent+ parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent+ parseJSON (String "create") = pure WebhookCreateEvent+ parseJSON (String "delete") = pure WebhookDeleteEvent+ parseJSON (String "deployment") = pure WebhookDeploymentEvent+ parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent+ parseJSON (String "fork") = pure WebhookForkEvent+ parseJSON (String "gollum") = pure WebhookGollumEvent+ parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent+ parseJSON (String "issues") = pure WebhookIssuesEvent+ parseJSON (String "member") = pure WebhookMemberEvent+ parseJSON (String "page_build") = pure WebhookPageBuildEvent+ parseJSON (String "ping") = pure WebhookPingEvent+ parseJSON (String "public") = pure WebhookPublicEvent+ parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent+ parseJSON (String "pull_request") = pure WebhookPullRequestEvent+ parseJSON (String "push") = pure WebhookPushEvent+ parseJSON (String "release") = pure WebhookReleaseEvent+ parseJSON (String "status") = pure WebhookStatusEvent+ parseJSON (String "team_add") = pure WebhookTeamAddEvent+ parseJSON (String "watch") = pure WebhookWatchEvent+ parseJSON _ = fail "Could not build a Webhook event"++instance ToJSON RepoWebhookEvent where+ toJSON WebhookWildcardEvent = String "*"+ toJSON WebhookCommitCommentEvent = String "commit_comment"+ toJSON WebhookCreateEvent = String "create"+ toJSON WebhookDeleteEvent = String "delete"+ toJSON WebhookDeploymentEvent = String "deployment"+ toJSON WebhookDeploymentStatusEvent = String "deployment_status"+ toJSON WebhookForkEvent = String "fork"+ toJSON WebhookGollumEvent = String "gollum"+ toJSON WebhookIssueCommentEvent = String "issue_comment"+ toJSON WebhookIssuesEvent = String "issues"+ toJSON WebhookMemberEvent = String "member"+ toJSON WebhookPageBuildEvent = String "page_build"+ toJSON WebhookPingEvent = String "ping"+ toJSON WebhookPublicEvent = String "public"+ toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment"+ toJSON WebhookPullRequestEvent = String "pull_request"+ toJSON WebhookPushEvent = String "push"+ toJSON WebhookReleaseEvent = String "release"+ toJSON WebhookStatusEvent = String "status"+ toJSON WebhookTeamAddEvent = String "team_add"+ toJSON WebhookWatchEvent = String "watch"++instance FromJSON RepoWebhook where+ parseJSON = withObject "RepoWebhook" $ \o -> RepoWebhook+ <$> o .: "url"+ <*> o .: "test_url"+ <*> o .: "id"+ <*> o .: "name"+ <*> o .: "active"+ <*> o .: "events"+ <*> o .: "config"+ <*> o .: "last_response"+ <*> o .: "updated_at"+ <*> o .: "created_at"++instance FromJSON RepoWebhookResponse where+ parseJSON = withObject "RepoWebhookResponse" $ \o -> RepoWebhookResponse+ <$> o .: "code"+ <*> o .: "status"+ <*> o .: "message"++instance ToJSON NewRepoWebhook where+ toJSON (NewRepoWebhook { newRepoWebhookName = name+ , newRepoWebhookConfig = config+ , newRepoWebhookEvents = events+ , newRepoWebhookActive = active++ }) = object+ [ "name" .= name+ , "config" .= config+ , "events" .= events+ , "active" .= active+ ]++instance ToJSON EditRepoWebhook where+ toJSON (EditRepoWebhook { editRepoWebhookConfig = config+ , editRepoWebhookEvents = events+ , editRepoWebhookAddEvents = addEvents+ , editRepoWebhookRemoveEvents = removeEvents+ , editRepoWebhookActive = active+ }) = object+ [ "config" .= config+ , "events" .= events+ , "add_events" .= addEvents+ , "remove_events" .= removeEvents+ , "active" .= active+ ]++instance FromJSON PingEvent where+ parseJSON = withObject "PingEvent" $ \o -> PingEvent+ <$> o .: "zen"+ <*> o .: "hook"+ <*> o .: "hook_id"
+ src/GitHub/Internal/Prelude.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE NoImplicitPrelude #-}+-----------------------------------------------------------------------------+-- |+-- License : BSD-3-Clause+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- This module may change between minor releases. Do not rely on it contents.+module GitHub.Internal.Prelude (+ module Prelude.Compat,+ -- * Commonly used types+ UTCTime,+ HashMap,+ Text, pack, unpack,+ Vector,+ -- * Commonly used typeclasses+ Binary,+ Data, Typeable,+ Generic,+ Hashable(..),+ IsString(..),+ NFData(..), genericRnf,+ Semigroup(..),+ -- * Aeson+ FromJSON(..), ToJSON(..), Value(..), Object,+ encode,+ withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch,+ -- * Control.Applicative+ (<|>),+ -- * Data.Maybe+ catMaybes,+ -- * Data.List+ intercalate, toList,+ -- * Data.Time.ISO8601+ formatISO8601,+ ) where++import Control.Applicative ((<|>))+import Control.DeepSeq (NFData (..))+import Control.DeepSeq.Generics (genericRnf)+import Data.Aeson.Compat+ (FromJSON (..), Object, ToJSON (..), Value (..), encode, object,+ withObject, withText, (.!=), (.:), (.:?), (.=))+import Data.Aeson.Types (typeMismatch)+import Data.Binary (Binary)+import Data.Binary.Orphans ()+import Data.Data (Data, Typeable)+import Data.Foldable (toList)+import Data.Hashable (Hashable (..))+import Data.HashMap.Strict (HashMap)+import Data.List (intercalate)+import Data.Maybe (catMaybes)+import Data.Semigroup (Semigroup (..))+import Data.String (IsString (..))+import Data.Text (Text, pack, unpack)+import Data.Time (UTCTime)+import Data.Time.ISO8601 (formatISO8601)+import Data.Vector (Vector)+import Data.Vector.Instances ()+import GHC.Generics (Generic)+import Prelude.Compat