gh-labeler (empty) → 0.1.0
raw patch · 5 files changed
+351/−0 lines, 5 filesdep +basedep +directorydep +githubsetup-changed
Dependencies added: base, directory, github, memory, text, vector
Files
- LICENSE +30/−0
- README.md +71/−0
- Setup.hs +2/−0
- app/Main.hs +206/−0
- gh-labeler.cabal +42/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Vincent Hanquez (c) 2018++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 Author name here 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.
+ README.md view
@@ -0,0 +1,71 @@+# gh-labeler++This is a simple CLI tool to create, delete and synchronise labels+on a github repo.++## Install++The simplest method is to install `stack` and then:++```+stack install gh-labeler+```++## Usage++Create a github OAuth token with the `public_repo` priviledge (in `repo` section),+and copy the token into a file in your HOME directory called `.gh-labeler`.++Then:++* Listing labels:++```+gh-labeler vincenthz gh-labeler list+```++* Create a label++```+gh-labeler vincenthz gh-labeler create myLabel eeb2d3+```++* Delete a label++```+gh-labeler vincenthz gh-labeler delete myLabel+```++* Synchronise from a file (See Example label file for the format):++```+gh-labeler vincenthz gh-labeler sync my-labels.txt+```++## Caveats++* The tools doesn't yet support label description, since the underlying library doesn't support them.++## Example label file++Very simple syntax of `<color> <name>`:++Example:++```+b60205 B - Bug+0e8a16 D - easy+d93f0b D - hard+fbca04 D - medium+006b75 P - high+006b75 P - low+cccccc R - duplicate+cccccc R - invalid+cccccc R - wontfix+4ef47d X - WIP+fef2c0 X - code-structure+fef2c0 X - for-discussion+fef2c0 X - help wanted+fef2c0 X - question+fef2c0 X - voting+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+module Main where++import qualified GitHub.Auth as Github+import qualified GitHub.Endpoints.Issues as Github+import qualified GitHub.Endpoints.Issues.Labels as Github+-- import qualified GitHub.Data.Name as Github++import qualified Data.Vector as V+import qualified Data.ByteArray as BA++import qualified Data.Text as T++import System.Directory (getHomeDirectory)+import Data.Word (Word8)+import Data.Proxy+import Data.List (intercalate)+import Control.Monad++import System.Environment+import System.Exit++isHex :: Char -> Bool+isHex = flip elem ("0123456789abcdefABCDEF" :: String)++toToken :: String -> Github.Auth+toToken s+ | all isHex s = Github.OAuth $ BA.pack $ map toW8 s+ | otherwise = err+ where+ toW8 :: Char -> Word8+ toW8 = fromIntegral . fromEnum+ err = error $ "not a valid token. only expecting an hexadecimal token, but got: " ++ show s++data Cmd = List | Create String String | Delete [String] | Sync String+ deriving (Show,Eq)++newtype Color = Color String+ deriving (Eq)++instance Show Color where+ show (Color s) = s++newtype LabelName = LabelName String+ deriving (Eq)+instance Show LabelName where+ show (LabelName s) = s++data Label = Label { getLabelName :: LabelName, getLabelColor :: Color }+ deriving (Show,Eq)++data LabelCommand =+ LabelDelete LabelName+ | LabelCreate LabelName Color+ | LabelUpdate LabelName LabelName Color+ deriving (Show,Eq)++lblNameToGithub :: LabelName -> Github.Name entity+lblNameToGithub (LabelName name) = Github.mkName Proxy $ T.pack name++labelCommand :: LabelCommand -> Github.Auth -> Github.Name Github.Owner -> Github.Name Github.Repo -> IO (Either Github.Error ())+labelCommand (LabelDelete lbl) =+ \tok ghHandle repo -> Github.deleteLabel tok ghHandle repo (lblNameToGithub lbl)+labelCommand (LabelCreate lbl (Color color)) =+ \tok ghHandle repo -> fmap (const ()) <$> Github.createLabel tok ghHandle repo (lblNameToGithub lbl) color+labelCommand (LabelUpdate old new (Color color)) =+ \tok ghHandle repo -> fmap (const ()) <$> Github.updateLabel tok ghHandle repo (lblNameToGithub old) (lblNameToGithub new) color++readToken :: IO Github.Auth+readToken = do+ home <- getHomeDirectory+ maybe (error "file doesn't contain a token") toToken . headM . lines <$> readFile (home ++ "/" ++ ".gh-labeler")+ where+ headM [] = Nothing+ headM (x:_) = Just x+++parseColor :: String -> Either String Color+parseColor l = case l of+ ('#':lHash) | isColorFormat lHash -> Right $ Color lHash+ | otherwise -> invalidColor+ _ | isColorFormat l -> Right $ Color l+ | otherwise -> invalidColor+ where+ invalidColor = Left ("invalid: color " ++ l)+ isColorFormat s = length s == 6 && all isHex s++readLabels :: String -> IO [Label]+readLabels file = do+ (sequence . map toLabel . map breakOne . lines <$> readFile file) >>= either failExit pure+ where+ breakOne s = let (s1,s2) = break (== ' ') s+ in (s1, tail s2)+ toLabel (colorS, name) =+ case parseColor colorS of+ Left err -> Left (err ++ " for " ++ name)+ Right color -> Right $ Label (LabelName name) color++failExit :: String -> IO a+failExit s = putStrLn ("error: " ++ s) >> exitFailure++processError :: LabelCommand -> Either Github.Error () -> IO ()+processError cmd (Left err) = failExit (show err ++ " when trying to " ++ show cmd)+processError _ _ = pure ()++getRepoLabels :: Github.Auth -> Github.Name Github.Owner -> Github.Name Github.Repo -> IO [Label]+getRepoLabels tok ghHandle repo = do+ result <- Github.labelsOnRepo' (Just tok) ghHandle repo+ case result of+ Left e -> failExit ("failed getting labels on repository " ++ show ghHandle ++ "/" ++ show repo ++ ":\n" ++ show e)+ Right r ->+ case sequence $ map toLabel $ V.toList r of+ Left err -> failExit err+ Right l -> pure l+ where+ toLabel lbl =+ case parseColor (T.unpack $ Github.labelColor lbl) of+ Left err -> Left (err ++ " for label " ++ lblName)+ Right c -> Right $ Label (LabelName lblName) c+ where lblName = T.unpack (Github.untagName $ Github.labelName lbl)++findLabel :: LabelName -> [Label] -> Maybe Label+findLabel name = go+ where go [] = Nothing+ go (x@(Label n _):xs)+ | n == name = Just x+ | otherwise = go xs++command :: Github.Name Github.Owner -> Github.Name Github.Repo -> Cmd -> IO () +command ghHandle repo List = do+ tok <- readToken+ labels <- getRepoLabels tok ghHandle repo+ mapM_ (putStrLn . showLabel) labels+ where+ showLabel :: Label -> String+ showLabel (Label name color) =+ show name ++ " " ++ show color++command ghHandle repo (Sync file) = do+ tok <- readToken+ labels <- readLabels file++ existingLabels <- getRepoLabels tok ghHandle repo++ forM_ labels $ \(Label name color) -> do+ case findLabel name existingLabels of+ Nothing -> do+ putStrLn ("creating label " ++ show name ++ " with color " ++ show color)+ let cmd = LabelCreate name color+ processError cmd =<< labelCommand cmd tok ghHandle repo+ Just (Label _ currentCol)+ | currentCol == color -> do+ putStrLn ("skipping label " ++ show name)+ | otherwise -> do+ putStrLn ("updating label " ++ show name ++ " color from " ++ show currentCol ++ " to " ++ show color)+ let cmd = LabelUpdate name name color+ processError cmd =<< labelCommand cmd tok ghHandle repo++ let others = filter (\(Label n _) -> not $ elem n labelNames) existingLabels+ where labelNames = map getLabelName labels++ let quote s = "\"" ++ s ++ "\""+ let x = map (quote . show . getLabelName) others+ putStrLn $ "other tags: " ++ intercalate " " x+ pure ()++command ghHandle repo (Create name color) = do+ tok <- readToken+ case parseColor color of+ Left err -> putStrLn err >> exitFailure+ Right c -> do+ let cmd = LabelCreate (LabelName name) c+ processError cmd =<< labelCommand cmd tok ghHandle repo+ +command ghHandle repo (Delete names) = do+ tok <- readToken+ --existingLabels <- getRepoLabels tok ghHandle repo+ forM_ names $ \n -> do+ let cmd = LabelDelete (LabelName n)+ putStrLn ("Deleting " ++ n)+ processError cmd =<< labelCommand cmd tok ghHandle repo++main :: IO ()+main = do+ args <- getArgs+ case args of+ ghHandle:repo:"list":[] ->+ command (Github.mkName Proxy $ T.pack ghHandle) (Github.mkName Proxy $ T.pack repo) List+ ghHandle:repo:"create":name:color:[] ->+ command (Github.mkName Proxy $ T.pack ghHandle) (Github.mkName Proxy $ T.pack repo) (Create name color)+ ghHandle:repo:"sync":file:[] ->+ command (Github.mkName Proxy $ T.pack ghHandle) (Github.mkName Proxy $ T.pack repo) (Sync file)+ ghHandle:repo:"delete":l ->+ command (Github.mkName Proxy $ T.pack ghHandle) (Github.mkName Proxy $ T.pack repo) (Delete l)+ _ -> do+ putStrLn "usage: gh-labeler <github-handle> <repository> <cmd>"+ putStrLn ""+ putStrLn " list"+ putStrLn " sync <label-file>"+ putStrLn " create <label> <color>"+ putStrLn " delete <label1> [label2...]"+ putStrLn ""+ putStrLn "label file format:"+ putStrLn " <hexa color> <name>"+
+ gh-labeler.cabal view
@@ -0,0 +1,42 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 34d66880fe63a431fe51d67e86e09a5c437590054b74ad39f32ec46d79fcf531++name: gh-labeler+version: 0.1.0+synopsis: Github Standard Labeler+description: Please see the README on Github at <https://github.com/vincenthz/gh-labeler#readme>+homepage: https://github.com/vincenthz/gh-labeler#readme+bug-reports: https://github.com/vincenthz/gh-labeler/issues+author: Vincent Hanquez+maintainer: vincent@snarc.org+copyright: 2018 Vincent Hanquez+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/vincenthz/gh-labeler++executable gh-labeler+ main-is: Main.hs+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends:+ base >=0 && <5+ , directory+ , github+ , memory+ , text+ , vector+ other-modules:+ Paths_gh_labeler+ default-language: Haskell2010