update-repos (empty) → 0.0.1

raw patch · 9 files changed

+297/−0 lines, 9 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, directory, filepath, hspec, monad-parallel, process, split, text, update-repos

Files

• LICENSE +13/−0
• README.md +64/−0
• Setup.hs +2/−0
• app/Main.hs +40/−0
• src/Git.hs +63/−0
• src/System.hs +42/−0
• src/UpdateRepos.hs +16/−0
• test/Spec.hs +1/−0
• update-repos.cabal +56/−0

@@ -0,0 +1,13 @@+Copyright (C) 2017 Pedro Vicente Gómez Sánchez.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.

@@ -0,0 +1,64 @@+# UpdateRepos [![Build Status](https://travis-ci.org/pedrovgs/UpdateRepos.svg?branch=master)](https://travis-ci.org/pedrovgs/UpdateRepos)++A command line tool used to update all your git repositories with just one command. Written using purely functional Haskell.++<img alt="Follow me on Twitter" src="https://upload.wikimedia.org/wikipedia/commons/thumb/1/1c/Haskell-Logo.svg/245px-Haskell-Logo.svg.png" height="60" width="82"/>++### Screencast:++![screencast](./art/screencast.git)++### Contributing:++If you are going to modify the code or just review the implementation from any IDE I strongly recommend you to install [Atom](https://atom.io/) following this [guide](https://github.com/simonmichael/haskell-atom-setup) to set up the whole Haskell environment in a few minutes.++You can build this project using ``stack`` and just a bunch of commands:++```+// Open a Haskell REPL with the modules already loaded+stack ghci++// Generates the executable file associated with the project+stack build++// Installs the already generated executable file in your ~/.local/bin folder+stack install++// Clean a previous build+stack clean+```++The production code is covered covered using unit and [property based](https://en.wikipedia.org/wiki/QuickCheck) tests. If you want to build and execute the project tests you just need to install [Stack](https://docs.haskellstack.org/en/stable/README/) and execute the following command:++```+stack build --test+```++Developed By+------------++* Pedro Vicente Gómez Sánchez - <pedrovicente.gomez@gmail.com>++<a href="https://twitter.com/pedro_g_s">+  <img alt="Follow me on Twitter" src="https://image.freepik.com/iconos-gratis/twitter-logo_318-40209.jpg" height="60" width="60"/>+</a>+<a href="https://es.linkedin.com/in/pedrovgs">+  <img alt="Add me to Linkedin" src="https://image.freepik.com/iconos-gratis/boton-del-logotipo-linkedin_318-84979.png" height="60" width="60"/>+</a>++License+-------++    Copyright 2017 Pedro Vicente Gómez Sánchez++    Licensed under the Apache License, Version 2.0 (the "License");+    you may not use this file except in compliance with the License.+    You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++    Unless required by applicable law or agreed to in writing, software+    distributed under the License is distributed on an "AS IS" BASIS,+    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+    See the License for the specific language governing permissions and+    limitations under the License.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,40 @@+module Main where++import           Control.Monad+import qualified Control.Monad.Parallel as P+import           Data.Either+import           Data.List+import           Data.List.Split+import           Git+import           System.Directory+import           System.FilePath.Posix+import           UpdateRepos++main :: IO ()+main = do isReady <- isEnvironmentReady+          if not isReady then putStrLn "You need to install Git before to execute update-repos"+          else do putStrLn "Let's update your Git repositories!\n"+                  currentDir <- getCurrentDirectory+                  repositories <- listGitRepositories currentDir+                  updateReposResult <- P.mapM updateGitRepository repositories+                  putStrLn (prettyfiResults updateReposResult ++ "\n")+                  putStrLn "We are done!"++prettyfiResults :: [Either UpdateRepoError UpdateRepoSuccess] -> String+prettyfiResults results = intercalate "\n" prettyResults+                          where prettyResults = map prettifyResult results++prettifyResult :: Either UpdateRepoError UpdateRepoSuccess -> String+prettifyResult (Right (UpdateRepoSuccess path result)) = greenColor ++ "Success! Repo: " ++ prettifyPath path ++ " updated with result: " ++ prettifyStdOut result ++ clearColor+prettifyResult (Left (UpdateRepoError path result))    = redColor ++ "Error :_( Repo: " ++ prettifyPath path ++ " updated with result " ++ prettifyStdOut result  ++ clearColor++prettifyPath :: FilePath -> String+prettifyPath path = last $ init parts+                    where parts = splitOn [pathSeparator] path++prettifyStdOut :: String -> String+prettifyStdOut = filter (/= '\n')++clearColor = "\x1b[0m"+greenColor = "\x1b[32m"+redColor = "\x1b[31m"

