Be able to pass extra flags to stack integration

This commit is contained in:
Tom McLaughlin 2023-12-01 16:47:56 -07:00
parent 1c8f9c4ab8
commit 979e462486
3 changed files with 14 additions and 2 deletions

View File

@ -113,6 +113,8 @@ parseKernelArgs = foldl' addFlag defaultKernelSpecOptions
kernelSpecOpts { kernelSpecInstallPrefix = Just prefix } kernelSpecOpts { kernelSpecInstallPrefix = Just prefix }
addFlag kernelSpecOpts KernelspecUseStack = addFlag kernelSpecOpts KernelspecUseStack =
kernelSpecOpts { kernelSpecUseStack = True } kernelSpecOpts { kernelSpecUseStack = True }
addFlag kernelSpecOpts (KernelspecStackFlag flag) =
kernelSpecOpts { kernelSpecStackFlags = flag : (kernelSpecStackFlags kernelSpecOpts) }
addFlag kernelSpecOpts (KernelspecEnvFile fp) = addFlag kernelSpecOpts (KernelspecEnvFile fp) =
kernelSpecOpts { kernelSpecEnvFile = Just fp } kernelSpecOpts { kernelSpecEnvFile = Just fp }
addFlag _kernelSpecOpts flag = error $ "Unknown flag" ++ show flag addFlag _kernelSpecOpts flag = error $ "Unknown flag" ++ show flag
@ -125,6 +127,7 @@ runKernel kOpts profileSrc = do
let debug = kernelSpecDebug kOpts let debug = kernelSpecDebug kOpts
libdir = kernelSpecGhcLibdir kOpts libdir = kernelSpecGhcLibdir kOpts
useStack = kernelSpecUseStack kOpts useStack = kernelSpecUseStack kOpts
stackFlags = kernelSpecStackFlags kOpts
-- Parse the profile file. -- Parse the profile file.
let profileErr = error $ "ihaskell: "++profileSrc++": Failed to parse profile file" let profileErr = error $ "ihaskell: "++profileSrc++": Failed to parse profile file"
@ -145,7 +148,7 @@ runKernel kOpts profileSrc = do
-- If we're in a stack directory, use `stack` to set the environment -- 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. -- We can't do this with base <= 4.6 because setEnv doesn't exist.
when stack $ when stack $
readProcess "stack" ["exec", "env"] "" >>= parseAndSetEnv readProcess "stack" (["exec", "env"] <> stackFlags) "" >>= parseAndSetEnv
case kernelSpecEnvFile kOpts of case kernelSpecEnvFile kOpts of
Nothing -> return () Nothing -> return ()

View File

@ -43,6 +43,7 @@ data Argument = ConfFile String -- ^ A file with commands to load
| ConvertLhsStyle (LhsStyle String) | ConvertLhsStyle (LhsStyle String)
| KernelspecInstallPrefix String | KernelspecInstallPrefix String
| KernelspecUseStack | KernelspecUseStack
| KernelspecStackFlag String
| KernelspecEnvFile FilePath | KernelspecEnvFile FilePath
deriving (Eq, Show) deriving (Eq, Show)
@ -153,6 +154,10 @@ kernelStackFlag = flagNone ["stack"] addStack
where where
addStack (Args md prev) = Args md (KernelspecUseStack : prev) addStack (Args md prev) = Args md (KernelspecUseStack : prev)
kernelStackExtraFlags :: Flag Args
kernelStackExtraFlags = flagReq ["stack-flag"] (store KernelspecStackFlag) ""
"Extra flag to pass to `stack` when --stack is used. Can be specified multiple times."
kernelEnvFileFlag :: Flag Args kernelEnvFileFlag :: Flag Args
kernelEnvFileFlag = kernelEnvFileFlag =
flagReq flagReq
@ -181,7 +186,7 @@ store constructor str (Args md prev) = Right $ Args md $ constructor str : prev
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, ghcRTSFlag, kernelDebugFlag, kernelNameFlag, displayNameFlag, confFlag, installPrefixFlag, helpFlag, kernelStackFlag, kernelEnvFileFlag] [ghcLibFlag, ghcRTSFlag, kernelDebugFlag, kernelNameFlag, displayNameFlag, confFlag, installPrefixFlag, helpFlag, kernelStackFlag, kernelStackExtraFlags, kernelEnvFileFlag]
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
@ -189,6 +194,7 @@ kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel."
, kernelDebugFlag , kernelDebugFlag
, confFlag , confFlag
, kernelStackFlag , kernelStackFlag
, kernelStackExtraFlags
, kernelEnvFileFlag , kernelEnvFileFlag
, kernelCodeMirrorFlag , kernelCodeMirrorFlag
, kernelHtmlCodeWrapperClassFlag , kernelHtmlCodeWrapperClassFlag

View File

@ -45,6 +45,7 @@ data KernelSpecOptions =
, 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. , kernelSpecUseStack :: Bool -- ^ Whether to use @stack@ environments.
, kernelSpecStackFlags :: [String] -- ^ Extra flags to pass to @stack@.
, kernelSpecEnvFile :: Maybe FilePath , kernelSpecEnvFile :: Maybe FilePath
, kernelSpecKernelName :: String -- ^ The IPython kernel name , kernelSpecKernelName :: String -- ^ The IPython kernel name
, kernelSpecDisplayName :: String -- ^ The IPython kernel display name , kernelSpecDisplayName :: String -- ^ The IPython kernel display name
@ -62,6 +63,7 @@ defaultKernelSpecOptions = KernelSpecOptions
, kernelSpecConfFile = defaultConfFile , kernelSpecConfFile = defaultConfFile
, kernelSpecInstallPrefix = Nothing , kernelSpecInstallPrefix = Nothing
, kernelSpecUseStack = False , kernelSpecUseStack = False
, kernelSpecStackFlags = []
, kernelSpecEnvFile = Nothing , kernelSpecEnvFile = Nothing
, kernelSpecKernelName = "haskell" , kernelSpecKernelName = "haskell"
, kernelSpecDisplayName = "Haskell" , kernelSpecDisplayName = "Haskell"
@ -150,6 +152,7 @@ installKernelspec repl opts = void $ do
[] -> [] [] -> []
_ -> "+RTS" : kernelSpecRTSOptions opts ++ ["-RTS"]) _ -> "+RTS" : kernelSpecRTSOptions opts ++ ["-RTS"])
++ ["--stack" | kernelSpecUseStack opts] ++ ["--stack" | kernelSpecUseStack opts]
++ mconcat [["--stack-flag", f] | f <- kernelSpecStackFlags opts]
let kernelSpec = KernelSpec let kernelSpec = KernelSpec
{ kernelDisplayName = kernelSpecDisplayName opts { kernelDisplayName = kernelSpecDisplayName opts