ihaskell 0.6.0.0 → 0.6.1.0

raw patch · 10 files changed

+206/−30 lines, 10 filesdep ~aeson

Dependency ranges changed: aeson

Files

• Hspec.hs +2/−2
• html/kernel.js +8/−2
• ihaskell.cabal +4/−2
• src/IHaskell/Eval/Evaluate.hs +7/−5
• src/IHaskell/Eval/Hoogle.hs +1/−1
• src/IHaskell/Eval/Inspect.hs +51/−0
• src/IHaskell/Eval/Lint.hs +1/−1
• src/IHaskell/IPython/Stdin.hs +113/−0
• src/IHaskell/Types.hs +3/−2
• src/Main.hs +16/−15

@@ -2,7 +2,7 @@ -- Keep all the language pragmas here so it can be compiled separately. module Main where import Prelude-import GHC+import GHC hiding (Qualified) import GHC.Paths import Data.IORef import Control.Monad@@ -62,7 +62,7 @@   interpret libdir False $ Eval.evaluate state string publish   out <- readIORef outputAccum   pagerOut <- readIORef pagerAccum-  return (reverse out, unlines $ reverse pagerOut)+  return (reverse out, unlines . map extractPlain . reverse $ pagerOut)  evaluationComparing comparison string = do     let indent (' ':x) = 1 + indent x

@@ -10,7 +10,7 @@             var onload = function(){                 console.log('Kernel haskell kernel.js is loading.'); -                // add here logic that shoudl be run once per **page load**+                // add here logic that should be run once per **page load**                 // like adding specific UI, or changing the default value                 // of codecell highlight. @@ -47,10 +47,16 @@                             // This is necessary, otherwise sometimes highlighting just doesn't happen.                             // This may be an IPython bug.                             c.code_mirror.setOption('mode', 'ihaskell');-                            c.auto_highlight();+                            c.force_highlight('ihaskell');                         }                     }                 });+                if(IPython.notebook.set_codemirror_mode){+                    // this first one will not be necessary in the future+                    // neither should the loop on all cells above+                    IPython.notebook.set_codemirror_mode('null')+                    IPython.notebook.set_codemirror_mode('ihaskell')+                }                  // Prevent the pager from surrounding everything with a <pre>                 IPython.Pager.prototype.append_text = function (text) {

@@ -7,7 +7,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.6.0.0+version:             0.6.1.0  -- A short (one-line) description of the package. synopsis:            A Haskell backend kernel for the IPython project.@@ -55,7 +55,7 @@   hs-source-dirs:      src   default-language:    Haskell2010   build-depends:       -                       aeson                >=0.6 && < 0.9,+                       aeson                >=0.7 && < 0.9,                        base                 >=4.6 && < 4.9,                        base64-bytestring    >=1.0,                        bytestring           >=0.10,@@ -106,6 +106,7 @@                    IHaskell.Convert.IpynbToLhs                    IHaskell.Convert.LhsToIpynb                    IHaskell.Eval.Completion+                   IHaskell.Eval.Inspect                    IHaskell.Eval.Evaluate                    IHaskell.Eval.Info                    IHaskell.Eval.Lint@@ -114,6 +115,7 @@                    IHaskell.Eval.ParseShell                    IHaskell.Eval.Util                    IHaskell.IPython+                   IHaskell.IPython.Stdin                    IHaskell.Flags                    IHaskell.Types                    IHaskell.BrokenPackages

@@ -12,6 +12,7 @@     liftIO,     typeCleaner,     globalImports,+    formatType,     ) where  import           ClassyPrelude hiding (init, last, liftIO, head, hGetContents, tail, try)@@ -183,9 +184,10 @@                              pkg <- db                              depId <- depends pkg                              dep <- filter ((== depId) . installedPackageId) db-                             guard-                               (iHaskellPkgName `isPrefixOf` packageIdString (packageConfigId dep))+                             let idString = packageIdString' dflags (packageConfigId dep)+                             guard (iHaskellPkgName `isPrefixOf` idString) +                            -- ideally the Paths_ihaskell module could provide a way to get the hash too                            -- (ihaskell-0.2.0.5-f2bce922fa881611f72dfc4a854353b9), for now. Things will end badly if you also                            -- happen to have an ihaskell-0.2.0.5-ce34eadc18cf2b28c8d338d0f3755502 installed.@@ -282,14 +284,14 @@                  when (getLintStatus kernelState /= LintOff) $ liftIO $ do                    lintSuggestions <- lint cmds                    unless (noResults lintSuggestions) $-                     output $ FinalResult lintSuggestions "" []+                     output $ FinalResult lintSuggestions [] []                   runUntilFailure kernelState (map unloc cmds ++ [storeItCommand execCount])                -- Print all parse errors.                errs -> do                  forM_ errs $ \err -> do                    out <- evalCommand output err kernelState-                   liftIO $ output $ FinalResult (evalResult out) "" []+                   liftIO $ output $ FinalResult (evalResult out) [] []                  return kernelState    return updated { getExecutionCounter = execCount + 1 }@@ -315,7 +317,7 @@       -- Output things only if they are non-empty.       let empty = noResults result && null helpStr && null (evalComms evalOut)       unless empty $-        liftIO $ output $ FinalResult result helpStr (evalComms evalOut)+        liftIO $ output $ FinalResult result [plain helpStr] (evalComms evalOut)        -- Make sure to clear all comms we've started.       let newState = evalState evalOut { evalComms = [] }

