Commit 3ebf5b07 authored by Andrew Gibiansky's avatar Andrew Gibiansky

Hide stack support behind --stack flag

parent 783bcb94
...@@ -103,6 +103,8 @@ parseKernelArgs = foldl' addFlag defaultKernelSpecOptions ...@@ -103,6 +103,8 @@ parseKernelArgs = foldl' addFlag defaultKernelSpecOptions
kernelSpecOpts { kernelSpecGhcLibdir = libdir } kernelSpecOpts { kernelSpecGhcLibdir = libdir }
addFlag kernelSpecOpts (KernelspecInstallPrefix prefix) = addFlag kernelSpecOpts (KernelspecInstallPrefix prefix) =
kernelSpecOpts { kernelSpecInstallPrefix = Just prefix } kernelSpecOpts { kernelSpecInstallPrefix = Just prefix }
addFlag kernelSpecOpts KernelspecUseStack =
kernelSpecOpts { kernelSpecUseStack = True }
addFlag kernelSpecOpts flag = error $ "Unknown flag" ++ show flag addFlag kernelSpecOpts flag = error $ "Unknown flag" ++ show flag
-- | Run the IHaskell language kernel. -- | Run the IHaskell language kernel.
...@@ -112,6 +114,7 @@ runKernel :: KernelSpecOptions -- ^ Various options from when the kernel was ins ...@@ -112,6 +114,7 @@ runKernel :: KernelSpecOptions -- ^ Various options from when the kernel was ins
runKernel kernelOpts profileSrc = do runKernel kernelOpts profileSrc = do
let debug = kernelSpecDebug kernelOpts let debug = kernelSpecDebug kernelOpts
libdir = kernelSpecGhcLibdir kernelOpts libdir = kernelSpecGhcLibdir kernelOpts
useStack = kernelSpecUseStack kernelOpts
-- Parse the profile file. -- Parse the profile file.
Just profile <- liftM decode $ LBS.readFile profileSrc Just profile <- liftM decode $ LBS.readFile profileSrc
...@@ -121,22 +124,23 @@ runKernel kernelOpts profileSrc = do ...@@ -121,22 +124,23 @@ runKernel kernelOpts profileSrc = do
Stdin.recordKernelProfile dir profile Stdin.recordKernelProfile dir profile
#if MIN_VERSION_ghc(7,8,0) #if MIN_VERSION_ghc(7,8,0)
-- Detect if we have stack when useStack $ do
runResult <- try $ readProcessWithExitCode "stack" [] "" -- Detect if we have stack
let stack = runResult <- try $ readProcessWithExitCode "stack" [] ""
case runResult :: Either SomeException (ExitCode, String, String) of let stack =
Left _ -> False case runResult :: Either SomeException (ExitCode, String, String) of
Right (exitCode, stackStdout, _) -> exitCode == ExitSuccess && "The Haskell Tool Stack" `isInfixOf` stackStdout Left _ -> False
Right (exitCode, stackStdout, _) -> exitCode == ExitSuccess && "The Haskell Tool Stack" `isInfixOf` stackStdout
-- If we're in a stack directory, use `stack` to set the environment
-- We can't do this with base <= 4.6 because setEnv doesn't exist. -- If we're in a stack directory, use `stack` to set the environment
when stack $ do -- We can't do this with base <= 4.6 because setEnv doesn't exist.
stackEnv <- lines <$> readProcess "stack" ["exec", "env"] "" when stack $ do
forM_ stackEnv $ \line -> stackEnv <- lines <$> readProcess "stack" ["exec", "env"] ""
let (var, val) = break (== '=') line forM_ stackEnv $ \line ->
in case tailMay val of let (var, val) = break (== '=') line
Nothing -> return () in case tailMay val of
Just val' -> setEnv var val' Nothing -> return ()
Just val' -> setEnv var val'
#endif #endif
-- Serve on all sockets and ports defined in the profile. -- Serve on all sockets and ports defined in the profile.
......
...@@ -38,6 +38,7 @@ data Argument = ConfFile String -- ^ A file with commands to load at startup ...@@ -38,6 +38,7 @@ data Argument = ConfFile String -- ^ A file with commands to load at startup
| ConvertToFormat NotebookFormat | ConvertToFormat NotebookFormat
| ConvertLhsStyle (LhsStyle String) | ConvertLhsStyle (LhsStyle String)
| KernelspecInstallPrefix String | KernelspecInstallPrefix String
| KernelspecUseStack
deriving (Eq, Show) deriving (Eq, Show)
data LhsStyle string = data LhsStyle string =
...@@ -100,6 +101,11 @@ kernelDebugFlag = flagNone ["debug"] addDebug "Print debugging output from the k ...@@ -100,6 +101,11 @@ kernelDebugFlag = flagNone ["debug"] addDebug "Print debugging output from the k
where where
addDebug (Args mode prev) = Args mode (KernelDebug : prev) addDebug (Args mode prev) = Args mode (KernelDebug : prev)
kernelStackFlag :: Flag Args
kernelStackFlag = flagNone ["stack"] addStack "Inherit environment from `stack` when it is installed"
where
addStack (Args mode prev) = Args mode (KernelspecUseStack : prev)
confFlag :: Flag Args confFlag :: Flag Args
confFlag = flagReq ["conf", "c"] (store ConfFile) "<rc.hs>" confFlag = flagReq ["conf", "c"] (store ConfFile) "<rc.hs>"
"File with commands to execute at start; replaces ~/.ihaskell/rc.hs." "File with commands to execute at start; replaces ~/.ihaskell/rc.hs."
...@@ -118,11 +124,11 @@ store constructor str (Args mode prev) = Right $ Args mode $ constructor str : p ...@@ -118,11 +124,11 @@ store constructor str (Args mode prev) = Right $ Args mode $ constructor str : p
installKernelSpec :: Mode Args installKernelSpec :: Mode Args
installKernelSpec = installKernelSpec =
mode "install" (Args InstallKernelSpec []) "Install the Jupyter kernelspec." noArgs mode "install" (Args InstallKernelSpec []) "Install the Jupyter kernelspec." noArgs
[ghcLibFlag, kernelDebugFlag, confFlag, installPrefixFlag, helpFlag] [ghcLibFlag, kernelDebugFlag, confFlag, installPrefixFlag, helpFlag, kernelStackFlag]
kernel :: Mode Args kernel :: Mode Args
kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel." kernelArg kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel." kernelArg
[ghcLibFlag, kernelDebugFlag, confFlag] [ghcLibFlag, kernelDebugFlag, confFlag, kernelStackFlag]
where where
kernelArg = flagArg update "<json-kernel-file>" kernelArg = flagArg update "<json-kernel-file>"
update filename (Args _ flags) = Right $ Args (Kernel $ Just filename) flags update filename (Args _ flags) = Right $ Args (Kernel $ Just filename) flags
......
...@@ -47,6 +47,7 @@ data KernelSpecOptions = ...@@ -47,6 +47,7 @@ data KernelSpecOptions =
, kernelSpecDebug :: Bool -- ^ Spew debugging output? , kernelSpecDebug :: Bool -- ^ Spew debugging output?
, kernelSpecConfFile :: IO (Maybe String) -- ^ Filename of profile JSON file. , kernelSpecConfFile :: IO (Maybe String) -- ^ Filename of profile JSON file.
, kernelSpecInstallPrefix :: Maybe String , kernelSpecInstallPrefix :: Maybe String
, kernelSpecUseStack :: Bool -- ^ Whether to use @stack@ environments.
} }
defaultKernelSpecOptions :: KernelSpecOptions defaultKernelSpecOptions :: KernelSpecOptions
...@@ -55,6 +56,7 @@ defaultKernelSpecOptions = KernelSpecOptions ...@@ -55,6 +56,7 @@ defaultKernelSpecOptions = KernelSpecOptions
, kernelSpecDebug = False , kernelSpecDebug = False
, kernelSpecConfFile = defaultConfFile , kernelSpecConfFile = defaultConfFile
, kernelSpecInstallPrefix = Nothing , kernelSpecInstallPrefix = Nothing
, kernelSpecUseStack = False
} }
-- | The IPython kernel name. -- | The IPython kernel name.
...@@ -188,6 +190,7 @@ installKernelspec replace opts = void $ do ...@@ -188,6 +190,7 @@ installKernelspec replace opts = void $ do
Nothing -> [] Nothing -> []
Just file -> ["--conf", file]) Just file -> ["--conf", file])
++ ["--ghclib", kernelSpecGhcLibdir opts] ++ ["--ghclib", kernelSpecGhcLibdir opts]
++ ["--stack" | kernelSpecUseStack opts]
let kernelSpec = KernelSpec let kernelSpec = KernelSpec
{ kernelDisplayName = "Haskell" { kernelDisplayName = "Haskell"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment