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.2 +version: 0.10.1.0 -- A short (one-line) description of the package. synopsis: A Haskell backend kernel for the IPython project. @@ -87,8 +87,8 @@ unordered-containers -any, utf8-string -any, vector -any, - ipython-kernel >=0.9.1, - ghc-boot >=8.0 && <8.9 + ipython-kernel >=0.10.2.0, + ghc-boot >=8.0 && <8.11 exposed-modules: IHaskell.Display IHaskell.Convert @@ -135,10 +135,10 @@ default-language: Haskell2010 build-depends: ihaskell -any, - base >=4.9 && < 4.14, + base >=4.9 && < 4.15, text >=0.11, transformers -any, - ghc >=8.0 && < 8.9, + ghc >=8.0 && < 8.11, process >=1.1, aeson >=0.7, bytestring >=0.10, @@ -147,7 +147,7 @@ strict >=0.3, unix >= 2.6, directory -any, - ipython-kernel >=0.7, + ipython-kernel >=0.10, unordered-containers -any Test-Suite hspec diff --git a/main/Main.hs b/main/Main.hs --- a/main/Main.hs +++ b/main/Main.hs @@ -221,7 +221,7 @@ err = error $ "No reply for message " ++ show (mhMsgType parent) return $ MessageHeader (mhIdentifiers parent) (Just parent) mempty - newMessageId (mhSessionId parent) (mhUsername parent) repType + newMessageId (mhSessionId parent) (mhUsername parent) repType [] -- | Compute a reply to a message. replyTo :: ZeroMQInterface -> Message -> MessageHeader -> KernelState -> Interpreter (KernelState, Message) diff --git a/src/IHaskell/Display.hs b/src/IHaskell/Display.hs --- a/src/IHaskell/Display.hs +++ b/src/IHaskell/Display.hs @@ -37,6 +37,7 @@ vega, vegalite, vdom, + custom, many, -- ** Image and data encoding functions @@ -115,6 +116,11 @@ -- | Generate a Vdom display. vdom :: String -> DisplayData vdom = DisplayData MimeVdom . T.pack + +-- | Generate a custom display. The first argument is the mimetype and the second argument is the +-- payload. +custom :: T.Text -> String -> DisplayData +custom mimetype = DisplayData (MimeCustom mimetype) . T.pack -- | Generate a Markdown display. markdown :: String -> DisplayData 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 @@ -28,6 +28,7 @@ import Data.Char as Char import Data.Dynamic import qualified Data.Serialize as Serialize +import qualified Debugger import System.Directory import System.Posix.IO (fdToHandle) import System.IO (hGetChar, hSetEncoding, utf8) @@ -735,11 +736,12 @@ , " :type - Print expression type." , " :info - Print all info for a name." , " :hoogle - Search for a query on Hoogle." - , " :doc - Get documentation for an identifier via Hogole." + , " :doc - Get documentation for an identifier via Hoogle." , " :set -XFlag -Wall - Set an option (like ghci)." , " :option - Set an option." , " :option no- - Unset an option." , " :?, :help - Show this help text." + , " :sprint - Print a value without forcing evaluation." , "" , "Any prefix of the commands will also suffice, e.g. use :ty for :type." , "" @@ -785,6 +787,17 @@ results <- liftIO $ Hoogle.document query return $ hoogleResults state results +evalCommand _ (Directive SPrint binding) state = wrapExecution state $ do + flags <- getSessionDynFlags + contents <- liftIO $ newIORef [] + let action = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' contents (showSDoc flags msg :) + let flags' = flags { log_action = action } + _ <- setSessionDynFlags flags' + Debugger.pprintClosureCommand False False binding + _ <- setSessionDynFlags flags + sprint <- liftIO $ readIORef contents + return $ formatType (unlines sprint) + evalCommand output (Statement stmt) state = wrapExecution state $ evalStatementOrIO output state (CapturedStmt stmt) @@ -1072,7 +1085,11 @@ return $ displayError $ "Failed to load module " ++ modName ++ ": " ++ show exception objTarget :: DynFlags -> HscTarget +#if MIN_VERSION_ghc(8,10,0) +objTarget = defaultObjectTarget +#else objTarget flags = defaultObjectTarget $ targetPlatform flags +#endif data Captured a = CapturedStmt String | CapturedIO (IO a) 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 @@ -8,10 +8,14 @@ import Data.Maybe (mapMaybe) import System.IO.Unsafe (unsafePerformIO) +#if MIN_VERSION_hlint(3,0,0) +import Language.Haskell.HLint +import SrcLoc (SrcSpan(..), srcSpanStartLine) +#else import Language.Haskell.Exts hiding (Module) - import Language.Haskell.HLint as HLint import Language.Haskell.HLint3 +#endif import IHaskell.Types import IHaskell.Display @@ -191,14 +195,24 @@ Just wn -> Just Suggest - { line = srcSpanStartLine $ ideaSpan idea + { line = getSrcSpanStartLine $ ideaSpan idea , found = showSuggestion $ ideaFrom idea , whyNot = showSuggestion wn , severity = ideaSeverity idea , suggestion = ideaHint idea } + where + getSrcSpanStartLine span = +#if MIN_VERSION_hlint(3,0,0) + case span of + RealSrcSpan realSpan -> srcSpanStartLine realSpan + UnhelpfulSpan _ -> 1 +#else + srcSpanStartLine span +#endif + plainSuggestion :: LintSuggestion -> String plainSuggestion suggest = printf "Line %d: %s\nFound:\n%s\nWhy not:\n%s" (line suggest) (suggestion suggest) (found suggest) @@ -212,12 +226,13 @@ [ named $ suggestion suggest , floating "left" $ styl severityClass "Found:" ++ -- Things that look like this get highlighted. - styleId "highlight-code" "haskell" (found suggest) + styleId "highlight-code" "haskell" (escapeDollar $ found suggest) , floating "left" $ styl severityClass "Why Not:" ++ -- Things that look like this get highlighted. - styleId "highlight-code" "haskell" (whyNot suggest) + styleId "highlight-code" "haskell" (escapeDollar $ whyNot suggest) ] where + escapeDollar = replace "$" "\\$" severityClass = case severity suggest of Error -> "error" 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 @@ -63,6 +63,7 @@ | GetDoc -- ^ Get documentation for an identifier via Hoogle. | GetKind -- ^ Get the kind of a type via ':kind'. | LoadModule -- ^ Load and unload modules via ':module'. + | SPrint -- ^ Print without evaluating via ':sprint'. deriving (Show, Eq) -- | Pragma types. Only LANGUAGE pragmas are currently supported. Other pragma types are kept around @@ -285,6 +286,7 @@ , (SetExtension, "extension") , (GetHelp, "?") , (GetHelp, "help") + , (SPrint, "sprint") ] parseDirective _ _ = error "Directive must start with colon!" @@ -293,7 +295,11 @@ -- piece by piece. getModuleName :: GhcMonad m => String -> m [String] getModuleName moduleSrc = do - flags <- getSessionDynFlags + flags' <- getSessionDynFlags + flags <- do + result <- liftIO $ parsePragmasIntoDynFlags flags' "" moduleSrc + return $ fromMaybe flags' result + _ <- setSessionDynFlags flags let output = runParser flags parserModule moduleSrc case output of Failure{} -> error "Module parsing failed." diff --git a/src/IHaskell/Eval/Util.hs b/src/IHaskell/Eval/Util.hs --- a/src/IHaskell/Eval/Util.hs +++ b/src/IHaskell/Eval/Util.hs @@ -115,7 +115,9 @@ is_on = test f dflags quiet = not show_all && test f default_dflags == is_on -#if MIN_VERSION_ghc(8,6,0) +#if MIN_VERSION_ghc(8,10,0) + default_dflags = defaultDynFlags (settings dflags) (llvmConfig dflags) +#elif MIN_VERSION_ghc(8,6,0) default_dflags = defaultDynFlags (settings dflags) (llvmTargets dflags, llvmPasses dflags) #elif MIN_VERSION_ghc(8,4,0) default_dflags = defaultDynFlags (settings dflags) (llvmTargets dflags) @@ -167,7 +169,9 @@ quiet = not show_all && test f default_dflags == is_on default_dflags = -#if MIN_VERSION_ghc(8,6,0) +#if MIN_VERSION_ghc(8,10,0) + defaultDynFlags (settings dflags) (llvmConfig dflags) `lang_set` +#elif MIN_VERSION_ghc(8,6,0) defaultDynFlags (settings dflags) (llvmTargets dflags, llvmPasses dflags) `lang_set` #elif MIN_VERSION_ghc(8,4,0) defaultDynFlags (settings dflags) (llvmTargets dflags) `lang_set` @@ -319,7 +323,11 @@ #endif importOf _ (IIModule _) = False importOf imp (IIDecl decl) = +#if MIN_VERSION_ghc(8,10,0) + ((==) `on` (unLoc . ideclName)) decl imp && not (isImportDeclQualified $ ideclQualified decl) +#else ((==) `on` (unLoc . ideclName)) decl imp && not (ideclQualified decl) +#endif -- Check whether an import is an *implicit* import of something. #if MIN_VERSION_ghc(8,4,0) diff --git a/src/IHaskell/IPython/Stdin.hs b/src/IHaskell/IPython/Stdin.hs --- a/src/IHaskell/IPython/Stdin.hs +++ b/src/IHaskell/IPython/Stdin.hs @@ -94,6 +94,7 @@ . readMay <$> readFile fpath let hdr = MessageHeader (mhIdentifiers parentHdr) (Just parentHdr) mempty uuid (mhSessionId parentHdr) (mhUsername parentHdr) InputRequestMessage + [] let msg = RequestInput hdr "" writeChan req msg diff --git a/src/StringUtils.hs b/src/StringUtils.hs --- a/src/StringUtils.hs +++ b/src/StringUtils.hs @@ -9,6 +9,7 @@ import IHaskellPrelude import qualified Data.Text as T +import Data.List.Split (splitOn) lstrip :: String -> String lstrip = dropWhile (`elem` (" \t\r\n" :: String)) @@ -24,4 +25,4 @@ T.unpack $ T.replace (T.pack needle) (T.pack replacement) (T.pack haystack) split :: String -> String -> [String] -split delim = map T.unpack . T.splitOn (T.pack delim) . T.pack +split = splitOn 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 @@ -168,7 +168,11 @@ ":typ 3" `becomes` ["3 :: forall t. Num t => t"] #endif ":k Maybe" `becomes` ["Maybe :: * -> *"] +#if MIN_VERSION_ghc(8,10,0) + ":in String" `pages` ["type String :: *\ntype String = [Char]\n \t-- Defined in \8216GHC.Base\8217"] +#else ":in String" `pages` ["type String = [Char] \t-- Defined in \8216GHC.Base\8217"] +#endif it "captures stderr" $ do [hereLit| 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 @@ -227,7 +227,11 @@ second |]) >>= (`shouldBe` [Located 2 (Expression "first"), Located 4 (Expression "second")]) where +#if MIN_VERSION_ghc(8,10,0) + dataKindsError = ParseError (Loc 1 11) msg +#else dataKindsError = ParseError (Loc 1 10) msg +#endif #if MIN_VERSION_ghc(8,8,0) msg = "Cannot parse data constructor in a data/newtype declaration:\n 3" #else