@@ -66,7 +66,7 @@ urlEncode :: String -> String urlEncode [] = [] urlEncode (ch:t)-  | (isAscii ch && isAlphaNum ch) || ch `P.elem` "-_.~" = ch : urlEncode t+  | (isAscii ch && isAlphaNum ch) || ch `P.elem` ("-_.~" :: String) = ch : urlEncode t   | not (isAscii ch) = P.foldr escape (urlEncode t) (eightBs [] (P.fromEnum ch))   | otherwise = escape (P.fromEnum ch) (urlEncode t)   where

@@ -0,0 +1,51 @@+{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings, DoAndIfThenElse, FlexibleContexts #-}++{- |+Description:    Generates inspections when asked for by the frontend.++-}+module IHaskell.Eval.Inspect (inspect) where++import           ClassyPrelude+import qualified Prelude as P++import           Data.List.Split (splitOn)++import           Exception (ghandle)++import           IHaskell.Eval.Evaluate (Interpreter)+import           IHaskell.Display+import           IHaskell.Eval.Util (getType)+import           IHaskell.Types++-- | Characters used in Haskell operators.+operatorChars :: String+operatorChars = "!#$%&*+./<=>?@\\^|-~:"++-- | Whitespace characters.+whitespace :: String+whitespace = " \t\n"++-- | Compute the identifier that is being queried.+getIdentifier :: String -> Int -> String+getIdentifier code pos = identifier+  where+    chunks = splitOn whitespace code+    lastChunk = P.last chunks :: String+    identifier =+      if all (`elem` operatorChars) lastChunk+        then "(" ++ lastChunk ++ ")"+        else lastChunk+++inspect :: String -- ^ Code in the cell+        -> Int    -- ^ Cursor position in the cell+        -> Interpreter (Maybe Display)+inspect code pos = do+  let identifier = getIdentifier code pos+      handler :: SomeException -> Interpreter (Maybe a)+      handler _  = return Nothing+  response <- ghandle handler (Just <$> getType identifier)+  let prefix = identifier ++ " :: "+      fmt str = Display [plain $ prefix ++ str]+  return $ fmt <$> response

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude, QuasiQuotes, ViewPatterns #-}+{-# LANGUAGE FlexibleContexts, NoImplicitPrelude, QuasiQuotes, ViewPatterns #-}  module IHaskell.Eval.Lint (lint) where 

@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings, DoAndIfThenElse #-}++-- | This module provides a way in which the Haskell standard input may be forwarded to the IPython+-- frontend and thus allows the notebook to use the standard input.+--+-- This relies on the implementation of file handles in GHC, and is generally unsafe and terrible.+-- However, it is difficult to find another way to do it, as file handles are generally meant to+-- point to streams and files, and not networked communication protocols.+--+-- In order to use this module, it must first be initialized with two things. First of all, in order+-- to know how to communicate with the IPython frontend, it must know the kernel profile used for+-- communication. For this, use @recordKernelProfile@ once the profile is known. Both this and+-- @recordParentHeader@ take a directory name where they can store this data.+--+-- Finally, the module must know what @execute_request@ message is currently being replied to (which+-- will request the input). Thus, every time the language kernel receives an @execute_request@+-- message, it should inform this module via @recordParentHeader@, so that the module may generate+-- messages with an appropriate parent header set. If this is not done, the IPython frontends will+-- not recognize the target of the communication.+--+-- Finally, in order to activate this module, @fixStdin@ must be called once. It must be passed the+-- same directory name as @recordParentHeader@ and @recordKernelProfile@. Note that if this is being+-- used from within the GHC API, @fixStdin@ /must/ be called from within the GHC session not from+-- the host code.+module IHaskell.IPython.Stdin (fixStdin, recordParentHeader, recordKernelProfile) where++import           Control.Concurrent+import           Control.Applicative ((<$>))+import           Control.Concurrent.Chan+import           Control.Monad+import           GHC.IO.Handle+import           GHC.IO.Handle.Types+import           System.IO+import           System.Posix.IO+import           System.IO.Unsafe+import qualified Data.Map as Map++import           IHaskell.IPython.Types+import           IHaskell.IPython.ZeroMQ+import           IHaskell.IPython.Message.UUID as UUID++stdinInterface :: MVar ZeroMQStdin+{-# NOINLINE stdinInterface #-}+stdinInterface = unsafePerformIO newEmptyMVar++-- | Manipulate standard input so that it is sourced from the IPython frontend. This function is+-- build on layers of deep magical hackery, so be careful modifying it.+fixStdin :: String -> IO ()+fixStdin dir = do+  -- Initialize the stdin interface.+  profile <- read <$> readFile (dir ++ "/.kernel-profile")+  interface <- serveStdin profile+  putMVar stdinInterface interface+  void $ forkIO $ stdinOnce dir++stdinOnce :: String -> IO ()+stdinOnce dir = do+  -- Create a pipe using and turn it into handles.+  (readEnd, writeEnd) <- createPipe+  newStdin <- fdToHandle readEnd+  stdinInput <- fdToHandle writeEnd+  hSetBuffering newStdin NoBuffering+  hSetBuffering stdinInput NoBuffering++  -- Store old stdin and swap in new stdin.+  oldStdin <- hDuplicate stdin+  hDuplicateTo newStdin stdin++  loop stdinInput oldStdin newStdin++  where+    loop stdinInput oldStdin newStdin = do+      let FileHandle _ mvar = stdin+      threadDelay $ 150 * 1000+      empty <- isEmptyMVar mvar+      if not empty+        then loop stdinInput oldStdin newStdin+        else do+          line <- getInputLine dir+          hPutStr stdinInput $ line ++ "\n"+          loop stdinInput oldStdin newStdin++-- | Get a line of input from the IPython frontend.+getInputLine :: String -> IO String+getInputLine dir = do+  StdinChannel req rep <- readMVar stdinInterface++  -- Send a request for input.+  uuid <- UUID.random+  parentHeader <- read <$> readFile (dir ++ "/.last-req-header")+  let header = MessageHeader+        { username = username parentHeader+        , identifiers = identifiers parentHeader+        , parentHeader = Just parentHeader+        , messageId = uuid+        , sessionId = sessionId parentHeader+        , metadata = Map.fromList []+        , msgType = InputRequestMessage+        }+  let msg = RequestInput header ""+  writeChan req msg++  -- Get the reply.+  InputReply _ value <- readChan rep+  return value++recordParentHeader :: String -> MessageHeader -> IO ()+recordParentHeader dir header =+  writeFile (dir ++ "/.last-req-header") $ show header++recordKernelProfile :: String -> Profile -> IO ()+recordKernelProfile dir profile =+  writeFile (dir ++ "/.kernel-profile") $ show profile

@@ -127,7 +127,7 @@   , useSvg = True   , useShowErrors = False   , useShowTypes = False-  , usePager = False+  , usePager = True   , openComms = empty   , kernelDebug = False   }@@ -173,7 +173,8 @@                       |                         FinalResult                           { outputs :: Display        -- ^ Display outputs.-                          , pagerOut :: String        -- ^ Text to display in the IPython pager.+                          , pagerOut :: [DisplayData] -- ^ Mimebundles to display in the IPython+                                                      -- pager.                           , startComms :: [CommInfo]  -- ^ Comms to start.                           }   deriving Show

