ihaskell 0.10.0.0 → 0.10.0.1
raw patch · 11 files changed
+138/−106 lines, 11 filesdep −system-argv0dep −uuiddep ~basedep ~ghcdep ~ghc-boot
Dependencies removed: system-argv0, uuid
Dependency ranges changed: base, ghc, ghc-boot, ghc-parser
Files
- html/kernel.js +0/−2
- ihaskell.cabal +5/−7
- main/Main.hs +10/−18
- src/IHaskell/Convert/Args.hs +6/−0
- src/IHaskell/Eval/Evaluate.hs +22/−24
- src/IHaskell/Eval/Hoogle.hs +1/−3
- src/IHaskell/Eval/Lint.hs +67/−22
- src/IHaskell/Eval/Parser.hs +5/−1
- src/IHaskell/IPython.hs +3/−29
- src/tests/IHaskell/Test/Eval.hs +14/−0
- src/tests/IHaskell/Test/Parser.hs +5/−0
html/kernel.js view
@@ -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'); } }
ihaskell.cabal view
@@ -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,
main/Main.hs view
@@ -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
src/IHaskell/Convert/Args.hs view
@@ -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
src/IHaskell/Eval/Evaluate.hs view
@@ -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
src/IHaskell/Eval/Hoogle.hs view
@@ -119,9 +119,7 @@ where matches (SearchResult resp) =- case split " " $ self resp of- name:_ -> strip string == strip name- _ -> False+ ("<s0>" ++ strip string ++ "</s0>") `elem` (split " " $ self resp) matches _ = False toDocResult (SearchResult resp) = Just $ DocResult resp
src/IHaskell/Eval/Lint.hs view
@@ -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 =
src/IHaskell/Eval/Parser.hs view
@@ -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' "<interactive>" codeString+ return $ fromMaybe flags' result+ _ <- setSessionDynFlags flags let output = runParser flags parserModule codeString case output of Parsed mdl
src/IHaskell/IPython.hs view
@@ -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
src/tests/IHaskell/Test/Eval.hs view
@@ -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` []
src/tests/IHaskell/Test/Parser.hs view
@@ -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