Allows type declarations above function declarations.

Haskell-Notebook.ipynb

@@ -55,13 +55,13 @@
      "outputs": [
       {
        "html": [
-        "<span style='color: red; font-style: italic;'>Not in scope: `<*>'<br/>Perhaps you meant `<$>' (imported from Control.Applicative)<br/></span>"
+        "<span style='color: red; font-style: italic;'>Failed to load interface for `Control.Appldaicative'<br/>Perhaps you meant Control.Applicative (from base)<br/></span>"
        ],
        "metadata": {},
        "output_type": "display_data"
       }
      ],
-     "prompt_number": 6
+     "prompt_number": 2
     },
     {
      "cell_type": "code",
@@ -78,7 +78,7 @@
       {
        "metadata": {},
        "output_type": "pyout",
-       "prompt_number": 1,
+       "prompt_number": 3,
        "text": [
         "1\n",
         "4\n",
@@ -92,7 +92,7 @@
        "output_type": "display_data"
       }
      ],
-     "prompt_number": 1
+     "prompt_number": 3
     },
     {
      "cell_type": "code",
@@ -106,13 +106,13 @@
      "outputs": [
       {
        "html": [
-        "<span style='color: red; font-style: italic;'>Failed to load interface for `Alksjdfljksd'<br/>Use -v to see a list of the files searched for.<br/></span>"
+        "<span style='color: red; font-style: italic;'>Failed to load interface for `Lkjadflkjad'<br/></span>"
        ],
        "metadata": {},
        "output_type": "display_data"
       }
      ],
-     "prompt_number": 7
+     "prompt_number": 4
     },
     {
      "cell_type": "code",
@@ -126,18 +126,108 @@
      "outputs": [
       {
        "html": [
-        "<span style='color: red; font-style: italic;'>Not in scope: `adsf'<br/></span>"
+        "<span style='color: red; font-style: italic;'>Not in scope: `abc'<br/>Perhaps you meant `abs' (imported from Prelude)<br/></span>"
+       ],
+       "metadata": {},
+       "output_type": "display_data"
+      }
+     ],
+     "prompt_number": 5
+    },
+    {
+     "cell_type": "code",
+     "collapsed": false,
+     "input": [
+      "doubleIt :: Int -> String\n",
+      "doubleIt = show"
+     ],
+     "language": "python",
+     "metadata": {},
+     "outputs": [
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      }
+     ],
+     "prompt_number": 3
+    },
+    {
+     "cell_type": "code",
+     "collapsed": false,
+     "input": [
+      "f 3 = 2 "
+     ],
+     "language": "python",
+     "metadata": {},
+     "outputs": [
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      }
+     ],
+     "prompt_number": 4
+    },
+    {
+     "cell_type": "code",
+     "collapsed": false,
+     "input": [
+      "a :: Int\n",
+      "a = 3"
+     ],
+     "language": "python",
+     "metadata": {},
+     "outputs": [
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      }
+     ],
+     "prompt_number": 5
+    },
+    {
+     "cell_type": "code",
+     "collapsed": false,
+     "input": [
+      "f 1"
+     ],
+     "language": "python",
+     "metadata": {},
+     "outputs": [
+      {
+       "html": [
+        "<span style='color: red; font-style: italic;'><interactive>:1:1-7: Non-exhaustive patterns in function f<br/></span>"
        ],
        "metadata": {},
        "output_type": "display_data"
       }
      ],
-     "prompt_number": 9
+     "prompt_number": 6
+    },
+    {
+     "cell_type": "code",
+     "collapsed": false,
+     "input": [
+      "doubleIt \"hello\""
+     ],
+     "language": "python",
+     "metadata": {},
+     "outputs": [
+      {
+       "html": [
+        "<span style='color: red; font-style: italic;'>Couldn't match expected type `Int'<br/>            with actual type `[Char]'<br/></span>"
+       ],
+       "metadata": {},
+       "output_type": "display_data"
+      }
+     ],
+     "prompt_number": 7
     },
     {
      "cell_type": "code",
      "collapsed": false,
-     "input": [],
+     "input": [
+      "\""
+     ],
      "language": "python",
      "metadata": {},
      "outputs": []

IHaskell/Eval/Evaluate.hs

@@ -16,14 +16,14 @@ import Data.List(findIndex)
 import Data.String.Utils
 import Text.Printf
 
-import Language.Haskell.Exts.Parser
+import Language.Haskell.Exts.Parser hiding (parseType)
 import Language.Haskell.Exts.Pretty
 import Language.Haskell.Exts.Syntax hiding (Name)
 
 import InteractiveEval
 import HscTypes
 import GhcMonad (liftIO)
-import GHC hiding (Stmt)
+import GHC hiding (Stmt, TypeSig)
 import GHC.Paths
 import Exception hiding (evaluate)
 
@@ -37,6 +37,9 @@ data ErrorOccurred = Success | Failure
 debug :: Bool
 debug = True
 
+ignoreTypePrefixes :: [String]
+ignoreTypePrefixes = ["GHC.Types", "GHC.Base"]
+
 makeWrapperStmts :: (String, [String], [String])
 makeWrapperStmts = (fileName, initStmts, postStmts)
   where
@@ -71,6 +74,7 @@ data Command
   | Import String
   | Declaration String
   | Statement String
+  | TypedStatement Command Command
   | ParseError LineNumber ColumnNumber String
   deriving Show
 
@@ -145,23 +149,47 @@ parseCommands code = concatMap makeCommands pieces
     makePieces (first:rest)
       | isDirective first = first : makePieces rest
       | isImport first = first : makePieces rest
-      | otherwise = unlines (first:take endOfBlock rest) : makePieces (drop endOfBlock rest)
-          where
-            endOfBlock = fromMaybe (length rest) $ findIndex (\x -> indentLevel x <= indentLevel first) rest
-
-
-    pieces = trace (show $ makePieces $ lines code ) $ makePieces $ lines code
-    makeCommands lines
-      | isDirective lines = [createDirective lines]
-      | isImport lines    = [Import $ strip lines]
-      | otherwise = case (parseDecl lines, parseStmts lines) of
+      | otherwise =
+          -- Special case having a type declaration right before
+          -- a function declaration. Using normal parsing, the type
+          -- declaration and the function declaration are separate
+          -- statements.
+          if isTypeDeclaration firstStmt
+          then case restStmt of
+            funDec:rest -> (firstStmt ++ "\n" ++ funDec) : rest
+            [] -> [firstStmt]
+          else firstStmt : restStmt
+          where (firstStmt, otherLines) = splitByIndent $ first:rest
+                restStmt = makePieces otherLines
+
+    splitByIndent :: [String] -> (String, [String])
+    splitByIndent (first:rest) = (unlines $ first:take endOfBlock rest, filter (/= "") $ drop endOfBlock rest)
+      where
+        endOfBlock = fromMaybe (length rest) $ findIndex (\x -> indentLevel x <= indentLevel first) rest
+
+    pieces = makePieces $ lines code
+    makeCommands str
+      | isDirective str = [createDirective str]
+      | isImport str    = [Import $ strip str]
+      | length rest > 0 && isTypeDeclaration first =
+          let (firstStmt:restStmts) = makeCommands $ unlines rest in
+            TypedStatement (Declaration first) firstStmt : restStmts
+      | otherwise = case (parseDecl str, parseStmts str) of
             (ParseOk declaration, _) -> [Declaration $ prettyPrint declaration]
             (ParseFailed {}, Right stmts) -> map (Statement . prettyPrint) $ init stmts
 
-            -- show the parse error for the most likely type
-            (ParseFailed srcLoc errMsg, _)
-                | isDeclaration lines  -> [ParseError (srcLine srcLoc) (srcColumn srcLoc) errMsg]
+            -- Show the parse error for the most likely type.
+            (ParseFailed srcLoc errMsg, _) | isDeclaration str  -> [ParseError (srcLine srcLoc) (srcColumn srcLoc) errMsg]
             (_, Left (lineNumber, colNumber,errMsg)) -> [ParseError lineNumber colNumber errMsg]
+      where
+        (first, rest) = trace (show $ splitByIndent $ lines str) $ splitByIndent $ lines str
+
+    -- Check whether this string reasonably represents a type declaration
+    -- for a variable. 
+    isTypeDeclaration :: String -> Bool
+    isTypeDeclaration str = case parseDecl str of
+      ParseOk TypeSig{} -> True
+      _ -> False
 
     isDeclaration line = any (`isInfixOf` line) ["type", "newtype", "data", "instance", "class"]
     isDirective line = startswith [directiveChar] (strip line) 
@@ -193,6 +221,12 @@ evalCommand (Directive (GetType expr)) = wrapExecution $ do
   dflags <- getSessionDynFlags
   return [Display MimeHtml $ printf "<span style='font-weight: bold; color: green;'>%s</span>" $ showSDocUnqual dflags $ ppr result]
 
+evalCommand (TypedStatement (Declaration declType) (Declaration typedDecl)) = evalCommand $ Declaration $ declType ++ typedDecl
+
+evalCommand (TypedStatement (Declaration declType) _) = return (Failure, [Display MimeHtml $ makeError err])
+  where
+    err = printf "Type annotation `%s` must be followed by value declaration." (strip declType)
+
 evalCommand (Statement stmt) = do
   write $ "Statement: " ++ stmt
   ghandle handler $ do
@@ -254,5 +288,8 @@ parseStmts code =
     returnStmt = "return ()"
 
 makeError :: String -> String
-makeError = printf "<span style='color: red; font-style: italic;'>%s</span>" . replace "\n" "<br/>" . replace useDashV ""
-  where useDashV = "\nUse -v to see a list of the files searched for."
+makeError = printf "<span style='color: red; font-style: italic;'>%s</span>" . replace "\n" "<br/>" . dropper
+  where dropper = foldl' (.) useStringType (map (`replace` "") dropList)
+        dropList = useDashV : map (++ ".") ignoreTypePrefixes
+        useDashV = "\nUse -v to see a list of the files searched for."
+        useStringType = replace "[Char]" "String"