Added basic code search functionality

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"

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,32 +390,32 @@ 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
   ,repoMasterBranch :: Maybe String
   ,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)
 

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 
+
+

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.

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

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 = ""

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 = ""

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 = ""

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 = ""

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) 
+

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