Setting of exit codes improved

src/CPM/ErrorLogger.curry

@@ -6,6 +6,8 @@ module CPM.ErrorLogger
   ( ErrorLogger
   , LogEntry
   , LogLevel (..)
+  , logLevelOf
+  , levelGte
   , setLogLevel
   , (|>=)
   , (|>)
@@ -30,6 +32,9 @@ type ErrorLogger a = ([LogEntry], Either LogEntry a)
 --- A log entry.
 data LogEntry = LogEntry LogLevel String
 
+logLevelOf :: LogEntry -> LogLevel
+logLevelOf (LogEntry ll _) = ll
+
 --- A log level.
 data LogLevel = Info
               | Debug

src/CPM/FileUtil.curry

@@ -11,6 +11,7 @@ module CPM.FileUtil
   , inTempDir
   , inDirectory
   , recreateDirectory
+  , removeDirectoryComplete
   ) where
 
 import Directory ( doesFileExist, getCurrentDirectory, setCurrentDirectory
@@ -104,7 +105,12 @@ inDirectory dir b = do
 --- Recreates a directory. Deletes its contents if it already exists.
 recreateDirectory :: String -> IO ()
 recreateDirectory dir = do
-  exists <- doesDirectoryExist dir
-  when exists $ system ("rm -Rf " ++ quote dir) >> done
+  removeDirectoryComplete dir
   createDirectoryIfMissing True dir
 
+--- Deletes a directory and its contents, if it exists, otherwise nothing
+--- is done.
+removeDirectoryComplete :: String -> IO ()
+removeDirectoryComplete dir = do
+  exists <- doesDirectoryExist dir
+  when exists $ system ("rm -Rf " ++ quote dir) >> done

src/CPM/Main.curry

@@ -80,10 +80,10 @@ runWithArgs opts = do
     then do 
       putStrLn "Problems while reading the package index:"
       mapIO putStrLn repoErrors
-      return ()
+      exitWith 1
     else return ()
   setLogLevel $ optLogLevel opts
-  result <- case optCommand opts of
+  (msgs, result) <- case optCommand opts of
     NoCommand   -> failIO "NoCommand"
     Deps        -> deps config repo globalCache
     PkgInfo o   -> info      o config repo globalCache
@@ -100,8 +100,10 @@ runWithArgs opts = do
     Upgrade o   -> upgrade   o config repo globalCache
     Link o      -> link      o config repo globalCache
     New         -> newPackage
-  case result of
-    (msgs, _) -> mapIO showLogEntry msgs >> return ()
+  mapIO showLogEntry msgs
+  let allOk =  all (levelGte Info) (map logLevelOf msgs) &&
+               either (\le -> levelGte Info (logLevelOf le)) (const True) result
+  exitWith (if allOk then 0 else 1)
 
 data Options = Options
   { optLogLevel :: LogLevel
@@ -458,13 +460,13 @@ checkout (CheckoutOptions pkg Nothing pre) cfg repo gc =
  case findLatestVersion repo pkg pre of
   Nothing -> failIO $ "Package '" ++ pkg ++
                       "' not found in package repository."
-  Just  p -> acquireAndInstallPackageWithDependencies cfg repo gc p >>
+  Just  p -> acquireAndInstallPackageWithDependencies cfg repo gc p |>
              checkoutPackage cfg repo gc p
 checkout (CheckoutOptions pkg (Just ver) _) cfg repo gc =
  case findVersion repo pkg ver of
   Nothing -> failIO $ "Package '" ++ pkg ++ "-" ++ showVersion ver ++
                       "' not found in package repository."
-  Just  p -> acquireAndInstallPackageWithDependencies cfg repo gc p >>
+  Just  p -> acquireAndInstallPackageWithDependencies cfg repo gc p |>
              checkoutPackage cfg repo gc p
 
 install :: InstallOptions -> Config -> Repository -> GlobalCache

src/CPM/PackageCache/Global.curry

@@ -32,8 +32,8 @@ import System (system)
 
 import CPM.Config (Config, packageInstallDir)
 import CPM.ErrorLogger
-import CPM.FileUtil (copyDirectory, inTempDir, recreateDirectory, inDirectory
-                    , tempDir)
+import CPM.FileUtil ( copyDirectory, inTempDir, recreateDirectory, inDirectory
+                    , removeDirectoryComplete, tempDir)
 import CPM.Package
 
 --- The global package cache.
@@ -137,8 +137,9 @@ installFromSource cfg pkg (Git url rev) = do
                                 in checkoutGitRef pkgDir tag |> 
                                   log Info ("Package " ++ (packageId pkg) ++
                                             " installed")
-        else failIO $ "Failed to clone repository from '" ++ url ++
-                      "', return code " ++ (show c)
+        else removeDirectoryComplete pkgDir >>
+             failIO ("Failed to clone repository from '" ++ url ++
+                     "', return code " ++ show c)
  where
   pkgDir = (packageInstallDir cfg) </> (packageId pkg)
   cloneCommand = "git clone " ++ (quote url) ++ " " ++ (quote $ packageId pkg)
@@ -155,7 +156,8 @@ installFromSource cfg pkg (FileSource zip) = do
                                 " " ++ (quote absZip)
       if c == 0
         then log Info $ "Installed " ++ (packageId pkg)
-        else failIO $ "Failed to unzip package " ++ (show c)
+        else removeDirectoryComplete pkgDir >>
+             failIO ("Failed to unzip package, return code " ++ show c)
  where
   pkgDir = (packageInstallDir cfg) </> (packageId pkg)
 
@@ -205,7 +207,8 @@ checkoutGitRef dir ref = do
   c <- inDirectory dir $ system $ "git checkout " ++ ref
   if c == 0
     then succeedIO ()
-    else failIO $ "Failed to check out " ++ ref ++ ", return code " ++ (show c)
+    else removeDirectoryComplete dir >>
+         failIO ("Failed to check out " ++ ref ++ ", return code " ++ show c)
 
 --- Installs a package's missing dependencies.
 installMissingDependencies :: Config -> GlobalCache -> [Package] 
@@ -234,7 +237,7 @@ checkoutPackage cfg _ _ pkg = do
     then log Error $ "Package '" ++ pkgId ++ "' already checked out."
     else if sexists
            then copyDirectory pkgDir pkgId >> log Info logMsg
-           else log Info $ "Package '" ++ pkgId ++ "' is not installed."
+           else log Error $ "Package '" ++ pkgId ++ "' is not installed."
  where
   pkgDir = (packageInstallDir cfg) </> pkgId
   pkgId = packageId pkg