Merge remote-tracking branch 'upstream/master' into path_completion

.ghci

 :set -package ghc
 :set -package ghc-paths
 :set -optP-include -optPdist/build/autogen/cabal_macros.h
+:set -i. -isrc -idist/build/autogen
 :set -XDoAndIfThenElse -XNoImplicitPrelude -XOverloadedStrings

IHaskell.cabal

@@ -46,6 +46,7 @@ data-files:
   profile/profile.tar
 
 library
+  hs-source-dirs:      src
   build-depends:       base ==4.6.*,
                        hlint,
                        cmdargs >= 0.10,
@@ -75,8 +76,7 @@ library
                        filepath,
                        cereal ==0.3.*,
                        text >=0.11,
-                       mtl >= 2.1,
-                       template-haskell
+                       mtl >= 2.1
   exposed-modules: IHaskell.Display,
                    Paths_ihaskell,
                    IHaskell.Types,
@@ -84,6 +84,7 @@ library
 
 executable IHaskell
   -- .hs or .lhs file containing the Main module.
+  hs-source-dirs:      src
   main-is:             Main.hs
 
   build-tools:         happy, cpphs
@@ -102,7 +103,6 @@ executable IHaskell
              IHaskell.Types
              IHaskell.ZeroMQ
              IHaskell.Display
-             IHaskell.Config
 
   extensions: DoAndIfThenElse
   
@@ -136,8 +136,7 @@ executable IHaskell
                        filepath,
                        cereal ==0.3.*,
                        text >=0.11,
-                       mtl >= 2.1,
-                       template-haskell
+                       mtl >= 2.1
 
 Test-Suite hspec
   Type:     exitcode-stdio-1.0
@@ -170,8 +169,7 @@ Test-Suite hspec
                        system-filepath,
                        cereal ==0.3.*,
                        text >=0.11,
-                       mtl >= 2.1,
-                       template-haskell
+                       mtl >= 2.1
 
 source-repository head
   type:     git

IHaskell/Config.hs

-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
--- | Description : IPython configuration files are compiled-into IHaskell
-module IHaskell.Config (ipython, notebook, console, qtconsole, customjs, notebookJavascript) where
-
-import Data.String.Here
-import ClassyPrelude
-
-ipython :: String -> String
-ipython executable = [template|config/ipython_config.py|]
-
-notebook :: String
-notebook = [template|config/ipython_notebook_config.py|]
-
-console :: String
-console = [template|config/ipython_console_config.py|]
-
-qtconsole :: String
-qtconsole = [template|config/ipython_qtconsole_config.py|]
-
-customjs :: String
-customjs = [template|config/custom.js|]
-
-notebookJavascript :: [(FilePath, String)]
-notebookJavascript = [("tooltip.js", [template|deps/tooltip.js|]),
-                      ("codecell.js", [template|deps/codecell.js|])]

README.md

@@ -69,8 +69,7 @@ Compilation Tools
 ---
 Install the `happy` parser generator tool and `cpphs` preprocessor:
 ```bash
-cabal install happy
-cabal install cpphs
+cabal install happy cpphs
 ```
 
 IHaskell Installation
@@ -148,10 +147,17 @@ The will hide all packages not listed in the
 
 **Using GHCi directly**
 
-If you don't want to use cabal repl, you can just call ghci with the appropriate options. You can find these in the IHaskell.cabal file. 
+If you don't want to use `cabal repl`, you can just call ghci which can read the `.ghci` file included in the repository for the options.
 
 ```bash
-ghci -XDoAndIfThenElse -XNoImplicitPrelude -XOverloadedStrings -package ghc -optP-include -optPdist/build/autogen/cabal_macros.h
+cd <path-to-IHaskell>
+chmod 600 .ghci # trust the .ghci file
+ghci
 ```
+Then in the ghci session  you can type things like:
 
-If you just call ghci, it will use the options present in the .ghci file that comes with the IHaskell repo. 
+```
+:load src/Hspec.hs
+hspec parserTests
+:browse IHaskell.Types
+```

profile/ipython_config.py

@@ -2,8 +2,8 @@
 # exe:    Path to IHaskell kernel.
 c = get_config()
 c.KernelManager.kernel_cmd = [exe, 'kernel', '{connection_file}']
-c.Session.key = ''
-c.Session.keyfile = ''
+c.Session.key = b''
+c.Session.keyfile = b''
 
 # Syntax highlight properly in Haskell notebooks. 
 c.NbConvertBase.default_language = "haskell"

profile/static/custom/conceal/conceal.js

