From d6fc3faf845661f3953c694a5706c9dcb0e9c74c Mon Sep 17 00:00:00 2001
From: Falco Peijnenburg <falco.peijnenburg@channable.com>
Date: Sun, 13 Nov 2022 17:23:46 +0100
Subject: [PATCH] Add options to set kernel and display name

---
 main/Main.hs            |  4 ++++
 src/IHaskell/Flags.hs   | 20 +++++++++++++++++++-
 src/IHaskell/IPython.hs | 13 +++++++------
 3 files changed, 30 insertions(+), 7 deletions(-)

diff --git a/main/Main.hs b/main/Main.hs
index ffae8dc6..1eb50f67 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -99,6 +99,10 @@ parseKernelArgs = foldl' addFlag defaultKernelSpecOptions
       kernelSpecOpts { kernelSpecCodeMirror = codemirror }
     addFlag kernelSpecOpts (GhcLibDir libdir) =
       kernelSpecOpts { kernelSpecGhcLibdir = libdir }
+    addFlag kernelSpecOpts (KernelName name) =
+      kernelSpecOpts { kernelSpecKernelName = name}
+    addFlag kernelSpecOpts (DisplayName name) =
+      kernelSpecOpts { kernelSpecDisplayName = name}
     addFlag kernelSpecOpts (RTSFlags rts) =
       kernelSpecOpts { kernelSpecRTSOptions = rts }
     addFlag kernelSpecOpts (KernelspecInstallPrefix prefix) =
diff --git a/src/IHaskell/Flags.hs b/src/IHaskell/Flags.hs
index 7b53d81b..6be6ae2b 100644
--- a/src/IHaskell/Flags.hs
+++ b/src/IHaskell/Flags.hs
@@ -29,6 +29,8 @@ data Argument = ConfFile String     -- ^ A file with commands to load at startup
               | RTSFlags [String]   -- ^ Options for the GHC runtime (e.g. heap-size limit
                                     --     or number of threads).
               | KernelDebug         -- ^ Spew debugging output from the kernel.
+              | KernelName String   -- ^ The IPython kernel directory name.
+              | DisplayName String  -- ^ The IPython display name.
               | Help                -- ^ Display help text.
               | Version             -- ^ Display version text.
               | CodeMirror String   -- ^ change codemirror mode (default=ihaskell)
@@ -115,6 +117,22 @@ kernelDebugFlag = flagNone ["debug"] addDebug "Print debugging output from the k
   where
     addDebug (Args md prev) = Args md (KernelDebug : prev)
 
+kernelNameFlag :: Flag Args
+kernelNameFlag =
+  flagReq
+    ["kernel-name"]
+    (store KernelName)
+    "<name>"
+    "The directory name of the kernel."
+
+displayNameFlag :: Flag Args
+displayNameFlag =
+  flagReq
+    ["display-name"]
+    (store DisplayName)
+    "<name>"
+    "The display name of the kernel."
+
 kernelCodeMirrorFlag :: Flag Args
 kernelCodeMirrorFlag = flagReq ["codemirror"] (store CodeMirror) "<codemirror>"
         "Specify codemirror mode that is used for syntax highlighting (default: ihaskell)."
@@ -153,7 +171,7 @@ store constructor str (Args md prev) = Right $ Args md $ constructor str : prev
 installKernelSpec :: Mode Args
 installKernelSpec =
   mode "install" (Args InstallKernelSpec []) "Install the Jupyter kernelspec." noArgs
-    [ghcLibFlag, ghcRTSFlag, kernelDebugFlag, confFlag, installPrefixFlag, helpFlag, kernelStackFlag, kernelEnvFileFlag]
+    [ghcLibFlag, ghcRTSFlag, kernelDebugFlag, kernelNameFlag, displayNameFlag, confFlag, installPrefixFlag, helpFlag, kernelStackFlag, kernelEnvFileFlag]
 
 kernel :: Mode Args
 kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel." kernelArg
diff --git a/src/IHaskell/IPython.hs b/src/IHaskell/IPython.hs
index 2d31e43b..b6783320 100644
--- a/src/IHaskell/IPython.hs
+++ b/src/IHaskell/IPython.hs
@@ -8,7 +8,6 @@ module IHaskell.IPython (
     getIHaskellDir,
     getSandboxPackageConf,
     subHome,
-    kernelName,
     KernelSpecOptions(..),
     defaultKernelSpecOptions,
     installLabextension,
@@ -45,6 +44,8 @@ data KernelSpecOptions =
          , kernelSpecInstallPrefix :: Maybe String
          , kernelSpecUseStack :: Bool              -- ^ Whether to use @stack@ environments.
          , kernelSpecEnvFile :: Maybe FilePath
+         , kernelSpecKernelName :: String          -- ^ The IPython kernel name
+         , kernelSpecDisplayName :: String         -- ^ The IPython kernel display name
          }
 
 defaultKernelSpecOptions :: KernelSpecOptions
@@ -58,12 +59,10 @@ defaultKernelSpecOptions = KernelSpecOptions
   , kernelSpecInstallPrefix = Nothing
   , kernelSpecUseStack = False
   , kernelSpecEnvFile = Nothing
+  , kernelSpecKernelName = "haskell"
+  , kernelSpecDisplayName = "Haskell"
   }
 
--- | The IPython kernel name.
-kernelName :: String
-kernelName = "haskell"
-
 ipythonCommand :: SH.Sh SH.FilePath
 ipythonCommand = do
   jupyterMay <- SH.which "jupyter"
@@ -134,6 +133,8 @@ installKernelspec repl opts = void $ do
   ihaskellPath <- getIHaskellPath
   confFile <- liftIO $ kernelSpecConfFile opts
 
+  let kernelName = kernelSpecKernelName opts
+
   let kernelFlags :: [String]
       kernelFlags =
         ["--debug" | kernelSpecDebug opts] ++
@@ -147,7 +148,7 @@ installKernelspec repl opts = void $ do
            ++ ["--stack" | kernelSpecUseStack opts]
 
   let kernelSpec = KernelSpec
-        { kernelDisplayName = "Haskell"
+        { kernelDisplayName = kernelSpecDisplayName opts
         , kernelLanguage = kernelName
         , kernelCommand = [ihaskellPath, "kernel", "{connection_file}"] ++ kernelFlags
         }