packages feed

thank-you-stars (empty) → 0.1.0

raw patch · 10 files changed

+388/−0 lines, 10 filesdep +Cabaldep +aesondep +basesetup-changed

Dependencies added: Cabal, aeson, base, bytestring, containers, directory, filepath, hackage-db, hspec, req, split, text, thank-you-stars

Files

+ LICENSE view
@@ -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.
+ README.md view
@@ -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).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -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
+ src/Utils/ThankYouStars/GitHub.hs view
@@ -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+        )
+ src/Utils/ThankYouStars/Package.hs view
@@ -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
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Utils/ThankYouStars/GitHubSpec.hs view
@@ -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"
+ test/Utils/ThankYouStars/PackageSpec.hs view
@@ -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
+ thank-you-stars.cabal view
@@ -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 <ytaka23dev@gmail.com>+maintainer:          TAKAHASHI Yuto <ytaka23dev@gmail.com>+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