something work i think (???)

IHaskell.cabal

@@ -93,9 +93,6 @@ executable IHaskell
 
 
   extensions: DoAndIfThenElse
-              NoImplicitPrelude
-              OverloadedStrings
-             
   
   -- Other library packages from which modules are imported.
   build-depends:       base ==4.6.*,
@@ -126,5 +123,5 @@ Test-Suite doctests
   Type:     exitcode-stdio-1.0
   Ghc-Options: -threaded
   Main-Is: rundoctests.hs
-  Build-Depends: base, doctest >= 0.8, process
+  Build-Depends: base, doctest >= 0.8, process, text ==0.11.*, shelly ==1.3.*, MissingH ==1.2.*
 

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

IHaskell/Display.hs

+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
 {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
 module IHaskell.Display (
   IHaskellDisplay(..),

IHaskell/Eval/Completion.hs

+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
 {- | Description : generates tab-completion options
 
   context-insensitive completion for what is probably

IHaskell/Eval/Evaluate.hs

-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
 {- | Description : Wrapper around GHC API, exposing a single `evaluate` interface that runs
                    a statement, declaration, import, or directive.
 
@@ -35,6 +34,7 @@ import Module
 import qualified System.IO.Strict as StrictIO
 
 import IHaskell.Types
+import IHaskell.Eval.Parser
 
 data ErrorOccurred = Success | Failure
 
@@ -79,21 +79,8 @@ makeWrapperStmts = (fileName, initStmts, postStmts)
 write :: GhcMonad m => String -> m ()
 write x = when debug $ liftIO $ hPutStrLn stderr x
 
-type LineNumber = Int
-type ColumnNumber = Int
-
 type Interpreter = Ghc
 
-data DirectiveType = GetType String deriving Show
-
-data Command
-  = Directive DirectiveType
-  | Import String
-  | Declaration String
-  | Statement String
-  | ParseError LineNumber ColumnNumber String
-  deriving Show
-
 globalImports :: [String]
 globalImports = 
   [ "import Prelude"
@@ -152,9 +139,11 @@ evaluate :: Int                       -- ^ The execution counter of this evaluat
          -> Interpreter [DisplayData] -- ^ All of the output.
 evaluate execCount code
   | strip code == "" = return [] 
-  | otherwise = joinDisplays <$> runUntilFailure (parseCommands (strip code) ++ [storeItCommand execCount])
+  | otherwise = do
+      cmds <- parseCommands (strip code) 
+      joinDisplays <$> runUntilFailure (cmds ++ [storeItCommand execCount])
   where
-    runUntilFailure :: [Command] -> Interpreter [DisplayData]
+    runUntilFailure :: [CodeBlock] -> Interpreter [DisplayData]
     runUntilFailure [] = return []
     runUntilFailure (cmd:rest) = do 
       (success, result) <- evalCommand cmd
@@ -178,8 +167,12 @@ joinDisplays displays =
       _ -> joinedPlains : other
 
 
+parseCommands :: GhcMonad m => String       -- ^ Code containing commands.
+              -> m [CodeBlock]  -- ^ Commands contained in code string.
+parseCommands  = parseCell 
+{-
 parseCommands :: String     -- ^ Code containing commands.
-              -> [Command]  -- ^ Commands contained in code string.
+              -> [CodeBlock]  -- ^ Commands contained in code string.
 parseCommands code = joinMultilineDeclarations $ concatMap makeCommands pieces
   where
     -- Group the text into different pieces.
@@ -246,20 +239,21 @@ parseCommands code = joinMultilineDeclarations $ concatMap makeCommands pieces
       ':':'t':' ':expr -> Directive (GetType expr)
       other            -> ParseError 0 0 $ "Unknown command: " ++ other ++ "."
 
-joinMultilineDeclarations :: [Command] -> [Command]
+joinMultilineDeclarations :: [CodeBlock] -> [CodeBlock]
 joinMultilineDeclarations = map joinCommands . groupBy declaringSameFunction
   where
-    joinCommands :: [Command] -> Command
+    joinCommands :: [CodeBlock] -> CodeBlock
     joinCommands [x] = x
     joinCommands commands = Declaration . unlines $ map getDeclarationText commands
       where
         getDeclarationText (Declaration text) = text
 
-    declaringSameFunction :: Command -> Command -> Bool
+    declaringSameFunction :: CodeBlock -> CodeBlock -> Bool
     declaringSameFunction (Declaration first) (Declaration second) = declared first == declared second
       where declared :: String -> String
             declared = takeWhile (`notElem` (" \t\n:" :: String)) . strip
     declaringSameFunction _ _ = False
+-}
 
 wrapExecution :: Interpreter [DisplayData] -> Interpreter (ErrorOccurred, [DisplayData])
 wrapExecution exec = ghandle handler $ exec >>= \res ->
@@ -270,7 +264,7 @@ wrapExecution exec = ghandle handler $ exec >>= \res ->
 
 -- | Return the display data for this command, as well as whether it
 -- resulted in an error.
-evalCommand :: Command -> Interpreter (ErrorOccurred, [DisplayData])
+evalCommand :: CodeBlock -> Interpreter (ErrorOccurred, [DisplayData])
 evalCommand (Import importStr) = wrapExecution $ do
   write $ "Import: " ++ importStr
   importDecl <- parseImportDecl importStr
@@ -278,7 +272,7 @@ evalCommand (Import importStr) = wrapExecution $ do
   setContext $ IIDecl importDecl : context
   return []
 
-evalCommand (Directive (GetType expr)) = wrapExecution $ do
+evalCommand (Directive GetType expr) = wrapExecution $ do
   result <- exprType expr
   dflags <- getSessionDynFlags
   return [Display MimeHtml $ printf "<span style='font-weight: bold; color: green;'>%s</span>" $ showSDocUnqual dflags $ ppr result]

IHaskell/Eval/Info.hs

+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {- | Description : Inspect type and function information and documentation.

IHaskell/Eval/Parser.hs

-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
 module IHaskell.Eval.Parser (
-     chunkCode,
-     CodeChunk(..),
-     ChunkType(..),
+    parseCell,
+    CodeBlock(..),
+    DirectiveType(..),
+    LineNumber,
+    ColumnNumber,
+    splitAtLoc
     ) where
 
-import ClassyPrelude hiding (liftIO, hGetContents)
+import ClassyPrelude hiding (liftIO)
+
+import Data.String.Utils (startswith, strip)
+import Prelude (init, last)
 
 import FastString
 import StringBuffer
 import ErrUtils
 import SrcLoc
 import GHC
+import GhcMonad (liftIO)
 import Bag
+import Outputable hiding ((<>))
 import Lexer
-
-import Data.String.Utils (strip, startswith)
-import Data.List.Utils (grab)
-import Control.Monad.State
-
--- | A chunk of code with with a source span and an associated chunk type.
-data CodeChunk = Chunk RealSrcSpan ChunkType
-
--- | Possible types of code chunks.
-data ChunkType = Directive
-               | Expr
-               | Stmt
-               | Decl
-               | Import
-               deriving (Eq, Show, Ord)
-
--- | Simple tree data structure.
-data Tree a = Branch [Tree a] | Leaf a deriving Show
-
--- | Delimiter categorization as an opening, closing, or neither opening
--- nor closing delimiter. Used to generate trees of tokens.
-data DelimType = Opening | Closing | Neither
-
--- | Put the given statements into a `do` block.
-wrapInDoBlock :: String -> String
-wrapInDoBlock codeStr =
-  if null stripped
-  then []
-  else unlines $ "do" : map indent (lines stripped)
-  where
-    stripped = strip codeStr
-    indent = ("    " ++)
-
--- | Convert a string of code into raw, uncleaned code chunks.
-classifyCode :: DynFlags -> String -> Either String [CodeChunk]
-classifyCode flags codeStr = groupLikeChunks . treeToChunks . tokenTree <$> runLexer flags (wrapInDoBlock codeStr)
-
--- | Group code chunks that are alike into one code chunk.
-groupLikeChunks :: [CodeChunk] -> [CodeChunk]
-groupLikeChunks chunks = map joinChunks $ groupBy sameChunkType chunks 
-  where
-    sameChunkType (Chunk _ firstType) (Chunk _ secondType) = firstType == secondType
-
-    joinChunks :: [CodeChunk] -> CodeChunk
-    joinChunks [chunk] = chunk
-    joinChunks (Chunk firstLoc chunkType:rest) = Chunk newSpan chunkType
-      where newSpan = mkRealSrcSpan (realSrcSpanStart firstLoc) (realSrcSpanEnd restChunkLoc)
-            Chunk restChunkLoc _ = joinChunks rest
-
--- | Convert a list of tokens into a tree of tokens.
-tokenTree :: [Located Lexer.Token] -> Tree (Located Lexer.Token)
-tokenTree = toTree $ \x -> case x of
-            -- Opening delimiters are opening curly braces and opening parentheses. 
-            L _ ITvocurly -> Opening
-            L _ IToparen -> Opening
-
-            -- Closing delimiters are closing curly braces and closing parentheses. 
-            L _ ITvccurly -> Closing
-            L _ ITcparen -> Closing
-
-            -- Everthing else isn't a delimiter.
-            _ -> Neither
-
--- | Convert a list into a tree given a function that can classify each
--- element of the list as a delimiter (opening or closing) or not
--- a delimiter.
-toTree :: (a -> DelimType) -- ^ Function which classifies the delimiter type of a list element.
-       -> [a]             -- ^ List of tokens.
-       -> Tree a          -- ^ Tree generated from tokens where each set of delimiters encodes a new level.
-toTree delimType tokens = 
-  case toTree' delimType 0 [[]] tokens of
-    x -> Branch $ reverse x
-
+import OrdList
+
+import IHaskell.GHC.HaskellParser
+
+import Debug.Trace
+
+type LineNumber = Int
+type ColumnNumber = Int
+
+data CodeBlock
+  = Expression String
+  | Declaration String
+  | Statement String
+  | Import String
+  | Directive DirectiveType String
+  | ParseError LineNumber ColumnNumber String
+  deriving Show
+
+data DirectiveType
+  = GetType
+  | GetInfo
+  deriving Show
+
+-- $setup
+-- >>> import GHC
+-- >>> import GHC.Paths
+-- >>> import IHaskell.Eval.Parser
+-- >>> let ghc = runGhc (Just libdir)
+-- >>> let test = ghc . parseCell
+
+-- $extendedParserTests
+--
+-- >>> test "let x = 3 in x + 3"
+-- [Expression "let x = 3 in x + 3"]
+--
+-- >>> test "3\n:t expr"
+-- [Expression "3",Directive GetType "expr"]
+--
+-- >>> test "3\nlet x = expr"
+-- [Expression "3",Statement "let x = expr"]
+--
+-- >>> test "y <- do print 'no'\nlet x = expr"
+-- [Statement "y <- do print 'no'",Statement "let x = expr"]
+--
+-- >>> test "y <- do print 'no'\nlet x = expr"
+-- [Statement "y <- print 'no'",Statement "let x = expr"]
+--
+-- >>> test "print yes\nprint no"
+-- [Expression "print yes",Statement "print no"]
+
+
+-- | Parse a single cell into code blocks.
+--
+-- >>> test "let x = 3"
+-- [Statement "let x = 3"]
+--
+-- >>> test ":type hello\n:in goodbye"
+-- [Directive GetType "hello",Directive GetInfo "goodbye"]
+--
+-- >>> test "import Data.Monoid"
+-- [Import "import Data.Monoid"]
+--
+-- >>> test "3 + 5"
+-- [Expression "3 + 5"]
+parseCell :: GhcMonad m => String -> m [CodeBlock]
+parseCell codeString = concat <$> processChunks 1 [] chunks
   where
-    -- Helper function for tree conversion.
-    toTree' :: (a -> DelimType)   -- Convert list element to a tree.
-            -> Int               -- The level of the tree which is being parsed.
-            -> [[Tree a]]        -- The currently parsed branches at every level.
-                                -- The first element is a list of branches
-                                -- at the level currently being parsed, the
-                                -- second element is the branches at the
-                                -- level above, and so on.
-            -> [a]               -- Remaining tokens.
-            -> [Tree a]          -- Branches of the output tree.
-    toTree' delimType n accum (token:rest) =
-      case delimType token of
-        -- If we see an opening delimiter, go down one level.
-        -- Reset the parsed things at the current level to nothing, since
-        -- we haven't parsed any tokens. 
-        Opening -> toTree' delimType (n+1) ([] : accum) rest
-
-        -- If we see a closing parenthesis, go back up one level.
-        -- The level below just becomes a single parsed token at this level.
-        Closing -> case accum of
-          sublevel : currentLevel : uplevels -> toTree' delimType (n-1) levels rest
-            where first = Branch $ reverse sublevel
-                  currentLevelNodes = first : currentLevel
-                  levels = currentLevelNodes : uplevels
-
-        -- If we see something that isn't a delimiter, simply add it to the
-        -- current level of parsed nodes.
-        Neither -> case accum of
-          currentLevel : uplevels -> toTree' delimType n ((Leaf token : currentLevel) : uplevels) rest
-
-    -- Once done parsing, return the branches. We're done paring because
-    -- the remaining tokens are empty and because the level of the tree is
-    -- just zero (the top level).
-    toTree' _ 0 (a:_) [] = a
-
--- | Divide the code string into chunks. Each code chunk can be evaluated
--- separately.
-chunkCode :: GhcMonad m => String                        -- ^ String containing code to parse and split.
-          -> m (Either String [(String, ChunkType)])    -- ^ Either an error string or a list of code chunks.
-chunkCode codeString = do
+    chunks = splitOnDirectives [] $ lines codeString
+    parseChunk chunk line =
+      if isDirective chunk
+      then return [parseDirective chunk line]
+      else parseCell' chunk line
+
+    isDirective = startswith ":" . strip
+
+    processChunks _ results [] = return $ reverse results
+    processChunks line accum (chunk:remaining) = do
+      block <- parseChunk chunk line
+      processChunks (line + nlines chunk) (block : accum) remaining
+
+    splitOnDirectives results [] = reverse results
+    splitOnDirectives chunks (line:lines) =
+      if startswith ":" $ strip line
+      then splitOnDirectives (line : chunks) lines
+      else
+        let goodLines = takeWhile (not . startswith ":" . strip) (line:lines)
+            remaining = drop (length goodLines) (line:lines) in
+          splitOnDirectives (unlines goodLines : chunks) remaining
+
+    nlines = length . lines
+
+parseCell' :: GhcMonad m => String -> Int  -> m [CodeBlock]
+parseCell' code startLine = do
     flags <- getSessionDynFlags
-  let chunks = classifyCode flags codeString
-  return $ case chunks of
-    Right chunks -> Right $ evalState (extractDirectives chunks) $ lines codeString
-    Left str -> Left str
+    let parseResults = map tryParser (parsers flags)
+    case rights parseResults of
+      [] -> return [ParseError startLine 0 "Failed"]
+      (result, used, remaining):_ -> do
+        remainResult <- parseCell' remaining $ startLine + length (lines used)
+        return $ result : if null (strip remaining)
+                          then []
+                          else remainResult
 
   where
-    -- Get number of lines in a source span.
-    nlines :: RealSrcSpan -> Int
-    nlines span = 1 + srcLocLine (realSrcSpanEnd span) - srcLocLine (realSrcSpanStart span)
-
-    -- Extract all directives in this chunk. Convert a chunk into a list of
-    -- strings and their chunk types.
-    extractDirectives :: [CodeChunk] -> State [String] [(String, ChunkType)]
-    extractDirectives (Chunk span chunkType:rest) = do
-      spanLines <- grab $ nlines span
-      next <- extractDirectives rest
-      return $ catchDirectives spanLines chunkType ++ next
+    tryParser :: (String -> CodeBlock, String -> (Either String String, String, String)) -> Either String (CodeBlock, String, String)
+    tryParser (blockType, parser) = case parser code of
+      (Left err, _, _) -> Left err
+      (Right res, used, remaining) -> Right (blockType res, used, remaining)
+    parsers flags =
+      [ (Import,      strParser flags partialImport)
+      , (Expression,  strParser flags partialExpression)
+      , (Statement,   strParser flags partialStatement)
+      , (Declaration, lstParser flags partialDeclaration)
+      ]
+
+    lstParser :: Outputable a => DynFlags -> P (OrdList a) -> String -> (Either String String, String, String)
+    lstParser flags parser code =
+      case runParser flags parser code of
+        Left err -> (Left err, code, "")
+        Right (out, used, remainingCode) -> (Right . showSDoc flags . ppr . fromOL $ out, used, remainingCode)
+
+    strParser :: Outputable a => DynFlags -> P a -> String -> (Either String String, String, String)
+    strParser flags parser code =
+      case runParser flags parser code of
+        Left err -> (Left err, code, "")
+        Right (out, used, remainingCode) -> (Right . showSDoc flags . ppr $ out, used, remainingCode)
+
+-- | Parse a directive of the form :directiveName.
+parseDirective :: String       -- ^ Directive string.
+               -> Int          -- ^ Line number at which the directive appears.
+               -> CodeBlock    -- ^ Directive code block or a parse error.
+parseDirective (':':directive) line = case find rightDirective directives of
+  Just (directiveType, _) -> Directive directiveType arg
+    where arg = unwords restLine
+          _:restLine = words directive
+  Nothing -> ParseError line 0 $ "Unknown command: '" ++ directive ++ "'."
   where
-        catchDirectives :: [String] -> ChunkType -> [(String, ChunkType)]
-        catchDirectives codeLines chunkType = case break isDirective codeLines of
-          -- If there are no directives...
-          (allLines, []) -> [(unlines allLines, chunkType)]
-          (preLines, directiveLine:postLines) -> [(unlines preLines, chunkType), (directiveLine, Directive)] ++ catchDirectives postLines chunkType
-
-        isDirective line = startswith ":" $ strip line
-
-    extractDirectives [] = return []
-
--- | only go down one level
-treeToChunks :: Tree (Located Lexer.Token) -> [CodeChunk]
-treeToChunks = convertToChunks (convertToChunks leafToChunk)
-  where
-    convertToChunks recursion (Branch subnodes) = concatMap recursion subnodes
-    convertToChunks _ (Leaf value) = makeChunk value
-
-    leafToChunk (Leaf value) = makeChunk value
-    leafToChunk _ = []
-
-    makeChunk (L (RealSrcSpan location) token) = [Chunk location $ classifyToken token]
-    makeChunk _ = []
-
--- | Classifies a token based on what type of Haskell form it is likely to
--- be part of.  Certain tokens can mean you are in an import or in
--- a declaration.  However, you can have declarations inside expressions or
--- statements when between curly brackets. After lexing the input, lines
--- are classified based on tokens using `classifyToken` and then the
--- original input is split based on these classifications.
-classifyToken :: Lexer.Token -> ChunkType
-classifyToken tok = case tok of
-  ITclass               -> Decl 
-  ITdata                -> Decl 
-  ITdefault             -> Decl 
-  ITderiving            -> Decl 
-  IThiding              -> Decl 
-  ITimport              -> Import
-  ITinfix               -> Decl 
-  ITinfixl              -> Decl 
-  ITinfixr              -> Decl 
-  ITinstance            -> Decl 
-  ITmodule              -> Decl 
-  ITnewtype             -> Decl 
-  ITqualified           -> Import
-  ITtype                -> Decl 
-  ITwhere               -> Decl 
-  ITscc                 -> Decl 
-  ITforeign             -> Decl 
-  ITexport              -> Decl 
-  ITlabel               -> Decl  -- ?
-  ITdynamic             -> Decl 
-  ITsafe                -> Decl 
-  ITinterruptible       -> Decl 
-  ITunsafe              -> Decl 
-  ITstdcallconv         -> Decl 
-  ITccallconv           -> Decl 
-  ITcapiconv            -> Decl 
-  ITprimcallconv        -> Decl 
-  ITfamily              -> Decl 
-  ITinline_prag {}      -> Decl 
-  ITspec_prag {}        -> Decl 
-  ITspec_inline_prag {} -> Decl 
-  ITsource_prag {}      -> Decl 
-  ITrules_prag    {}    -> Decl 
-  ITwarning_prag   {}   -> Decl 
-  ITdeprecated_prag  {} -> Decl 
-  ITline_prag {}        -> Decl 
-  ITscc_prag            -> Decl 
-  ITgenerated_prag      -> Decl 
-  ITcore_prag           -> Decl 
-  ITunpack_prag         -> Decl 
-  ITnounpack_prag       -> Decl 
-  ITann_prag            -> Decl 
-  ITclose_prag          -> Decl 
-  IToptions_prag {}     -> Decl 
-  ITinclude_prag {}     -> Decl 
-  ITlanguage_prag       -> Decl 
-  ITvect_prag           -> Decl  -- ?
-  ITvect_scalar_prag    -> Decl 
-  ITnovect_prag         -> Decl 
-  ITctype               -> Decl 
-  ITdcolon              -> Decl 
-  ITequal               -> Decl 
-  ITvbar                -> Decl  -- |
-  ITdotdot              -> Expr  -- [1 .. ]
-  ITcolon               -> Expr
-  ITcase                -> Expr 
-  ITdo                  -> Expr 
-  ITelse                -> Expr 
-  ITif                  -> Expr 
-  ITin                  -> Expr 
-  ITlet                 -> Expr 
-  ITof                  -> Expr 
-  ITthen                -> Expr 
-  ITforall              -> Expr 
-  ITmdo                 -> Expr 
-  ITgroup               -> Expr  -- SQL comprehensions.
-  ITby                  -> Expr 
-  ITusing               -> Expr 
-  ITlam                 -> Expr 
-  ITlcase               -> Expr 
-  ITlarrow              -> Expr 
-  ITrarrow              -> Expr 
-  ITat                  -> Expr 
-  ITtilde               -> Expr 
-  ITtildehsh            -> Expr
-  ITdarrow              -> Expr 
-  ITminus               -> Expr 
-  ITbang                -> Expr 
-  ITstar                -> Expr 
-  ITdot                 -> Expr 
-  ITbiglam              -> Expr
-  ITocurly              -> Expr 
-  ITccurly              -> Expr 
-  ITvocurly             -> Expr 
-  ITvccurly             -> Expr 
-  ITobrack              -> Expr 
-  ITopabrack            -> Expr 
-  ITcpabrack            -> Expr 
-  ITcbrack              -> Expr 
-  IToparen              -> Expr 
-  ITcparen              -> Expr 
-  IToubxparen           -> Expr 
-  ITcubxparen           -> Expr 
-  ITsemi                -> Expr 
-  ITcomma               -> Expr 
-  ITunderscore          -> Expr 
-  ITbackquote           -> Expr 
-  ITsimpleQuote         -> Expr 
-  ITvarid {}            -> Expr 
-  ITconid {}            -> Expr 
-  ITvarsym {}           -> Expr 
-  ITconsym {}           -> Expr 
-  ITqvarid {}           -> Expr 
-  ITqconid {}           -> Expr 
-  ITqvarsym {}          -> Expr 
-  ITqconsym {}          -> Expr 
-  ITprefixqvarsym {}    -> Expr 
-  ITprefixqconsym {}    -> Expr 
-  ITdupipvarid {}       -> Expr
-  ITchar {}             -> Expr 
-  ITstring {}           -> Expr 
-  ITinteger{}           -> Expr 
-  ITrational{}          -> Expr 
-  ITprimchar {}         -> Expr 
-  ITprimstring{}        -> Expr 
-  ITprimint  {}         -> Expr 
-  ITprimword   {}       -> Expr 
-  ITprimfloat    {}     -> Expr 
-  ITprimdouble  {}      -> Expr 
-  ITopenExpQuote        -> Expr 
-  ITopenPatQuote        -> Expr 
-  ITopenDecQuote        -> Expr 
-  ITopenTypQuote        -> Expr 
-  ITcloseQuote          -> Expr 
-  ITidEscape  {}        -> Expr
-  ITparenEscape         -> Expr 
-  ITtyQuote             -> Expr 
-  ITquasiQuote {}       -> Expr 
-  ITqQuasiQuote {}      -> Expr 
-  ITproc                -> Expr 
-  ITrec                 -> Expr 
-  IToparenbar           -> Expr 
-  ITcparenbar           -> Expr 
-  ITlarrowtail          -> Expr 
-  ITrarrowtail          -> Expr 
-  ITLarrowtail          -> Expr 
-  ITRarrowtail          -> Expr 
-  ITunknown    {}       -> Expr 
-  ITeof                 -> Expr 
-  ITdocCommentNext {}   -> Expr 
-  ITdocCommentPrev {}   -> Expr 
-  ITdocCommentNamed {}  -> Expr 
-  ITdocSection {}       -> Expr 
-  ITdocOptions {}       -> Expr 
-  ITdocOptionsOld {}    -> Expr 
-  ITlineComment {}      -> Expr 
-  ITblockComment {}     -> Expr 
-  -- All constructors are listed above.
-  -- A new keyword addition to GHC will trigger a warning here.
-
--- | Runs the GHC lexer on the code string. Returns an error string or
--- a list of tokens and locations for each token.
-runLexer :: DynFlags -> String -> Either String [Located Token]
-runLexer flags codeString = toEither (lexTokenStream buffer location flags)
+    rightDirective (_, strings) = case words directive of
+      [] -> False
+      dir:_ -> dir `elem` strings
+    directives =
+      [(GetType, ["t", "ty", "typ", "type"])
+      ,(GetInfo, ["i", "in", "inf", "info"])
+      ]
+
+-- | Run a GHC parser on a string.
+runParser :: DynFlags -> P a -> String -> Either String (a, String, String)
+runParser dflags parser str = toEither (unP parser (mkPState dflags buffer location))
     where
-    -- Location displayed as the parsing location.
        filename = "<interactive>"
-    initLine = 1
-    initCol = 1
-    location  = mkRealSrcLoc (mkFastString filename) initLine initCol
-    buffer  = stringToStringBuffer codeString
+       location = mkRealSrcLoc (mkFastString filename) 1 1
+       buffer = stringToStringBuffer str
+
+       toEither (PFailed span err) = Left $ printErrorBag $ unitBag $ mkPlainErrMsg dflags span err
+       toEither (POk parseState result) = 
+         let parseEnd = loc parseState
+             endLine = srcLocLine parseEnd
+             endCol = srcLocCol parseEnd
+             (before, after) = splitAtLoc endLine endCol str in
+           Right (result, before, after)
+
+       -- Convert the bag of errors into an error string.
+       printErrorBag bag = unlines . map show $ bagToList bag
+
+-- | Split a string at a given line and column.
+--
+-- >>> splitAtLoc 2 3 "abc\ndefghi\nxyz\n123"
+-- ("abc\ndef","ghi\nxyz\n123")
+--
+-- >>> splitAtLoc 2 1 "abc"
+-- ("abc","")
+splitAtLoc :: LineNumber -> ColumnNumber -> String -> (String, String)
+splitAtLoc line col string = 
+  if line > length (lines string)
+  then (string, "")
+  else (before, after)
+  where
+    (beforeLines, afterLines) = splitAt line $ lines string
+    theLine = last beforeLines
+    (beforeChars, afterChars) = splitAt col theLine
+
+    -- Not the same as 'unlines', due to trailing \n
+    joinLines = intercalate "\n"
 
-    -- Convert a parse success or failure into an Either type.
-    toEither (PFailed span err) = Left $ printErrorBag $ unitBag $ mkPlainErrMsg flags span err
-    toEither (POk _ tokens) = Right tokens
-    printErrorBag bag = unlines $ map show $ bagToList bag
+    before = joinLines (init beforeLines) ++ '\n' : beforeChars
+    after = afterChars ++ '\n' : joinLines afterLines

IHaskell/IPython.hs

+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
 -- | Description : Shell scripting wrapper using @Shelly@ for the @notebook@, @setup@, and
 --                 @console@ commands.
 module IHaskell.IPython (
   runIHaskell,
   setupIPythonProfile,
-  ipythonVersion
+  ipythonVersion,
+  parseVersion
 ) where
 
 import ClassyPrelude
@@ -19,6 +21,10 @@ import qualified System.IO.Strict as StrictIO
 
 import qualified IHaskell.Config as Config
 
+-- $setup
+-- >>> import ClassyPrelude
+-- >>> import IHaskell.IPython
+
 -- | Run IPython with any arguments.
 ipython :: Bool         -- ^ Whether to suppress output.
         -> [Text]       -- ^ IPython command line arguments.
@@ -44,13 +50,10 @@ ipythonVersion = shelly $ do
   [major, minor, patch] <- parseVersion <$>  ipython True ["--version"]
   return (major, minor, patch)
 
-{- |
-
->>> parseVersion `map` ["2.0.0-dev", "2.0.0-alpha", "12.5.10"]
-[[2,0,0],[2,0,0],[12,5,10]]
-
-
--}
+-- | Parse an IPython version string into a list of integers.
+--
+-- >>> parseVersion `map` ["2.0.0-dev", "2.0.0-alpha", "12.5.10"]
+-- [[2,0,0],[2,0,0],[12,5,10]]
 parseVersion :: String -> [Int]
 parseVersion versionStr = map read' $ split "." versionStr
     where read' x = case reads x of

IHaskell/Message/UUID.hs

+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
 -- | Description : UUID generator and data structure
 --
 -- Generate, parse, and pretty print UUIDs for use with IPython.

IHaskell/Message/Writer.hs

+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
 {-# LANGUAGE CPP #-}
 -- | Description : @ToJSON@ for Messages
 --
@@ -18,6 +19,7 @@ ghcVersionInts :: [Int]
 ghcVersionInts = ints . map read . words . map dotToSpace $ (VERSION_ghc :: String)
   where dotToSpace '.' = ' '
         dotToSpace x = x
+--ghcVersionInts = [7,6,3]
 
 -- Convert message bodies into JSON.
 instance ToJSON Message where

IHaskell/ZeroMQ.hs

+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
 -- | Description : Low-level ZeroMQ communication wrapper.
 --
 -- The "ZeroMQ" module abstracts away the low-level 0MQ based interface with IPython,

rundoctests.hs

+{-# LANGUAGE OverloadedStrings #-}
 import System.Process
-import System.Exit
-import System.IO
 import Test.DocTest
-import Data.Char
 import System.Environment
+import Data.String.Utils
 
 -- | tests that all the >>> comments are followed by correct output. Easiest is to
 --
@@ -18,17 +17,24 @@ import System.Environment
 -- > runghc examples/rundoctests.hs Data/HList/File1.hs Data/HList/File2.hs
 --
 -- you need Cabal >= 1.18 since that's around when cabal repl got added.
+main :: IO ()
 main = do
-    as <- getArgs
-    o <- readProcess
-        "cabal" ["repl","--ghc-options","-v0 -w"]
-        ":show packages\n:show language"
-    let flags = words $ unlines $ filter ((=="-") . take 1 . dropWhile isSpace)
-                    $ lines o
+    -- Get files to run on.
+    args <- getArgs
 
-    let files = case as of
+    -- Get flags via cabal repl.
+    let cabalCmds = unlines [":show packages", ":show language"]
+        cabalOpts = ["repl","--ghc-options","-v0 -w"]
+    options <- readProcess "cabal" cabalOpts cabalCmds
+    let extraFlags = ["-fobject-code", "-XNoImplicitPrelude"]
+        flags = words (unlines $ filter (startswith "-" . strip) $ lines options) ++ extraFlags
+
+    let files = case args of
             [] -> ["Main.hs"]
-            _ -> as
+            _ -> args
+    putStrLn "Testing:\n--------"
+    mapM_ putStrLn files
+    putStr "\n"
 
     doctest $ "-i.": "-idist/build/autogen":
              "-optP-include":