@@ -19,10 +19,12 @@ import           System.Posix.Signals import qualified Data.Map as Map import           Data.String.Here (hereFile)+import qualified Data.Text as T  -- IHaskell imports. import           IHaskell.Convert (convert) import           IHaskell.Eval.Completion (complete)+import           IHaskell.Eval.Inspect (inspect) import           IHaskell.Eval.Evaluate import           IHaskell.Display import           IHaskell.Eval.Info@@ -235,7 +237,7 @@   -- re-display with the updated output.   displayed <- liftIO $ newMVar []   updateNeeded <- liftIO $ newMVar False-  pagerOutput <- liftIO $ newMVar ""+  pagerOutput <- liftIO $ newMVar []   let clearOutput = do         header <- dupHeader replyHeader ClearOutputMessage         send $ ClearOutput header True@@ -296,8 +298,8 @@           let pager = pagerOut result           unless (null pager) $             if usePager state-              then modifyMVar_ pagerOutput (return . (++ pager ++ "\n"))-              else sendOutput $ Display [html pager]+              then modifyMVar_ pagerOutput (return . (++ pager))+              else sendOutput $ Display pager    let execCount = getExecutionCounter state   -- Let all frontends know the execution count and code that's about to run@@ -314,7 +316,7 @@   -- Take pager output if we're using the pager.   pager <- if usePager state              then liftIO $ readMVar pagerOutput-             else return ""+             else return []   return     (updatedState, ExecuteReply                      { header = replyHeader@@ -334,17 +336,16 @@       reply = CompleteReply replyHeader (map pack completions) start end Map.empty True   return (state, reply) --- Reply to the object_info_request message. Given an object name, return the associated type--- calculated by GHC.-replyTo _ ObjectInfoRequest { objectName = oname } replyHeader state = do-  docs <- pack <$> info (unpack oname)-  let reply = ObjectInfoReply-        { header = replyHeader-        , objectName = oname-        , objectFound = strip docs /= ""-        , objectTypeString = docs-        , objectDocString = docs-        }+replyTo _ req@InspectRequest{} replyHeader state = do+  result <- inspect (unpack $ inspectCode req) (inspectCursorPos req)+  let reply =+        case result of+          Just (Display datas) -> InspectReply+            { header = replyHeader+            , inspectStatus = True+            , inspectData = datas+            }+          _ -> InspectReply { header = replyHeader, inspectStatus = False, inspectData = [] }   return (state, reply)  -- TODO: Implement history_reply.