@@ -0,0 +1,63 @@+module Git where++import           Data.List.Split+import           System+import           System.Directory+import           System.Exit+import           System.Process++data UpdateRepoError = UpdateRepoError {+  path    :: FilePath+, message :: String+} deriving (Eq, Show)++data UpdateRepoSuccess = UpdateRepoSuccess {+  repo   :: FilePath+, result :: String+} deriving (Eq, Show)++isGitInstalled :: IO Bool+isGitInstalled = do (exitCode, stdOut, stdErr) <- readProcessWithExitCode "git" ["--version"] []+                    return (exitCode == ExitSuccess)++getCurrentBranch :: FilePath ->  IO String+getCurrentBranch path = do let gitRepoPath = appendGitFolder path+                           (exitCode, stdOut, stdErr) <- readProcessWithExitCode "git" ["--git-dir", gitRepoPath, "branch"] []+                           return (extractCurrentBranch stdOut)++updateRepo :: FilePath -> String -> IO (Either UpdateRepoError UpdateRepoSuccess)+updateRepo path branch = do let gitRepoPath = appendGitFolder path+                            readProcessWithExitCode "git" ["--git-dir", "--work-tree", path, gitRepoPath, "fetch", "origin", "master"] []+                            readProcessWithExitCode "git" ["--git-dir", "--work-tree", path, gitRepoPath, "fetch", "origin", "develop"] []+                            readProcessWithExitCode "git" ["--git-dir", "--work-tree", path, gitRepoPath, "stash"] []+                            (exitCode, stdOut, stdErr) <- readProcessWithExitCode "git" ["--git-dir", gitRepoPath, "--work-tree", path, "pull", "origin", branch, "-n" , "-f"] []+                            if exitCode == ExitSuccess then return (Right (UpdateRepoSuccess path stdOut))+                            else return (Left (UpdateRepoError path stdErr))++containsGitMetadataDirectory :: [FilePath] -> Bool+containsGitMetadataDirectory = any isGitMetadataDirectory++containsOtherVCSMetadataDirectory :: [FilePath] -> Bool+containsOtherVCSMetadataDirectory = any isOtherVCSDierctory++isGitMetadataDirectory :: FilePath -> Bool+isGitMetadataDirectory = contains gitFolder++isOtherVCSDierctory :: FilePath -> Bool+isOtherVCSDierctory = contains ".hg"++contains :: FilePath -> FilePath -> Bool+contains directory path+  | null path = False+  | path == directory = True+  | path == directory ++ separator = True+  | otherwise = contains directory (tail path)++extractCurrentBranch :: String -> String+extractCurrentBranch stdOut = drop 2 $ head selectedBranches+                              where branches = splitOn "\n" stdOut+                                    selectedBranches = filter (\branch -> '*' `elem` branch) branches+appendGitFolder :: String -> String+appendGitFolder path = path ++ gitFolder++gitFolder = ".git"

@@ -0,0 +1,42 @@+module System where++import Control.Monad+import qualified Control.Monad.Parallel as P+import           Data.List+import           System.Directory+import           System.FilePath.Posix++type FilesPredicate = [FilePath] -> Bool+type StopSearchingPredicate = [FilePath] -> Bool++listDirectoriesRecursive :: FilesPredicate -> StopSearchingPredicate -> FilePath -> IO [FilePath]+listDirectoriesRecursive predicate stopSearchingPredicate absPath =+  do let path = appendSeparatorIfNeeded absPath+     subDirectories <- listDirectories path+     let predicateMatch = predicate subDirectories+     let stopSearchingMatch = stopSearchingPredicate subDirectories+     if null subDirectories then return []+     else if predicateMatch then return [path]+     else if stopSearchingMatch then return []+     else do restOfDirectories <- mapM (listDirectoriesRecursive predicate stopSearchingPredicate) subDirectories+             if predicateMatch then do let restOfGitDirectories = concat restOfDirectories+                                       return (path : restOfGitDirectories)+             else return (concat restOfDirectories)++listDirectories :: FilePath -> IO [FilePath]+listDirectories path = do subFilesAndSubDirectories <- listDirectory path+                          let absolutePath = map (\sub -> path ++ sub) subFilesAndSubDirectories+                              absPathsWithSeparators = map appendSeparatorIfNeeded absolutePath+                          filterM isDirectory absPathsWithSeparators++isDirectory :: FilePath -> IO Bool+isDirectory absolutePath = do let isHidden = "." `isPrefixOf` absolutePath+                              isDirectory <- doesDirectoryExist absolutePath+                              return (isDirectory && not isHidden)++appendSeparatorIfNeeded :: String -> String+appendSeparatorIfNeeded absPath+  | last absPath == pathSeparator = absPath+  | otherwise = absPath ++ separator++separator = [pathSeparator]

@@ -0,0 +1,16 @@+module UpdateRepos where++import           Data.Either+import           Git+import           System+++isEnvironmentReady :: IO Bool+isEnvironmentReady = isGitInstalled++listGitRepositories :: FilePath -> IO [FilePath]+listGitRepositories = listDirectoriesRecursive containsGitMetadataDirectory containsOtherVCSMetadataDirectory++updateGitRepository :: FilePath -> IO (Either UpdateRepoError UpdateRepoSuccess)+updateGitRepository path = do currentBranch <- getCurrentBranch path+                              updateRepo path currentBranch

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,56 @@+name:                update-repos+version:             0.0.1+synopsis:            Update all your git repositories with just one command.+description:         Please see README.md+homepage:            https://github.com/pedrovgs/update-repos+license:             Apache-2.0+license-file:        LICENSE+author:              Pedro Vicente Gómez Sánchez+maintainer:          pedrovicente.gomez@gmail.com+copyright:           2017 Pedro Vicente Gómez Sánchez+category:            Command line tool+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     UpdateRepos+                     , Git+  other-modules:       System+  build-depends:       base >= 4.7 && < 5+                     , directory+                     , bytestring+                     , text+                     , filepath+                     , process+                     , split+                     , monad-parallel+  default-language:    Haskell2010++executable update-repos+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , update-repos+                     , directory+                     , filepath+                     , split+                     , monad-parallel+  default-language:    Haskell2010++test-suite update-repos-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , update-repos+                     , hspec+                     , QuickCheck+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/pedrovgs/update-repos