diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,8 @@ +0.2.9 +===== + + * Exit with failure if cabal thrown non-success exit code + 0.2.8 ===== diff --git a/cabalg.cabal b/cabalg.cabal --- a/cabalg.cabal +++ b/cabalg.cabal @@ -1,5 +1,5 @@ name: cabalg -version: 0.2.8 +version: 0.2.9 synopsis: alias for cabal install from given git repo license: MIT license-file: LICENSE @@ -8,28 +8,29 @@ build-type: Simple cabal-version: >=1.10 description: - Short alias for installing cabal package from git source repository. + 'cabalg' is an alias for installing cabal package from a git source repository. . - I.e. + E.g. . - @$> cabalg https:\/\/github.com\/biegunka\/biegunka + @$ git clone https:\/\/github.com\/author\/foo + $ git clone https:\/\/github.com\/author\/bar + $ cabal install foo\/foo.cabal bar\/bar.cabal baz.cabal @ . - is just a shorthand for + could be abbreviated by . - @$> mktemp - $> git clone --single-branch --depth=1 --quiet https:\/\/github.com\/biegunka\/biegunka \ - $> cabal install \/\ + + @$ cabalg https:\/\/github.com\/author\/foo https:\/\/github.com\/author\/bar -- biegunka.cabal @ . It also supports arbitrary git revisions mentioning like . - @$> cabalg https:\/\/github.com\/biegunka\/biegunka\@beefboa + @ $ cabalg https:\/\/github.com\/baz\/quux\@f524f97 @ . Necessary arguments could be passed to 'cabal install' with '--' delimiter like . - @$> cabalg \ ... \ [\-\- \] + @$ cabalg \ ... \ [\-\- \] @ . Please notice, that '--single-branch' flag comes with git-1.7.10 () and later, so you probably want to have it. @@ -43,8 +44,9 @@ main-is: Main.hs hs-source-dirs: src other-modules: - Args - Git + Cabalg.Args + Cabalg.Git + Cabalg.Version System.Directory.NonExistent ghc-options: -Wall default-language: Haskell2010 @@ -58,7 +60,7 @@ library hs-source-dirs: src exposed-modules: System.Directory.NonExistent - other-modules: Git + other-modules: Cabalg.Git ghc-options: -Wall default-language: Haskell2010 build-depends: @@ -83,3 +85,11 @@ , filepath , process +test-suite doctest + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Doctest.hs + build-depends: + base == 4.* + , doctest diff --git a/src/Args.hs b/src/Args.hs deleted file mode 100644 --- a/src/Args.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Args where - -import Control.Arrow (second) - -data Action - = Help - | Version - | Install [String] (Maybe String) - - -fromArgs :: [String] -> Action -fromArgs [x] | x `elem` ["--help", "--usage", "-h"] = Help -fromArgs ["--version"] = Version -fromArgs x = uncurry Install . second flags . span (/= "--") $ x - where - flags [] = Nothing - flags ["--"] = Nothing - flags (_:xs) = Just $ unwords xs - - -printHelp :: IO () -printHelp = putStrLn $ unlines - [ "cabalg is an alias for installing cabal package from git source repository." - , "" - , "Usage:" - , " $> cabalg ... [-- ]" - , "" - , "Example:" - , " $> cabalg https://github.com/biegunka/biegunka@f524f97" - ] - diff --git a/src/Cabalg/Args.hs b/src/Cabalg/Args.hs new file mode 100644 --- /dev/null +++ b/src/Cabalg/Args.hs @@ -0,0 +1,51 @@ +module Cabalg.Args where + +import Control.Arrow (second) + +data Action + = Help + | Version + | Install [String] (Maybe String) + deriving (Eq, Show) + + +-- | Deserialize cabalg action +-- +-- >>> fromString ["--version"] +-- Version +-- +-- >>> fromString ["--help"] +-- Help +-- +-- >>> fromString ["--usage"] +-- Help +-- +-- >>> fromString ["-h"] +-- Help +-- +-- >>> fromString ["https://url"] +-- Install ["https://url"] Nothing +-- +-- >>> fromString ["https://url", "--", "--flags"] +-- Install ["https://url"] (Just "--flags") +fromString :: [String] -> Action +fromString [x] | x `elem` ["--help", "--usage", "-h"] = Help +fromString ["--version"] = Version +fromString x = uncurry Install . second flags . span (/= "--") $ x + where + flags [] = Nothing + flags ["--"] = Nothing + flags (_:xs) = Just $ unwords xs + + +printHelp :: IO () +printHelp = putStrLn $ unlines + [ "cabalg is an alias for installing cabal package from git source repository." + , "" + , "Usage:" + , " $ cabalg [--version | [repository url...] [-- [cabal-install args...]]]" + , "" + , "Example:" + , " $ cabalg https://github.com/biegunka/biegunka@f524f97" + ] + diff --git a/src/Cabalg/Git.hs b/src/Cabalg/Git.hs new file mode 100644 --- /dev/null +++ b/src/Cabalg/Git.hs @@ -0,0 +1,28 @@ +module Cabalg.Git where + +import System.Directory +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 = putStr =<< readProcess "git" + [ "clone" + , "--single-branch" + , "--depth=1" + , url + , dir] [] + +-- | git clone and checkout particular revision (could be much slower than 'clone') +cloneRevision :: String -- ^ url + -> String -- ^ revision + -> FilePath -- ^ directory where repository will be cloned to + -> IO () +cloneRevision url revision dir = do + putStr =<< readProcess "git" [ "clone", url, dir ] [] + currentDir <- getCurrentDirectory + setCurrentDirectory dir + putStr =<< readProcess "git" [ "checkout", revision, "--force" ] [] + setCurrentDirectory currentDir diff --git a/src/Cabalg/Version.hs b/src/Cabalg/Version.hs new file mode 100644 --- /dev/null +++ b/src/Cabalg/Version.hs @@ -0,0 +1,7 @@ +module Cabalg.Version where + +import Data.Version (showVersion) +import Paths_cabalg (version) + +version :: String +version = showVersion Paths_cabalg.version diff --git a/src/Git.hs b/src/Git.hs deleted file mode 100644 --- a/src/Git.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Git where - -import System.Directory -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 = putStr =<< readProcess "git" - [ "clone" - , "--single-branch" - , "--depth=1" - , url - , dir] [] - --- | git clone and checkout particular revision (could be much slower than 'clone') -cloneRevision :: String -- ^ url - -> String -- ^ revision - -> FilePath -- ^ directory where repository will be cloned to - -> IO () -cloneRevision url revision dir = do - putStr =<< readProcess "git" [ "clone", url, dir ] [] - currentDir <- getCurrentDirectory - setCurrentDirectory dir - putStr =<< readProcess "git" [ "checkout", revision, "--force" ] [] - setCurrentDirectory currentDir diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -5,25 +5,25 @@ import Data.List import Data.Maybe import Data.Traversable -import Data.Version (showVersion) -import Paths_cabalg (version) import System.Directory import System.Environment +import System.Exit import System.FilePath import System.IO.Error import System.Process -import Args -import Git +import Cabalg.Args +import Cabalg.Git +import Cabalg.Version import System.Directory.NonExistent main :: IO () main = do - action <- fromArgs <$> getArgs + action <- fromString <$> getArgs case action of Help -> printHelp - Version -> putStrLn $ showVersion version + Version -> putStrLn version Install repos args -> do cabalFiles <- Data.Traversable.mapM fetch repos cabalInstall (catMaybes cabalFiles) args @@ -59,19 +59,31 @@ cabalInstall :: [String] -> Maybe String -> IO () cabalInstall cabalFiles args = do - let process = proc "cabal" ("install" : cabalFiles ++ words (fromMaybe "" args)) - (_, _, _, procHandle) <- createProcess process - void $ waitForProcess procHandle + (_, _, _, procHandle) <- createProcess $ proc "cabal" $ "install" : cabalFiles ++ words (fromMaybe "" args) + exitCode <- waitForProcess procHandle + case exitCode of + ExitSuccess -> return () + ExitFailure _ -> exitFailure +-- | Compute the repository name from the URL +-- +-- >>> repoName "https://github.com/dmalikov/cabalg" +-- "cabalg" +-- +-- >>> repoName "https://github.com/dmalikov/cabalg@master" +-- "cabalg" +-- +-- >>> repoName "git://github.com/dmalikov/cabalg" +-- "cabalg" 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 + where + lastSplitOn c = go + where + go xs = case break (== c) xs of + (ys , []) -> ys + (_ , _ : xs') -> go xs' findCabalFile :: FilePath -> IO (Maybe FilePath) diff --git a/test/Doctest.hs b/test/Doctest.hs new file mode 100644 --- /dev/null +++ b/test/Doctest.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Test.DocTest (doctest) + +main :: IO () +main = doctest ["-i src", "-i dist/build/autogen", "src/Cabalg/Args.hs", "src/Main.hs"] diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,21 +1,25 @@ module Main where -import Control.Monad import System.Directory +import System.Exit import System.FilePath import System.Process - main :: IO () main = do + throwsExitCode + +throwsExitCode :: IO () +throwsExitCode = do currentDir <- getCurrentDirectory exec <- findExecutableCabalg currentDir case exec of Nothing -> error "unable to find cabalg executable in dist/build" Just cabalg -> do - void $ readProcess cabalg ["https://github.com/dmalikov/dotfiles@master", "https://github.com/biegunka/biegunka@develop"] [] - setCurrentDirectory currentDir - + (exitCode, _, _) <- readProcessWithExitCode cabalg ["https://github.com/dmalikov/cabalg@broken"] [] + case exitCode of + ExitSuccess -> error "cabalg masks cabal failure, proper exit code was not thrown" + _ -> setCurrentDirectory currentDir findExecutableCabalg :: FilePath -> IO (Maybe FilePath) findExecutableCabalg dir = do