mirrors/IHaskell
1
0
Fork 0
mirror of https://github.com/IHaskell/IHaskell.git synced 2025-04-16 03:16:20 +00:00
Code Issues Packages Projects Releases Wiki Activity

Finished simplifying command-line interface

Browse Source
This commit is contained in:
Andrew Gibiansky 2015-03-10 14:14:05 -07:00
parent 027184cabb
commit 39a2725035
6 changed files with 83 additions and 227 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
ihaskell.cabal
View File

@ -68,6 +68,7 @@ library
filepath -any,
ghc >=7.6 || < 7.11,
ghc-parser >=0.1.4,
ghc-paths ==0.1.*,
haskeline -any,
here ==1.2.*,
hlint >=1.9 && <2.0,
@ -120,18 +121,15 @@ library
-- other-modules:
-- Paths_ihaskell
executable IHaskell
executable ihaskell
-- .hs or .lhs file containing the Main module.
main-is: src/Main.hs
ghc-options: -threaded
default-extensions: DoAndIfThenElse
-- Other library packages from which modules are imported.
default-language: Haskell2010
build-depends:
base >=4.6 && < 4.9,
ghc-paths ==0.1.*,
aeson >=0.6 && < 0.9,
bytestring >=0.10,
cereal >=0.3,

11
src/IHaskell/Eval/Evaluate.hs
View File

@ -686,9 +686,8 @@ evalCommand _ (Directive GetInfo str) state = safely state $ do
-- Get all the info for all the names we're given.
strings <- getDescription str
let output = case getFrontend state of
IPythonConsole -> unlines strings
IPythonNotebook -> unlines (map htmlify strings)
-- TODO: Make pager work without html by porting to newer architecture
let output = unlines (map htmlify strings)
htmlify str =
printf "<div style='background: rgb(247, 247, 247);'><form><textarea id='code'>%s</textarea></form></div>" str
++ script
@ -980,10 +979,8 @@ hoogleResults state results = EvalOut {
evalComms = []
}
where
fmt =
case getFrontend state of
IPythonNotebook -> Hoogle.HTML
IPythonConsole -> Hoogle.Plain
-- TODO: Make pager work with plaintext
fmt = Hoogle.HTML
output = unlines $ map (Hoogle.render fmt) results
-- Read from a file handle until we hit a delimiter or until we've read

14
src/IHaskell/Flags.hs
View File

