From c61f101992e4af8663068c38b714acdc0311985f Mon Sep 17 00:00:00 2001 From: Pablo Lamela Seijas Date: Sat, 23 Aug 2014 13:27:56 +0100 Subject: [PATCH] Implemented code search --- Github/Data.hs | 41 +++++++++++++++++++-------- Github/Data/Definitions.hs | 41 ++++++++++++++++++--------- Github/Search.hs | 19 ++++++++++++- github.cabal | 2 +- samples/Repos/Forks/ListForks.hs | 5 +++- samples/Repos/ListOrgRepos.hs | 5 ++-- samples/Repos/ListUserRepos.hs | 5 ++-- samples/Repos/Starring/ListStarred.hs | 5 ++-- samples/Repos/Watching/ListWatched.hs | 5 ++-- samples/Search/SearchCode.hs | 34 ++++++++++++++++++++++ samples/Search/SearchRepos.hs | 2 +- 11 files changed, 127 insertions(+), 37 deletions(-) create mode 100644 samples/Search/SearchCode.hs diff --git a/Github/Data.hs b/Github/Data.hs index 7b66ce1b..b8cb3aa5 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -503,28 +503,28 @@ instance FromJSON SearchReposResult where instance FromJSON Repo where parseJSON (Object o) = - Repo <$> o .: "ssh_url" + Repo <$> o .:? "ssh_url" <*> o .: "description" - <*> o .: "created_at" + <*> o .:? "created_at" <*> o .: "html_url" - <*> o .: "svn_url" - <*> o .: "forks" + <*> o .:? "svn_url" + <*> o .:? "forks" <*> o .:? "homepage" <*> o .: "fork" - <*> o .: "git_url" + <*> o .:? "git_url" <*> o .: "private" - <*> o .: "clone_url" - <*> o .: "size" - <*> o .: "updated_at" - <*> o .: "watchers" + <*> o .:? "clone_url" + <*> o .:? "size" + <*> o .:? "updated_at" + <*> o .:? "watchers" <*> o .: "owner" <*> o .: "name" - <*> o .: "language" + <*> o .:? "language" <*> o .:? "master_branch" - <*> o .: "pushed_at" + <*> o .:? "pushed_at" <*> o .: "id" <*> o .: "url" - <*> o .: "open_issues" + <*> o .:? "open_issues" <*> o .:? "has_wiki" <*> o .:? "has_issues" <*> o .:? "has_downloads" @@ -533,6 +533,23 @@ instance FromJSON Repo where <*> o .: "hooks_url" parseJSON _ = fail "Could not build a Repo" +instance FromJSON SearchCodeResult where + parseJSON (Object o) = + SearchCodeResult <$> o .: "total_count" + <*> o .:< "items" + parseJSON _ = fail "Could not build a SearchCodeResult" + +instance FromJSON Code where + parseJSON (Object o ) = + Code <$> o .: "name" + <*> o .: "path" + <*> o .: "sha" + <*> o .: "url" + <*> o .: "git_url" + <*> o .: "html_url" + <*> o .: "repository" + parseJSON _ = fail "Could not build a Code" + instance FromJSON RepoRef where parseJSON (Object o) = RepoRef <$> o .: "owner" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 3a0eb35a..c3ea56ab 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -103,7 +103,7 @@ data Comment = Comment { ,commentUpdatedAt :: UTCTime ,commentHtmlUrl :: Maybe String ,commentUrl :: String - ,commentCreatedAt :: UTCTime + ,commentCreatedAt :: Maybe UTCTime ,commentPath :: Maybe String ,commentUser :: GithubOwner ,commentId :: Int @@ -390,24 +390,24 @@ data PullRequestCommit = PullRequestCommit { data SearchReposResult = SearchReposResult { searchReposTotalCount :: Int - ,searchReposRepos :: [ Repo ] + ,searchReposRepos :: [Repo] } deriving (Show, Data, Typeable, Eq, Ord) data Repo = Repo { - repoSshUrl :: String + repoSshUrl :: Maybe String ,repoDescription :: Maybe String - ,repoCreatedAt :: GithubDate + ,repoCreatedAt :: Maybe GithubDate ,repoHtmlUrl :: String - ,repoSvnUrl :: String - ,repoForks :: Int + ,repoSvnUrl :: Maybe String + ,repoForks :: Maybe Int ,repoHomepage :: Maybe String - ,repoFork :: Bool - ,repoGitUrl :: String + ,repoFork :: Maybe Bool + ,repoGitUrl :: Maybe String ,repoPrivate :: Bool - ,repoCloneUrl :: String - ,repoSize :: Int - ,repoUpdatedAt :: GithubDate - ,repoWatchers :: Int + ,repoCloneUrl :: Maybe String + ,repoSize :: Maybe Int + ,repoUpdatedAt :: Maybe GithubDate + ,repoWatchers :: Maybe Int ,repoOwner :: GithubOwner ,repoName :: String ,repoLanguage :: Maybe String @@ -415,7 +415,7 @@ data Repo = Repo { ,repoPushedAt :: Maybe GithubDate -- ^ this is Nothing for new repositories ,repoId :: Int ,repoUrl :: String - ,repoOpenIssues :: Int + ,repoOpenIssues :: Maybe Int ,repoHasWiki :: Maybe Bool ,repoHasIssues :: Maybe Bool ,repoHasDownloads :: Maybe Bool @@ -427,6 +427,21 @@ data Repo = Repo { data RepoRef = RepoRef GithubOwner String -- Repo owner and name deriving (Show, Data, Typeable, Eq, Ord) +data SearchCodeResult = SearchCodeResult { + searchCodeTotalCount :: Int + ,searchCodeCodes :: [Code] +} deriving (Show, Data, Typeable, Eq, Ord) + +data Code = Code { + codeName :: String + ,codePath :: String + ,codeSha :: String + ,codeUrl :: String + ,codeGitUrl :: String + ,codeHtmlUrl :: String + ,codeRepo :: Repo +} deriving (Show, Data, Typeable, Eq, Ord) + data Content = ContentFile ContentData | ContentDirectory [ContentData] deriving (Show, Data, Typeable, Eq, Ord) diff --git a/Github/Search.hs b/Github/Search.hs index 41fe84a3..88036073 100644 --- a/Github/Search.hs +++ b/Github/Search.hs @@ -3,6 +3,8 @@ module Github.Search( searchRepos' ,searchRepos +,searchCode' +,searchCode ,module Github.Data ) where @@ -14,7 +16,7 @@ import Github.Private -- -- > searchRepos' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchRepos' :: Maybe GithubAuth -> String -> IO (Either Error SearchReposResult) -searchRepos' auth queryString = githubGetWithQueryString' auth ["search/repositories"] queryString +searchRepos' auth queryString = githubGetWithQueryString' auth ["search", "repositories"] queryString -- | Perform a repository search. -- | Without authentication. @@ -23,3 +25,18 @@ searchRepos' auth queryString = githubGetWithQueryString' auth ["search/reposito searchRepos :: String -> IO (Either Error SearchReposResult) searchRepos = searchRepos' Nothing +-- | Perform a code search. +-- | With authentication. +-- +-- > searchCode' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" +searchCode' :: Maybe GithubAuth -> String -> IO (Either Error SearchCodeResult) +searchCode' auth queryString = githubGetWithQueryString' auth ["search", "code"] queryString + +-- | Perform a code search. +-- | Without authentication. +-- +-- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" +searchCode :: String -> IO (Either Error SearchCodeResult) +searchCode = searchCode' Nothing + + diff --git a/github.cabal b/github.cabal index 58dabe57..b26aa680 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.10.0 +Version: 0.11.0 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. diff --git a/samples/Repos/Forks/ListForks.hs b/samples/Repos/Forks/ListForks.hs index 6543844f..13ea670e 100644 --- a/samples/Repos/Forks/ListForks.hs +++ b/samples/Repos/Forks/ListForks.hs @@ -12,7 +12,10 @@ main = do formatFork fork = (Github.githubOwnerLogin $ Github.repoOwner fork) ++ "\t" ++ (formatPushedAt $ Github.repoPushedAt fork) ++ "\n" ++ - (Github.repoCloneUrl fork) + (formatCloneUrl $ Github.repoCloneUrl fork) formatPushedAt Nothing = "" formatPushedAt (Just pushedAt) = show $ Github.fromGithubDate pushedAt + +formatCloneUrl Nothing = "" +formatCloneUrl (Just cloneUrl) = cloneUrl diff --git a/samples/Repos/ListOrgRepos.hs b/samples/Repos/ListOrgRepos.hs index 17793a06..ce19985d 100644 --- a/samples/Repos/ListOrgRepos.hs +++ b/samples/Repos/ListOrgRepos.hs @@ -14,13 +14,14 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate Nothing = "????" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/ListUserRepos.hs b/samples/Repos/ListUserRepos.hs index 09ab1d80..928e20e0 100644 --- a/samples/Repos/ListUserRepos.hs +++ b/samples/Repos/ListUserRepos.hs @@ -14,13 +14,14 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/Starring/ListStarred.hs b/samples/Repos/Starring/ListStarred.hs index fec084ac..522b809b 100644 --- a/samples/Repos/Starring/ListStarred.hs +++ b/samples/Repos/Starring/ListStarred.hs @@ -14,11 +14,12 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/Watching/ListWatched.hs b/samples/Repos/Watching/ListWatched.hs index c2f1f8ba..1691906a 100644 --- a/samples/Repos/Watching/ListWatched.hs +++ b/samples/Repos/Watching/ListWatched.hs @@ -14,13 +14,14 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Search/SearchCode.hs b/samples/Search/SearchCode.hs new file mode 100644 index 00000000..68a73c96 --- /dev/null +++ b/samples/Search/SearchCode.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} +module SearchCode where + +import qualified Github.Search as Github +import qualified Github.Data as Github +import Control.Monad (forM,forM_) +import Data.Maybe (fromMaybe) +import Data.List (intercalate) + +main = do + let query = "q=Code repo:jwiegley/github&per_page=100" + let auth = Nothing + result <- Github.searchCode' auth query + case result of + Left e -> putStrLn $ "Error: " ++ show e + Right r -> do forM_ (Github.searchCodeCodes r) (\r -> do + putStrLn $ formatCode r + putStrLn "" + ) + putStrLn $ "Count: " ++ show n ++ " matches for the query: \"" ++ query ++ "\"" + where n = Github.searchCodeTotalCount r + +formatCode :: Github.Code -> String +formatCode r = + let fields = [ ("Name", Github.codeName) + ,("Path", Github.codePath) + ,("Sha", Github.codeSha) + ,("URL", Github.codeHtmlUrl) + ] + in intercalate "\n" $ map fmt fields + where fmt (s,f) = fill 12 (s ++ ":") ++ " " ++ f r + fill n s = s ++ replicate n' ' ' + where n' = max 0 (n - length s) + diff --git a/samples/Search/SearchRepos.hs b/samples/Search/SearchRepos.hs index cd3dcd36..6c937941 100644 --- a/samples/Search/SearchRepos.hs +++ b/samples/Search/SearchRepos.hs @@ -42,7 +42,7 @@ formatRepo r = let fields = [ ("Name", Github.repoName) ,("URL", Github.repoHtmlUrl) ,("Description", orEmpty . Github.repoDescription) - ,("Created-At", formatDate . Github.repoCreatedAt) + ,("Created-At", formatMaybeDate . Github.repoCreatedAt) ,("Pushed-At", formatMaybeDate . Github.repoPushedAt) ] in intercalate "\n" $ map fmt fields