{-# language NoImplicitPrelude, DoAndIfThenElse, OverloadedStrings, ExtendedDefaultRules #-}

-- | Description : Shell scripting wrapper using @Shelly@ for the @notebook@, and
--                 @console@ commands.
module IHaskell.IPython (
    replaceIPythonKernelspec,
    defaultConfFile,
    getIHaskellDir,
    getSandboxPackageConf,
    subHome,
    KernelSpecOptions(..),
    defaultKernelSpecOptions,
    installLabextension,
    ) where

import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import           IHaskellPrelude

import qualified Shelly as SH
import qualified System.IO as IO
import qualified System.FilePath as FP
import           System.Directory
import           System.Environment (getExecutablePath)
import           System.Exit (exitFailure)
import           Data.Aeson (toJSON)
import           Data.Aeson.Text (encodeToTextBuilder)
import           Data.Text.Lazy.Builder (toLazyText)

import qualified Paths_ihaskell as Paths

import qualified GHC.Paths
import           IHaskell.Types

import           StringUtils (replace, split)

data KernelSpecOptions =
       KernelSpecOptions
         { KernelSpecOptions -> FilePath
kernelSpecGhcLibdir :: String                  -- ^ GHC libdir.
         , KernelSpecOptions -> [FilePath]
kernelSpecRTSOptions :: [String]               -- ^ Runtime options to use.
         , KernelSpecOptions -> Bool
kernelSpecDebug :: Bool                        -- ^ Spew debugging output?
         , KernelSpecOptions -> FilePath
kernelSpecCodeMirror :: String                 -- ^ CodeMirror mode
         , KernelSpecOptions -> Maybe FilePath
kernelSpecHtmlCodeWrapperClass :: Maybe String -- ^ HTML output: class name for wrapper div
         , KernelSpecOptions -> FilePath
kernelSpecHtmlCodeTokenPrefix :: String        -- ^ HTML output: class name prefix for token spans
         , KernelSpecOptions -> IO (Maybe FilePath)
kernelSpecConfFile :: IO (Maybe String)        -- ^ Filename of profile JSON file.
         , KernelSpecOptions -> Maybe FilePath
kernelSpecInstallPrefix :: Maybe String
         , KernelSpecOptions -> Bool
kernelSpecUseStack :: Bool                     -- ^ Whether to use @stack@ environments.
         , KernelSpecOptions -> [FilePath]
kernelSpecStackFlags :: [String]               -- ^ Extra flags to pass to @stack@.
         , KernelSpecOptions -> Maybe FilePath
kernelSpecEnvFile :: Maybe FilePath
         , KernelSpecOptions -> FilePath
kernelSpecKernelName :: String                 -- ^ The IPython kernel name
         , KernelSpecOptions -> FilePath
kernelSpecDisplayName :: String                -- ^ The IPython kernel display name
         }

defaultKernelSpecOptions :: KernelSpecOptions
defaultKernelSpecOptions :: KernelSpecOptions
defaultKernelSpecOptions = KernelSpecOptions
  { kernelSpecGhcLibdir :: FilePath
kernelSpecGhcLibdir = FilePath
GHC.Paths.libdir
  , kernelSpecRTSOptions :: [FilePath]
kernelSpecRTSOptions = [FilePath
"-M3g", FilePath
"-N2"]  -- Memory cap 3 GiB,
                                            -- multithreading on two processors.
  , kernelSpecDebug :: Bool
kernelSpecDebug = Bool
False
  , kernelSpecCodeMirror :: FilePath
kernelSpecCodeMirror = FilePath
"ihaskell"
  , kernelSpecHtmlCodeWrapperClass :: Maybe FilePath
kernelSpecHtmlCodeWrapperClass = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"CodeMirror cm-s-jupyter cm-s-ipython"
  , kernelSpecHtmlCodeTokenPrefix :: FilePath
kernelSpecHtmlCodeTokenPrefix = FilePath
"cm-"
  , kernelSpecConfFile :: IO (Maybe FilePath)
kernelSpecConfFile = IO (Maybe FilePath)
defaultConfFile
  , kernelSpecInstallPrefix :: Maybe FilePath
kernelSpecInstallPrefix = Maybe FilePath
forall a. Maybe a
Nothing
  , kernelSpecUseStack :: Bool
kernelSpecUseStack = Bool
False
  , kernelSpecStackFlags :: [FilePath]
kernelSpecStackFlags = []
  , kernelSpecEnvFile :: Maybe FilePath
kernelSpecEnvFile = Maybe FilePath
forall a. Maybe a
Nothing
  , kernelSpecKernelName :: FilePath
kernelSpecKernelName = FilePath
"haskell"
  , kernelSpecDisplayName :: FilePath
kernelSpecDisplayName = FilePath
"Haskell"
  }

ipythonCommand :: SH.Sh SH.FilePath
ipythonCommand :: Sh FilePath
ipythonCommand = do
  Maybe FilePath
jupyterMay <- FilePath -> Sh (Maybe FilePath)
SH.which FilePath
"jupyter"
  FilePath -> Sh FilePath
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Sh FilePath) -> FilePath -> Sh FilePath
forall a b. (a -> b) -> a -> b
$
    case Maybe FilePath
