Merge branch 'master' of https://github.com/aavogt/IHaskell

Conflicts:
	src/Hspec.hs

.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,
@@ -73,8 +74,7 @@ library
                        system-filepath,
                        cereal ==0.3.*,
                        text >=0.11,
-                       mtl >= 2.1,
-                       template-haskell
+                       mtl >= 2.1
   exposed-modules: IHaskell.Display,
                    Paths_ihaskell,
                    IHaskell.Types,
@@ -82,6 +82,7 @@ library
 
 executable IHaskell
   -- .hs or .lhs file containing the Main module.
+  hs-source-dirs:      src
   main-is:             Main.hs
 
   build-tools:         happy, cpphs
@@ -132,8 +133,7 @@ executable IHaskell
                        system-filepath,
                        cereal ==0.3.*,
                        text >=0.11,
-                       mtl >= 2.1,
-                       template-haskell
+                       mtl >= 2.1
 
 Test-Suite hspec
   Type:     exitcode-stdio-1.0
@@ -166,8 +166,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

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
+```

Untitled0.ipynb

+{
+ "metadata": {
+  "name": ""
+ },
+ "nbformat": 3,
+ "nbformat_minor": 0,
+ "worksheets": [
+  {
+   "cells": [
+    {
+     "cell_type": "code",
+     "collapsed": false,
+     "input": [
+      "import \n"
+     ],
+     "language": "python",
+     "metadata": {},
+     "outputs": [
+      {
+       "output_type": "stream",
+       "stream": "stdout",
+       "text": [
+        "no Python documentation found for 'PATH'\n",
+        "\n"
+       ]
+      }
+     ],
+     "prompt_number": 4
+    },
+    {
+     "cell_type": "code",
+     "collapsed": false,
+     "input": [],
+     "language": "python",
+     "metadata": {},
+     "outputs": []
+    }
+   ],
+   "metadata": {}
+  }
+ ]
+}
\ No newline at end of file

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,12 @@ eval string = do
   outputAccum <- newIORef []
   let publish final displayDatas = when final $ modifyIORef outputAccum (displayDatas :)
   getTemporaryDirectory >>= setCurrentDirectory
+<<<<<<< HEAD:Hspec.hs
   let state = KernelState 1 LintOff "."
+=======
+  let state :: KernelState
+      state = mempty { getLintStatus = LintOff }
+>>>>>>> 63ecc797eb66565e4bb6ed04d503b3884b37cb4e:src/Hspec.hs
   interpret $ Eval.evaluate state string publish
   out <- readIORef outputAccum
   return $ reverse out

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

 {-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
 module IHaskell.Display (
   IHaskellDisplay(..),
   plain, html, png, jpg, svg, latex,
@@ -14,6 +13,12 @@ import Data.String.Utils (rstrip)
 import IHaskell.Types
 
 -- | 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]
 

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.
 
@@ -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.
@@ -425,7 +452,7 @@ evalCommand output (Expression expr) state = do
 
   -- 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

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,45 +115,55 @@ 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 = 
+
+
+showSuggestion :: String -> String
+showSuggestion = 
+    replace ("return " ++ lintIdent) "" .
     replace (lintIdent ++ "=") "" .
-      replace (lintIdent ++ "$do ") "" .
-      replace (replicate (length lintIdent + length " $ do ") ' ' ++ lintIdent) "" .
-      replace (" in " ++ lintIdent) "" .
-      show
+    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.
@@ -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'.
+    -- 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'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
+        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/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

@@ -75,6 +75,13 @@ data KernelState = KernelState
     getCwd :: String
   }
 
+
+-- | like 'First', except also add up the execution counter
+instance Monoid KernelState where
+   mempty = KernelState 1 LintOn "." 
+   KernelState na sa cwda `mappend` KernelState nb sb cwdb = 
+    KernelState (na+nb) sa cwda
+
 -- | Initialization information for the kernel.
 data InitInfo = InitInfo {
   extensions :: [String],   -- ^ Extensions to enable at start.

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 mempty
 
 -- | Duplicate a message header, giving it a new UUID and message type.
 dupHeader :: MessageHeader -> MessageType -> IO MessageHeader