cabalg 0.2.2 → 0.2.3
raw patch · 3 files changed
+64/−47 lines, 3 filesdep −filemanipdep −randomdep −splitdep ~directorydep ~filepathdep ~process
Dependencies removed: filemanip, random, split
Dependency ranges changed: directory, filepath, process
Files
- cabalg.cabal +6/−9
- src/Git.hs +14/−14
- src/Main.hs +44/−24
cabalg.cabal view
@@ -1,5 +1,5 @@ name: cabalg-version: 0.2.2+version: 0.2.3 synopsis: alias for cabal install from given git repo license: MIT license-file: LICENSE@@ -40,17 +40,14 @@ main-is: Main.hs hs-source-dirs: src other-modules: Git+ ghc-options: -Wall+ default-language: Haskell2010 build-depends: base >= 4 && < 5- , process >= 1.2- , directory >= 1.2- , filepath >= 1.3- , filemanip >= 0.3.5.2- , split >= 0.2.2- , random >= 1.0.1.1-- default-language: Haskell2010+ , process+ , directory+ , filepath source-repository head type: git
src/Git.hs view
@@ -1,22 +1,21 @@-{-# LANGUAGE ScopedTypeVariables #-} module Git where -import System.FilePath-import System.Process (callProcess)+import Control.Monad+import System.FilePath+import System.Process -- | git clone "master" branch clone :: String -- | url -> FilePath -- | directory where repository will be cloned to -> IO ()-clone url dir =- callProcess "git"- [ "clone"- , "--branch", "master"- , "--single-branch"- , "--depth=1"- , "--quiet"- , url- , dir]+clone url dir = void $ readProcess "git"+ [ "clone"+ , "--branch", "master"+ , "--single-branch"+ , "--depth=1"+ , "--quiet"+ , url+ , dir] [] -- | git clone and checkout in particular revision (could be much slower than 'clone') cloneRevision :: String -- | url@@ -24,5 +23,6 @@ -> FilePath -- | directory where repository will be cloned to -> IO () cloneRevision url revision dir = do- callProcess "git" [ "clone", url, dir ]- callProcess "git" [ "--git-dir", dir </> ".git", "checkout", revision, "--quiet" ]+ void $ readProcess "git" [ "clone", url, dir ] []+ void $ readProcess "git" [ "--git-dir", dir </> ".git", "checkout", revision, "--force", "--quiet" ] []+
src/Main.hs view
@@ -1,23 +1,20 @@-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}-import Control.Applicative-import Control.Arrow (second)-import Control.Monad-import Data.List.Split (splitOn)-import Data.Maybe (catMaybes, fromMaybe, listToMaybe)-import System.Directory (createDirectory, getCurrentDirectory)-import System.Environment-import System.FilePath-import System.FilePath.Find-import System.Process (callProcess)-import System.Random+import Control.Applicative+import Control.Arrow+import Control.Monad+import Data.List+import Data.Maybe+import System.Directory+import System.Environment+import System.FilePath+import System.Process -import Git+import Git main :: IO () main = do (repos, args) <- reposAndArgs <$> getArgs- cabalFiles :: [Maybe FilePath] <- mapM fetch repos+ cabalFiles <- mapM fetch repos cabalInstall (catMaybes cabalFiles) args @@ -31,18 +28,41 @@ fetch :: String -> IO (Maybe FilePath) fetch urlAndMaybeRevision = do currentDir <- getCurrentDirectory- cabalDir <- (currentDir </>) . addName <$> genstr- createDirectory cabalDir+ newDir <- createNonExistentDirectory currentDir ("cabalg_" ++ repoName urlAndMaybeRevision) case maybeRevision of- Just revision -> cloneRevision url revision cabalDir- Nothing -> clone url cabalDir- listToMaybe <$> find always (extension ==? ".cabal" &&? depth ==? 1) cabalDir+ Just revision -> cloneRevision url revision newDir+ Nothing -> clone url newDir+ findCabalFile newDir where- maybeRevision = listToMaybe . tail . splitOn "@" $ urlAndMaybeRevision- url = head $ splitOn "@" urlAndMaybeRevision- genstr = liftM (take 10 . randomRs ('a','z')) newStdGen- addName = (("cabalg_" ++ last (splitOn "/" url)) ++) . ('_' :)+ maybeRevision = case dropWhile (/= '@') urlAndMaybeRevision of+ '@':x -> Just x+ _ -> Nothing+ url = takeWhile (/= '@') urlAndMaybeRevision cabalInstall :: [String] -> Maybe String -> IO ()-cabalInstall cabalFiles args = callProcess "cabal" $ "install" : cabalFiles ++ words (fromMaybe "" args)+cabalInstall cabalFiles args = void $ readProcess "cabal" ("install" : cabalFiles ++ words (fromMaybe "" args)) [] +repoName :: String -> String+repoName = takeWhile (/= '@') . lastSplitOn '/'+ where lastSplitOn :: Eq a => a -> [a] -> [a]+ lastSplitOn c = go []+ where+ go acc (x:xs) | x == c = go [] xs+ | otherwise = go (acc ++ [x]) xs+ go acc [] = acc++createNonExistentDirectory :: FilePath -> String -> IO FilePath+createNonExistentDirectory currentDir dirname = do+ newDir <- generateNonExistentDirectory dirname Nothing+ createDirectory newDir+ return newDir+ where+ generateNonExistentDirectory :: FilePath -> Maybe Int -> IO FilePath+ generateNonExistentDirectory d suffix = let fullDirName = currentDir </> d ++ maybe "" show suffix in do+ exist <- doesDirectoryExist fullDirName+ if exist+ then generateNonExistentDirectory d $ return $ maybe 1 (+ 1) suffix+ else return fullDirName++findCabalFile :: FilePath -> IO (Maybe FilePath)+findCabalFile path = ((path </>) `fmap`) `fmap` find (".cabal" `isSuffixOf`) `fmap` getDirectoryContents path