jupyterMay of
      Maybe FilePath
Nothing -> FilePath
"ipython"
      Just FilePath
_  -> FilePath
"jupyter"

locateIPython :: SH.Sh SH.FilePath
locateIPython :: Sh FilePath
locateIPython = do
  Maybe FilePath
mbinary <- FilePath -> Sh (Maybe FilePath)
SH.which FilePath
"jupyter"
  case Maybe FilePath
mbinary of
    Maybe FilePath
Nothing      -> Text -> Sh FilePath
forall a. Text -> Sh a
SH.errorExit Text
"The Jupyter binary could not be located"
    Just FilePath
ipython -> FilePath -> Sh FilePath
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
ipython

fp :: SH.FilePath -> FilePath
fp :: FilePath -> FilePath
fp = Text -> FilePath
T.unpack (Text -> FilePath) -> (FilePath -> Text) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
SH.toTextIgnore

-- | Create the directory and return it.
ensure :: SH.Sh SH.FilePath -> SH.Sh SH.FilePath
ensure :: Sh FilePath -> Sh FilePath
ensure Sh FilePath
getDir = do
  FilePath
dir <- Sh FilePath
getDir
  FilePath -> Sh ()
SH.mkdir_p FilePath
dir
  FilePath -> Sh FilePath
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir

-- | Return the data directory for IHaskell.
ihaskellDir :: SH.Sh FilePath
ihaskellDir :: Sh FilePath
ihaskellDir = do
  FilePath
home <- FilePath -> (Text -> FilePath) -> Maybe Text -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"$HOME not defined.") Text -> FilePath
SH.fromText (Maybe Text -> FilePath) -> Sh (Maybe Text) -> Sh FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Sh (Maybe Text)
SH.get_env Text
"HOME"
  FilePath -> FilePath
fp (FilePath -> FilePath) -> Sh FilePath -> Sh FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sh FilePath -> Sh FilePath
ensure (FilePath -> Sh FilePath
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
home FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
SH.</> (FilePath
".ihaskell" :: SH.FilePath)))

getIHaskellDir :: IO String
getIHaskellDir :: IO FilePath
getIHaskellDir = Sh FilePath -> IO FilePath
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
SH.shelly Sh FilePath
ihaskellDir

defaultConfFile :: IO (Maybe String)
defaultConfFile :: IO (Maybe FilePath)
defaultConfFile = (Maybe FilePath -> Maybe FilePath)
-> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
fp) (IO (Maybe FilePath) -> IO (Maybe FilePath))
-> (Sh (Maybe FilePath) -> IO (Maybe FilePath))
-> Sh (Maybe FilePath)
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sh (Maybe FilePath) -> IO (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
SH.shelly (Sh (Maybe FilePath) -> IO (Maybe FilePath))
-> Sh (Maybe FilePath) -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ do
  FilePath
filename <- (FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
SH.</> (FilePath
"rc.hs" :: SH.FilePath)) (FilePath -> FilePath) -> Sh FilePath -> Sh FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sh FilePath
ihaskellDir
  Bool
exists <- FilePath -> Sh Bool
SH.test_f FilePath
filename
  Maybe FilePath -> Sh (Maybe FilePath)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Sh (Maybe FilePath))