@@ -53,7 +53,19 @@ var concealExtension = (function() {
 
     // Process a non-infix conceal token.
     function markNonInfixToken(editor, line, token) {
-        // First, check if this is a normal concealable element. (non-infix)
+        // We have a special case for the dot operator.
+        // This is because CodeMirror parses some bits of Haskell incorrectly.
+        // For instance: [1..100] gets parsed as a number "1." followed by a dot ".".
+        // This causes the "." to become marked, although it shouldn't be.
+        if (token.string == ".") {
+            var prev = prevToken(editor, token, line);
+            var prevStr = prev.string;
+            if(prevStr[prevStr.length - 1] == ".") {
+                return false;
+            }
+        }
+
+        // Check if this is a normal concealable element. (non-infix)
         for (var str in conceals) {
             if (conceals.hasOwnProperty(str)) {
                 if (token.string == str) {

profile/static/custom/custom.css

 /*
 Custom IHaskell CSS.
 */
+
+/* Styles used for basic displays */
+.get-type {
+    color: green;
+    font-weight: bold;
+    font-family: monospace;
+}
+
+.err-msg {
+    color: red;
+    font-style: italic;
+    font-family: monospace;
+    white-space: pre;
+}
+
+
+/* Code that will get highlighted before it is highlighted */
 .highlight-code {
     white-space: pre;
     font-family: monospace;
 }
+
+/* Hlint styles */
 .suggestion-warning { 
     font-weight: bold;
     color: rgb(200, 130, 0);

profile/static/custom/custom.js

@@ -53,7 +53,7 @@ $([IPython.events]).on('notebook_loaded.Notebook', function(){
     // add here logic that should be run once per **notebook load**
     // (!= page load), like restarting a checkpoint
 
-    var md = IPython.notebook.metadata 
+    var md = IPython.notebook.metadata;
     if(md.language){
         console.log('language already defined and is :', md.language);
     } else {
@@ -71,14 +71,21 @@ $([IPython.events]).on('app_initialized.NotebookApp', function(){
         cells = IPython.notebook.get_cells();
         for(var i in cells){
             c = cells[i];
-            if (c.cell_type === 'code'){
+            if (c.cell_type === 'code') {
+                // Force the mode to be Haskell
+                // This is necessary, otherwise sometimes highlighting just doesn't happen.
+                // This may be an IPython bug.
+                c.code_mirror.setOption('mode', 'haskell');
+
                 c.auto_highlight()
             }
         }
-    })
+
+        // We can only load the conceal scripts once all cells have mode 'haskell'
+        require(['/static/custom/conceal/conceal.js']);
+    });
 
     IPython.CodeCell.options_default['cm_config']['mode'] = 'haskell';
-    require(['/static/custom/conceal/conceal.js']);
 });
 
 var highlightCodes = function() {

Hspec.hs → src/Hspec.hs

 {-# LANGUAGE QuasiQuotes #-}
+module Main where
+import Prelude
 import GHC
 import GHC.Paths
 import Data.IORef
@@ -7,6 +9,7 @@ import Data.List
 import System.Directory
 import Data.String.Here
 import Data.String.Utils (strip, replace)
+import Data.Monoid
 
 import IHaskell.Eval.Parser
 import IHaskell.Types
@@ -33,7 +36,7 @@ eval string = do
   outputAccum <- newIORef []
   let publish final displayDatas = when final $ modifyIORef outputAccum (displayDatas :)
   getTemporaryDirectory >>= setCurrentDirectory
-  let state = KernelState 1 LintOff "."
+  let state = defaultKernelState { getLintStatus = LintOff }
   interpret $ Eval.evaluate state string publish
   out <- readIORef outputAccum
   return $ reverse out
@@ -283,7 +286,7 @@ parseStringTests = describe "Parser" $ do
 
   it "parses :set x" $
     parses ":set x" `like` [
-      Directive HelpForSet "x"
+      Directive SetOpt "x"
     ]
 
   it "parses :extension x" $

IHaskell/Display.hs → src/IHaskell/Display.hs

 {-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
 module IHaskell.Display (
   IHaskellDisplay(..),
   plain, html, png, jpg, svg, latex,
-  serializeDisplay
+  serializeDisplay,
+  Width, Height, Base64Data
   ) where
 
 import ClassyPrelude
@@ -13,9 +13,17 @@ import Data.String.Utils (rstrip)
 
 import IHaskell.Types
 
+type Base64Data = String
+
 -- | A class for displayable Haskell types.
+--
+-- IHaskell's displaying of results behaves as if these two
+-- overlapping/undecidable instances also existed:
+-- 
+-- > instance (Show a) => IHaskellDisplay a
+-- > instance Show a where shows _ = id
 class IHaskellDisplay a where
-  display :: a -> [DisplayData]
+  display :: a -> IO [DisplayData]
 
 -- | Generate a plain text display.
 plain :: String -> DisplayData
@@ -25,11 +33,11 @@ plain = Display PlainText . rstrip
 html :: String -> DisplayData
 html = Display MimeHtml
 
-png :: String -> DisplayData
-png = Display MimePng 
+png :: Width -> Height -> Base64Data -> DisplayData
+png width height = Display (MimePng width height)
 
-jpg :: String -> DisplayData
-jpg = Display MimeJpg
+jpg :: Width -> Height -> Base64Data -> DisplayData
+jpg width height = Display (MimeJpg width height)
 
 svg :: String -> DisplayData
 svg = Display MimeSvg

IHaskell/Eval/Completion.hs → src/IHaskell/Eval/Completion.hs

 {-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
-{- | Description : generates tab-completion options
-
-  context-insensitive completion for what is probably
-  the identifier under the cursor.
-  
-  [@Known issues@]
-
-  > import Data.Lef<tab>
-  > System.IO.h<tab>
-  > Just.he<tab>
-
-  The first should not complete to Left. The second should only
-  include things like System.IO.hPutStrLn, not head. Qualified
-  names should not be confused by the third option.
+{- |
+Description : Generates tab completion options.
+
+This has a limited amount of context sensitivity. It distinguishes between four contexts at the moment:
+- import statements (completed using modules)
+- identifiers (completed using in scope values)
+- extensions via :ext (completed using GHC extensions)
+- qualified identifiers (completed using in-scope values)
 
 -}
 module IHaskell.Eval.Completion (complete, completionTarget, completionType, CompletionType(..)) where

IHaskell/Eval/Evaluate.hs → src/IHaskell/Eval/Evaluate.hs

-{-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE DoAndIfThenElse, NoOverloadedStrings #-}
 {- | Description : Wrapper around GHC API, exposing a single `evaluate` interface that runs
                    a statement, declaration, import, or directive.
 
@@ -12,7 +12,7 @@ import ClassyPrelude hiding (liftIO, hGetContents, try)
 import Control.Concurrent (forkIO, threadDelay)
 import Prelude (putChar, head, tail, last, init, (!!))
 import Data.List.Utils
-import Data.List(findIndex)
+import Data.List(findIndex, and)
 import Data.String.Utils
 import Text.Printf
 import Data.Char as Char
@@ -24,6 +24,7 @@ import System.Posix.IO
 import System.IO (hGetChar, hFlush)
 import System.Random (getStdGen, randomRs)
 import Unsafe.Coerce
+import Control.Monad (guard)
 
 import NameSet
 import Name
@@ -52,6 +53,9 @@ import IHaskell.Eval.Parser
 import IHaskell.Eval.Lint
 import IHaskell.Display
 
+import Paths_ihaskell (version)
+import Data.Version (versionBranch)
+
 data ErrorOccurred = Success | Failure deriving Show
 
 debug :: Bool
@@ -101,15 +105,38 @@ interpret action = runGhc (Just libdir) $ do
 -- | Initialize our GHC session with imports and a value for 'it'.
 initializeImports :: Interpreter ()
 initializeImports = do
-  -- Load packages that start with ihaskell-* and aren't just IHaskell.
+  -- Load packages that start with ihaskell-*, aren't just IHaskell,
+  -- and depend directly on the right version of the ihaskell library
   dflags <- getSessionDynFlags
   displayPackages <- liftIO $ do
     (dflags, _) <- initPackages dflags
     let Just db = pkgDatabase dflags
         packageNames = map (packageIdString . packageConfigId) db
+
         initStr = "ihaskell-"
-        ihaskellPkgs = filter (startswith initStr) packageNames
-        displayPkgs = filter (isAlpha . (!! (length initStr + 1))) ihaskellPkgs
+        -- "ihaskell-1.2.3.4"
+        iHaskellPkgName = initStr ++ intercalate "." (map show (versionBranch version))
+
+        dependsOnRight pkg = not $ null $ do
+            pkg <- db
+            depId <- depends pkg
+            dep <- filter ((== depId) . installedPackageId) db
+            guard (iHaskellPkgName `isPrefixOf` packageIdString (packageConfigId dep))
+
+        -- 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.
+        iHaskellPkg = case filter (== iHaskellPkgName) packageNames of
+                [x] -> x
+                [] -> error ("cannot find required haskell library: "++iHaskellPkgName)
+                _ -> error ("multiple haskell packages "++iHaskellPkgName++" found")
+
+        displayPkgs = [ pkgName
+                  | pkgName <- packageNames,
+                    Just (x:_) <- [stripPrefix initStr pkgName],
+                    isAlpha x]
+
     return displayPkgs
 
   -- Generate import statements all Display modules.
@@ -305,17 +332,6 @@ evalCommand _ (Directive SetExtension exts) state = wrapExecution state $ do
     -- In that case, we disable the extension.
     flagMatchesNo ext (name, _, _) = ext == "No"  ++ name
 
-evalCommand _ (Directive SetLint status) state = do
-  let isOn = "on" == strip status
-  let isOff = "off" == strip status
-  return $ if isOn
-           then EvalOut Success [] (state { getLintStatus = LintOn })
-           else if isOff
-             then EvalOut Success [] (state { getLintStatus = LintOff })
-             else EvalOut Failure err state
-  where
-    err = displayError $ "Unknown hlint command: " ++ status
-
 evalCommand _ (Directive GetType expr) state = wrapExecution state $ do
   write $ "Type: " ++ expr
   result <- exprType expr
@@ -339,18 +355,33 @@ evalCommand _ (Directive LoadFile name) state = wrapExecution state $ do
 
 
 -- This is taken largely from GHCi's info section in InteractiveUI.
-evalCommand _ (Directive HelpForSet _) state = do
-  write "Help for :set."
+evalCommand _ (Directive SetOpt option) state = do
+  let opt = strip option
+      newState = setOpt opt state
+      out = case newState of
+        Nothing -> displayError $ "Unknown option: " ++ opt
+        Just _ -> []
+
   return EvalOut {
-    evalStatus = Success,
-    evalResult = [out],
-    evalState = state
+    evalStatus = if isJust newState then Success else Failure,
+    evalResult = out,
+    evalState = fromMaybe state newState
   }
-  where out = plain $ intercalate "\n"
-          [":set is not implemented in IHaskell."
-          ,"  Use :extension <Extension> to enable a GHC extension."
-          ,"  Use :extension No<Extension> to disable a GHC extension."
-          ]
+
+  where 
+    setOpt :: String -> KernelState -> Maybe KernelState
+
+    setOpt "lint" state = Just $
+      state { getLintStatus = LintOn }
+    setOpt "nolint" state = Just $
+      state { getLintStatus = LintOff }
+
+    setOpt "svg" state = Just $
+      state { useSvg = True }
+    setOpt "nosvg" state = Just $
+      state { useSvg = False }
+
+    setOpt _ _ = Nothing
 
 -- This is taken largely from GHCi's info section in InteractiveUI.
 evalCommand _ (Directive GetHelp _) state = do
@@ -366,9 +397,15 @@ evalCommand _ (Directive GetHelp _) state = do
           ,"    :extension No<Extension>  -  disable a GHC extension."
           ,"    :type <expression>        -  Print expression type."
           ,"    :info <name>              -  Print all info for a name."
+          ,"    :set <opt>                -  Set an option."
+          ,"    :set no<opt>              -  Unset an option."
           ,"    :?, :help                 -  Show this help text."
           ,""
           ,"Any prefix of the commands will also suffice, e.g. use :ty for :type."
+          ,""
+          ,"Options:"
+          ,"  lint       - enable or disable linting."
+          ,"  svg        - use svg output (cannot be resized)."
           ]
 
 -- This is taken largely from GHCi's info section in InteractiveUI.
@@ -423,9 +460,9 @@ evalCommand output (Expression expr) state = do
   -- The output is bound to 'it', so we can then use it.
   evalOut <- evalCommand output (Statement expr) state
 
-    -- Try to use `display` to convert our type into the output
+  -- Try to use `display` to convert our type into the output
   -- DisplayData. If typechecking fails and there is no appropriate
-  -- typeclass, this will throw an exception and thus `attempt` will
+  -- typeclass instance, this will throw an exception and thus `attempt` will
   -- return False, and we just resort to plaintext.
   let displayExpr = printf "(IHaskell.Display.display (%s))" expr
   canRunDisplay <- attempt $ exprType displayExpr
@@ -463,6 +500,9 @@ evalCommand output (Expression expr) state = do
       Nothing -> False
       where isPlain (Display mime _) = mime == PlainText
 
+    isSvg (Display MimeSvg _) = True
+    isSvg _ = False
+
     useDisplay displayExpr = wrapExecution state $ do
       -- If there are instance matches, convert the object into
       -- a [DisplayData]. We also serialize it into a bytestring. We get
@@ -472,7 +512,7 @@ evalCommand output (Expression expr) state = do
       -- back gives very strange errors - all the types match but it
       -- refuses to decode back into a [DisplayData].
       -- Suppress output, so as not to mess up console.
-      capturedStatement (const $ return ()) displayExpr
+      out <- capturedStatement (const $ return ()) displayExpr
 
       displayedBytestring <- dynCompileExpr "IHaskell.Display.serializeDisplay it"
       case fromDynamic displayedBytestring of
@@ -482,7 +522,10 @@ evalCommand output (Expression expr) state = do
             Left err -> error err
             Right displayData -> do
               write $ show displayData
-              return displayData
+              return $
+                if useSvg state
+                then displayData
+                else filter (not . isSvg) displayData
 
 
 evalCommand _ (Declaration decl) state = wrapExecution state $ do
@@ -692,20 +735,44 @@ capturedStatement output stmt = do
   return (printedOutput, result)
 
 formatError :: ErrMsg -> String
-formatError = printf "<span style='color: red; font-style: italic;'>%s</span>" .
+formatError = printf "<span class='err-msg'>%s</span>" .
             replace "\n" "<br/>" . 
+            fixLineWrapping .
             replace useDashV "" .
             rstrip . 
             typeCleaner
   where 
-        useDashV = "\nUse -v to see a list of the files searched for."
+    useDashV = "\nUse -v to see a list of the files searched for."
+    fixLineWrapping err
+      | isThreePartTypeError err =
+          let (before, exp:after) = break ("Expected type" `isInfixOf`)  $ lines err
+              (expected, act:actual) = break ("Actual type" `isInfixOf`) after in
+            unlines $ map unstripped [before, exp:expected, act:actual]
+      | isTwoPartTypeError err =
+          let (one, two) = break ("with actual type" `isInfixOf`)  $ lines err in
+            unlines $ map unstripped [one, two]
+      | otherwise = err
+      where 
+        unstripped (line:lines) = unwords $ line:map lstrip lines
+
+    isThreePartTypeError err = all (`isInfixOf` err) [
+      "Couldn't match type",
+      "with",
+      "Expected type:",
+      "Actual type:"
+      ]
+    isTwoPartTypeError err = all (`isInfixOf` err) [
+      "Couldn't match expected type",
+      "with actual type"
+      ]
+
 
 formatParseError :: StringLoc -> String -> ErrMsg
 formatParseError (Loc line col) = 
   printf "Parse error (line %d, column %d): %s" line col
 
 formatGetType :: String -> String
-formatGetType = printf "<span style='font-weight: bold; color: green;'>%s</span>"
+formatGetType = printf "<span class='get-type'>%s</span>"
 
 displayError :: ErrMsg -> [DisplayData]
 displayError msg = [plain . typeCleaner $ msg, html $ formatError msg] 

IHaskell/Eval/Lint.hs → src/IHaskell/Eval/Lint.hs

-{-# LANGUAGE NoImplicitPrelude, QuasiQuotes #-}
+{-# LANGUAGE NoImplicitPrelude, QuasiQuotes, ViewPatterns #-}
 module IHaskell.Eval.Lint ( 
   lint
   ) where
@@ -11,6 +11,8 @@ import Control.Monad
 import Data.List (findIndex)
 import Text.Printf
 import Data.String.Here
+import Data.Char
+import Data.Monoid
 
 import IHaskell.Types
 import IHaskell.Display
@@ -22,6 +24,7 @@ data LintSeverity = LintWarning | LintError deriving (Eq, Show)
 data LintSuggestion
   = Suggest {
     line :: LineNumber,
+    chunkNumber :: Int,
     found :: String,
     whyNot :: String,
     severity :: LintSeverity,
@@ -38,7 +41,7 @@ lintIdent = "lintIdentAEjlkQeh"
 lint :: [Located CodeBlock] -> IO [DisplayData]
 lint blocks = do
   let validBlocks = map makeValid blocks
-      fileContents = joinBlocks 1 validBlocks
+      fileContents = joinBlocks validBlocks
   -- Get a temporarly location to store this file.
   ihaskellDir <- getIHaskellDir
   let filename = ihaskellDir ++ "/.hlintFile.hs"
@@ -54,15 +57,13 @@ lint blocks = do
     -- Join together multiple valid file blocks into a single file.
     -- However, join them with padding so that the line numbers are
     -- correct.
-    joinBlocks :: LineNumber -> [Located String] -> String
-    joinBlocks nextLine (Located desiredLine str:strs) =
-      -- Place padding to shift the line number appropriately.
-      replicate (desiredLine - nextLine) '\n' ++
-      str ++ "\n" ++
-      joinBlocks (desiredLine + nlines str) strs
-    joinBlocks _ [] = ""
+    joinBlocks :: [Located String] -> String
+    joinBlocks = unlines . zipWith addPragma [1 .. ]
 
-    nlines = length . lines
+    addPragma :: Int -> Located String -> String
+    addPragma i (Located desiredLine str) = linePragma desiredLine i ++ str
+
+    linePragma = printf "{-# LINE %d \"%d\" #-}\n"
 
 plainSuggestion :: LintSuggestion -> String
 plainSuggestion suggest = 
@@ -114,46 +115,56 @@ htmlSuggestions = concatMap toHtml
 -- If parsing fails, return Nothing.
 parseSuggestion :: Suggestion -> Maybe LintSuggestion
 parseSuggestion suggestion = do
-  let str = showSuggestion suggestion
+  let str = showSuggestion (show suggestion)
       severity = suggestionSeverity suggestion
   guard (severity /= HLint.Ignore)
   let lintSeverity = case severity of
         Warning -> LintWarning
         Error -> LintError
 
-  let suggestionLines = lines str
-  -- Expect a header line, a "Found" line, and a "Why not" line.
-  guard (length suggestionLines > 3)
+  headerLine:foundLine:rest <- Just (lines str)
 
   -- Expect the line after the header to have 'Found' in it.
-  let headerLine:foundLine:rest = suggestionLines
   guard ("Found:" `isInfixOf` foundLine)
 
   -- Expect something like:
   -- ".hlintFile.hs:1:19: Warning: Redundant bracket"
-  let headerPieces = split ":" headerLine
-  guard (length headerPieces == 5)
-  let [file, line, col, severity, name] = headerPieces
+  -- ==> 
+  -- [".hlintFile.hs","1","19"," Warning"," Redundant bracket"]
+  [readMay -> Just chunkN,
+   readMay -> Just lineNum, _col, severity, name] <- Just (split ":" headerLine)
 
-  whyIndex <- findIndex ("Why not:" `isInfixOf`) rest
-  let (before, _:after) = splitAt whyIndex rest
-  lineNum <- readMay line
+  (before, _:after) <- Just (break ("Why not:" `isInfixOf`) rest)
   return Suggest {
     line = lineNum,
+    chunkNumber = chunkN,
     found = unlines before,
     whyNot = unlines after,
     suggestion = name,
     severity = lintSeverity
   }
-  where
-    showSuggestion = 
-      replace (lintIdent ++ "=") "" .
-      replace (lintIdent ++ "$do ") "" .
-      replace (replicate (length lintIdent + length " $ do ") ' ' ++ lintIdent) "" .
-      replace (" in " ++ lintIdent) "" .
-      show
 
 
+showSuggestion :: String -> String
+showSuggestion = 
+    replace ("return " ++ lintIdent) "" .
+    replace (lintIdent ++ "=") "" .
+    dropDo
+    where
+
+    -- drop leading '  do ', and blank spaces following
+    dropDo :: String -> String
+    dropDo = unlines . f . lines
+        where
+        f :: [String] -> [String]
+        f ((stripPrefix "  do " -> Just a) : as) =
+                let as' = catMaybes
+                        $ takeWhile isJust
+                        $ map (stripPrefix "     ") as
+                in a : as' ++ f (drop (length as') as)
+        f (x:xs) = x : f xs
+        f [] = []
+
 -- | Convert a code chunk into something that could go into a file.
 -- The line number on the output is the same as on the input.
 makeValid :: Located CodeBlock -> Located String
@@ -162,28 +173,27 @@ makeValid (Located line block) = Located line $
     -- Expressions need to be bound to some identifier.
     Expression expr -> lintIdent ++ "=" ++ expr
 
-    -- Statements need to go in a 'do' block bound to an identifier.
-    -- It must also end with a 'return'.
-    Statement stmt -> 
-      -- Let's must be handled specially, because we can't have layout
-      -- inside non-layout. For instance, this is illegal:
-      --   a = do { let x = 3; return 3 }
-      --   because it should be
-      --   a = do { let {x = 3}; return 3 }
-      -- Thus, we rely on template haskell and instead turn it into an
-      -- expression via let x = blah 'in blah'.
-      if startswith "let" $ strip stmt
-      then stmt ++ " in " ++ lintIdent
-      else 
-        -- We take advantage of the fact that naked expressions at toplevel
-        -- are allowed by Template Haskell, and output them to a file.
-        let prefix = lintIdent ++ " $ do "
-            first:rest = split "\n" stmt
-            indent = replicate (length prefix) ' '
-            fixedLines = first : map (indent ++) rest
-            extraReturnLine = [indent ++ lintIdent]
-            code = intercalate "\n" (fixedLines ++ extraReturnLine) in
-        prefix ++ code
+    -- Statements go in a 'do' block bound to an identifier.
+    --
+    -- a cell can contain:
+    -- > x <- readFile "foo"
+    -- so add a return () to avoid a Parse error: Last statement in
+    -- a do-block must be an expression
+    --
+    -- one place this goes wrong is when the chunk is:
+    --
+    -- > do
+    -- >  {- a comment that has to -} let x = 1
+    -- >   {- count as whitespace -}      y = 2
+    -- >                              return (x+y) 
+    Statement stmt ->
+        let expandTabs = replace "\t" "        " 
+            nLeading = maybe 0 (length . takeWhile isSpace)
+                    $ listToMaybe
+                    $ filter (not . all isSpace)
+                            (lines (expandTabs stmt))
+            finalReturn = replicate nLeading ' ' ++ "return " ++ lintIdent
+        in intercalate ("\n ") ((lintIdent ++ " $ do") : lines stmt ++ [finalReturn])
 
     -- Modules, declarations, and type signatures are fine as is.
     Module mod -> mod

IHaskell/Eval/Parser.hs → src/IHaskell/Eval/Parser.hs

@@ -61,8 +61,7 @@ data DirectiveType
   | GetInfo         -- ^ Get info about the identifier via ':info' (or unique prefixes)
   | SetExtension    -- ^ Enable or disable an extension via ':extension' (or prefixes)
   | LoadFile        -- ^ Load a Haskell module.
-  | SetLint         -- ^ Enable or disable a hlint via ':hlint on' or ':hlint off'
-  | HelpForSet      -- ^ Provide useful info if people try ':set'.
+  | SetOpt          -- ^ Set various options.
   | GetHelp         -- ^ General help via ':?' or ':help'.
   deriving (Show, Eq)
 
@@ -238,8 +237,7 @@ parseDirective (':':directive) line = case find rightDirective directives of
       ,(GetInfo,      "info")
       ,(SetExtension, "extension")
       ,(LoadFile,     "load")
-      ,(SetLint,      "hlint")
-      ,(HelpForSet,   "set")
+      ,(SetOpt,       "set")
       ,(GetHelp,      "?")
       ,(GetHelp,      "help")
       ]

IHaskell/IPython.hs → src/IHaskell/IPython.hs

@@ -201,30 +201,39 @@ installIPython = void . shellyNoDir $ do
 
 -- | Install all Python dependencies.
 installPipDependencies :: Sh ()
-installPipDependencies = mapM_ installDependency [("markupsafe", "0.18")
-                                                 ,("pyzmq", "14.0.1")
-                                                 ,("tornado","3.1.1")
-                                                 ,("jinja2","2.7.1")]
+installPipDependencies = withTmpDir $ \tmpDir -> 
+    mapM_ (installDependency tmpDir) 
+      [
+        ("pyzmq", "14.0.1")
+      , ("setuptools", "2.0.2") -- This cannot go first in the dependenc list, because its setup.py is broken.
+      , ("MarkupSafe", "0.18")  -- Neither can this
+      , ("tornado","3.1.1")
+      , ("jinja2","2.7.1")
+      ]
   where
-    installDependency :: (Text, Text) -> Sh ()
-    installDependency (dep, version) = withTmpDir $ \tmpDir -> do
+    installDependency :: FilePath -> (Text, Text) -> Sh ()
+    installDependency tmpDir (dep, version) = sub $ do
       let versioned = dep ++ "-" ++ version
       putStrLn $ "Installing dependency: " ++ versioned
 
       pipPath <- path "pip"
       tarPath <- path "tar"
+      pythonPath <- path "python"
 
       -- Download the package.
       let downloadOpt = "--download=" ++ fpToText tmpDir
       run_ pipPath ["install", downloadOpt, dep ++ "==" ++ version]
 
       -- Extract it.
+      cd tmpDir
       run_ tarPath ["-xf", versioned ++ ".tar.gz"]
 
       -- Install it.
       cd $ fromText versioned
-      prefixOpt <-  ("--prefix=" ++) <$>  fpToText <$> ipythonDir
-      run_ pipPath ["install", prefixOpt]
+      dir <- fpToText <$> ipythonDir
+      setenv "PYTHONPATH" $ dir ++ "/lib/python2.7/site-packages/"
+      let prefixOpt =  "--prefix=" ++ dir
+      run_ pythonPath ["setup.py", "install", prefixOpt]
 
 
 -- | Once things are checked out into the IPython source directory, build it and install it.

IHaskell/Message/Writer.hs → src/IHaskell/Message/Writer.hs

-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings #-}
 -- | Description : @ToJSON@ for Messages
 --
 -- This module contains the @ToJSON@ instance for @Message@.
@@ -11,20 +10,16 @@ import Prelude (read)
 import ClassyPrelude
 import Data.Aeson
 
-import Language.Haskell.TH
 import Shelly hiding (trace)
 
 import IHaskell.Types
 
--- | Compute the GHC API version number using Template Haskell.
+-- | Compute the GHC API version number using the dist/build/autogen/cabal_macros.h
 ghcVersionInts :: [Int]
-ghcVersionInts = ints . map read . words . map dotToSpace $ version
+ghcVersionInts = ints . map read . words . map dotToSpace $ VERSION_ghc
   where dotToSpace '.' = ' '
         dotToSpace x = x
 
-        version :: String
-        version = $(runIO (unpack <$> shelly (run "ghc" ["--numeric-version"])) >>= stringE)
-
 -- Convert message bodies into JSON.
 instance ToJSON Message where
   toJSON KernelInfoReply{} = object [

IHaskell/Types.hs → src/IHaskell/Types.hs

@@ -18,6 +18,8 @@ module IHaskell.Types (
   InitInfo(..),
   KernelState(..),
   LintStatus(..),
+  Width, Height,
+  defaultKernelState
   ) where
 
 import ClassyPrelude
@@ -72,7 +74,16 @@ instance ToJSON Profile where
 data KernelState = KernelState
   { getExecutionCounter :: Int,
     getLintStatus :: LintStatus,  -- Whether to use hlint, and what arguments to pass it. 
-    getCwd :: String
+    getCwd :: String,
+    useSvg :: Bool
+  }
+
+defaultKernelState :: KernelState
+defaultKernelState = KernelState
+  { getExecutionCounter = 1,
+    getLintStatus = LintOn,
+    getCwd = ".",
+    useSvg = True
   }
 
 -- | Initialization information for the kernel.
@@ -294,17 +305,25 @@ instance Show ExecuteReplyStatus where
 data ExecutionState = Busy | Idle | Starting deriving Show
 
 -- | Data for display: a string with associated MIME type.
-data DisplayData = Display MimeType String deriving (Show, Typeable, Generic)
+data DisplayData = Display MimeType String deriving (Typeable, Generic)
+
+-- We can't print the actual data, otherwise this will be printed every
+-- time it gets computed because of the way the evaluator is structured.
+-- See how `displayExpr` is computed.
+instance Show DisplayData where
+  show _ = "Display"
 
 -- Allow DisplayData serialization
 instance Serialize DisplayData
 instance Serialize MimeType
 
 -- | Possible MIME types for the display data.
+type Width = Int
+type Height = Int
 data MimeType = PlainText
               | MimeHtml
-              | MimePng
-              | MimeJpg
+              | MimePng Width Height
+              | MimeJpg Width Height
               | MimeSvg
               | MimeLatex
               deriving (Eq, Typeable, Generic)
@@ -313,8 +332,8 @@ data MimeType = PlainText
 instance Show MimeType where
   show PlainText = "text/plain"
   show MimeHtml  = "text/html"
-  show MimePng   = "image/png" 
-  show MimeJpg   = "image/jpeg"
+  show (MimePng _ _)   = "image/png" 
+  show (MimeJpg _ _)   = "image/jpeg"
   show MimeSvg   = "image/svg+xml"
   show MimeLatex = "text/latex"
 

Main.hs → src/Main.hs

@@ -260,11 +260,7 @@ runKernel profileSrc initInfo = do
 -- Initial kernel state.
 initialKernelState :: IO (MVar KernelState)
 initialKernelState =
-  newMVar KernelState {
-    getExecutionCounter = 1,
-    getLintStatus = LintOn,
-    getCwd = "."
-  }
+  newMVar defaultKernelState
 
 -- | Duplicate a message header, giving it a new UUID and message type.
 dupHeader :: MessageHeader -> MessageType -> IO MessageHeader