diff --git a/html/kernel.js b/html/kernel.js
--- a/html/kernel.js
+++ b/html/kernel.js
@@ -23,7 +23,6 @@
IPython.keyboard.keycodes.down = downArrow; // space
IPython.CodeCell.options_default['cm_config']['mode'] = 'ihaskell';
- IPython.CodeCell.options_default['cm_config']['autoCloseBrackets'] = '()[]{}';
utils.requireCodeMirrorMode('haskell', function(){
// Create a multiplexing mode that uses Haskell highlighting by default but
@@ -48,7 +47,6 @@
// This is necessary, otherwise sometimes highlighting just doesn't happen.
// This may be an IPython bug.
c.code_mirror.setOption('mode', 'ihaskell');
- c.code_mirror.setOption('autoCloseBrackets', '()[]{}');
c.force_highlight('ihaskell');
}
}
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.10.0.0
+version: 0.10.0.1
-- A short (one-line) description of the package.
synopsis: A Haskell backend kernel for the IPython project.
@@ -65,7 +65,7 @@
directory -any,
filepath -any,
ghc >=8.0,
- ghc-parser >=0.1.7,
+ ghc-parser >=0.2.1,
ghc-paths >=0.1,
haskeline -any,
hlint >=1.9,
@@ -80,17 +80,15 @@
split >= 0.2,
stm -any,
strict >=0.3,
- system-argv0 -any,
text >=0.11,
time >= 1.6,
transformers -any,
unix >= 2.6,
unordered-containers -any,
utf8-string -any,
- uuid >=1.3,
vector -any,
ipython-kernel >=0.9.1,
- ghc-boot >=8.0 && <8.7
+ ghc-boot >=8.0 && <8.9
exposed-modules: IHaskell.Display
IHaskell.Convert
@@ -137,10 +135,10 @@
default-language: Haskell2010
build-depends:
ihaskell -any,
- base >=4.9 && < 4.13,
+ base >=4.9 && < 4.14,
text >=0.11,
transformers -any,
- ghc >=8.0 && < 8.7,
+ ghc >=8.0 && < 8.9,
process >=1.1,
aeson >=0.7,
bytestring >=0.10,
diff --git a/main/Main.hs b/main/Main.hs
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -171,6 +171,12 @@
-- Create a header for the reply.
replyHeader <- createReplyHeader (header request)
+ -- Notify the frontend that the kernel is busy computing. All the headers are copies of the reply
+ -- header with a different message type, because this preserves the session ID, parent header, and
+ -- other important information.
+ busyHeader <- liftIO $ dupHeader replyHeader StatusMessage
+ liftIO $ writeChan (iopubChannel interface) $ PublishStatus busyHeader Busy
+
-- We handle comm messages and normal ones separately. The normal ones are a standard
-- request/response style, while comms can be anything, and don't necessarily require a response.
if isCommMessage request
@@ -191,6 +197,10 @@
-- Write the reply to the reply channel.
liftIO $ writeChan (shellReplyChannel interface) reply
+ -- Notify the frontend that we're done computing.
+ idleHeader <- liftIO $ dupHeader replyHeader StatusMessage
+ liftIO $ writeChan (iopubChannel interface) $ PublishStatus idleHeader Idle
+
where
ignoreCtrlC =
installHandler keyboardSignal (CatchOnce $ putStrLn "Press Ctrl-C again to quit kernel.")
@@ -266,12 +276,6 @@
dir <- liftIO getIHaskellDir
liftIO $ Stdin.recordParentHeader dir $ header req
- -- Notify the frontend that the kernel is busy computing. All the headers are copies of the reply
- -- header with a different message type, because this preserves the session ID, parent header, and
- -- other important information.
- busyHeader <- liftIO $ dupHeader replyHeader StatusMessage
- send $ PublishStatus busyHeader Busy
-
-- Construct a function for publishing output as this is going. This function accepts a boolean
-- indicating whether this is the final output and the thing to display. Store the final outputs in
-- a list so that when we receive an updated non-final output, we can clear the entire output and
@@ -290,10 +294,6 @@
publish = publishResult send replyHeader displayed updateNeeded pOut (usePager state)
updatedState <- evaluate state (T.unpack code) publish widgetMessageHandler
- -- Notify the frontend that we're done computing.
- idleHeader <- liftIO $ dupHeader replyHeader StatusMessage
- send $ PublishStatus idleHeader Idle
-
-- Take pager output if we're using the pager.
pager <- if usePager state
then liftIO $ readMVar pOut
@@ -418,10 +418,6 @@
let run = capturedIO publish kernelState
publish = publishResult send replyHeader displayed updateNeeded pOut toUsePager
- -- Notify the frontend that the kernel is busy
- busyHeader <- liftIO $ dupHeader replyHeader StatusMessage
- liftIO . send $ PublishStatus busyHeader Busy
-
newState <- case Map.lookup uuid widgets of
Nothing -> return kernelState
Just (Widget widget) ->
@@ -439,9 +435,5 @@
_ ->
-- Only sensible thing to do.
return kernelState
-
- -- Notify the frontend that the kernel is idle once again
- idleHeader <- liftIO $ dupHeader replyHeader StatusMessage
- liftIO . send $ PublishStatus idleHeader Idle
return newState
diff --git a/src/IHaskell/Convert/Args.hs b/src/IHaskell/Convert/Args.hs
--- a/src/IHaskell/Convert/Args.hs
+++ b/src/IHaskell/Convert/Args.hs
@@ -93,6 +93,12 @@
(prev@(Just _), _) -> prev
(Nothing, format) -> fmap (== IpynbFile) format
}
+mergeArg (ConvertToFormat format) convertSpec = case format of
+ LhsMarkdown -> convertSpec { convertToIpynb = Just False }
+ IpynbFile -> convertSpec { convertToIpynb = Just True }
+mergeArg (ConvertFromFormat format) convertSpec = case format of
+ LhsMarkdown -> convertSpec { convertToIpynb = Just True }
+ IpynbFile -> convertSpec { convertToIpynb = Just False }
mergeArg unexpectedArg _ = error $ "IHaskell.Convert.mergeArg: impossible argument: "
++ show unexpectedArg
diff --git a/src/IHaskell/Eval/Evaluate.hs b/src/IHaskell/Eval/Evaluate.hs
--- a/src/IHaskell/Eval/Evaluate.hs
+++ b/src/IHaskell/Eval/Evaluate.hs
@@ -24,13 +24,11 @@
import Data.Foldable (foldMap)
import Prelude (head, tail, last, init)
import Data.List (nubBy)
+import qualified Data.Set as Set
import Data.Char as Char
import Data.Dynamic
import qualified Data.Serialize as Serialize
import System.Directory
-#if !MIN_VERSION_base(4,8,0)
-import System.Posix.IO (createPipe)
-#endif
import System.Posix.IO (fdToHandle)
import System.IO (hGetChar, hSetEncoding, utf8)
import System.Random (getStdGen, randomRs)
@@ -116,6 +114,9 @@
, "import qualified IHaskell.Eval.Widgets"
]
+hiddenPackageNames :: Set.Set String
+hiddenPackageNames = Set.fromList ["ghc-lib", "ghc-lib-parser"]
+
-- | Interpreting function for testing.
testInterpret :: Interpreter a -> IO a
testInterpret v = interpret GHC.Paths.libdir False (const v)
@@ -182,7 +183,8 @@
(dflgs, _) <- liftIO $ initPackages dflags
let db = getPackageConfigs dflgs
packageNames = map (packageIdString' dflgs) db
-
+ hiddenPackages = Set.intersection hiddenPackageNames (Set.fromList packageNames)
+ hiddenFlags = fmap HidePackage $ Set.toList hiddenPackages
initStr = "ihaskell-"
#if MIN_VERSION_ghc(8,2,0)
@@ -222,6 +224,8 @@
displayImports = map toImportStmt displayPkgs
+ void $ setSessionDynFlags $ dflgs { packageFlags = hiddenFlags ++ packageFlags dflgs }
+
-- Import implicit prelude.
importDecl <- parseImportDecl "import Prelude"
let implicitPrelude = importDecl { ideclImplicit = True }
@@ -232,10 +236,6 @@
else []
setContext $ map IIDecl $ implicitPrelude : imports
- -- Set -fcontext-stack to 100 (default in ghc-7.10). ghc-7.8 uses 20, which is too small.
- let contextStackFlag = printf "-fcontext-stack=%d" (100 :: Int)
- void $ setFlags [contextStackFlag]
-
return hasIHaskellPackage
-- | Give a value for the `it` variable.
@@ -294,7 +294,7 @@
-- Only run things if there are no parse errors.
[] -> do
when (getLintStatus kernelState /= LintOff) $ liftIO $ do
- lintSuggestions <- lint cmds
+ lintSuggestions <- lint code cmds
unless (noResults lintSuggestions) $
output (FinalResult lintSuggestions [] []) Success
@@ -658,7 +658,7 @@
return mempty
else return $ displayError $ printf "No such directory: '%s'" directory
cmd1 -> liftIO $ do
- (pipe, hdl) <- createPipe'
+ (pipe, hdl) <- createPipe
let initProcSpec = shell $ unwords cmd1
procSpec = initProcSpec
{ std_in = Inherit
@@ -712,16 +712,6 @@
]
loop
- where
-#if MIN_VERSION_base(4,8,0)
- createPipe' = createPipe
-#else
- createPipe' = do
- (readEnd, writeEnd) <- createPipe
- handle <- fdToHandle writeEnd
- pipe <- fdToHandle readEnd
- return (pipe, handle)
-#endif
-- This is taken largely from GHCi's info section in InteractiveUI.
evalCommand _ (Directive GetHelp _) state = do
write state "Help via :help or :?."
@@ -1101,8 +1091,11 @@
writeVariable = var "file_write_var_"
-- Variable where to store old stdout.
- oldVariable = var "old_var_"
+ oldVariableStdout = var "old_var_stdout_"
+ -- Variable where to store old stderr.
+ oldVariableStderr = var "old_var_stderr_"
+
-- Variable used to store true `it` value.
itVariable = var "it_var_"
@@ -1112,9 +1105,12 @@
initStmts =
[ printf "let %s = it" itVariable
, printf "(%s, %s) <- IHaskellIO.createPipe" readVariable writeVariable
- , printf "%s <- IHaskellIO.dup IHaskellIO.stdOutput" oldVariable
+ , printf "%s <- IHaskellIO.dup IHaskellIO.stdOutput" oldVariableStdout
+ , printf "%s <- IHaskellIO.dup IHaskellIO.stdError" oldVariableStderr
, voidpf "IHaskellIO.dupTo %s IHaskellIO.stdOutput" writeVariable
+ , voidpf "IHaskellIO.dupTo %s IHaskellIO.stdError" writeVariable
, voidpf "IHaskellSysIO.hSetBuffering IHaskellSysIO.stdout IHaskellSysIO.NoBuffering"
+ , voidpf "IHaskellSysIO.hSetBuffering IHaskellSysIO.stderr IHaskellSysIO.NoBuffering"
, printf "let it = %s" itVariable
]
@@ -1122,7 +1118,9 @@
postStmts =
[ printf "let %s = it" itVariable
, voidpf "IHaskellSysIO.hFlush IHaskellSysIO.stdout"
- , voidpf "IHaskellIO.dupTo %s IHaskellIO.stdOutput" oldVariable
+ , voidpf "IHaskellSysIO.hFlush IHaskellSysIO.stderr"
+ , voidpf "IHaskellIO.dupTo %s IHaskellIO.stdOutput" oldVariableStdout
+ , voidpf "IHaskellIO.dupTo %s IHaskellIO.stdError" oldVariableStderr
, voidpf "IHaskellIO.closeFd %s" writeVariable
, printf "let it = %s" itVariable
]
@@ -1144,7 +1142,7 @@
-- This works fine on GHC 8.0 and newer
dyn <- dynCompileExpr readVariable
pipe <- case fromDynamic dyn of
- Nothing -> fail "Evaluate: Bad pipe"
+ Nothing -> error "Evaluate: Bad pipe"
Just fd -> liftIO $ do
hdl <- fdToHandle fd
hSetEncoding hdl utf8
diff --git a/src/IHaskell/Eval/Hoogle.hs b/src/IHaskell/Eval/Hoogle.hs
--- a/src/IHaskell/Eval/Hoogle.hs
+++ b/src/IHaskell/Eval/Hoogle.hs
@@ -119,9 +119,7 @@
where
matches (SearchResult resp) =
- case split " " $ self resp of
- name:_ -> strip string == strip name
- _ -> False
+ ("" ++ strip string ++ "") `elem` (split " " $ self resp)
matches _ = False
toDocResult (SearchResult resp) = Just $ DocResult resp
diff --git a/src/IHaskell/Eval/Lint.hs b/src/IHaskell/Eval/Lint.hs
--- a/src/IHaskell/Eval/Lint.hs
+++ b/src/IHaskell/Eval/Lint.hs
@@ -1,16 +1,13 @@
-{-# LANGUAGE NoImplicitPrelude, FlexibleContexts, ViewPatterns #-}
+{-# LANGUAGE NoImplicitPrelude, FlexibleContexts, ViewPatterns, CPP #-}
module IHaskell.Eval.Lint (lint) where
import IHaskellPrelude
-import Prelude (last)
+
import Data.Maybe (mapMaybe)
import System.IO.Unsafe (unsafePerformIO)
-import Language.Haskell.Exts.Syntax hiding (Module)
-import qualified Language.Haskell.Exts.Syntax as SrcExts
-import Language.Haskell.Exts (parseFileContentsWithMode)
import Language.Haskell.Exts hiding (Module)
import Language.Haskell.HLint as HLint
@@ -21,8 +18,16 @@
import IHaskell.Eval.Parser hiding (line)
import StringUtils (replace)
-type ExtsModule = SrcExts.Module SrcSpanInfo
+#if MIN_VERSION_hlint(2,1,18)
+#else
+
+import Prelude (last)
+import qualified Language.Haskell.Exts.Syntax as SrcExts
+import Language.Haskell.Exts (parseFileContentsWithMode)
+
+#endif
+
data LintSuggestion =
Suggest
{ line :: LineNumber
@@ -42,10 +47,47 @@
lintIdent :: String
lintIdent = "lintIdentAEjlkQeh"
+#if MIN_VERSION_hlint(2,1,18)
+
+-- | Given code chunks, perform linting and output a displayable report on linting warnings
+-- and errors.
+lint :: String -> [Located CodeBlock] -> IO Display
+lint code _blocks = do
+ -- Initialize hlint settings
+ initialized <- not <$> isEmptyMVar hlintSettings
+ unless initialized $
+ autoSettings' >>= putMVar hlintSettings
+
+ -- Get hlint settings
+ (flags, classify, hint) <- readMVar hlintSettings
+
+ parsed <- parseModuleEx flags "-" (Just code)
+
+ -- create 'suggestions'
+ let ideas = case parsed of
+ Left _ -> []
+ Right mods -> applyHints classify hint [mods]
+ suggestions = mapMaybe showIdea $ filter (not . ignoredIdea) ideas
+
+ return $ Display $
+ if null suggestions
+ then []
+ else [plain $ concatMap plainSuggestion suggestions, html $ htmlSuggestions suggestions]
+ where
+ autoSettings' = do
+ (fixts, classify, hints) <- autoSettings
+ let hidingIgnore = Classify Ignore "Unnecessary hiding" "" ""
+ return (fixts, hidingIgnore:classify, hints)
+ ignoredIdea idea = ideaSeverity idea == Ignore
+
+#else
+
+type ExtsModule = SrcExts.Module SrcSpanInfo
+
-- | Given parsed code chunks, perform linting and output a displayable report on linting warnings
-- and errors.
-lint :: [Located CodeBlock] -> IO Display
-lint blocks = do
+lint :: String -> [Located CodeBlock] -> IO Display
+lint _code blocks = do
-- Initialize hlint settings
initialized <- not <$> isEmptyMVar hlintSettings
unless initialized $
@@ -70,20 +112,6 @@
return (fixts, hidingIgnore:classify, hints)
ignoredIdea idea = ideaSeverity idea == Ignore
-showIdea :: Idea -> Maybe LintSuggestion
-showIdea idea =
- case ideaTo idea of
- Nothing -> Nothing
- Just wn ->
- Just
- Suggest
- { line = srcSpanStartLine $ ideaSpan idea
- , found = showSuggestion $ ideaFrom idea
- , whyNot = showSuggestion wn
- , severity = ideaSeverity idea
- , suggestion = ideaHint idea
- }
-
createModule :: ParseMode -> Located CodeBlock -> Maybe ExtsModule
createModule md (Located ln block) =
case block of
@@ -153,6 +181,23 @@
imptToModule :: String -> ParseResult ExtsModule
imptToModule = parseFileContentsWithMode md
+
+#endif
+
+showIdea :: Idea -> Maybe LintSuggestion
+showIdea idea =
+ case ideaTo idea of
+ Nothing -> Nothing
+ Just wn ->
+ Just
+ Suggest
+ { line = srcSpanStartLine $ ideaSpan idea
+ , found = showSuggestion $ ideaFrom idea
+ , whyNot = showSuggestion wn
+ , severity = ideaSeverity idea
+ , suggestion = ideaHint idea
+ }
+
plainSuggestion :: LintSuggestion -> String
plainSuggestion suggest =
diff --git a/src/IHaskell/Eval/Parser.hs b/src/IHaskell/Eval/Parser.hs
--- a/src/IHaskell/Eval/Parser.hs
+++ b/src/IHaskell/Eval/Parser.hs
@@ -75,7 +75,11 @@
parseString :: String -> Ghc [Located CodeBlock]
parseString codeString = do
-- Try to parse this as a single module.
- flags <- getSessionDynFlags
+ flags' <- getSessionDynFlags
+ flags <- do
+ result <- liftIO $ parsePragmasIntoDynFlags flags' "" codeString
+ return $ fromMaybe flags' result
+ _ <- setSessionDynFlags flags
let output = runParser flags parserModule codeString
case output of
Parsed mdl
diff --git a/src/IHaskell/IPython.hs b/src/IHaskell/IPython.hs
--- a/src/IHaskell/IPython.hs
+++ b/src/IHaskell/IPython.hs
@@ -17,16 +17,15 @@
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
-import System.Argv0
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 Control.Monad (mplus)
import qualified Paths_ihaskell as Paths
@@ -115,30 +114,13 @@
case pathMay of
Nothing -> badIPython
"No Jupyter / IPython detected -- install Jupyter 3.0+ before using IHaskell."
- Just path -> do
- sout <- SH.silently (SH.run path ["--version"])
- serr <- SH.lastStderr
- let majorVersion = join . fmap listToMaybe . parseVersion . T.unpack
- case mplus (majorVersion serr) (majorVersion sout) of
- Nothing -> badIPython $ T.concat
- [ "Detected Jupyter, but could not parse version number."
- , "\n"
- , "(stdout = "
- , sout
- , ", stderr = "
- , serr
- , ")"
- ]
-
- Just version -> when (version < 3) oldIPython
+ Just _ -> pure ()
where
badIPython :: Text -> SH.Sh ()
badIPython message = liftIO $ do
IO.hPutStrLn IO.stderr (T.unpack message)
exitFailure
- oldIPython = badIPython
- "Detected old version of Jupyter / IPython. IHaskell requires 3.0.0 or up."
-- | Install an IHaskell kernelspec into the right location. The right location is determined by
-- using `ipython kernelspec install --user`.
@@ -192,19 +174,11 @@
home <- T.unpack <$> fromMaybe "~" <$> SH.get_env "HOME"
return $ replace "~" home path
--- | Parse an IPython version string into a list of integers.
-parseVersion :: String -> Maybe [Int]
-parseVersion versionStr =
- let versions = map readMay $ split "." versionStr
- in if all isJust versions
- then Just $ catMaybes versions
- else Nothing
-
-- | Get the absolute path to this IHaskell executable.
getIHaskellPath :: SH.Sh FilePath
getIHaskellPath = do
-- Get the absolute filepath to the argument.
- f <- T.unpack <$> SH.toTextIgnore <$> liftIO getArgv0
+ f <- liftIO getExecutablePath
-- If we have an absolute path, that's the IHaskell we're interested in.
if FP.isAbsolute f
diff --git a/src/tests/IHaskell/Test/Eval.hs b/src/tests/IHaskell/Test/Eval.hs
--- a/src/tests/IHaskell/Test/Eval.hs
+++ b/src/tests/IHaskell/Test/Eval.hs
@@ -169,3 +169,17 @@
#endif
":k Maybe" `becomes` ["Maybe :: * -> *"]
":in String" `pages` ["type String = [Char] \t-- Defined in \8216GHC.Base\8217"]
+
+ it "captures stderr" $ do
+ [hereLit|
+ import Debug.Trace
+ trace "test" 5
+ |] `becomes` ["test\n5"]
+
+ it "immediately applies language extensions" $ do
+ [hereLit|
+ {-# LANGUAGE RankNTypes #-}
+
+ identity :: forall a. a -> a
+ identity a = a
+ |] `becomes` []
diff --git a/src/tests/IHaskell/Test/Parser.hs b/src/tests/IHaskell/Test/Parser.hs
--- a/src/tests/IHaskell/Test/Parser.hs
+++ b/src/tests/IHaskell/Test/Parser.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE CPP #-}
module IHaskell.Test.Parser (testParser) where
import Prelude
@@ -227,4 +228,8 @@
|]) >>= (`shouldBe` [Located 2 (Expression "first"), Located 4 (Expression "second")])
where
dataKindsError = ParseError (Loc 1 10) msg
+#if MIN_VERSION_ghc(8,8,0)
+ msg = "Cannot parse data constructor in a data/newtype declaration:\n 3"
+#else
msg = "Cannot parse data constructor in a data/newtype declaration: 3"
+#endif