Merge branch 'master' of https://github.com/gibiansky/IHaskell into allow_pragmas

ihaskell-display/ihaskell-magic/ihaskell-magic.cabal

@@ -68,6 +68,7 @@ library
                        bytestring,
                        utf8-string,
                        base64-bytestring,
+                       ipython-kernel,
                        ihaskell >= 0.4
   
   -- Directories containing source files.

ihaskell.cabal

@@ -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,

src/IHaskell/Eval/Evaluate.hs

@@ -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

src/IHaskell/Flags.hs

 {-# 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
 

src/Main.hs

@@ -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).