octohat 0.1.3 → 0.1.4

raw patch · 4 files changed

+121/−2 lines, 4 filesdep ~octohatdep ~text

Dependency ranges changed: octohat, text

Files

• octohat.cabal +7/−2
• src-demo/Web/GitHub/CLI/Actions.hs +61/−0
• src-demo/Web/GitHub/CLI/Messages.hs +10/−0
• src-demo/Web/GitHub/CLI/Options.hs +43/−0

@@ -1,7 +1,7 @@ Name:                octohat Synopsis:            A tested, minimal wrapper around GitHub's API. Description:         A tested, minimal wrapper around GitHub's API.-Version:             0.1.3+Version:             0.1.4 License:             MIT License-file:        LICENSE Author:              Stack Builders@@ -59,11 +59,16 @@     base                      >=4.4 && <4.8,     text                      ==1.2.0.*,     optparse-applicative      ==0.11.0.*,-    octohat                   ==0.1.2,+    octohat                   ==0.1.4,     utf8-string               >=0.3 && <=1,     yaml                      ==0.8.10.*    default-language: Haskell2010++  other-modules:   Web.GitHub.CLI.Actions+                 , Web.GitHub.CLI.Messages+                 , Web.GitHub.CLI.Options+   ghc-options: -threaded -Wall  test-suite spec

@@ -0,0 +1,61 @@+module Web.GitHub.CLI.Actions+  ( findTeamsInOrganization+  , addUserToTeamInOrganization+  , deleteUserFromTeamInOrganization+  , findMembersInTeam) where++import Web.GitHub.CLI.Messages+import Network.Octohat.Members (teamsForOrganization, deleteMemberFromTeam)+import Network.Octohat+import Network.Octohat.Types+import qualified Data.Text as T+import Data.Yaml as Y+import Data.List (find)+import Data.ByteString.UTF8 (toString)+import System.IO (hPutStrLn, stderr)+import System.Exit (ExitCode(..), exitWith)++findTeamsInOrganization :: OrganizationName -> IO ()+findTeamsInOrganization nameOfOrg = do+  teamListing <- runGitHub $ teamsForOrganization nameOfOrg+  case teamListing of+    Left status -> errorHandler $ commandMessage status+    Right teams -> putStrLn (toString $ Y.encode teams)++addUserToTeamInOrganization :: String -> OrganizationName -> TeamName -> IO ()+addUserToTeamInOrganization nameOfUser nameOfOrg nameOfTeam = do+  addResult <- runGitHub $ addUserToTeam (T.pack nameOfUser) nameOfOrg nameOfTeam+  case addResult of+    Left status   -> errorHandler $ commandMessage status+    Right Pending -> putStrLn "User invited to join team"+    Right Active  -> putStrLn "User added to team"++deleteUserFromTeamInOrganization :: String -> OrganizationName -> TeamName -> IO ()+deleteUserFromTeamInOrganization nameOfUser nameOfOrg nameOfTeam = do+  teamListing <- runGitHub $ teamsForOrganization nameOfOrg+  case teamListing of+    Left status -> errorHandler $ commandMessage status+    Right []    -> errorHandler "No teams found on this organization"+    Right teams -> getTheTeamAndDeleteUser nameOfUser nameOfTeam teams++findMembersInTeam :: OrganizationName -> TeamName -> IO ()+findMembersInTeam nameOfOrg nameOfTeam = do+  memberListing <- runGitHub $ membersOfTeamInOrganization nameOfOrg nameOfTeam+  case memberListing of+    Left status   -> errorHandler $ commandMessage status+    Right members -> putStrLn (toString $ Y.encode members)++errorHandler :: String -> IO ()+errorHandler message = hPutStrLn stderr message >> exitWith (ExitFailure 1)++getTheTeamAndDeleteUser :: String -> TeamName -> [Team] -> IO ()+getTheTeamAndDeleteUser nameOfUser nameOfTeam teams = +  case (getTeam teams) of+    Nothing   -> errorHandler "There's no such team in that organization"+    Just team -> do+      result <- runGitHub $ deleteMemberFromTeam (T.pack nameOfUser) (teamId team)+      case result of+        Left status      -> errorHandler $ commandMessage status+        Right NotDeleted -> errorHandler "The user could not be deleted from the team"+        Right Deleted    -> putStrLn "The user was succesfully deleted from the team"+  where getTeam = find (\t -> (teamName t) == (unTeamName nameOfTeam))

@@ -0,0 +1,10 @@+module Web.GitHub.CLI.Messages+  (commandMessage) where++import Network.Octohat.Types++commandMessage :: GitHubReturnStatus -> String+commandMessage NotFound               = "Organization or Team not found"+commandMessage NotAllowed             = "Not authorized"+commandMessage RequiresAuthentication = "Credentials must be configured to use this function"+commandMessage _                      = "Internal application error"

@@ -0,0 +1,43 @@+module Web.GitHub.CLI.Options ( TeamOptions(..)+                              , TeamCommand(..)+                              , teamOptions) where++import Options.Applicative++type OrganizationName = String+type Username = String+type TeamName = String++data TeamCommand = ListTeams OrganizationName+                 | ListMembers OrganizationName TeamName+                 | AddToTeam OrganizationName TeamName Username+                 | DeleteFromTeam OrganizationName TeamName Username ++data TeamOptions = TeamOptions TeamCommand++teamOptions :: Parser TeamOptions+teamOptions = TeamOptions <$> parseTeamCommand++parseTeamCommand :: Parser TeamCommand+parseTeamCommand = subparser $+  command "list-teams"  (info listTeams      (progDesc "List teams in a organization" ))          <>+  command "members-in"  (info listMembers    (progDesc "List members in team and organization" )) <>+  command "add-to-team" (info addToTeam      (progDesc "Add users to a team"))                    <>+  command "delete-user" (info deleteFromTeam (progDesc "Delete a user from a team"))++listTeams :: Parser TeamCommand+listTeams = ListTeams <$> argument str (metavar "<organization name>")++listMembers :: Parser TeamCommand+listMembers = ListMembers <$> argument str (metavar "<organization-name>")+                          <*> argument str (metavar "<team-name>")++addToTeam :: Parser TeamCommand+addToTeam = AddToTeam <$> argument str (metavar "<organization name>")+                      <*> argument str (metavar "<team name>")+                      <*> argument str (metavar "<github username>")++deleteFromTeam :: Parser TeamCommand+deleteFromTeam = DeleteFromTeam <$> argument str (metavar "<organization name>")+                                <*> argument str (metavar "<team name>")+                                <*> argument str (metavar "<github username>")