-> Maybe FilePath -> Sh (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
exists
             then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
filename
             else Maybe FilePath
forall a. Maybe a
Nothing

replaceIPythonKernelspec :: KernelSpecOptions -> IO ()
replaceIPythonKernelspec :: KernelSpecOptions -> IO ()
replaceIPythonKernelspec KernelSpecOptions
kernelSpecOpts = Sh () -> IO ()
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
SH.shelly (Sh () -> IO ()) -> Sh () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Sh ()
verifyIPythonVersion
  Bool -> KernelSpecOptions -> Sh ()
installKernelspec Bool
True KernelSpecOptions
kernelSpecOpts

-- | Verify that a proper version of IPython is installed and accessible.
verifyIPythonVersion :: SH.Sh ()
verifyIPythonVersion :: Sh ()
verifyIPythonVersion = do
  FilePath
cmd <- Sh FilePath
ipythonCommand
  Maybe FilePath
pathMay <- FilePath -> Sh (Maybe FilePath)
SH.which FilePath
cmd
  case Maybe FilePath
pathMay of
    Maybe FilePath
Nothing -> Text -> Sh ()
badIPython
                 Text
"No Jupyter / IPython detected -- install Jupyter 3.0+ before using IHaskell."
    Just FilePath
_ -> () -> Sh ()
forall a. a -> Sh a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  where
    badIPython :: Text -> SH.Sh ()
    badIPython :: Text -> Sh ()
badIPython Text
message = IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ do
      Handle -> FilePath -> IO ()
IO.hPutStrLn Handle
IO.stderr (Text -> FilePath
T.unpack Text
message)
      IO ()
forall a. IO a
exitFailure

-- | Install an IHaskell kernelspec into the right location. The right location is determined by
-- using `ipython kernelspec install --user`.
installKernelspec :: Bool -> KernelSpecOptions -> SH.Sh ()
installKernelspec :: Bool -> KernelSpecOptions -> Sh ()
installKernelspec Bool
repl KernelSpecOptions
opts = Sh Text -> Sh ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sh Text -> Sh ()) -> Sh Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ do
  FilePath
ihaskellPath <- Sh FilePath
getIHaskellPath
  Maybe FilePath
confFile <- IO (Maybe FilePath) -> Sh (Maybe FilePath)
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> Sh (Maybe FilePath))
-> IO (Maybe FilePath) -> Sh (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ KernelSpecOptions -> IO (Maybe FilePath)
kernelSpecConfFile KernelSpecOptions
opts

  let kernelName :: FilePath
kernelName = KernelSpecOptions -> FilePath
kernelSpecKernelName KernelSpecOptions
opts

  let kernelFlags :: [String]
      kernelFlags :: [FilePath]
kernelFlags =
        [FilePath
"--debug" | KernelSpecOptions -> Bool
kernelSpecDebug KernelSpecOptions
opts] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
        (case Maybe FilePath
confFile of
           Maybe FilePath
Nothing   -> []
           Just FilePath
file -> [FilePath
"--conf", FilePath
file])
        [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--ghclib", KernelSpecOptions -> FilePath
kernelSpecGhcLibdir KernelSpecOptions
opts]
        [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (case KernelSpecOptions -> [FilePath]
kernelSpecRTSOptions KernelSpecOptions
opts of
             [] -> []
             [FilePath]
_ -> FilePath
"+RTS" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: KernelSpecOptions -> [FilePath]
kernelSpecRTSOptions KernelSpecOptions
opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-RTS"])
           [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--stack" | KernelSpecOptions -> Bool
kernelSpecUseStack KernelSpecOptions
opts]
           [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat [[FilePath
"--stack-flag", FilePath
f] | FilePath
f <- KernelSpecOptions -> [FilePath]
kernelSpecStackFlags KernelSpecOptions
opts]

  let kernelSpec :: KernelSpec
kernelSpec = KernelSpec
        { kernelDisplayName :: FilePath
kernelDisplayName = KernelSpecOptions -> FilePath
kernelSpecDisplayName KernelSpecOptions
opts
        , kernelLanguage :: FilePath
kernelLanguage = FilePath
kernelName
        , kernelCommand :: [FilePath]
kernelCommand = [FilePath
ihaskellPath, FilePath
"kernel", FilePath
"{connection_file}"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
kernelFlags
        }

  -- Create a temporary directory. Use this temporary directory to make a kernelspec directory; then,
  -- shell out to IPython to install this kernelspec directory.
  (FilePath -> Sh Text) -> Sh Text
forall a. (FilePath -> Sh a) -> Sh a
SH.withTmpDir ((FilePath -> Sh Text) -> Sh Text)
-> (FilePath -> Sh Text) -> Sh Text
forall a b. (a -> b) -> a -> b
$ \FilePath
tmp -> do
    let kernelDir :: FilePath
kernelDir = FilePath
tmp FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
SH.</> FilePath
kernelName
    let filename :: FilePath
filename = FilePath
kernelDir FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
SH.</> (FilePath
"kernel.json" :: SH.FilePath)

    FilePath -> Sh ()
SH.mkdir_p FilePath
kernelDir
    FilePath -> Text -> Sh ()
SH.writefile FilePath
filename (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Builder
forall a. ToJSON a => a -> Builder
encodeToTextBuilder (Value -> Builder) -> Value -> Builder
forall a b. (a -> b) -> a -> b
$ KernelSpec -> Value
forall a. ToJSON a => a -> Value
toJSON KernelSpec
kernelSpec
    let files :: [FilePath]
files = [FilePath
"kernel.js", FilePath
"logo-64x64.svg"]
    [FilePath] -> (FilePath -> Sh ()) -> Sh ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files ((FilePath -> Sh ()) -> Sh ()) -> (FilePath -> Sh ()) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
      FilePath
src <- IO FilePath -> Sh FilePath
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Sh FilePath) -> IO FilePath -> Sh FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
Paths.getDataFileName (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"html/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
      FilePath -> FilePath -> Sh ()
SH.cp (Text -> FilePath
SH.fromText (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
src) (FilePath
tmp FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
SH.</> FilePath
kernelName FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
SH.</> FilePath
file)

    FilePath
ipython <- Sh FilePath
locateIPython

    let replaceFlag :: [Text]
replaceFlag = [Text
"--replace" | Bool
repl]
        installPrefixFlag :: [Text]
installPrefixFlag = [Text] -> (FilePath -> [Text]) -> Maybe FilePath -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text
"--user"] (\FilePath
prefix -> [Text
"--prefix", FilePath -> Text
T.pack FilePath
prefix]) (KernelSpecOptions -> Maybe FilePath
kernelSpecInstallPrefix KernelSpecOptions
opts)
        cmd :: [Text]
cmd = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text
"kernelspec", Text
"install"], [Text]
installPrefixFlag, [FilePath -> Text
SH.toTextIgnore FilePath
kernelDir], [Text]
replaceFlag]

    let transformOutput :: Sh a -> Sh a
transformOutput = if KernelSpecOptions -> Bool
kernelSpecDebug KernelSpecOptions
opts then Sh a -> Sh a
forall a. a -> a
id else Sh a -> Sh a
forall a. Sh a -> Sh a
SH.silently
    Sh Text -> Sh Text
forall a. Sh a -> Sh a
transformOutput (Sh Text -> Sh Text) -> Sh Text -> Sh Text
forall a b. (a -> b) -> a -> b
$ FilePath -> [Text] -> Sh Text
SH.run FilePath
ipython [Text]
cmd

installLabextension :: Bool -> IO ()
installLabextension :: Bool -> IO ()
installLabextension Bool
debug = Sh () -> IO ()
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
SH.shelly (Sh () -> IO ()) -> Sh () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  -- Find the prebuilt extension directory
  FilePath
ihaskellDataDir <- IO FilePath -> Sh FilePath
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Sh FilePath) -> IO FilePath -> Sh FilePath
forall a b. (a -> b) -> a -> b
$ IO FilePath
Paths.getDataDir
  let labextensionDataDir :: FilePath
labextensionDataDir = FilePath
ihaskellDataDir
        FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
SH.</> (FilePath
"jupyterlab-ihaskell" :: SH.FilePath)
        FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
SH.</> (FilePath
"labextension" :: SH.FilePath)

  -- Find the $(jupyter --data-dir)/labextensions/jupyterlab-ihaskell directory
  FilePath
jupyter <- Sh FilePath
locateIPython
  FilePath
jupyterDataDir <- Sh FilePath -> Sh FilePath
forall a. Sh a -> Sh a
SH.silently (Sh FilePath -> Sh FilePath) -> Sh FilePath -> Sh FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
SH.fromText (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> FilePath) -> Sh Text -> Sh FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [Text] -> Sh Text
SH.run FilePath
jupyter [Text
"--data-dir"]
  let jupyterlabIHaskellDir :: FilePath
jupyterlabIHaskellDir = FilePath
jupyterDataDir
        FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
SH.</> (FilePath
"labextensions" :: SH.FilePath)
        FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
SH.</> (FilePath
"jupyterlab-ihaskell" :: SH.FilePath)

  Bool -> Sh () -> Sh ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (FilePath -> Sh ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
putStrLn (FilePath -> Sh ()) -> FilePath -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Installing kernel in folder: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
jupyterlabIHaskellDir)
  -- Remove the extension directory with extreme prejudice if it already exists
  FilePath -> Sh ()
SH.rm_rf FilePath
jupyterlabIHaskellDir
  -- Create an empty 'jupyterlab-ihaskell' directory to install our extension in
  FilePath -> Sh ()
SH.mkdir_p FilePath
jupyterlabIHaskellDir
  -- Copy the prebuilt extension files over
  [FilePath]
extensionContents <- FilePath -> Sh [FilePath]
SH.ls FilePath
labextensionDataDir
  [FilePath] -> (FilePath -> Sh ()) -> Sh ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
extensionContents ((FilePath -> Sh ()) -> Sh ()) -> (FilePath -> Sh ()) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \FilePath
entry ->
    FilePath -> FilePath -> Sh ()
SH.cp_r FilePath
entry FilePath
jupyterlabIHaskellDir

-- | Replace "~" with $HOME if $HOME is defined. Otherwise, do nothing.
subHome :: String -> IO String
subHome :: FilePath -> IO FilePath
subHome FilePath
path = Sh FilePath -> IO FilePath
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
SH.shelly (Sh FilePath -> IO FilePath) -> Sh FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ do
  FilePath
home <- Text -> FilePath
T.unpack (Text -> FilePath)
-> (Maybe Text -> Text) -> Maybe Text -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"~" (Maybe Text -> FilePath) -> Sh (Maybe Text) -> Sh FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Sh (Maybe Text)
SH.get_env Text
"HOME"
  FilePath -> Sh FilePath
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Sh FilePath) -> FilePath -> Sh FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> FilePath
replace FilePath
"~" FilePath
home FilePath
path

-- | Get the absolute path to this IHaskell executable.
getIHaskellPath :: SH.Sh FilePath
getIHaskellPath :: Sh FilePath
getIHaskellPath = do
  --  Get the absolute filepath to the argument.
  FilePath
f <- IO FilePath -> Sh FilePath
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getExecutablePath

  -- If we have an absolute path, that's the IHaskell we're interested in.
  if FilePath -> Bool
FP.isAbsolute FilePath
f
    then FilePath -> Sh FilePath
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
f
    else
    -- Check whether this is a relative path, or just 'IHaskell' with $PATH resolution done by
    -- the shell. If it's just 'IHaskell', use the $PATH variable to find where IHaskell lives.
    if FilePath -> FilePath
FP.takeFileName FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
f
      then do
        Maybe FilePath
ihaskellPath <- FilePath -> Sh (Maybe FilePath)
SH.which FilePath
"ihaskell"
        case Maybe FilePath
ihaskellPath of
          Maybe FilePath
Nothing   -> FilePath -> Sh FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"ihaskell not on $PATH and not referenced relative to directory."
          Just FilePath
path -> FilePath -> Sh FilePath
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Sh FilePath) -> FilePath -> Sh FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
SH.toTextIgnore FilePath
path
      else IO FilePath -> Sh FilePath
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Sh FilePath) -> IO FilePath -> Sh FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
makeAbsolute FilePath
f
getSandboxPackageConf :: IO (Maybe String)
getSandboxPackageConf :: IO (Maybe FilePath)
getSandboxPackageConf = Sh (Maybe FilePath) -> IO (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
SH.shelly (Sh (Maybe FilePath) -> IO (Maybe FilePath))
-> Sh (Maybe FilePath) -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ do
  FilePath
myPath <- Sh FilePath
getIHaskellPath
  let sandboxName :: FilePath
sandboxName = FilePath
".cabal-sandbox"
  if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
sandboxName FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
myPath
    then Maybe FilePath -> Sh (Maybe FilePath)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
    else do
      let pieces :: [FilePath]
pieces = FilePath -> FilePath -> [FilePath]
split FilePath
"/" FilePath
myPath
          sandboxDir :: FilePath
sandboxDir = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"/" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
sandboxName) [FilePath]
pieces [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
sandboxName]
      [FilePath]
subdirs <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
fp ([FilePath] -> [FilePath]) -> Sh [FilePath] -> Sh [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Sh [FilePath]
SH.ls (Text -> FilePath
SH.fromText (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
sandboxDir)
      let confdirs :: [FilePath]
confdirs = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (FilePath
"packages.conf.d" :: String)) [FilePath]
subdirs
      case [FilePath]
confdirs of
        [] -> Maybe FilePath -> Sh (Maybe FilePath)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
        FilePath
dir:[FilePath]
_ ->
          Maybe FilePath -> Sh (Maybe FilePath)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Sh (Maybe FilePath))
-> Maybe FilePath -> Sh (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dir