diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +BSD 3-Clause License + +Copyright (c) 2017, TAKAHASHI Yuto +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 the copyright holder nor the names of its + 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 HOLDER 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,63 @@ +thank-you-stars +=============== + +[![Build Status](https://travis-ci.org/y-taka-23/thank-you-stars.svg?branch=master)](https://travis-ci.org/y-taka-23/thank-you-stars) + +A tool for starring GitHub repositories. It detects dependent libraries +which are hosted on GitHub via `package.cabal` file, +and stars the repositories all at once. + +Setup +----- + +The project is managed by Stack, so you can install it simply: + +```console +$ git clone https://github.com/y-taka-23/thank-you-stars.git +$ cd thank-you-stars +$ stack install +``` + +To star GitHub repositories, you have to get your personal access token. + +1. Open https://github.com/settings/tokens and press "Generate new token." +1. Input the description and check only "public_repo" as a scope. +1. Save the token as `$HOME/.thank-you-stars.json`: + +```json +{ + "token": "SET_YOUR_TOKEN_HERE" +} +``` + +Usage +----- + +Run `thank-you-stars` in the root directory of your project. +Then it scans the `package.cabal` and the local Hackage DB, +stars your dependent libraries if they are hosted on GitHub. + +```console +$ thank-you-stars +Starred! https://github.com/bos/aeson +Starred! https://github.com/bos/text +Starred! https://github.com/haskell/bytestring +Starred! https://github.com/haskell/cabal +Starred! https://github.com/haskell/containers +Starred! https://github.com/haskell/directory +Starred! https://github.com/haskell/filepath +Starred! https://github.com/mrkkrp/req +Starred! https://github.com/peti/hackage-db +``` + +License +------- + +This project is released under the BSD 3-clause license. +For more details, see [LICENSE](./LICENSE) file. + +Acknowledgement +--------------- + +This tool is greatly inspired by +[teppeis's JavaScript implementation](https://github.com/teppeis/thank-you-stars). diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,36 @@ +module Main (main) where + +import Utils.ThankYouStars.GitHub +import Utils.ThankYouStars.Package + +import Control.Exception ( SomeException, catch ) +import Data.Maybe ( catMaybes ) +import qualified Data.Set as S +import System.Exit ( die ) +import System.Directory ( getHomeDirectory ) +import System.FilePath ( joinPath, (<.>) ) + +main :: IO () +main = do + homeDir <- getHomeDirectory + thisPkg <- getThisPackageName + let tokenFile = joinPath [homeDir, ".thank-you-stars.json"] + cabalFile = unPackageName thisPkg <.> "cabal" + eToken <- readToken tokenFile + case eToken of + Left _ -> do + die ("Cannot parse " ++ show tokenFile ++ " into a token") + Right token -> do + desc <- readCabalFile cabalFile + db <- readHackage + let pkgs = S.delete thisPkg $ allBuildDepends desc + mRepos = S.map (flip lookupRepo $ db) pkgs + repos = catMaybes $ S.toList mRepos + mapM_ (starAction token) repos + +starAction :: Token -> GitHubRepo -> IO () +starAction token ghr = do + eResult <- starRepo token ghr + case eResult of + Left _ -> putStrLn $ "Error " ++ show ghr + Right () -> putStrLn $ "Starred! " ++ show ghr diff --git a/src/Utils/ThankYouStars/GitHub.hs b/src/Utils/ThankYouStars/GitHub.hs new file mode 100644 --- /dev/null +++ b/src/Utils/ThankYouStars/GitHub.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Utils.ThankYouStars.GitHub ( + Token(..) + , GitHubRepo(..) + , readToken + , starRepo + ) where + +import Control.Exception ( catch, throwIO ) +import Data.Aeson +import Data.ByteString ( ByteString ) +import qualified Data.ByteString.Lazy as BSL +import Data.Monoid ( (<>) ) +import Data.String ( fromString ) +import Data.Text.Encoding ( encodeUtf8 ) +import Data.Version ( showVersion ) +import Network.HTTP.Req +import Paths_thank_you_stars ( version ) + +data Token = Token { + unToken :: ByteString + } deriving ( Eq, Show ) + +instance FromJSON Token where + parseJSON (Object v) = Token . encodeUtf8 <$> v .: "token" + +readToken :: FilePath -> IO (Either String Token) +readToken fp = eitherDecode <$> BSL.readFile fp + +data GitHubRepo = GitHubRepo { + owner :: String + , repo :: String + } deriving ( Eq, Ord ) + +instance Show GitHubRepo where + show ghr = "https://github.com/" ++ owner ghr ++ "/" ++ repo ghr + +starringUrl :: GitHubRepo -> Url 'Https +starringUrl ghr = + https "api.github.com" /: "user" /: "starred" /~ owner ghr /~ repo ghr + +userAgent :: Option scheme +userAgent = header "User-Agent" agent + where + agent = "thank-you-stars/" <> fromString (showVersion version) + +instance MonadHttp IO where + handleHttpException = throwIO + +starRepo :: Token -> GitHubRepo -> IO (Either HttpException ()) +starRepo token ghr = + (do + let headers = oAuth2Token (unToken token) <> userAgent + _ <- req PUT (starringUrl ghr) NoReqBody ignoreResponse headers + return $ Right () + ) `catch` (\(e :: HttpException) -> do + return $ Left e + ) diff --git a/src/Utils/ThankYouStars/Package.hs b/src/Utils/ThankYouStars/Package.hs new file mode 100644 --- /dev/null +++ b/src/Utils/ThankYouStars/Package.hs @@ -0,0 +1,64 @@ +module Utils.ThankYouStars.Package ( + getThisPackageName + , allBuildDepends + , readHackage + , lookupRepo + , readCabalFile + , unPackageName + ) where + +import Utils.ThankYouStars.GitHub + +import Data.List ( isInfixOf ) +import Data.List.Split ( splitOneOf ) +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Maybe +import Distribution.Hackage.DB ( Hackage, readHackage ) +import Distribution.Package +import Distribution.PackageDescription +import Distribution.PackageDescription.Parse ( readPackageDescription ) +import Distribution.Verbosity ( normal ) +import System.Directory ( getCurrentDirectory ) +import System.FilePath ( takeBaseName ) + +allBuildDepends :: GenericPackageDescription -> S.Set PackageName +allBuildDepends desc = + let ls = map (libBuildInfo . condTreeData) . maybeToList . condLibrary $ desc + es = map (buildInfo . condTreeData . snd) . condExecutables $ desc + ts = map (testBuildInfo . condTreeData . snd) . condTestSuites $ desc + bs = map (benchmarkBuildInfo . condTreeData . snd) . condBenchmarks $ desc + in S.fromList . concatMap depends $ ls ++ es ++ ts ++ bs + +depends :: BuildInfo -> [PackageName] +depends = map toPackageName . targetBuildDepends + +getThisPackageName :: IO PackageName +getThisPackageName = (PackageName . takeBaseName) <$> getCurrentDirectory + +readCabalFile :: FilePath -> IO GenericPackageDescription +readCabalFile = readPackageDescription normal + +toPackageName :: Dependency -> PackageName +toPackageName (Dependency name _) = name + +lookupRepo :: PackageName -> Hackage -> Maybe GitHubRepo +lookupRepo pkg db = listToMaybe . catMaybes . map parseRepo $ repos + where + repos = fromMaybe [] $ toRepos <$> M.lookup (unPackageName pkg) db + toRepos = sourceRepos . packageDescription . snd . M.findMax + +parseRepo :: SourceRepo -> Maybe GitHubRepo +parseRepo src = case (repoType src, repoLocation src) of + (Just Git, Just loc) -> parseLocation loc + _ -> Nothing + +-- TODO: Too naive parsing +parseLocation :: String -> Maybe GitHubRepo +parseLocation loc + | isGitHub && length ps > 5 = + Just $ GitHubRepo { owner = ps !! 4, repo = ps !! 5 } + | otherwise = Nothing + where + isGitHub = isInfixOf "github.com" loc + ps = splitOneOf "/." loc diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/Utils/ThankYouStars/GitHubSpec.hs b/test/Utils/ThankYouStars/GitHubSpec.hs new file mode 100644 --- /dev/null +++ b/test/Utils/ThankYouStars/GitHubSpec.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} +module Utils.ThankYouStars.GitHubSpec (spec) where + +import Utils.ThankYouStars.GitHub + +import Test.Hspec + +spec :: Spec +spec = do + describe "readToken" $ do + it "parses a JSON into a Token" $ do + readToken "test/Fixture/valid-token.json" + `shouldReturn` Right (Token { unToken = "test" }) + it "returns an error message in the case of parse failure" $ do + readToken "test/Fixture/invalid-token.json" + `shouldReturn` Left "Error in $: key \"token\" not present" diff --git a/test/Utils/ThankYouStars/PackageSpec.hs b/test/Utils/ThankYouStars/PackageSpec.hs new file mode 100644 --- /dev/null +++ b/test/Utils/ThankYouStars/PackageSpec.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} +module Utils.ThankYouStars.PackageSpec (spec) where + +import Utils.ThankYouStars.GitHub +import Utils.ThankYouStars.Package + +import qualified Data.Set as S +import qualified Data.Map as M +import Distribution.Hackage.DB ( readHackage ) +import Distribution.Package +import Distribution.Version +import Test.Hspec + +spec :: Spec +spec = do + describe "getThisPackageName" $ do + it "returns the name of project root directory" $ do + getThisPackageName `shouldReturn` + PackageName { unPackageName = "thank-you-stars" } + + describe "allBuildDepends" $ do + it "returns all packages which are listed in build-depends" $ do + desc <- readCabalFile "thank-you-stars.cabal" + allBuildDepends desc `shouldBe` S.fromList (map PackageName [ + "aeson" + , "base" + , "bytestring" + , "Cabal" + , "containers" + , "directory" + , "filepath" + , "hackage-db" + , "hspec" + , "req" + , "split" + , "text" + , "thank-you-stars" + ]) + + describe "lookupRepo" $ do + it "extracts source-repository from the package description" $ do + desc <- readCabalFile "thank-you-stars.cabal" + let ver = Version [] [] + db = M.singleton "thank-you-stars" (M.singleton ver desc) + lookupRepo (PackageName { unPackageName = "thank-you-stars" }) db + `shouldBe` Just GitHubRepo { + owner = "y-taka-23" + , repo = "thank-you-stars" + } + it "returns Nothing if the package is not found" $ do + lookupRepo (PackageName { unPackageName = "hspec" }) M.empty + `shouldBe` Nothing diff --git a/thank-you-stars.cabal b/thank-you-stars.cabal new file mode 100644 --- /dev/null +++ b/thank-you-stars.cabal @@ -0,0 +1,65 @@ +name: thank-you-stars +version: 0.1.0 +synopsis: Give your dependencies stars on GitHub! +description: + A tool for starring GitHub repositories. It detects dependent libraries + which are hosted on GitHub via package.cabal file, + and stars the repositories all at once. +homepage: https://github.com/y-taka-23/thank-you-stars#readme +license: BSD3 +license-file: LICENSE +author: TAKAHASHI Yuto +maintainer: TAKAHASHI Yuto +copyright: Copyright (C) 2017 TAKAHASHI Yuto +category: Utils +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Utils.ThankYouStars.GitHub + , Utils.ThankYouStars.Package + other-modules: Paths_thank_you_stars + build-depends: base >= 4.7 && < 5 + , aeson + , bytestring + , Cabal + , containers + , directory + , filepath + , hackage-db + , req + , split + , text + default-language: Haskell2010 + +executable thank-you-stars + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base >= 4.7 && < 5 + , containers + , directory + , filepath + , thank-you-stars + default-language: Haskell2010 + +test-suite thank-you-stars-spec + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + other-modules: Utils.ThankYouStars.GitHubSpec + Utils.ThankYouStars.PackageSpec + build-depends: base + , Cabal + , containers + , hackage-db + , hspec + , thank-you-stars + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/y-taka-23/thank-you-stars