diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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. + +Follow me on Twitter + +### 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 - + + + Follow me on Twitter + + + Add me to Linkedin + + +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. 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,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" diff --git a/src/Git.hs b/src/Git.hs new file mode 100644 --- /dev/null +++ b/src/Git.hs @@ -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" diff --git a/src/System.hs b/src/System.hs new file mode 100644 --- /dev/null +++ b/src/System.hs @@ -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] diff --git a/src/UpdateRepos.hs b/src/UpdateRepos.hs new file mode 100644 --- /dev/null +++ b/src/UpdateRepos.hs @@ -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 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/update-repos.cabal b/update-repos.cabal new file mode 100644 --- /dev/null +++ b/update-repos.cabal @@ -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