Commit d47cf4e7 authored by Andrew Gibiansky's avatar Andrew Gibiansky

Add --ghclib flag to the kernel command to specify ghc libdir manually.

parent 1c3d12c5
......@@ -65,7 +65,6 @@ library
filepath -any,
ghc ==7.6.* || == 7.8.*,
ghc-parser >=0.1.2,
ghc-paths ==0.1.*,
haskeline -any,
here ==1.2.*,
hlint >=1.9 && <2.0,
......@@ -127,6 +126,7 @@ executable IHaskell
default-language: Haskell2010
build-depends:
base >=4.6 && < 4.8,
ghc-paths ==0.1.*,
aeson >=0.6 && < 0.9,
bytestring >=0.10,
cereal >=0.3,
......
......@@ -50,7 +50,6 @@ import Unify
import InstEnv
import GhcMonad (liftIO, withSession)
import GHC hiding (Stmt, TypeSig)
import GHC.Paths
import Exception hiding (evaluate)
import Outputable hiding ((<>))
import Packages
......@@ -122,8 +121,8 @@ globalImports =
-- | 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 :: Bool -> Interpreter a -> IO a
interpret allowedStdin action = runGhc (Just libdir) $ do
interpret :: String -> 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
initGhci sandboxPackages
......
{-# LANGUAGE NoImplicitPrelude, DeriveFunctor #-}
module IHaskell.Flags (
IHaskellMode(..),
Argument(..),
Args(..),
LhsStyle(..),
lhsStyleBird,
NotebookFormat(..),
parseFlags,
help,
) where
import ClassyPrelude
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Text
import Data.List (findIndex)
import IHaskell.Types
module IHaskell.Flags (
IHaskellMode(..),
Argument(..),
Args(..),
LhsStyle(..),
lhsStyleBird,
NotebookFormat(..),
parseFlags,
help,
) where
import ClassyPrelude
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Text
import Data.List (findIndex)
import IHaskell.Types
-- Command line arguments to IHaskell. A set of aruments is annotated with
-- the mode being invoked.
data Args = Args IHaskellMode [Argument]
deriving Show
data Argument
= ServeFrom String -- ^ Which directory to serve notebooks from.
| Extension String -- ^ An extension to load at startup.
| ConfFile String -- ^ A file with commands to load at startup.
| IPythonFrom String -- ^ Which executable to use for IPython.
| OverwriteFiles -- ^ Present when output should overwrite existing files.
| ConvertFrom String
| ConvertTo String
| ConvertFromFormat NotebookFormat
| ConvertToFormat NotebookFormat
| ConvertLhsStyle (LhsStyle String)
| Help -- ^ Display help text.
deriving Show
data Argument = ServeFrom String -- ^ Which directory to serve notebooks from.
| Extension String -- ^ An extension to load at startup.
| ConfFile String -- ^ A file with commands to load at startup.
| IPythonFrom String -- ^ Which executable to use for IPython.
| OverwriteFiles -- ^ Present when output should overwrite existing files.
| ConvertFrom String
| ConvertTo String
| ConvertFromFormat NotebookFormat
| ConvertToFormat NotebookFormat
| ConvertLhsStyle (LhsStyle String)
| GhcLibDir String -- ^ Where to find the GHC libraries.
| Help -- ^ Display help text.
deriving (Eq, Show)
data LhsStyle string = LhsStyle
{ lhsCodePrefix :: string, -- ^ @>@
lhsOutputPrefix :: string, -- ^ @<<@
lhsBeginCode :: string, -- ^ @\\begin{code}@
lhsEndCode :: string, -- ^ @\\end{code}@
lhsBeginOutput :: string, -- ^ @\\begin{verbatim}@
lhsEndOutput :: string -- ^ @\\end{verbatim}@
}
data LhsStyle string = LhsStyle { lhsCodePrefix :: string -- ^ @>@
, lhsOutputPrefix :: string -- ^ @<<@
, lhsBeginCode :: string -- ^ @\\begin{code}@
, lhsEndCode :: string -- ^ @\\end{code}@
, lhsBeginOutput :: string -- ^ @\\begin{verbatim}@
, lhsEndOutput :: string -- ^ @\\end{verbatim}@
}
deriving (Eq, Functor, Show)
data NotebookFormat
= LhsMarkdown
| IpynbFile
deriving (Eq,Show)
data NotebookFormat = LhsMarkdown
| IpynbFile
deriving (Eq, Show)
-- Which mode IHaskell is being invoked in.
-- `None` means no mode was specified.
data IHaskellMode
= ShowHelp String
| Notebook
| Console
| ConvertLhs
| Kernel (Maybe String)
| View (Maybe ViewFormat) (Maybe String)
data IHaskellMode = ShowHelp String
| Notebook
| Console
| ConvertLhs
| Kernel (Maybe String)
| View (Maybe ViewFormat) (Maybe String)
deriving (Eq, Show)
-- | Given a list of command-line arguments, return the IHaskell mode and
......@@ -84,8 +80,7 @@ allModes = [console, notebook, view, kernel, convert]
-- | Get help text for a given IHaskell ode.
help :: IHaskellMode -> String
help mode =
showText (Wrap 100) $ helpText [] HelpFormatAll $ chooseMode mode
help mode = showText (Wrap 100) $ helpText [] HelpFormatAll $ chooseMode mode
where
chooseMode Console = console
chooseMode Notebook = notebook
......@@ -93,16 +88,19 @@ help mode =
chooseMode ConvertLhs = convert
ipythonFlag :: Flag Args
ipythonFlag =
flagReq ["ipython", "i"] (store IPythonFrom) "<path>" "Executable for IPython."
ipythonFlag = flagReq ["ipython", "i"] (store IPythonFrom) "<path>" "Executable for IPython."
ghcLibFlag :: Flag Args
ghcLibFlag = flagReq ["ghclib", "l"] (store GhcLibDir) "<path>" "Library directory for GHC."
universalFlags :: [Flag Args]
universalFlags = [
flagReq ["extension","e", "X"] (store Extension) "<ghc-extension>" "Extension to enable at start.",
flagReq ["conf","c"] (store ConfFile) "<rc.hs>" "File with commands to execute at start; replaces ~/.ihaskell/rc.hs.",
flagHelpSimple (add Help)
]
where
universalFlags = [ flagReq ["extension", "e", "X"] (store Extension) "<ghc-extension>"
"Extension to enable at start."
, flagReq ["conf", "c"] (store ConfFile) "<rc.hs>"
"File with commands to execute at start; replaces ~/.ihaskell/rc.hs."
, flagHelpSimple (add Help)
]
where
add flag (Args mode flags) = Args mode $ flag : flags
store :: (String -> Argument) -> String -> Args -> Either String Args
......@@ -115,10 +113,10 @@ notebook = mode "notebook" (Args Notebook []) "Browser-based notebook interface.
universalFlags
console :: Mode Args
console = mode "console" (Args Console []) "Console-based interactive repl." noArgs $ ipythonFlag:universalFlags
console = mode "console" (Args Console []) "Console-based interactive repl." noArgs $ ipythonFlag : universalFlags
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]
where
kernelArg = flagArg update "<json-kernel-file>"
update filename (Args _ flags) = Right $ Args (Kernel $ Just filename) flags
......@@ -127,16 +125,23 @@ convert :: Mode Args
convert = mode "convert" (Args ConvertLhs []) description unnamedArg convertFlags
where
description = "Convert between Literate Haskell (*.lhs) and Ipython notebooks (*.ipynb)."
convertFlags = universalFlags
++ [ flagReq ["input","i"] (store ConvertFrom) "<file>" "File to read."
, flagReq ["output","o"] (store ConvertTo) "<file>" "File to write."
, flagReq ["from","f"] (storeFormat ConvertFromFormat) "lhs|ipynb" "Format of the file to read."
, flagReq ["to","t"] (storeFormat ConvertToFormat) "lhs|ipynb" "Format of the file to write."
, flagNone ["force"] consForce "Overwrite existing files with output."
, flagReq ["style","s"] storeLhs "bird|tex" "Type of markup used for the literate haskell file"
, flagNone ["bird"] (consStyle lhsStyleBird) "Literate haskell uses >"
, flagNone ["tex"] (consStyle lhsStyleTex ) "Literate haskell uses \\begin{code}"
]
convertFlags = universalFlags ++ [ flagReq ["input", "i"] (store ConvertFrom) "<file>"
"File to read."
, flagReq ["output", "o"] (store ConvertTo) "<file>"
"File to write."
, flagReq ["from", "f"] (storeFormat ConvertFromFormat)
"lhs|ipynb" "Format of the file to read."
, flagReq ["to", "t"] (storeFormat ConvertToFormat) "lhs|ipynb"
"Format of the file to write."
, flagNone ["force"] consForce
"Overwrite existing files with output."
, flagReq ["style", "s"] storeLhs "bird|tex"
"Type of markup used for the literate haskell file"
, flagNone ["bird"] (consStyle lhsStyleBird)
"Literate haskell uses >"
, flagNone ["tex"] (consStyle lhsStyleTex)
"Literate haskell uses \\begin{code}"
]
consForce (Args mode prev) = Args mode (OverwriteFiles : prev)
unnamedArg = Arg (store ConvertFrom) "<file>" False
......@@ -149,8 +154,8 @@ convert = mode "convert" (Args ConvertLhs []) description unnamedArg convertFlag
storeLhs str previousArgs = case toLower str of
"bird" -> success lhsStyleBird
"tex" -> success lhsStyleTex
_ -> Left $ "Unknown lhs style: " ++ str
"tex" -> success lhsStyleTex
_ -> Left $ "Unknown lhs style: " ++ str
where
success lhsStyle = Right $ consStyle lhsStyle previousArgs
......
......@@ -4,63 +4,61 @@
module Main where
-- Prelude imports.
import ClassyPrelude hiding (last, liftIO, readChan, writeChan)
import Prelude (last, read)
import ClassyPrelude hiding (last, liftIO, readChan, writeChan)
import Prelude (last, read)
-- Standard library imports.
import Control.Concurrent (threadDelay)
import Control.Concurrent.Chan
import Data.Aeson
import Data.Text (strip)
import System.Directory
import System.Exit (exitSuccess)
import Text.Printf
import System.Posix.Signals
import qualified Data.Map as Map
import Control.Concurrent (threadDelay)
import Control.Concurrent.Chan
import Data.Aeson
import Data.Text (strip)
import System.Directory
import System.Exit (exitSuccess)
import Text.Printf
import System.Posix.Signals
import qualified Data.Map as Map
-- IHaskell imports.
import IHaskell.Convert (convert)
import IHaskell.Eval.Completion (complete)
import IHaskell.Eval.Evaluate
import IHaskell.Display
import IHaskell.Eval.Info
import IHaskell.Flags
import IHaskell.IPython
import IHaskell.Types
import IHaskell.IPython.ZeroMQ
import IHaskell.IPython.Types
import qualified Data.ByteString.Char8 as Chars
import qualified IHaskell.IPython.Message.UUID as UUID
import qualified IHaskell.IPython.Stdin as Stdin
import IHaskell.Convert (convert)
import IHaskell.Eval.Completion (complete)
import IHaskell.Eval.Evaluate
import IHaskell.Display
import IHaskell.Eval.Info
import IHaskell.Flags
import IHaskell.IPython
import IHaskell.Types
import IHaskell.IPython.ZeroMQ
import IHaskell.IPython.Types
import qualified Data.ByteString.Char8 as Chars
import qualified IHaskell.IPython.Message.UUID as UUID
import qualified IHaskell.IPython.Stdin as Stdin
-- GHC API imports.
import GHC hiding (extensions, language)
import GHC hiding (extensions, language)
import qualified GHC.Paths
-- | Compute the GHC API version number using the dist/build/autogen/cabal_macros.h
ghcVersionInts :: [Int]
ghcVersionInts = map read . words . map dotToSpace $ VERSION_ghc
where dotToSpace '.' = ' '
dotToSpace x = x
where
dotToSpace '.' = ' '
dotToSpace x = x
main :: IO ()
main :: IO ()
main = do
args <- parseFlags <$> map unpack <$> getArgs
case args of
Left errorMessage ->
hPutStrLn stderr errorMessage
Right args ->
ihaskell args
Left errorMessage -> hPutStrLn stderr errorMessage
Right args -> ihaskell args
chooseIPython [] = return DefaultIPython
chooseIPython (IPythonFrom path:_) =
ExplicitIPython <$> subHome path
chooseIPython (IPythonFrom path:_) = ExplicitIPython <$> subHome path
chooseIPython (_:xs) = chooseIPython xs
ihaskell :: Args -> IO ()
-- If no mode is specified, print help text.
ihaskell (Args (ShowHelp help) _) =
putStrLn $ pack help
ihaskell (Args (ShowHelp help) _) = putStrLn $ pack help
ihaskell (Args ConvertLhs args) = showingHelp ConvertLhs args $ convert args
......@@ -95,9 +93,15 @@ ihaskell (Args Notebook flags) = showingHelp Notebook flags $ do
serveDir (ServeFrom dir) = Just dir
serveDir _ = Nothing
ihaskell (Args (Kernel (Just filename)) _) = do
ihaskell (Args (Kernel (Just filename)) flags) = do
initInfo <- readInitInfo
runKernel filename initInfo
runKernel libdir filename initInfo
where
libdir = case flags of
[] -> GHC.Paths.libdir
[GhcLibDir dir] -> dir
-- | Add a conf file to the arguments if none exists.
addDefaultConfFile :: [Argument] -> IO [Argument]
......@@ -131,10 +135,11 @@ initInfo front (flag:flags) = do
_ -> return info
-- | Run the IHaskell language kernel.
runKernel :: String -- ^ Filename of profile JSON file.
runKernel :: String -- ^ GHC libdir.
-> String -- ^ Filename of profile JSON file.
-> InitInfo -- ^ Initialization information from the invocation.
-> IO ()
runKernel profileSrc initInfo = do
runKernel libdir profileSrc initInfo = do
setCurrentDirectory $ initDir initInfo
-- Parse the profile file.
......@@ -153,7 +158,7 @@ runKernel profileSrc initInfo = do
kernelState { getFrontend = frontend initInfo }
-- Receive and reply to all messages on the shell socket.
interpret True $ do
interpret libdir True $ 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).
......
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