aboutsummaryrefslogtreecommitdiff
path: root/CabalHelper
diff options
context:
space:
mode:
authorDaniel Gröber <dxld@darkboxed.org>2016-01-13 03:06:21 +0100
committerDaniel Gröber <dxld@darkboxed.org>2016-01-14 19:19:05 +0100
commitc1b8fa2c397355076323c97c976b7d2cfd46504c (patch)
tree73f7391af80cdf47ea94f32d457fd28a2ef288a4 /CabalHelper
parent474c6e9ab033d605ec753ecb9041e3953778002f (diff)
Don't fail when cabal sandbox pkgdb doesn't exist
Diffstat (limited to 'CabalHelper')
-rw-r--r--CabalHelper/Compile.hs3
-rw-r--r--CabalHelper/Log.hs7
2 files changed, 9 insertions, 1 deletions
diff --git a/CabalHelper/Compile.hs b/CabalHelper/Compile.hs
index 54771b1..59bb48c 100644
--- a/CabalHelper/Compile.hs
+++ b/CabalHelper/Compile.hs
@@ -97,7 +97,8 @@ compileHelper opts cabalVer projdir distdir = withHelperSources $ \chdir -> do
compileSandbox :: FilePath -> MaybeT IO (Either ExitCode FilePath)
compileSandbox chdir = do
sandbox <- MaybeT $ getSandboxPkgDb projdir (display buildPlatform) =<< ghcVersion opts
- ver <- MaybeT $ find (== cabalVer) <$> listCabalVersions' opts (Just sandbox)
+ ver <- MaybeT $ logSomeError opts "compileSandbox" $
+ find (== cabalVer) <$> listCabalVersions' opts (Just sandbox)
vLog opts $ logMsg ++ "sandbox package-db"
liftIO $ compileWithPkg chdir (Just sandbox) ver
diff --git a/CabalHelper/Log.hs b/CabalHelper/Log.hs
index 9e04df0..bbc84a6 100644
--- a/CabalHelper/Log.hs
+++ b/CabalHelper/Log.hs
@@ -2,6 +2,7 @@ module CabalHelper.Log where
import Control.Monad
import Control.Monad.IO.Class
+import Control.Exception as E
import Data.String
import System.IO
import Prelude
@@ -12,3 +13,9 @@ vLog :: MonadIO m => Options -> String -> m ()
vLog Options { verbose = True } msg =
liftIO $ hPutStrLn stderr msg
vLog _ _ = return ()
+
+logSomeError :: Options -> String -> IO (Maybe a) -> IO (Maybe a)
+logSomeError opts label a = do
+ a `E.catch` \se@(SomeException _) -> do
+ vLog opts $ label ++ ": " ++ show se
+ return Nothing