Adding support for Stack and running without support lib

ihaskell.cabal

@@ -141,6 +141,7 @@ executable ihaskell
                        text                 >=0.11,
                        transformers         -any,
                        ghc                  >=7.6 || < 7.11,
+                       process              >=1.1,
                        here                 ==1.2.*,
                        aeson                >=0.7 && < 0.10,
                        bytestring           >=0.10,

main/Main.hs

@@ -16,12 +16,14 @@ import           Control.Concurrent (threadDelay)
 import           Control.Concurrent.Chan
 import           Data.Aeson
 import           System.Directory
-import           System.Exit (exitSuccess)
-import           System.Environment (getArgs)
+import           System.Process (readProcess, readProcessWithExitCode)
+import           System.Exit (exitSuccess, ExitCode(ExitSuccess))
+import           System.Environment (getArgs, setEnv)
 import           System.Posix.Signals
 import qualified Data.Map as Map
 import           Data.String.Here (hereFile)
 import qualified Data.Text.Encoding as E
+import           Data.List (break)
 
 -- IHaskell imports.
 import           IHaskell.Convert (convert)
@@ -111,6 +113,19 @@ runKernel kernelOpts profileSrc = do
   dir <- getIHaskellDir
   Stdin.recordKernelProfile dir profile
 
+  -- Detect if we have stack
+  (exitCode, stackStdout, _) <- readProcessWithExitCode "stack" [] ""
+  let stack = exitCode == ExitSuccess && "The Haskell Tool Stack" `isInfixOf` stackStdout
+
+  -- If we're in a stack directory, use `stack` to set the environment
+  when stack $ do
+    stackEnv <- lines <$> readProcess "stack" ["exec", "env"] ""
+    forM_ stackEnv $ \line ->
+      let (var, val) = break (== '=') line
+      in case tailMay val of
+           Nothing -> return ()
+           Just val' -> setEnv var val'
+
   -- Serve on all sockets and ports defined in the profile.
   interface <- serveProfile profile debug
 
@@ -120,11 +135,14 @@ runKernel kernelOpts profileSrc = do
     kernelState { kernelDebug = debug }
 
   -- Receive and reply to all messages on the shell socket.
-  interpret libdir True $ do
+  interpret libdir True $ \hasSupportLibraries -> do
     -- Ignore Ctrl-C the first time. This has to go inside the `interpret`, because GHC API resets the
     -- signal handlers for some reason (completely unknown to me).
     liftIO ignoreCtrlC
 
+    liftIO $ modifyMVar_ state $ \kernelState -> return $
+              kernelState { supportLibrariesAvailable = hasSupportLibraries }
+
     -- Initialize the context by evaluating everything we got from the command line flags.
     let noPublish _ = return ()
         noWidget s _ = return s

src/IHaskell/Eval/Evaluate.hs

@@ -12,7 +12,6 @@ module IHaskell.Eval.Evaluate (
     Interpreter,
     liftIO,
     typeCleaner,
-    globalImports,
     formatType,
     capturedIO,
     ) where
@@ -129,23 +128,26 @@ type Interpreter = Ghc
 instance MonadIO.MonadIO Interpreter where
   liftIO = MonadUtils.liftIO
 #endif