@ -4,6 +4,7 @@ module IHaskell.Flags (
Argument(..),
Args(..),
LhsStyle(..),
NotebookFormat(..),
lhsStyleBird,
parseFlags,
help,
@ -25,6 +26,10 @@ data Argument = ConfFile String -- ^ A file with commands to load at startup
| GhcLibDir String -- ^ Where to find the GHC libraries.
| KernelDebug -- ^ Spew debugging output from the kernel.
| Help -- ^ Display help text.
| ConvertFrom String
| ConvertTo String
| ConvertFromFormat NotebookFormat
| ConvertToFormat NotebookFormat
| ConvertLhsStyle (LhsStyle String)
deriving (Eq, Show)
@ -37,6 +42,11 @@ data LhsStyle string = LhsStyle { lhsCodePrefix :: string -- ^ @>@
}
deriving (Eq, Functor, 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
@ -66,15 +76,13 @@ parseFlags flags =
modeFlags = concatMap modeNames allModes
allModes :: [Mode Args]
allModes = [installKernelSpec, console, notebook, view, kernel, convert]
allModes = [installKernelSpec, kernel, convert]
-- | Get help text for a given IHaskell ode.
help :: IHaskellMode -> String
help mode = showText (Wrap 100) $ helpText [] HelpFormatAll $ chooseMode mode
where
chooseMode Console = console
chooseMode InstallKernelSpec = installKernelSpec
chooseMode Notebook = notebook
chooseMode (Kernel _) = kernel
chooseMode ConvertLhs = convert

118
src/IHaskell/IPython.hs
View File

@ -5,18 +5,14 @@
-- | Description : Shell scripting wrapper using @Shelly@ for the @notebook@, and
-- @console@ commands.
module IHaskell.IPython (
withIPython,
replaceIPythonKernelspec,
runConsole,
runNotebook,
readInitInfo,
defaultConfFile,
getIHaskellDir,
getSandboxPackageConf,
nbconvert,
subHome,
kernelName,
ViewFormat(..),
KernelSpecOptions(..),
defaultKernelSpecOptions,
) where
import ClassyPrelude
@ -40,9 +36,21 @@ import qualified System.IO.Strict as StrictIO
import qualified Paths_ihaskell as Paths
import qualified Codec.Archive.Tar as Tar
import qualified GHC.Paths
import IHaskell.Types
import System.Posix.Signals
data KernelSpecOptions = KernelSpecOptions { kernelSpecGhcLibdir :: String -- ^ GHC libdir.
, kernelSpecDebug :: Bool -- ^ Spew debugging output?
, kernelSpecConfFile :: IO (Maybe String) -- ^ Filename of profile JSON file.
}
defaultKernelSpecOptions :: KernelSpecOptions
defaultKernelSpecOptions = KernelSpecOptions { kernelSpecGhcLibdir = GHC.Paths.libdir
, kernelSpecDebug = False
, kernelSpecConfFile = defaultConfFile
}
-- | The IPython kernel name.
kernelName :: IsString a => a
kernelName = "haskell"
@ -106,50 +114,10 @@ defaultConfFile = shelly $ do
then Just $ fpToString filename
else Nothing
-- | Find a notebook and then convert it into the provided format.
-- Notebooks are searched in the current directory as well as the IHaskell
-- notebook directory (in that order).
nbconvert :: ViewFormat -> String -> IO ()
nbconvert fmt name = void . shelly $ do
curdir <- pwd
nbdir <- notebookDir
-- Find which of the options is available.
let notebookOptions = [ curdir </> fpFromString name
, curdir </> fpFromString (name ++ ".ipynb")
, nbdir </> fpFromString name
, nbdir </> fpFromString (name ++ ".ipynb")
]
maybeNb <- headMay <$> filterM test_f notebookOptions
case maybeNb of
Nothing -> do
putStrLn $ "Cannot find notebook: " ++ pack name
putStrLn "Tried:"
mapM_ (putStrLn . (" " ++) . fpToText) notebookOptions
Just notebook ->
let viewArgs =
case fmt of
Pdf -> ["--to=latex", "--post=pdf"]
Html -> ["--to=html", "--template=ihaskell"]
fmt -> ["--to=" ++ pack (show fmt)]
args = "nbconvert" : fpToText notebook : viewArgs
in void $ ipython False args
-- | Run an action after having verified that a proper IPython installation exists.
-- This ensures that an IHaskell kernelspec exists; if it doesn't, it creates it.
-- Note that this exits with an error if IPython isn't installed properly.
withIPython :: IO a -> IO a
withIPython act = shelly $ do
replaceIPythonKernelspec :: KernelSpecOptions -> IO ()
replaceIPythonKernelspec kernelSpecOpts = shelly $ do
verifyIPythonVersion
kernelspecExists <- kernelSpecCreated
unless kernelspecExists $ installKernelspec False
liftIO act
replaceIPythonKernelspec :: IO ()
replaceIPythonKernelspec = shelly $ do
verifyIPythonVersion
installKernelspec True
installKernelspec True kernelSpecOpts
-- | Verify that a proper version of IPython is installed and accessible.
verifyIPythonVersion :: Sh ()
@ -174,14 +142,21 @@ verifyIPythonVersion = do
-- | Install an IHaskell kernelspec into the right location.
-- The right location is determined by using `ipython kernelspec install --user`.
installKernelspec :: Bool -> Sh ()
installKernelspec replace = void $ do
installKernelspec :: Bool -> KernelSpecOptions -> Sh ()
installKernelspec replace opts = void $ do
ihaskellPath <- getIHaskellPath
let kernelSpec = KernelSpec {
kernelDisplayName = "Haskell",
kernelLanguage = kernelName,
kernelCommand = [ihaskellPath, "kernel", "{connection_file}"]
}
confFile <- liftIO $ kernelSpecConfFile opts
let kernelFlags :: [String]
kernelFlags =
["--debug" | kernelSpecDebug opts] ++
["--conf"] ++ maybe [] singleton confFile ++
["--ghclib", kernelSpecGhcLibdir opts]
let kernelSpec = KernelSpec { kernelDisplayName = "Haskell"
, kernelLanguage = kernelName
, kernelCommand = [ihaskellPath, "kernel", "{connection_file}"] ++ kernelFlags
}
-- Create a temporary directory. Use this temporary directory to make a kernelspec
-- directory; then, shell out to IPython to install this kernelspec directory.
@ -242,37 +217,6 @@ parseVersion versionStr =
[(n, _)] -> Just n
_ -> Nothing
runConsole :: InitInfo -> IO ()
runConsole initInfo = void . shelly $ do
writeInitInfo initInfo
ipython False $ "console" : "--no-banner" : kernelArgs
runNotebook :: InitInfo -> Maybe Text -> IO ()
runNotebook initInfo maybeServeDir = void . shelly $ do
notebookDirStr <- fpToText <$> notebookDir
let args =
case maybeServeDir of
Nothing -> ["--notebook-dir", notebookDirStr]
Just dir -> ["--notebook-dir", dir]
writeInitInfo initInfo
ipython False $ "notebook" : args
writeInitInfo :: InitInfo -> Sh ()
writeInitInfo info = do
filename <- (</> ".last-arguments") <$> ihaskellDir
liftIO $ writeFile filename $ show info
readInitInfo :: IO InitInfo
readInitInfo = shelly $ do
filename <- (</> ".last-arguments") <$> ihaskellDir
exists <- test_f filename
if exists
then read <$> liftIO (readFile filename)
else do
dir <- fromMaybe "." <$> fmap unpack <$> get_env "HOME"
return InitInfo { extensions = [], initCells = [], initDir = dir, frontend = IPythonNotebook }
-- | Get the absolute path to this IHaskell executable.
getIHaskellPath :: Sh String
getIHaskellPath = do

64
src/IHaskell/Types.hs
View File

@ -14,12 +14,9 @@ module IHaskell.Types (
DisplayData(..),
EvaluationResult(..),
ExecuteReplyStatus(..),
InitInfo(..),
KernelState(..),
LintStatus(..),
Width, Height,
FrontendType(..),
ViewFormat(..),
Display(..),
defaultKernelState,
extractPlain,
@ -32,45 +29,14 @@ module IHaskell.Types (
KernelSpec(..),
) where
import ClassyPrelude
import qualified Data.ByteString.Char8 as Char
import Data.Serialize
import GHC.Generics
import Data.Map (Map, empty)
import Data.Aeson (Value)
import ClassyPrelude
import qualified Data.ByteString.Char8 as Char
import Data.Serialize
import GHC.Generics
import Data.Map (Map, empty)
import Data.Aeson (Value)
import Text.Read as Read hiding (pfail, String)
import Text.ParserCombinators.ReadP
import IHaskell.IPython.Kernel
data ViewFormat
= Pdf
| Html
| Ipynb
| Markdown
| Latex
deriving Eq
instance Show ViewFormat where
show Pdf = "pdf"
show Html = "html"
show Ipynb = "ipynb"
show Markdown = "markdown"
show Latex = "latex"
instance Read ViewFormat where
readPrec = Read.lift $ do
str <- munch (const True)
case str of
"pdf" -> return Pdf
"html" -> return Html
"ipynb" -> return Ipynb
"notebook" -> return Ipynb
"latex" -> return Latex
"markdown" -> return Markdown
"md" -> return Markdown
_ -> pfail
import IHaskell.IPython.Kernel
-- | A class for displayable Haskell types.
--
@ -144,7 +110,6 @@ instance Semigroup Display where
-- | All state stored in the kernel between executions.
data KernelState = KernelState { getExecutionCounter :: Int
, getLintStatus :: LintStatus -- Whether to use hlint, and what arguments to pass it.
, getFrontend :: FrontendType
, useSvg :: Bool
, useShowErrors :: Bool
, useShowTypes :: Bool
@ -157,7 +122,6 @@ data KernelState = KernelState { getExecutionCounter :: Int
defaultKernelState :: KernelState
defaultKernelState = KernelState { getExecutionCounter = 1
, getLintStatus = LintOn
, getFrontend = IPythonConsole
, useSvg = True
, useShowErrors = False
, useShowTypes = False
@ -166,11 +130,6 @@ defaultKernelState = KernelState { getExecutionCounter = 1
, kernelDebug = False
}
data FrontendType
= IPythonConsole
| IPythonNotebook
deriving (Show, Eq, Read)
-- | Kernel options to be set via `:set` and `:option`.
data KernelOpt = KernelOpt {
getOptionName :: [String], -- ^ Ways to set this option via `:option`
@ -192,15 +151,6 @@ kernelOpts =
, KernelOpt ["no-pager"] [] $ \state -> state { usePager = False }
]
-- | Initialization information for the kernel.
data InitInfo = InitInfo {
extensions :: [String], -- ^ Extensions to enable at start.
initCells :: [String], -- ^ Code blocks to run before start.
initDir :: String, -- ^ Which directory this kernel should pretend to operate in.
frontend :: FrontendType -- ^ What frontend this serves.
}
deriving (Show, Read)
-- | Current HLint status.
data LintStatus
= LintOn

97
src/Main.hs
View File

@ -36,7 +36,6 @@ import qualified IHaskell.IPython.Stdin as Stdin
-- GHC API imports.
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]
@ -63,51 +62,12 @@ main = do
ihaskell :: Args -> IO ()
ihaskell (Args (ShowHelp help) _) = putStrLn $ pack help
ihaskell (Args ConvertLhs args) = showingHelp ConvertLhs args $ convert args
ihaskell (Args InstallKernelSpec args) = showingHelp InstallKernelSpec args replaceIPythonKernelspec
ihaskell (Args Console flags) = showingHelp Console flags $ do
putStrLn consoleBanner
withIPython $ do
flags <- addDefaultConfFile flags
info <- initInfo IPythonConsole flags
runConsole info
ihaskell (Args mode@(View (Just fmt) (Just name)) args) = showingHelp mode args $ withIPython $
nbconvert fmt name
ihaskell (Args Notebook flags) = showingHelp Notebook flags $ withIPython $ do
let server =
case mapMaybe serveDir flags of
[] -> Nothing
xs -> Just $ last xs
flags <- addDefaultConfFile flags
undirInfo <- initInfo IPythonNotebook flags
curdir <- getCurrentDirectory
let info = undirInfo { initDir = curdir }
runNotebook info (pack <$> server)
where
serveDir (ServeFrom dir) = Just dir
serveDir _ = Nothing
ihaskell (Args (Kernel (Just filename)) flags) = do
initInfo <- readInitInfo
runKernel debug libdir filename initInfo
where
(debug, libdir) = foldl' processFlag (False, GHC.Paths.libdir) flags
processFlag (debug, libdir) (GhcLibDir libdir') = (debug, libdir')
processFlag (debug, libdir) KernelDebug = (True, libdir)
processFlag x _ = x
-- | 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
ihaskell (Args InstallKernelSpec args) = showingHelp InstallKernelSpec args $ do
let kernelSpecOpts = parseKernelArgs args
replaceIPythonKernelspec kernelSpecOpts
ihaskell (Args (Kernel (Just filename)) args) = do
let kernelSpecOpts = parseKernelArgs args
runKernel kernelSpecOpts filename
showingHelp :: IHaskellMode -> [Argument] -> IO () -> IO ()
showingHelp mode flags act =
@ -118,25 +78,24 @@ showingHelp mode flags act =
act
-- | Parse initialization information from the flags.
initInfo :: FrontendType -> [Argument] -> IO InitInfo
initInfo front [] = return InitInfo { extensions = [], initCells = [], initDir = ".", frontend = front }
initInfo front (flag:flags) = do
info <- initInfo front 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 }
_ -> return info
parseKernelArgs :: [Argument] -> KernelSpecOptions
parseKernelArgs = foldl' addFlag defaultKernelSpecOptions
where
addFlag kernelSpecOpts (ConfFile filename) =
kernelSpecOpts { kernelSpecConfFile = return (Just filename) }
addFlag kernelSpecOpts KernelDebug =
kernelSpecOpts { kernelSpecDebug = True }
addFlag kernelSpecOpts (GhcLibDir libdir) =
kernelSpecOpts { kernelSpecGhcLibdir = libdir }
addFlag kernelSpecOpts flag = error $ "Unknown flag" ++ show flag
-- | Run the IHaskell language kernel.
runKernel :: Bool -- ^ Spew debugging output?
-> String -- ^ GHC libdir.
-> String -- ^ Filename of profile JSON file.
-> InitInfo -- ^ Initialization information from the invocation.
runKernel :: KernelSpecOptions -- ^ Various options from when the kernel was installed.
-> String -- ^ File with kernel profile JSON (ports, etc).
-> IO ()
runKernel debug libdir profileSrc initInfo = do
setCurrentDirectory $ initDir initInfo
runKernel kernelOpts profileSrc = do
let debug = kernelSpecDebug kernelOpts
libdir = kernelSpecGhcLibdir kernelOpts
-- Parse the profile file.
Just profile <- liftM decode . readFile . fpFromText $ pack profileSrc
@ -151,7 +110,7 @@ runKernel debug libdir profileSrc initInfo = do
-- Create initial state in the directory the kernel *should* be in.
state <- initialKernelState
modifyMVar_ state $ \kernelState -> return $
kernelState { getFrontend = frontend initInfo, kernelDebug = debug }
kernelState { kernelDebug = debug }
-- Receive and reply to all messages on the shell socket.
interpret libdir True $ do
@ -161,18 +120,18 @@ runKernel debug libdir profileSrc initInfo = do
liftIO ignoreCtrlC
-- 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 ()
-- command line flags.
let noPublish _ = return ()
evaluator line = void $ do
-- Create a new state each time.
stateVar <- liftIO initialKernelState
state <- liftIO $ takeMVar stateVar
evaluate state line noPublish
mapM_ evaluator extLines
mapM_ evaluator $ initCells initInfo
confFile <- liftIO $ kernelSpecConfFile kernelOpts
case confFile of
Just filename -> liftIO (readFile $ fpFromString filename) >>= evaluator
Nothing -> return ()
forever $ do
-- Read the request from the request channel.