diff --git a/IHaskell/Eval/Evaluate.hs b/IHaskell/Eval/Evaluate.hs --- a/IHaskell/Eval/Evaluate.hs +++ b/IHaskell/Eval/Evaluate.hs @@ -440,9 +440,16 @@ -- Do not display any output return [] -evalCommand _ (ParseError loc err) = wrapExecution $ do - write $ "Parse Error." - return $ displayError $ formatParseError loc err +evalCommand _ (TypeSignature sig) = wrapExecution $ + -- We purposefully treat this as a "success" because that way execution + -- continues. Empty type signatures are likely due to a parse error later + -- on, and we want that to be displayed. + return $ displayError $ "The type signature " ++ sig ++ + "\nlacks an accompanying binding." + +evalCommand _ (ParseError loc err) = do + write "Parse Error." + return (Failure, displayError $ formatParseError loc err) capturedStatement :: (String -> IO ()) -- ^ Function used to publish intermediate output. -> String -- ^ Statement to evaluate. diff --git a/IHaskell/Eval/Parser.hs b/IHaskell/Eval/Parser.hs --- a/IHaskell/Eval/Parser.hs +++ b/IHaskell/Eval/Parser.hs @@ -124,7 +124,7 @@ failures (_:rest) = failures rest bestError :: [(ErrMsg, LineNumber, ColumnNumber)] -> CodeBlock - bestError errors = ParseError (Loc line col) msg + bestError errors = ParseError (Loc (line + startLine - 1) col) msg where (msg, line, col) = maximumBy compareLoc errors compareLoc (_, line1, col1) (_, line2, col2) = compare line1 line2 <> compare col1 col2 diff --git a/IHaskell/IPython.hs b/IHaskell/IPython.hs --- a/IHaskell/IPython.hs +++ b/IHaskell/IPython.hs @@ -3,16 +3,17 @@ -- | Description : Shell scripting wrapper using @Shelly@ for the @notebook@, @setup@, and -- @console@ commands. module IHaskell.IPython ( - runIHaskell, - setupIPythonProfile, - ipythonVersion, - parseVersion, ipythonInstalled, - installIPython + installIPython, + removeIPython, + runConsole, + runNotebook, + readInitInfo, + defaultConfFile, ) where import ClassyPrelude -import Prelude (read, reads) +import Prelude (read, reads, init) import Shelly hiding (find, trace, path) import System.Argv0 import System.Directory @@ -22,20 +23,25 @@ import Text.Printf import qualified System.IO.Strict as StrictIO - import qualified Paths_ihaskell as Paths import qualified Codec.Archive.Tar as Tar +import IHaskell.Types + -- | Which commit of IPython we are on. ipythonCommit :: Text ipythonCommit = "1faf2f6e77fa31f4533e3edbe101c38ddf8943d8" +-- | The IPython profile name. +ipythonProfile :: String +ipythonProfile = "haskell" + -- | Run IPython with any arguments. ipython :: Bool -- ^ Whether to suppress output. -> [Text] -- ^ IPython command line arguments. -> Sh String -- ^ IPython output. ipython suppress args = do - (_, ipythonDir) <- ihaskellDirs + (_, ipythonDir, _) <- ihaskellDirs let ipythonPath = fromText $ ipythonDir ++ "/bin/ipython" sub $ do setenv "PYTHONPATH" $ ipythonDir ++ "/lib/python2.7/site-packages" @@ -56,21 +62,39 @@ nothing _ _ _ = return () -- | Return the data directory for IHaskell and the IPython subdirectory. -ihaskellDirs :: Sh (Text, Text) +ihaskellDirs :: Sh (Text, Text, Text) ihaskellDirs = do home <- maybe (error "$HOME not defined.") id <$> get_env "HOME" :: Sh Text let ihaskellDir = home ++ "/.ihaskell" ipythonDir = ihaskellDir ++ "/ipython" + notebookDir = ihaskellDir ++ "/notebooks" -- Make sure the directories exist. mkdir_p $ fromText ipythonDir + mkdir_p $ fromText notebookDir - return (ihaskellDir, ipythonDir) + return (ihaskellDir, ipythonDir, notebookDir) +defaultConfFile :: IO (Maybe String) +defaultConfFile = shellyNoDir $ do + (ihaskellDir, _, _) <- ihaskellDirs + let filename = ihaskellDir ++ "/rc.hs" + exists <- test_f $ fromText filename + return $ if exists + then Just $ unpack filename + else Nothing + +-- | Remove IPython so it can be reinstalled. +removeIPython :: IO () +removeIPython = void . shellyNoDir $ do + (ihaskellDir, _, _) <- ihaskellDirs + cd $ fromText ihaskellDir + rm_rf "ipython-src" + -- | Install IPython from source. installIPython :: IO () installIPython = void . shellyNoDir $ do - (ihaskellDir, ipythonDir) <- ihaskellDirs + (ihaskellDir, ipythonDir, _) <- ihaskellDirs -- Install all Python dependencies. pipPath <- path "pip" @@ -98,7 +122,7 @@ -- | Check whether IPython is properly installed. ipythonInstalled :: IO Bool ipythonInstalled = shellyNoDir $ do - (_, ipythonDir) <- ihaskellDirs + (_, ipythonDir, _) <- ihaskellDirs let ipythonPath = ipythonDir ++ "/bin/ipython" test_f $ fromText ipythonPath @@ -131,8 +155,8 @@ runIHaskell :: String -- ^ IHaskell profile name. -> String -- ^ IPython app name. -> [String] -- ^ Arguments to IPython. - -> IO () -runIHaskell profile app args = void . shellyNoDir $ do + -> Sh () +runIHaskell profile app args = void $ do -- Try to locate the profile. Do not die if it doesn't exist. errExit False $ ipython True ["locate", "profile", pack profile] @@ -145,6 +169,33 @@ -- Run the IHaskell command. ipython False $ map pack $ [app, "--profile", profile] ++ args +runConsole :: InitInfo -> IO () +runConsole initInfo = void . shellyNoDir $ do + writeInitInfo initInfo + runIHaskell ipythonProfile "console" [] + +runNotebook :: InitInfo -> Maybe String -> IO () +runNotebook initInfo maybeServeDir = void . shellyNoDir $ do + (_, _, notebookDir) <- ihaskellDirs + let args = case maybeServeDir of + Nothing -> ["--notebook-dir", unpack notebookDir] + Just dir -> ["--notebook-dir", dir] + + writeInitInfo initInfo + runIHaskell ipythonProfile "notebook" args + +writeInitInfo :: InitInfo -> Sh () +writeInitInfo info = do + (ihaskellDir, _, _) <- ihaskellDirs + let filename = fromText $ ihaskellDir ++ "/last-arguments" + liftIO $ writeFile filename $ show info + +readInitInfo :: IO InitInfo +readInitInfo = shellyNoDir $ do + (ihaskellDir, _, _) <- ihaskellDirs + let filename = fromText $ ihaskellDir ++ "/last-arguments" + read <$> liftIO (readFile filename) + -- | Create the IPython profile. setupIPythonProfile :: String -- ^ IHaskell profile name. -> IO () @@ -164,6 +215,17 @@ copyProfile :: Text -> IO () copyProfile profileDir = do profileTar <- Paths.getDataFileName "profile/profile.tar" + {- + -- Load profile from Resources directory of Mac *.app. + ihaskellPath <- shellyNoDir getIHaskellPath + profileTar <- if "IHaskell.app/Contents/MacOS" `isInfixOf` ihaskellPath + then + let pieces = split "/" ihaskellPath + pathPieces = init pieces ++ ["..", "Resources", "profile.tar"] in + return $ intercalate "/" pathPieces + else Paths.getDataFileName "profile/profile.tar" + -} + putStrLn $ pack $ "Loading profile from " ++ profileTar Tar.extract (unpack profileDir) profileTar -- | Insert the IHaskell path into the IPython configuration. diff --git a/IHaskell/Types.hs b/IHaskell/Types.hs --- a/IHaskell/Types.hs +++ b/IHaskell/Types.hs @@ -15,6 +15,7 @@ MimeType(..), DisplayData(..), ExecuteReplyStatus(..), + InitInfo(..), ) where import ClassyPrelude @@ -64,6 +65,13 @@ "iopub_port" .= iopubPort profile, "key" .= key profile ] + +-- | Initialization information for the kernel. +data InitInfo = InitInfo { + extensions :: [String], -- ^ Extensions to enable at start. + initCells :: [String] -- ^ Code blocks to run before start. + } + deriving (Show, Read) -- | A message header with some metadata. data MessageHeader = MessageHeader { diff --git a/IHaskell/ZeroMQ.hs b/IHaskell/ZeroMQ.hs --- a/IHaskell/ZeroMQ.hs +++ b/IHaskell/ZeroMQ.hs @@ -9,9 +9,9 @@ serveProfile ) where -import BasicPrelude +import ClassyPrelude hiding (stdin) import Control.Concurrent -import System.ZMQ3 +import System.ZMQ3 hiding (stdin) import Data.Aeson (encode) import qualified Data.ByteString.Lazy as ByteString @@ -71,7 +71,7 @@ serveSocket :: SocketType a => Context -> a -> Port -> (Socket a -> IO b) -> IO () serveSocket context socketType port action = void $ withSocket context socketType $ \socket -> do - bind socket $ textToString $ "tcp://127.0.0.1:" ++ show port + bind socket $ unpack $ "tcp://127.0.0.1:" ++ show port forever $ action socket -- | Listener on the heartbeat port. Echoes back any data it was sent. diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -5,11 +5,14 @@ -- Chans to communicate with the ZeroMQ sockets. module Main where import ClassyPrelude hiding (liftIO) +import Prelude (last) import Control.Concurrent.Chan +import Control.Concurrent (threadDelay) import Data.Aeson import Text.Printf import System.Exit (exitSuccess) import System.Directory +import System.Console.CmdArgs.Explicit hiding (complete) import qualified Data.Map as Map @@ -22,40 +25,160 @@ import qualified Data.ByteString.Char8 as Chars import IHaskell.IPython -import GHC +import GHC hiding (extensions) import Outputable (showSDoc, ppr) +-- All state stored in the kernel between executions. data KernelState = KernelState { getExecutionCounter :: Int } +-- Command line arguments to IHaskell. A set of aruments is annotated with +-- the mode being invoked. +data Args = Args IHaskellMode [Argument] + +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. + | Help -- ^ Display help text. + deriving (Eq, Show) + +-- Which mode IHaskell is being invoked in. +-- `None` means no mode was specified. +data IHaskellMode + = None + | Notebook + | Console + | UpdateIPython + | Kernel (Maybe String) + deriving (Eq, Show) + main :: IO () main = do + stringArgs <- map unpack <$> getArgs + writeFile "/users/silver/bloop" $ show stringArgs + case process ihaskellArgs stringArgs of + Left errmsg -> putStrLn $ pack errmsg + Right args -> + ihaskell args + +universalFlags :: [Flag Args] +universalFlags = [ + flagReq ["extension","e", "X"] (store Extension) "" "Extension to enable at start.", + flagReq ["conf","c"] (store ConfFile) "" "File with commands to execute at start.", + flagHelpSimple (add Help) + ] + where + add flag (Args mode flags) = Args mode $ flag : flags + +store :: (String -> Argument) -> String -> Args -> Either String Args +store constructor str (Args mode prev) = Right $ Args mode $ constructor str : prev + +notebook :: Mode Args +notebook = mode "notebook" (Args Notebook []) "Browser-based notebook interface." noArgs $ + flagReq ["serve","s"] (store ServeFrom) "" "Directory to serve notebooks from.": + universalFlags + +console :: Mode Args +console = mode "console" (Args Console []) "Console-based interactive repl." noArgs universalFlags + +kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel." kernelArg [] + where + kernelArg = flagArg update "" + update filename (Args _ flags) = Right $ Args (Kernel $ Just filename) flags + +update :: Mode Args +update = mode "update" (Args UpdateIPython []) "Update IPython frontends." noArgs [] + +ihaskellArgs :: Mode Args +ihaskellArgs = (modeEmpty $ Args None []) { modeGroupModes = toGroup [console, notebook, update, kernel] } + +noArgs = flagArg unexpected "" + where + unexpected a = error $ "Unexpected argument: " ++ a + +ihaskell :: Args -> IO () +-- If no mode is specified, print help text. +ihaskell (Args None _) = + print $ helpText [] HelpFormatAll ihaskellArgs + +-- Update IPython: remove then reinstall. +-- This is in case cabal updates IHaskell but the corresponding IPython +-- isn't updated. This is hard to detect since versions of IPython might +-- not change! +ihaskell (Args UpdateIPython _) = do + removeIPython + installIPython + putStrLn "IPython updated." + +ihaskell (Args Console flags) = showingHelp Console flags $ do installed <- ipythonInstalled unless installed installIPython - args <- map unpack <$> getArgs - case args of - -- Create the "haskell" profile. - ["setup"] -> setupIPythonProfile "haskell" + flags <- addDefaultConfFile flags + info <- initInfo flags + runConsole info - -- Run the ipython --profile haskell command. - "notebook":ipythonArgs -> runIHaskell "haskell" "notebook" ipythonArgs - "console":ipythonArgs -> runIHaskell "haskell" "console" ipythonArgs +ihaskell (Args Notebook flags) = showingHelp Notebook flags $ do + installed <- ipythonInstalled + unless installed installIPython - -- Read the profile JSON file from the argument list. - ["kernel", profileSrc] -> kernel profileSrc + let server = case mapMaybe serveDir flags of + [] -> Nothing + xs -> Just $ last xs - -- Bad arguments. - [] -> putStrLn $ "Provide command to run ('setup', 'kernel ', " ++ - "'notebook [args]', 'console [args]')." - cmd:_ -> putStrLn $ "Unknown command: " ++ pack cmd + flags <- addDefaultConfFile flags + info <- initInfo flags + runNotebook info server + where + serveDir (ServeFrom dir) = Just dir + serveDir _ = Nothing +ihaskell (Args (Kernel (Just filename)) _) = do + initInfo <- readInitInfo + runKernel filename initInfo +-- | Add a conf file to the arguments if none exists. +addDefaultConfFile :: [Argument] -> IO [Argument] +addDefaultConfFile flags = do + def <- defaultConfFile + case (find isConfFile flags, def) of + (Nothing, Just file) -> return $ ConfFile file : flags + _ -> return flags + where + isConfFile (ConfFile _) = True + isConfFile _ = False + +showingHelp :: IHaskellMode -> [Argument] -> IO () -> IO () +showingHelp mode flags act = + case find (==Help) flags of + Just _ -> + print $ helpText [] HelpFormatAll $ chooseMode mode + Nothing -> + act + where + chooseMode Console = console + chooseMode Notebook = notebook + chooseMode (Kernel _) = kernel + chooseMode UpdateIPython = update + +-- | Parse initialization information from the flags. +initInfo :: [Argument] -> IO InitInfo +initInfo [] = return InitInfo { extensions = [], initCells = []} +initInfo (flag:flags) = do + info <- initInfo flags + case flag of + Extension ext -> return info { extensions = ext:extensions info } + ConfFile filename -> do + cell <- readFile (fpFromText $ pack filename) + return info { initCells = cell:initCells info } + -- | Run the IHaskell language kernel. -kernel :: String -- ^ Filename of profile JSON file. - -> IO () -kernel profileSrc = do +runKernel :: String -- ^ Filename of profile JSON file. + -> InitInfo -- ^ Initialization information from the invocation. + -> IO () +runKernel profileSrc initInfo = do -- Switch to a temporary directory so that any files we create aren't -- visible. On Unix, this is usually /tmp. If there is no temporary -- directory available, just stay in the current one and ignore the @@ -71,20 +194,31 @@ state <- initialKernelState -- Receive and reply to all messages on the shell socket. - interpret $ forever $ do - -- Read the request from the request channel. - request <- liftIO $ readChan $ shellRequestChannel interface + interpret $ do + -- Initialize the context by evaluating everything we got from the + -- command line flags. This includes enabling some extensions and also + -- running some code. + let extLines = map (":extension " ++) $ extensions initInfo + noPublish _ _ = return () + zero = 0 -- To please hlint + evaluator line = evaluate zero line noPublish + mapM_ evaluator extLines + mapM_ evaluator $ initCells initInfo - -- Create a header for the reply. - replyHeader <- createReplyHeader (header request) + forever $ do + -- Read the request from the request channel. + request <- liftIO $ readChan $ shellRequestChannel interface - -- Create the reply, possibly modifying kernel state. - oldState <- liftIO $ takeMVar state - (newState, reply) <- replyTo interface request replyHeader oldState - liftIO $ putMVar state newState + -- Create a header for the reply. + replyHeader <- createReplyHeader (header request) - -- Write the reply to the reply channel. - liftIO $ writeChan (shellReplyChannel interface) reply + -- Create the reply, possibly modifying kernel state. + oldState <- liftIO $ takeMVar state + (newState, reply) <- replyTo interface request replyHeader oldState + liftIO $ putMVar state newState + + -- Write the reply to the reply channel. + liftIO $ writeChan (shellReplyChannel interface) reply -- Initial kernel state. initialKernelState :: IO (MVar KernelState) diff --git a/ihaskell.cabal b/ihaskell.cabal --- a/ihaskell.cabal +++ b/ihaskell.cabal @@ -7,7 +7,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.2.0.3 +version: 0.2.0.4 -- A short (one-line) description of the package. synopsis: A Haskell backend kernel for the IPython project. @@ -47,32 +47,32 @@ library build-depends: base ==4.6.*, + cmdargs >= 0.10, tar, ghc-parser, unix >= 2.6, hspec, - zeromq3-haskell ==0.5.*, - aeson ==0.6.*, - MissingH ==1.2.*, - basic-prelude ==0.3.*, + zeromq3-haskell >=0.5, + aeson >=0.6, + MissingH >=1.2, classy-prelude >=0.6, - bytestring ==0.10.*, + bytestring >=0.10, uuid >=1.2.6, - containers ==0.5.*, + containers >=0.5, ghc ==7.6.*, ghc-paths ==0.1.*, - random ==1.0.*, + random >=1.0, split >= 0.2, utf8-string, - strict ==0.3.*, - shelly ==1.3.*, + strict >=0.3, + shelly >=1.3, system-argv0, directory, here, system-filepath, cereal ==0.3.*, - text ==0.11.*, - mtl == 2.1.*, + text >=0.11, + mtl >= 2.1, template-haskell exposed-modules: IHaskell.Display, Paths_ihaskell, @@ -104,32 +104,32 @@ -- Other library packages from which modules are imported. build-depends: base ==4.6.*, + cmdargs >= 0.10, tar, ghc-parser, unix >= 2.6, hspec, - zeromq3-haskell ==0.5.*, - aeson ==0.6.*, - MissingH ==1.2.*, - basic-prelude ==0.3.*, - classy-prelude ==0.6.*, - bytestring ==0.10.*, + zeromq3-haskell >=0.5, + aeson >=0.6, + MissingH >=1.2, + classy-prelude >=0.6, + bytestring >=0.10, uuid >=1.2.6, - containers ==0.5.*, + containers >=0.5, ghc ==7.6.*, ghc-paths ==0.1.*, - random ==1.0.*, + random >=1.0, split >= 0.2, utf8-string, - strict ==0.3.*, - shelly ==1.3.*, + strict >=0.3, + shelly >=1.3, system-argv0, directory, here, system-filepath, cereal ==0.3.*, - text ==0.11.*, - mtl == 2.1.*, + text >=0.11, + mtl >= 2.1, template-haskell Test-Suite hspec @@ -137,32 +137,32 @@ Ghc-Options: -threaded Main-Is: Hspec.hs build-depends: base ==4.6.*, + cmdargs >= 0.10, tar, ghc-parser, unix >= 2.6, hspec, - zeromq3-haskell ==0.5.*, - aeson ==0.6.*, - MissingH ==1.2.*, - basic-prelude ==0.3.*, - classy-prelude ==0.6.*, - bytestring ==0.10.*, + zeromq3-haskell >=0.5, + aeson >=0.6, + MissingH >=1.2, + classy-prelude >=0.6, + bytestring >=0.10, uuid >=1.2.6, - containers ==0.5.*, + containers >=0.5, ghc ==7.6.*, ghc-paths ==0.1.*, - random ==1.0.*, + random >=1.0, split >= 0.2, utf8-string, - strict ==0.3.*, - shelly ==1.3.*, + strict >=0.3, + shelly >=1.3, system-argv0, directory, here, system-filepath, cereal ==0.3.*, - text ==0.11.*, - mtl == 2.1.*, + text >=0.11, + mtl >= 2.1, template-haskell source-repository head diff --git a/profile/profile.tar b/profile/profile.tar Binary files a/profile/profile.tar and b/profile/profile.tar differ