-globalImports :: [String]
-globalImports =
-  [ "import IHaskell.Display()"
-  , "import qualified Prelude as IHaskellPrelude"
+requiredGlobalImports :: [String]
+requiredGlobalImports =
+  [ "import qualified Prelude as IHaskellPrelude"
   , "import qualified System.Directory as IHaskellDirectory"
-  , "import qualified IHaskell.Display"
-  , "import qualified IHaskell.IPython.Stdin"
-  , "import qualified IHaskell.Eval.Widgets"
   , "import qualified System.Posix.IO as IHaskellIO"
   , "import qualified System.IO as IHaskellSysIO"
   , "import qualified Language.Haskell.TH as IHaskellTH"
   ]
+ihaskellGlobalImports :: [String]
+ihaskellGlobalImports =
+  [ "import IHaskell.Display()"
+  , "import qualified IHaskell.Display"
+  , "import qualified IHaskell.IPython.Stdin"
+  , "import qualified IHaskell.Eval.Widgets"
+  ]
 
 -- | Run an interpreting action. This is effectively runGhc with initialization and importing. First
 -- argument indicates whether `stdin` is handled specially, which cannot be done in a testing
--- environment.
-interpret :: String -> Bool -> Interpreter a -> IO a
+-- environment. The argument passed to the action indicates whether Haskell support libraries are available.
+interpret :: String -> Bool -> (Bool -> Interpreter a) -> IO a
 interpret libdir allowedStdin action = runGhc (Just libdir) $ do
   -- If we're in a sandbox, add the relevant package database
   sandboxPackages <- liftIO getSandboxPackageConf
@@ -156,18 +158,18 @@ interpret libdir allowedStdin action = runGhc (Just libdir) $ do
       void $ setSessionDynFlags $ dflags { verbosity = verb }
     Nothing -> return ()
 
-  initializeImports
+  hasSupportLibraries <- initializeImports
 
   -- Close stdin so it can't be used. Otherwise it'll block the kernel forever.
   dir <- liftIO getIHaskellDir
   let cmd = printf "IHaskell.IPython.Stdin.fixStdin \"%s\"" dir
-  when allowedStdin $ void $
+  when (allowedStdin && hasSupportLibraries) $ void $
     runStmt cmd RunToCompletion
 
   initializeItVariable
 
   -- Run the rest of the interpreter
-  action
+  action hasSupportLibraries
 #if MIN_VERSION_ghc(7,10,2)
 packageIdString' dflags pkg_key = fromMaybe "(unknown)" (packageKeyPackageIdString dflags pkg_key)
 #elif MIN_VERSION_ghc(7,10,0)
@@ -176,22 +178,21 @@ packageIdString' dflags = packageKeyPackageIdString dflags
 packageIdString' dflags = packageIdString
 #endif
 -- | Initialize our GHC session with imports and a value for 'it'.
-initializeImports :: Interpreter ()
+-- Return whether the IHaskell support libraries are available.
+initializeImports :: Interpreter Bool
 initializeImports = do
   -- Load packages that start with ihaskell-*, aren't just IHaskell, and depend directly on the right
   -- version of the ihaskell library. Also verify that the packages we load are not broken.
   dflags <- getSessionDynFlags
   broken <- liftIO getBrokenPackages
-  displayPackages <- liftIO $ do
-                       (dflags, _) <- initPackages dflags
+  (dflags, _) <- liftIO $ initPackages dflags
   let Just db = pkgDatabase dflags
       packageNames = map (packageIdString' dflags . packageConfigId) db
 
       initStr = "ihaskell-"
 
       -- Name of the ihaskell package, e.g. "ihaskell-1.2.3.4"
-                           iHaskellPkgName = initStr ++ intercalate "."
-                                                          (map show (versionBranch version))
+      iHaskellPkgName = initStr ++ intercalate "." (map show (versionBranch version))
 
       dependsOnRight pkg = not $ null $ do
         pkg <- db
@@ -200,24 +201,12 @@ initializeImports = do
         let idString = packageIdString' dflags (packageConfigId dep)
         guard (iHaskellPkgName `isPrefixOf` idString)
 
-
-                           -- ideally the Paths_ihaskell module could provide a way to get the hash too
-                           -- (ihaskell-0.2.0.5-f2bce922fa881611f72dfc4a854353b9), for now. Things will end badly if you also
-                           -- happen to have an ihaskell-0.2.0.5-ce34eadc18cf2b28c8d338d0f3755502 installed.
-                           iHaskellPkg =
-                             case filter (== iHaskellPkgName) packageNames of
-                               [x] -> x
-                               [] -> error
-                                       ("cannot find required haskell library: " ++ iHaskellPkgName)
-                               _ -> error
-                                      ("multiple haskell packages " ++ iHaskellPkgName ++ " found")
-
       displayPkgs = [pkgName | pkgName <- packageNames
                             , Just (x:_) <- [stripPrefix initStr pkgName]
                             , pkgName `notElem` broken
                             , isAlpha x]
 
-                       return displayPkgs
+      hasIHaskellPackage = not $ null $ filter (== iHaskellPkgName) packageNames
 
   -- Generate import statements all Display modules.
   let capitalize :: String -> String
@@ -231,20 +220,24 @@ initializeImports = do
       toImportStmt :: String -> String
       toImportStmt = printf importFmt . concatMap capitalize . dropFirstAndLast . split "-"
 
-      displayImports = map toImportStmt displayPackages
+      displayImports = map toImportStmt displayPkgs
 
   -- Import implicit prelude.
   importDecl <- parseImportDecl "import Prelude"
   let implicitPrelude = importDecl { ideclImplicit = True }
 
   -- Import modules.
-  imports <- mapM parseImportDecl $ globalImports ++ displayImports
+  imports <- mapM parseImportDecl $ requiredGlobalImports ++ if hasIHaskellPackage
+                                                             then ihaskellGlobalImports ++ displayImports
+                                                             else []
   setContext $ map IIDecl $ implicitPrelude : imports
 
   -- Set -fcontext-stack to 100 (default in ghc-7.10). ghc-7.8 uses 20, which is too small.
   let contextStackFlag = printf "-fcontext-stack=%d" (100 :: Int)
   void $ setFlags [contextStackFlag]
 
+  return hasIHaskellPackage
+
 -- | Give a value for the `it` variable.
 initializeItVariable :: Interpreter ()
 initializeItVariable =
@@ -324,8 +317,9 @@ evaluate kernelState code output widgetHandler = do
       evalOut <- evalCommand output cmd state
 
       -- Get displayed channel outputs. Merge them with normal display outputs.
-      dispsIO <- extractValue "IHaskell.Display.displayFromChan"
-      dispsMay <- liftIO dispsIO
+      dispsMay <- if supportLibrariesAvailable state
+                  then extractValue "IHaskell.Display.displayFromChan" >>= liftIO
+                  else return Nothing
       let result =
             case dispsMay of
               Nothing    -> evalResult evalOut
@@ -341,7 +335,9 @@ evaluate kernelState code output widgetHandler = do
           tempState = evalState evalOut { evalMsgs = [] }
 
       -- Handle the widget messages
-      newState <- flushWidgetMessages tempState tempMsgs widgetHandler
+      newState <- if supportLibrariesAvailable state
+                  then flushWidgetMessages tempState tempMsgs widgetHandler 
+                  else return tempState
 
       case evalStatus evalOut of
         Success -> runUntilFailure newState rest

src/IHaskell/Types.hs

@@ -139,6 +139,7 @@ data KernelState =
          , usePager :: Bool
          , openComms :: Map UUID Widget
          , kernelDebug :: Bool
+         , supportLibrariesAvailable :: Bool
          }
   deriving Show
 
@@ -152,6 +153,7 @@ defaultKernelState = KernelState
   , usePager = True
   , openComms = mempty
   , kernelDebug = False
+  , supportLibrariesAvailable = True
   }
 
 -- | Kernel options to be set via `:set` and `:option`.