mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-16 03:16:20 +00:00
Capture intermediate results and display them
This commit is contained in:
Andrew Gibiansky
parent
de493373b4
commit
6c404483bc
@ -12,7 +12,7 @@
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"data Value = X Int\n",
|
||||
"data X = X Int\n",
|
||||
" | Y String\n",
|
||||
" | Z Float\n",
|
||||
" deriving Show\n",
|
||||
@ -95,12 +95,20 @@
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"import Prel"
|
||||
"1"
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [],
|
||||
"prompt_number": 1
|
||||
"outputs": [
|
||||
{
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"1"
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 4
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -111,7 +119,7 @@
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [],
|
||||
"prompt_number": 1
|
||||
"prompt_number": 5
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -121,7 +129,20 @@
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [],
|
||||
"outputs": [
|
||||
{
|
||||
"html": [
|
||||
"<span style='color: red; font-style: italic;'>Not in scope: `ma'<br/>Perhaps you meant one of these:<br/> `map' (imported from Prelude), `max' (imported from Prelude)</span>"
|
||||
],
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"Not in scope: `ma'\n",
|
||||
"Perhaps you meant one of these:\n",
|
||||
" `map' (imported from Prelude), `max' (imported from Prelude)"
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 6
|
||||
},
|
||||
{
|
||||
@ -168,38 +189,30 @@
|
||||
"outputs": [
|
||||
{
|
||||
"html": [
|
||||
"<span style='color: red; font-style: italic;'>No instance for (Show X)<br/> arising from a use of `print'<br/>Possible fix:<br/> add an instance declaration for (Show X)</span>"
|
||||
"<span style='color: red; font-style: italic;'>No instance for (Num String)<br/> arising from the literal `3'<br/>Possible fix:<br/> add an instance declaration for (Num String)</span>"
|
||||
],
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"No instance for (GHC.Show.Show :Interactive.X)\n",
|
||||
" arising from a use of `System.IO.print'\n",
|
||||
"No instance for (GHC.Num.Num GHC.Base.String)\n",
|
||||
" arising from the literal `3'\n",
|
||||
"Possible fix:\n",
|
||||
" add an instance declaration for (GHC.Show.Show :Interactive.X)"
|
||||
" add an instance declaration for (GHC.Num.Num GHC.Base.String)"
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 9
|
||||
"prompt_number": 2
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"1+1"
|
||||
"data X = Y Int"
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"2"
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 10
|
||||
"outputs": [],
|
||||
"prompt_number": 14
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -210,7 +223,7 @@
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [],
|
||||
"prompt_number": 11
|
||||
"prompt_number": 18
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -222,14 +235,20 @@
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"html": [
|
||||
"<span style='color: red; font-style: italic;'>No instance for (Num String)<br/> arising from the literal `3'<br/>Possible fix:<br/> add an instance declaration for (Num String)</span>"
|
||||
],
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"Y 3"
|
||||
"No instance for (GHC.Num.Num GHC.Base.String)\n",
|
||||
" arising from the literal `3'\n",
|
||||
"Possible fix:\n",
|
||||
" add an instance declaration for (GHC.Num.Num GHC.Base.String)"
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 12
|
||||
"prompt_number": 19
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -240,7 +259,7 @@
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [],
|
||||
"prompt_number": 13
|
||||
"prompt_number": 20
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -262,7 +281,7 @@
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 14
|
||||
"prompt_number": 21
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -284,7 +303,7 @@
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 15
|
||||
"prompt_number": 22
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -306,7 +325,7 @@
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 16
|
||||
"prompt_number": 23
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -317,7 +336,7 @@
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [],
|
||||
"prompt_number": 17
|
||||
"prompt_number": 24
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -338,13 +357,13 @@
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 18
|
||||
"prompt_number": 25
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"m"
|
||||
":extension OverloadedStrings"
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
@ -408,79 +427,39 @@
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"forM_ [100, 200, 300, 400, 500, 600, 700, 800] $ \\size -> do\n",
|
||||
" let s = show size\n",
|
||||
" img ! src \"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" ! width (toValue s)\n",
|
||||
":t y\n",
|
||||
"y"
|
||||
" let s = show size\n",
|
||||
" unsafePerformIO $ do\n",
|
||||
" threadDelay 100000\n",
|
||||
" putStrLn $ \"Generating size: \" ++ s\n",
|
||||
" return $ img ! src \"/static/base/images/ipynblogo.png\" ! width (toValue s)"
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"html": [
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"100\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"200\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"300\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"400\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"500\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"600\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"700\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"800\">\n"
|
||||
"<span style='color: red; font-style: italic;'>Not in scope: `unsafePerformIO'<br/>Not in scope: `threadDelay'</span>"
|
||||
],
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"100\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"200\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"300\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"400\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"500\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"600\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"700\">\n",
|
||||
"<img src=\"http://127.0.0.1:8693/static/base/images/ipynblogo.png\" width=\"800\">"
|
||||
]
|
||||
},
|
||||
{
|
||||
"html": [
|
||||
"<span style='color: red; font-style: italic;'>Not in scope: `y'</span>"
|
||||
],
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"Not in scope: `y'"
|
||||
"Not in scope: `unsafePerformIO'\n",
|
||||
"Not in scope: `threadDelay'"
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 3
|
||||
"prompt_number": 4
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"let y = forM (map (* 10) [1..40]) $ \\size -> do\n",
|
||||
" let s = show size\n",
|
||||
" Text.Blaze.Html4.Strict.div ! Text.Blaze.Html4.Strict.style \"bar\" $ \"Hello.\"\n",
|
||||
" img ! src \"http://127.0.0.1:8800/static/base/images/ipynblogo.png\" ! width (toValue s)\n",
|
||||
"y"
|
||||
"import System.IO.Unsafe"
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"html": [
|
||||
"<span style='color: red; font-style: italic;'>Couldn't match type `Text.Blaze.Internal.MarkupM ()'<br/> with `Text.Blaze.Internal.Attribute'<br/>Expected type: Text.Blaze.Internal.Attribute<br/> Actual type: Text.Blaze.Html.Html</span>"
|
||||
],
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"Couldn't match type `Text.Blaze.Internal.MarkupM ()'\n",
|
||||
" with `Text.Blaze.Internal.Attribute'\n",
|
||||
"Expected type: Text.Blaze.Internal.Attribute\n",
|
||||
" Actual type: Text.Blaze.Html.Html"
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 25
|
||||
"outputs": [],
|
||||
"prompt_number": 8
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -518,7 +497,7 @@
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 58
|
||||
"prompt_number": 8
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
@ -575,6 +554,128 @@
|
||||
],
|
||||
"prompt_number": 61
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"import Control.Concurrent\n",
|
||||
"import Control.Monad\n",
|
||||
"\n",
|
||||
"forM_ [1..10] $ \\x -> do \n",
|
||||
" print x\n",
|
||||
" threadDelay 100000"
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"1\n",
|
||||
"2\n",
|
||||
"3\n",
|
||||
"4\n",
|
||||
"5\n",
|
||||
"6\n",
|
||||
"7\n",
|
||||
"8\n",
|
||||
"9\n",
|
||||
"10"
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 5
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"3"
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"3"
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 6
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"data Thing = One Int | Two String deriving Show\n",
|
||||
"One 3"
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"html": [
|
||||
"<span style='color: red; font-style: italic;'>No instance for (Show Thing)<br/> arising from a use of `print'<br/>Possible fix:<br/> add an instance declaration for (Show Thing)</span>"
|
||||
],
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"No instance for (GHC.Show.Show :Interactive.Thing)\n",
|
||||
" arising from a use of `System.IO.print'\n",
|
||||
"Possible fix:\n",
|
||||
" add an instance declaration for (GHC.Show.Show :Interactive.Thing)"
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 4
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"Two \"hello\""
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"Two \"hello\""
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 5
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"One 3"
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"html": [
|
||||
"<span style='color: red; font-style: italic;'>No instance for (Show Thing)<br/> arising from a use of `print'<br/>Possible fix:<br/> add an instance declaration for (Show Thing)</span>"
|
||||
],
|
||||
"metadata": {},
|
||||
"output_type": "display_data",
|
||||
"text": [
|
||||
"No instance for (GHC.Show.Show :Interactive.Thing)\n",
|
||||
" arising from a use of `System.IO.print'\n",
|
||||
"Possible fix:\n",
|
||||
" add an instance declaration for (GHC.Show.Show :Interactive.Thing)"
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 6
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
|
||||
2
Hspec.hs
2
Hspec.hs
@ -29,7 +29,7 @@ is string blockType = do
|
||||
|
||||
eval string = do
|
||||
outputAccum <- newIORef []
|
||||
let publish displayDatas = liftIO $ modifyIORef outputAccum (displayDatas :)
|
||||
let publish _ displayDatas = modifyIORef outputAccum (displayDatas :)
|
||||
getTemporaryDirectory >>= setCurrentDirectory
|
||||
interpret $ evaluate 1 string publish
|
||||
out <- readIORef outputAccum
|
||||
|
||||
@ -56,6 +56,7 @@ extra-source-files:
|
||||
|
||||
library
|
||||
build-depends: base ==4.6.*,
|
||||
unix >= 2.6,
|
||||
hspec,
|
||||
zeromq3-haskell ==0.5.*,
|
||||
aeson ==0.6.*,
|
||||
@ -113,6 +114,7 @@ executable IHaskell
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base ==4.6.*,
|
||||
unix >= 2.6,
|
||||
hspec,
|
||||
zeromq3-haskell ==0.5.*,
|
||||
aeson ==0.6.*,
|
||||
@ -143,6 +145,7 @@ Test-Suite hspec
|
||||
Ghc-Options: -threaded
|
||||
Main-Is: Hspec.hs
|
||||
build-depends: base ==4.6.*,
|
||||
unix >= 2.6,
|
||||
hspec,
|
||||
zeromq3-haskell ==0.5.*,
|
||||
aeson ==0.6.*,
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
module IHaskell.Eval.Completion (complete, completionTarget, completionType, CompletionType(..)) where
|
||||
|
||||
import Prelude
|
||||
import Data.List (find, isPrefixOf, nub, findIndex, intercalate)
|
||||
import Data.List (find, isPrefixOf, nub, findIndex, intercalate, elemIndex)
|
||||
import GHC
|
||||
import GhcMonad
|
||||
import PackageConfig
|
||||
@ -53,7 +53,7 @@ complete line pos = do
|
||||
|
||||
let Just db = pkgDatabase flags
|
||||
getNames = map moduleNameString . exposedModules
|
||||
moduleNames = nub $ concat $ map getNames db
|
||||
moduleNames = nub $ concatMap getNames db
|
||||
|
||||
let target = completionTarget line pos
|
||||
matchedText = intercalate "." target
|
||||
@ -97,19 +97,17 @@ getTrueModuleName name = do
|
||||
|
||||
completionType :: String -> [String] -> CompletionType
|
||||
completionType line [] = Empty
|
||||
completionType line target =
|
||||
if startswith "import" (strip line) && isModName
|
||||
then ModuleName dotted candidate
|
||||
else
|
||||
if isModName && (not . null . init) target
|
||||
then Qualified dotted candidate
|
||||
else Identifier candidate
|
||||
where
|
||||
dotted = dots target
|
||||
candidate = last target
|
||||
dots = intercalate "." . init
|
||||
isModName = all isCapitalized (init target)
|
||||
isCapitalized = isUpper . head
|
||||
completionType line target
|
||||
| startswith "import" (strip line) && isModName =
|
||||
ModuleName dotted candidate
|
||||
| isModName && (not . null . init) target =
|
||||
Qualified dotted candidate
|
||||
| otherwise = Identifier candidate
|
||||
where dotted = dots target
|
||||
candidate = last target
|
||||
dots = intercalate "." . init
|
||||
isModName = all isCapitalized (init target)
|
||||
isCapitalized = isUpper . head
|
||||
|
||||
|
||||
-- | Get the word under a given cursor location.
|
||||
@ -132,7 +130,7 @@ completionTarget code cursor = expandCompletionPiece pieceToComplete
|
||||
splitAlongCursor :: [[(Char, Int)]] -> [[(Char, Int)]]
|
||||
splitAlongCursor [] = []
|
||||
splitAlongCursor (x:xs) =
|
||||
case findIndex (== cursor) $ map snd x of
|
||||
case elemIndex cursor $ map snd x of
|
||||
Nothing -> x:splitAlongCursor xs
|
||||
Just idx -> take (idx + 1) x:drop (idx + 1) x:splitAlongCursor xs
|
||||
|
||||
|
||||
@ -9,6 +9,7 @@ module IHaskell.Eval.Evaluate (
|
||||
) where
|
||||
|
||||
import ClassyPrelude hiding (liftIO, hGetContents)
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Prelude (putChar, head, tail, last, init, (!!))
|
||||
import Data.List.Utils
|
||||
import Data.List(findIndex)
|
||||
@ -19,9 +20,11 @@ import Data.Dynamic
|
||||
import Data.Typeable
|
||||
import qualified Data.Serialize as Serialize
|
||||
import System.Directory (removeFile, createDirectoryIfMissing, removeDirectoryRecursive)
|
||||
import System.Posix.IO
|
||||
import System.IO (hGetChar, hFlush)
|
||||
import System.Random (getStdGen, randomRs)
|
||||
|
||||
import NameSet
|
||||
import DynFlags (defaultObjectTarget)
|
||||
import Name
|
||||
import PprTyThing
|
||||
import InteractiveEval
|
||||
@ -63,31 +66,6 @@ typeCleaner = useStringType . foldl' (.) id (map (`replace` "") fullPrefixes)
|
||||
fullPrefixes = map (++ ".") ignoreTypePrefixes
|
||||
useStringType = replace "[Char]" "String"
|
||||
|
||||
makeWrapperStmts :: (String, [String], [String])
|
||||
makeWrapperStmts = (fileName, initStmts, postStmts)
|
||||
where
|
||||
randStr = "1345964344725219474" :: String
|
||||
fileVariable = "file_var_" ++ randStr
|
||||
oldVariable = fileVariable ++ "_old"
|
||||
itVariable = "it_var_" ++ randStr
|
||||
fileName = ".ihaskell_capture"
|
||||
|
||||
initStmts :: [String]
|
||||
initStmts = [
|
||||
printf "let %s = it" itVariable,
|
||||
printf "%s <- openFile \"%s\" WriteMode" fileVariable fileName,
|
||||
printf "%s <- hDuplicate stdout" oldVariable,
|
||||
printf "hDuplicateTo %s stdout" fileVariable,
|
||||
printf "let it = %s" itVariable]
|
||||
|
||||
postStmts :: [String]
|
||||
postStmts = [
|
||||
printf "let %s = it" itVariable,
|
||||
"hFlush stdout",
|
||||
printf "hDuplicateTo %s stdout" oldVariable,
|
||||
printf "hClose %s" fileVariable,
|
||||
printf "let it = %s" itVariable]
|
||||
|
||||
write :: GhcMonad m => String -> m ()
|
||||
write x = when debug $ liftIO $ hPutStrLn stderr x
|
||||
|
||||
@ -98,6 +76,8 @@ globalImports =
|
||||
[ "import IHaskell.Display"
|
||||
, "import Control.Applicative ((<$>))"
|
||||
, "import GHC.IO.Handle (hDuplicateTo, hDuplicate)"
|
||||
, "import System.Posix.IO"
|
||||
, "import System.Posix.Files"
|
||||
, "import System.IO"
|
||||
]
|
||||
|
||||
@ -156,10 +136,14 @@ initializeItVariable =
|
||||
-- statements - if it doesn't exist, the first statement will fail.
|
||||
void $ runStmt "let it = ()" RunToCompletion
|
||||
|
||||
-- | Publisher for IHaskell outputs. The first argument indicates whether
|
||||
-- this output is final (true) or intermediate (false).
|
||||
type Publisher = (Bool -> [DisplayData] -> IO ())
|
||||
|
||||
-- | Evaluate some IPython input code.
|
||||
evaluate :: Int -- ^ The execution counter of this evaluation.
|
||||
-> String -- ^ Haskell code or other interpreter commands.
|
||||
-> ([DisplayData] -> Interpreter ()) -- ^ Function used to publish data outputs.
|
||||
evaluate :: Int -- ^ The execution counter of this evaluation.
|
||||
-> String -- ^ Haskell code or other interpreter commands.
|
||||
-> Publisher -- ^ Function used to publish data outputs.
|
||||
-> Interpreter ()
|
||||
evaluate execCount code output = do
|
||||
cmds <- parseString (strip code)
|
||||
@ -168,8 +152,8 @@ evaluate execCount code output = do
|
||||
runUntilFailure :: [CodeBlock] -> Interpreter ()
|
||||
runUntilFailure [] = return ()
|
||||
runUntilFailure (cmd:rest) = do
|
||||
(success, result) <- evalCommand cmd
|
||||
unless (null result) $ output result
|
||||
(success, result) <- evalCommand output cmd
|
||||
unless (null result) $ liftIO $ output True result
|
||||
case success of
|
||||
Success -> runUntilFailure rest
|
||||
Failure -> return ()
|
||||
@ -185,8 +169,8 @@ wrapExecution exec = ghandle handler $ exec >>= \res ->
|
||||
|
||||
-- | Return the display data for this command, as well as whether it
|
||||
-- resulted in an error.
|
||||
evalCommand :: CodeBlock -> Interpreter (ErrorOccurred, [DisplayData])
|
||||
evalCommand (Import importStr) = wrapExecution $ do
|
||||
evalCommand :: Publisher -> CodeBlock -> Interpreter (ErrorOccurred, [DisplayData])
|
||||
evalCommand _ (Import importStr) = wrapExecution $ do
|
||||
write $ "Import: " ++ importStr
|
||||
importDecl <- parseImportDecl importStr
|
||||
context <- getContext
|
||||
@ -202,7 +186,7 @@ evalCommand (Import importStr) = wrapExecution $ do
|
||||
implicitImportOf _ (IIModule _) = False
|
||||
implicitImportOf imp (IIDecl decl) = ideclImplicit decl && ((==) `on` (unLoc . ideclName)) decl imp
|
||||
|
||||
evalCommand (Module contents) = wrapExecution $ do
|
||||
evalCommand _ (Module contents) = wrapExecution $ do
|
||||
-- Write the module contents to a temporary file in our work directory
|
||||
namePieces <- getModuleName contents
|
||||
let directory = "./" ++ intercalate "/" (init namePieces) ++ "/"
|
||||
@ -270,7 +254,7 @@ evalCommand (Module contents) = wrapExecution $ do
|
||||
Succeeded -> return []
|
||||
Failed -> return $ displayError $ "Failed to load module " ++ modName
|
||||
|
||||
evalCommand (Directive SetExtension exts) = wrapExecution $ do
|
||||
evalCommand _ (Directive SetExtension exts) = wrapExecution $ do
|
||||
results <- mapM setExtension (words exts)
|
||||
case catMaybes results of
|
||||
[] -> return []
|
||||
@ -304,14 +288,14 @@ evalCommand (Directive SetExtension exts) = wrapExecution $ do
|
||||
-- In that case, we disable the extension.
|
||||
flagMatchesNo ext (name, _, _) = ext == "No" ++ name
|
||||
|
||||
evalCommand (Directive GetType expr) = wrapExecution $ do
|
||||
evalCommand _ (Directive GetType expr) = wrapExecution $ do
|
||||
result <- exprType expr
|
||||
flags <- getSessionDynFlags
|
||||
let typeStr = showSDocUnqual flags $ ppr result
|
||||
return [plain typeStr, html $ formatGetType typeStr]
|
||||
|
||||
-- This is taken largely from GHCi's info section in InteractiveUI.
|
||||
evalCommand (Directive HelpForSet _) = return (Success, [out])
|
||||
evalCommand _ (Directive HelpForSet _) = return (Success, [out])
|
||||
where out = plain $ intercalate "\n"
|
||||
[":set is not implemented in IHaskell."
|
||||
," Use :extension <Extension> to enable a GHC extension."
|
||||
@ -319,7 +303,7 @@ evalCommand (Directive HelpForSet _) = return (Success, [out])
|
||||
]
|
||||
|
||||
-- This is taken largely from GHCi's info section in InteractiveUI.
|
||||
evalCommand (Directive GetHelp _) = return (Success, [out])
|
||||
evalCommand _ (Directive GetHelp _) = return (Success, [out])
|
||||
where out = plain $ intercalate "\n"
|
||||
["The following commands are available:"
|
||||
," :extension <Extension> - enable a GHC extension."
|
||||
@ -332,7 +316,7 @@ evalCommand (Directive GetHelp _) = return (Success, [out])
|
||||
]
|
||||
|
||||
-- This is taken largely from GHCi's info section in InteractiveUI.
|
||||
evalCommand (Directive GetInfo str) = wrapExecution $ do
|
||||
evalCommand _ (Directive GetInfo str) = wrapExecution $ do
|
||||
-- Get all the info for all the names we're given.
|
||||
names <- parseName str
|
||||
maybeInfos <- mapM getInfo names
|
||||
@ -363,10 +347,11 @@ evalCommand (Directive GetInfo str) = wrapExecution $ do
|
||||
let strings = map (showSDocForUser flags unqual) outs
|
||||
return [plain $ intercalate "\n" strings]
|
||||
|
||||
evalCommand (Statement stmt) = do
|
||||
evalCommand output (Statement stmt) = do
|
||||
write $ "Statement: " ++ stmt
|
||||
ghandle handler $ do
|
||||
(printed, result) <- capturedStatement stmt
|
||||
let outputter str = output False [plain str]
|
||||
(printed, result) <- capturedStatement outputter stmt
|
||||
case result of
|
||||
RunOk names -> do
|
||||
dflags <- getSessionDynFlags
|
||||
@ -383,16 +368,12 @@ evalCommand (Statement stmt) = do
|
||||
handler exception = do
|
||||
write $ concat ["BreakCom: ", show exception, "\nfrom statement:\n", stmt]
|
||||
|
||||
-- Close the file handle we opened for writing stdout and other cleanup.
|
||||
let (_, _, postStmts) = makeWrapperStmts
|
||||
forM_ postStmts $ \s -> runStmt s RunToCompletion
|
||||
|
||||
return (Failure, displayError $ show exception)
|
||||
|
||||
evalCommand (Expression expr) = do
|
||||
evalCommand output (Expression expr) = do
|
||||
-- Evaluate this expression as though it's just a statement.
|
||||
-- The output is bound to 'it', so we can then use it.
|
||||
(success, out) <- evalCommand (Statement expr)
|
||||
(success, out) <- evalCommand output (Statement expr)
|
||||
|
||||
-- Try to use `display` to convert our type into the output
|
||||
-- DisplayData. If typechecking fails and there is no appropriate
|
||||
@ -427,7 +408,7 @@ evalCommand (Expression expr) = do
|
||||
startswith "No instance for (GHC.Show.Show " msg &&
|
||||
isInfixOf " arising from a use of `System.IO.print'" msg
|
||||
Nothing -> False
|
||||
where isPlain (Display mime _) = (mime == PlainText)
|
||||
where isPlain (Display mime _) = mime == PlainText
|
||||
|
||||
useDisplay displayExpr = wrapExecution $ do
|
||||
-- If there are instance matches, convert the object into
|
||||
@ -449,27 +430,143 @@ evalCommand (Expression expr) = do
|
||||
return displayData
|
||||
|
||||
|
||||
evalCommand (Declaration decl) = wrapExecution $ runDecls decl >> return []
|
||||
evalCommand _ (Declaration decl) = wrapExecution $ runDecls decl >> return []
|
||||
|
||||
evalCommand (ParseError loc err) = wrapExecution $
|
||||
evalCommand _ (ParseError loc err) = wrapExecution $
|
||||
return $ displayError $ formatParseError loc err
|
||||
|
||||
capturedStatement :: String -> Interpreter (String, RunResult)
|
||||
capturedStatement stmt = do
|
||||
capturedStatement :: (String -> IO ()) -- ^ Function used to publish intermediate output.
|
||||
-> String -- ^ Statement to evaluate.
|
||||
-> Interpreter (String, RunResult) -- ^ Return the output and result.
|
||||
capturedStatement output stmt = do
|
||||
-- Generate random variable names to use so that we cannot accidentally
|
||||
-- override the variables by using the right names in the terminal.
|
||||
let (fileName, initStmts, postStmts) = makeWrapperStmts
|
||||
goStmt s = runStmt s RunToCompletion
|
||||
gen <- liftIO getStdGen
|
||||
let
|
||||
-- Variable names generation.
|
||||
rand = take 20 $ randomRs ('0', '9') gen
|
||||
var name = name ++ rand
|
||||
|
||||
-- Variables for the pipe input and outputs.
|
||||
readVariable = var "file_read_var_"
|
||||
writeVariable = var "file_write_var_"
|
||||
|
||||
-- Variable where to store old stdout.
|
||||
oldVariable = var "old_var_"
|
||||
|
||||
-- Variable used to store true `it` value.
|
||||
itVariable = var "it_var_"
|
||||
|
||||
voidpf str = printf $ str ++ " >> return ()"
|
||||
|
||||
-- Statements run before the thing we're evaluating.
|
||||
initStmts =
|
||||
[ printf "let %s = it" itVariable
|
||||
, printf "(%s, %s) <- createPipe" readVariable writeVariable
|
||||
, printf "%s <- dup stdOutput" oldVariable
|
||||
, voidpf "dupTo %s stdOutput" writeVariable
|
||||
, voidpf "hSetBuffering stdout NoBuffering"
|
||||
, printf "let it = %s" itVariable
|
||||
]
|
||||
|
||||
-- Statements run after evaluation.
|
||||
postStmts =
|
||||
[ printf "let %s = it" itVariable
|
||||
, voidpf "hFlush stdout"
|
||||
, voidpf "dupTo %s stdOutput" oldVariable
|
||||
, voidpf "closeFd %s" writeVariable
|
||||
, printf "let it = %s" itVariable
|
||||
]
|
||||
|
||||
goStmt s = runStmt s RunToCompletion
|
||||
|
||||
-- Initialize evaluation context.
|
||||
forM_ initStmts goStmt
|
||||
result <- goStmt stmt
|
||||
forM_ postStmts goStmt
|
||||
|
||||
-- We must use strict IO, because we write to that file again if we
|
||||
-- execute more statements. If we read lazily, we may cause errors when
|
||||
-- trying to open the file for writing later.
|
||||
printedOutput <- liftIO $ StrictIO.readFile fileName
|
||||
-- Get the pipe to read printed output from.
|
||||
dynPipe <- dynCompileExpr readVariable
|
||||
pipe <- case fromDynamic dynPipe of
|
||||
Nothing -> error "Expecting lazy Bytestring"
|
||||
Just fd -> liftIO $ fdToHandle fd
|
||||
|
||||
-- Read from a file handle until we hit a delimieter or until we've read
|
||||
-- as many characters as requested
|
||||
let
|
||||
readChars :: Handle -> String -> Int -> IO String
|
||||
|
||||
-- If we're done reading, return nothing.
|
||||
readChars handle delims 0 = return []
|
||||
|
||||
readChars handle delims nchars = do
|
||||
-- Try reading a single character. It will throw an exception if the
|
||||
-- handle is already closed.
|
||||
tryRead <- gtry $ hGetChar handle :: IO (Either SomeException Char)
|
||||
case tryRead of
|
||||
Right char ->
|
||||
-- If this is a delimiter, stop reading.
|
||||
if char `elem` delims
|
||||
then return [char]
|
||||
else do
|
||||
next <- readChars handle delims (nchars - 1)
|
||||
return $ char:next
|
||||
-- An error occurs at the end of the stream, so just stop reading.
|
||||
Left _ -> return []
|
||||
|
||||
-- Keep track of whether execution has completed.
|
||||
completed <- liftIO $ newMVar False
|
||||
finishedReading <- liftIO newEmptyMVar
|
||||
outputAccum <- liftIO $ newMVar ""
|
||||
|
||||
-- Start a loop to publish intermediate results.
|
||||
let
|
||||
-- Compute how long to wait between reading pieces of the output.
|
||||
-- `threadDelay` takes an argument of microseconds.
|
||||
ms = 1000
|
||||
delay = 100 * ms
|
||||
|
||||
-- How much to read each time.
|
||||
chunkSize = 100
|
||||
|
||||
-- Maximum size of the output (after which we truncate).
|
||||
maxSize = 100 * 1000
|
||||
|
||||
loop = do
|
||||
-- Wait and then check if the computation is done.
|
||||
threadDelay delay
|
||||
computationDone <- readMVar completed
|
||||
|
||||
if not computationDone
|
||||
then do
|
||||
-- Read next chunk and append to accumulator.
|
||||
nextChunk <- readChars pipe "\n" 100
|
||||
modifyMVar_ outputAccum (return . (++ nextChunk))
|
||||
|
||||
-- Write to frontend and repeat.
|
||||
readMVar outputAccum >>= output
|
||||
loop
|
||||
else do
|
||||
-- Read remainder of output and accumulate it.
|
||||
nextChunk <- readChars pipe "" maxSize
|
||||
modifyMVar_ outputAccum (return . (++ nextChunk))
|
||||
|
||||
-- We're done reading.
|
||||
putMVar finishedReading True
|
||||
|
||||
liftIO $ forkIO loop
|
||||
|
||||
result <- gfinally (goStmt stmt) $ do
|
||||
-- Execution is done.
|
||||
liftIO $ modifyMVar_ completed (const $ return True)
|
||||
|
||||
-- Finalize evaluation context.
|
||||
forM_ postStmts goStmt
|
||||
|
||||
-- Once context is finalized, reading can finish.
|
||||
-- Wait for reading to finish to that the output accumulator is
|
||||
-- completely filled.
|
||||
liftIO $ takeMVar finishedReading
|
||||
|
||||
printedOutput <- liftIO $ readMVar outputAccum
|
||||
return (printedOutput, result)
|
||||
|
||||
formatError :: ErrMsg -> String
|
||||
|
||||
@ -1,6 +1,4 @@
|
||||
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{- | Description : Inspect type and function information and documentation.
|
||||
-}
|
||||
module IHaskell.Eval.Info (
|
||||
|
||||
@ -81,6 +81,10 @@ instance ToJSON Message where
|
||||
"restart" .= restart
|
||||
]
|
||||
|
||||
toJSON ClearOutput{wait = wait} = object [
|
||||
"wait" .= wait
|
||||
]
|
||||
|
||||
|
||||
toJSON body = error $ "Do not know how to convert to JSON for message " ++ show body
|
||||
|
||||
|
||||
@ -108,6 +108,7 @@ data MessageType = KernelInfoReplyMessage
|
||||
| ObjectInfoReplyMessage
|
||||
| ShutdownRequestMessage
|
||||
| ShutdownReplyMessage
|
||||
| ClearOutputMessage
|
||||
|
||||
instance Show MessageType where
|
||||
show KernelInfoReplyMessage = "kernel_info_reply"
|
||||
@ -125,6 +126,7 @@ instance Show MessageType where
|
||||
show ObjectInfoReplyMessage = "object_info_reply"
|
||||
show ShutdownRequestMessage = "shutdown_request"
|
||||
show ShutdownReplyMessage = "shutdown_reply"
|
||||
show ClearOutputMessage = "clear_output"
|
||||
|
||||
instance FromJSON MessageType where
|
||||
parseJSON (String s) = case s of
|
||||
@ -143,6 +145,7 @@ instance FromJSON MessageType where
|
||||
"object_info_reply" -> return ObjectInfoReplyMessage
|
||||
"shutdown_request" -> return ShutdownRequestMessage
|
||||
"shutdown_reply" -> return ShutdownReplyMessage
|
||||
"clear_output" -> return ClearOutputMessage
|
||||
|
||||
_ -> fail ("Unknown message type: " ++ show s)
|
||||
parseJSON _ = fail "Must be a string."
|
||||
@ -222,22 +225,7 @@ data Message
|
||||
completionText :: ByteString,
|
||||
completionStatus :: Bool
|
||||
}
|
||||
{- ^
|
||||
# The list of all matches to the completion request, such as
|
||||
# ['a.isalnum', 'a.isalpha'] for the above example.
|
||||
'matches' : list,
|
||||
|
||||
# the substring of the matched text
|
||||
# this is typically the common prefix of the matches,
|
||||
# and the text that is already in the block that would be replaced by the full completion.
|
||||
# This would be 'a.is' in the above example.
|
||||
'text' : str,
|
||||
|
||||
# status should be 'ok' unless an exception was raised during the request,
|
||||
# in which case it should be 'error', along with the usual error message content
|
||||
# in other messages.
|
||||
'status' : 'ok'
|
||||
} -}
|
||||
| ObjectInfoRequest {
|
||||
header :: MessageHeader,
|
||||
objectName :: ByteString, -- ^ Name of object being searched for.
|
||||
@ -245,6 +233,7 @@ data Message
|
||||
-- 0 is equivalent to foo?, 1 is equivalent
|
||||
-- to foo??.
|
||||
}
|
||||
|
||||
| ObjectInfoReply {
|
||||
header :: MessageHeader,
|
||||
objectName :: ByteString, -- ^ Name of object which was searched for.
|
||||
@ -262,6 +251,11 @@ data Message
|
||||
restartPending :: Bool -- ^ Whether this shutdown precedes a restart.
|
||||
}
|
||||
|
||||
| ClearOutput {
|
||||
header :: MessageHeader,
|
||||
wait :: Bool -- ^ Whether to wait to redraw until there is more output.
|
||||
}
|
||||
|
||||
deriving Show
|
||||
|
||||
-- | Possible statuses in the execution reply messages.
|
||||
|
||||
40
Main.hs
40
Main.hs
@ -96,7 +96,7 @@ initialKernelState =
|
||||
}
|
||||
|
||||
-- | Duplicate a message header, giving it a new UUID and message type.
|
||||
dupHeader :: MessageHeader -> MessageType -> Interpreter MessageHeader
|
||||
dupHeader :: MessageHeader -> MessageType -> IO MessageHeader
|
||||
dupHeader header messageType = do
|
||||
uuid <- liftIO UUID.random
|
||||
|
||||
@ -145,20 +145,48 @@ replyTo interface ExecuteRequest{ getCode = code } replyHeader state = do
|
||||
-- All the headers are copies of the reply header with a different
|
||||
-- message type, because this preserves the session ID, parent header,
|
||||
-- and other important information.
|
||||
busyHeader <- dupHeader replyHeader StatusMessage
|
||||
busyHeader <- liftIO $ dupHeader replyHeader StatusMessage
|
||||
send $ PublishStatus busyHeader Busy
|
||||
|
||||
-- Construct a function for publishing output as this is going.
|
||||
let publish :: [DisplayData] -> Interpreter ()
|
||||
publish outputs = do
|
||||
-- This function accepts a boolean indicating whether this is the final
|
||||
-- output and the thing to display. Store the final outputs in a list so
|
||||
-- that when we receive an updated non-final output, we can clear the
|
||||
-- entire output and re-display with the updated output.
|
||||
displayed <- liftIO $ newMVar []
|
||||
updateNeeded <- liftIO $ newMVar False
|
||||
let clearOutput = do
|
||||
header <- dupHeader replyHeader ClearOutputMessage
|
||||
send $ ClearOutput header True
|
||||
|
||||
sendOutput outs = do
|
||||
header <- dupHeader replyHeader DisplayDataMessage
|
||||
send $ PublishDisplayData header "haskell" outputs
|
||||
send $ PublishDisplayData header "haskell" outs
|
||||
|
||||
publish :: Bool -> [DisplayData] -> IO ()
|
||||
publish final outputs = do
|
||||
-- If necessary, clear all previous output and redraw.
|
||||
clear <- readMVar updateNeeded
|
||||
when clear $ do
|
||||
clearOutput
|
||||
disps <- readMVar displayed
|
||||
mapM_ sendOutput $ reverse disps
|
||||
|
||||
-- Draw this message.
|
||||
sendOutput outputs
|
||||
|
||||
-- If this is the final message, add it to the list of completed
|
||||
-- messages. If it isn't, make sure we clear it later by marking
|
||||
-- update needed as true.
|
||||
modifyMVar_ updateNeeded (const $ return $ not final)
|
||||
when final $
|
||||
modifyMVar_ displayed (return . (outputs:))
|
||||
|
||||
-- Run code and publish to the frontend as we go.
|
||||
evaluate execCount (Chars.unpack code) publish
|
||||
|
||||
-- Notify the frontend that we're done computing.
|
||||
idleHeader <- dupHeader replyHeader StatusMessage
|
||||
idleHeader <- liftIO $ dupHeader replyHeader StatusMessage
|
||||
send $ PublishStatus idleHeader Idle
|
||||
|
||||
-- Increment the execution counter in the kernel state.
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user