(Optionally) copy '-package-id' args from 'stack'

README.md

@@ -38,6 +38,13 @@ halive demo/Main.hs
 ```
 Changing values in `Main.hs` or `Green.hs` and saving should live-update the program.
 
+* Note: if you get an error about an ``Ambiguous module name``, you can use this
+  command line instead:
+
+  ``HALIVE_STACK_COMPONENT=halive:test:demo halive demo/Main.hs``
+
+  It will be slower.
+
 Keeping values alive
 --------------------
 

demo/SetupGLFW.hs

@@ -1,23 +1,34 @@
+{-# LANGUAGE LambdaCase #-}
 module SetupGLFW where
 
 import qualified Graphics.UI.GLFW as GLFW
 
 import Control.Monad
+import Data.Bool
+import System.Exit
+import System.IO
 
 setupGLFW :: String -> Int -> Int -> IO GLFW.Window
 setupGLFW windowName desiredW desiredH = do
-    _ <- GLFW.init
+
+    GLFW.setErrorCallback (Just (const (hPutStrLn stderr)))
+    GLFW.init >>= bool (bail initFailMsg) (return ())
 
     GLFW.windowHint $ GLFW.WindowHint'ClientAPI GLFW.ClientAPI'OpenGL
     GLFW.windowHint $ GLFW.WindowHint'OpenGLForwardCompat True
     GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core
     GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor 4
     GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor 1
     GLFW.windowHint $ GLFW.WindowHint'sRGBCapable True
-
-    Just win <- GLFW.createWindow desiredW desiredH windowName Nothing Nothing
-
-    GLFW.makeContextCurrent (Just win)
 
-    GLFW.swapInterval 1
-    return win
+    GLFW.createWindow desiredW desiredH windowName Nothing Nothing >>= \case
+        Nothing -> bail cwFailMsg
+        Just win -> do
+            GLFW.makeContextCurrent (Just win)
+            GLFW.swapInterval 1
+            return win
+
+  where
+    initFailMsg = "Error: GLFW init() failed; perhaps $DISPLAY is not set."
+    cwFailMsg = "Error: GLFW createWindow() failed; probably your GPU is too old."
+    bail = hPutStrLn stderr >=> const exitFailure >=> undefined

exec/FindPackageDBs.hs

@@ -6,6 +6,7 @@ import Data.Maybe
 import System.Directory
 import System.FilePath
 import System.Process
+import System.Environment (lookupEnv)
 import Data.List
 import Data.Char
 import Control.Monad.IO.Class
@@ -67,9 +68,19 @@ getStackDb = do
             return . Just . catMaybes $ map (flip extractKey pathInfo) ["local-pkg-db:", "snapshot-pkg-db:"]
 
 updateDynFlagsWithStackDB :: MonadIO m => DynFlags -> m DynFlags
-updateDynFlagsWithStackDB dflags = 
+updateDynFlagsWithStackDB dflags =
     liftIO getStackDb >>= \case
         Nothing -> return dflags
         Just stackDBs -> do
             let pkgs = map PkgConfFile stackDBs
-            return dflags { extraPkgConfs = (pkgs ++) . extraPkgConfs dflags }
+                dflags' = dflags { extraPkgConfs = (pkgs ++) . extraPkgConfs dflags }
+            maybe (return dflags' ) (nastyHack dflags') =<< liftIO (lookupEnv "HALIVE_STACK_COMPONENT")
+
+    where
+      cmd c = "echo|stack -v ghci " ++ c ++ " 2>&1 >/dev/null |sed -ne 's/ @([^)]*)$//; s/.*Run process: ghc --interactive //p'"
+      nastyHack :: MonadIO m => DynFlags -> String -> m DynFlags
+      nastyHack dflags' component = do
+            ghciArguments <- words <$> liftIO (readProcess "sh" ["-c", cmd component] "")
+            let packageIdArguments = map noLoc $ filter ("-package-id=" `isPrefixOf`) ghciArguments
+            fst' <$> parseDynamicFlagsCmdLine (gopt_set dflags' Opt_HideAllPackages) packageIdArguments
+      fst' (x, _, _) = x

stack.yaml

@@ -1,4 +1,4 @@
 flags: {}
 packages:
 - '.'
-resolver: nightly-2015-12-03
+resolver: lts-4.0