Commit b04c7f62 authored by Andrew Gibiansky's avatar Andrew Gibiansky

something work i think (???)

parent 67e98e69
...@@ -93,9 +93,6 @@ executable IHaskell ...@@ -93,9 +93,6 @@ executable IHaskell
extensions: DoAndIfThenElse extensions: DoAndIfThenElse
NoImplicitPrelude
OverloadedStrings
-- Other library packages from which modules are imported. -- Other library packages from which modules are imported.
build-depends: base ==4.6.*, build-depends: base ==4.6.*,
...@@ -126,5 +123,5 @@ Test-Suite doctests ...@@ -126,5 +123,5 @@ Test-Suite doctests
Type: exitcode-stdio-1.0 Type: exitcode-stdio-1.0
Ghc-Options: -threaded Ghc-Options: -threaded
Main-Is: rundoctests.hs 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.*
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
-- | Description : IPython configuration files are compiled-into IHaskell -- | Description : IPython configuration files are compiled-into IHaskell
module IHaskell.Config (ipython, notebook, console, qtconsole, customjs, notebookJavascript) where module IHaskell.Config (ipython, notebook, console, qtconsole, customjs, notebookJavascript) where
......
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module IHaskell.Display ( module IHaskell.Display (
IHaskellDisplay(..), IHaskellDisplay(..),
......
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
{- | Description : generates tab-completion options {- | Description : generates tab-completion options
context-insensitive completion for what is probably context-insensitive completion for what is probably
......
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{- | Description : Wrapper around GHC API, exposing a single `evaluate` interface that runs {- | Description : Wrapper around GHC API, exposing a single `evaluate` interface that runs
a statement, declaration, import, or directive. a statement, declaration, import, or directive.
...@@ -35,6 +34,7 @@ import Module ...@@ -35,6 +34,7 @@ import Module
import qualified System.IO.Strict as StrictIO import qualified System.IO.Strict as StrictIO
import IHaskell.Types import IHaskell.Types
import IHaskell.Eval.Parser
data ErrorOccurred = Success | Failure data ErrorOccurred = Success | Failure
...@@ -79,21 +79,8 @@ makeWrapperStmts = (fileName, initStmts, postStmts) ...@@ -79,21 +79,8 @@ makeWrapperStmts = (fileName, initStmts, postStmts)
write :: GhcMonad m => String -> m () write :: GhcMonad m => String -> m ()
write x = when debug $ liftIO $ hPutStrLn stderr x write x = when debug $ liftIO $ hPutStrLn stderr x
type LineNumber = Int
type ColumnNumber = Int
type Interpreter = Ghc 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 :: [String]
globalImports = globalImports =
[ "import Prelude" [ "import Prelude"
...@@ -152,9 +139,11 @@ evaluate :: Int -- ^ The execution counter of this evaluat ...@@ -152,9 +139,11 @@ evaluate :: Int -- ^ The execution counter of this evaluat
-> Interpreter [DisplayData] -- ^ All of the output. -> Interpreter [DisplayData] -- ^ All of the output.
evaluate execCount code evaluate execCount code
| strip code == "" = return [] | strip code == "" = return []
| otherwise = joinDisplays <$> runUntilFailure (parseCommands (strip code) ++ [storeItCommand execCount]) | otherwise = do
cmds <- parseCommands (strip code)
joinDisplays <$> runUntilFailure (cmds ++ [storeItCommand execCount])
where where
runUntilFailure :: [Command] -> Interpreter [DisplayData] runUntilFailure :: [CodeBlock] -> Interpreter [DisplayData]
runUntilFailure [] = return [] runUntilFailure [] = return []
runUntilFailure (cmd:rest) = do runUntilFailure (cmd:rest) = do
(success, result) <- evalCommand cmd (success, result) <- evalCommand cmd
...@@ -178,8 +167,12 @@ joinDisplays displays = ...@@ -178,8 +167,12 @@ joinDisplays displays =
_ -> joinedPlains : other _ -> joinedPlains : other
parseCommands :: GhcMonad m => String -- ^ Code containing commands.
-> m [CodeBlock] -- ^ Commands contained in code string.
parseCommands = parseCell
{-
parseCommands :: String -- ^ Code containing commands. parseCommands :: String -- ^ Code containing commands.
-> [Command] -- ^ Commands contained in code string. -> [CodeBlock] -- ^ Commands contained in code string.
parseCommands code = joinMultilineDeclarations $ concatMap makeCommands pieces parseCommands code = joinMultilineDeclarations $ concatMap makeCommands pieces
where where
-- Group the text into different pieces. -- Group the text into different pieces.
...@@ -246,20 +239,21 @@ parseCommands code = joinMultilineDeclarations $ concatMap makeCommands pieces ...@@ -246,20 +239,21 @@ parseCommands code = joinMultilineDeclarations $ concatMap makeCommands pieces
':':'t':' ':expr -> Directive (GetType expr) ':':'t':' ':expr -> Directive (GetType expr)
other -> ParseError 0 0 $ "Unknown command: " ++ other ++ "." other -> ParseError 0 0 $ "Unknown command: " ++ other ++ "."
joinMultilineDeclarations :: [Command] -> [Command] joinMultilineDeclarations :: [CodeBlock] -> [CodeBlock]
joinMultilineDeclarations = map joinCommands . groupBy declaringSameFunction joinMultilineDeclarations = map joinCommands . groupBy declaringSameFunction
where where
joinCommands :: [Command] -> Command joinCommands :: [CodeBlock] -> CodeBlock
joinCommands [x] = x joinCommands [x] = x
joinCommands commands = Declaration . unlines $ map getDeclarationText commands joinCommands commands = Declaration . unlines $ map getDeclarationText commands
where where
getDeclarationText (Declaration text) = text getDeclarationText (Declaration text) = text
declaringSameFunction :: Command -> Command -> Bool declaringSameFunction :: CodeBlock -> CodeBlock -> Bool
declaringSameFunction (Declaration first) (Declaration second) = declared first == declared second declaringSameFunction (Declaration first) (Declaration second) = declared first == declared second
where declared :: String -> String where declared :: String -> String
declared = takeWhile (`notElem` (" \t\n:" :: String)) . strip declared = takeWhile (`notElem` (" \t\n:" :: String)) . strip
declaringSameFunction _ _ = False declaringSameFunction _ _ = False
-}
wrapExecution :: Interpreter [DisplayData] -> Interpreter (ErrorOccurred, [DisplayData]) wrapExecution :: Interpreter [DisplayData] -> Interpreter (ErrorOccurred, [DisplayData])
wrapExecution exec = ghandle handler $ exec >>= \res -> wrapExecution exec = ghandle handler $ exec >>= \res ->
...@@ -270,7 +264,7 @@ 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 -- | Return the display data for this command, as well as whether it
-- resulted in an error. -- resulted in an error.
evalCommand :: Command -> Interpreter (ErrorOccurred, [DisplayData]) evalCommand :: CodeBlock -> Interpreter (ErrorOccurred, [DisplayData])
evalCommand (Import importStr) = wrapExecution $ do evalCommand (Import importStr) = wrapExecution $ do
write $ "Import: " ++ importStr write $ "Import: " ++ importStr
importDecl <- parseImportDecl importStr importDecl <- parseImportDecl importStr
...@@ -278,7 +272,7 @@ evalCommand (Import importStr) = wrapExecution $ do ...@@ -278,7 +272,7 @@ evalCommand (Import importStr) = wrapExecution $ do
setContext $ IIDecl importDecl : context setContext $ IIDecl importDecl : context
return [] return []
evalCommand (Directive (GetType expr)) = wrapExecution $ do evalCommand (Directive GetType expr) = wrapExecution $ do
result <- exprType expr result <- exprType expr
dflags <- getSessionDynFlags dflags <- getSessionDynFlags
return [Display MimeHtml $ printf "<span style='font-weight: bold; color: green;'>%s</span>" $ showSDocUnqual dflags $ ppr result] return [Display MimeHtml $ printf "<span style='font-weight: bold; color: green;'>%s</span>" $ showSDocUnqual dflags $ ppr result]
......
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{- | Description : Inspect type and function information and documentation. {- | Description : Inspect type and function information and documentation.
......
This diff is collapsed.
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
-- | Description : Shell scripting wrapper using @Shelly@ for the @notebook@, @setup@, and -- | Description : Shell scripting wrapper using @Shelly@ for the @notebook@, @setup@, and
-- @console@ commands. -- @console@ commands.
module IHaskell.IPython ( module IHaskell.IPython (
runIHaskell, runIHaskell,
setupIPythonProfile, setupIPythonProfile,
ipythonVersion ipythonVersion,
parseVersion
) where ) where
import ClassyPrelude import ClassyPrelude
...@@ -19,6 +21,10 @@ import qualified System.IO.Strict as StrictIO ...@@ -19,6 +21,10 @@ import qualified System.IO.Strict as StrictIO
import qualified IHaskell.Config as Config import qualified IHaskell.Config as Config
-- $setup
-- >>> import ClassyPrelude
-- >>> import IHaskell.IPython
-- | Run IPython with any arguments. -- | Run IPython with any arguments.
ipython :: Bool -- ^ Whether to suppress output. ipython :: Bool -- ^ Whether to suppress output.
-> [Text] -- ^ IPython command line arguments. -> [Text] -- ^ IPython command line arguments.
...@@ -44,13 +50,10 @@ ipythonVersion = shelly $ do ...@@ -44,13 +50,10 @@ ipythonVersion = shelly $ do
[major, minor, patch] <- parseVersion <$> ipython True ["--version"] [major, minor, patch] <- parseVersion <$> ipython True ["--version"]
return (major, minor, patch) return (major, minor, patch)
{- | -- | Parse an IPython version string into a list of integers.
--
>>> parseVersion `map` ["2.0.0-dev", "2.0.0-alpha", "12.5.10"] -- >>> parseVersion `map` ["2.0.0-dev", "2.0.0-alpha", "12.5.10"]
[[2,0,0],[2,0,0],[12,5,10]] -- [[2,0,0],[2,0,0],[12,5,10]]
-}
parseVersion :: String -> [Int] parseVersion :: String -> [Int]
parseVersion versionStr = map read' $ split "." versionStr parseVersion versionStr = map read' $ split "." versionStr
where read' x = case reads x of where read' x = case reads x of
......
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
-- | Description : UUID generator and data structure -- | Description : UUID generator and data structure
-- --
-- Generate, parse, and pretty print UUIDs for use with IPython. -- Generate, parse, and pretty print UUIDs for use with IPython.
......
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
-- | Description : @ToJSON@ for Messages -- | Description : @ToJSON@ for Messages
-- --
...@@ -18,6 +19,7 @@ ghcVersionInts :: [Int] ...@@ -18,6 +19,7 @@ ghcVersionInts :: [Int]
ghcVersionInts = ints . map read . words . map dotToSpace $ (VERSION_ghc :: String) ghcVersionInts = ints . map read . words . map dotToSpace $ (VERSION_ghc :: String)
where dotToSpace '.' = ' ' where dotToSpace '.' = ' '
dotToSpace x = x dotToSpace x = x
--ghcVersionInts = [7,6,3]
-- Convert message bodies into JSON. -- Convert message bodies into JSON.
instance ToJSON Message where instance ToJSON Message where
......
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
-- | Description : Low-level ZeroMQ communication wrapper. -- | Description : Low-level ZeroMQ communication wrapper.
-- --
-- The "ZeroMQ" module abstracts away the low-level 0MQ based interface with IPython, -- The "ZeroMQ" module abstracts away the low-level 0MQ based interface with IPython,
......
{-# LANGUAGE OverloadedStrings #-}
import System.Process import System.Process
import System.Exit
import System.IO
import Test.DocTest import Test.DocTest
import Data.Char
import System.Environment import System.Environment
import Data.String.Utils
-- | tests that all the >>> comments are followed by correct output. Easiest is to -- | tests that all the >>> comments are followed by correct output. Easiest is to
-- --
...@@ -18,17 +17,24 @@ import System.Environment ...@@ -18,17 +17,24 @@ import System.Environment
-- > runghc examples/rundoctests.hs Data/HList/File1.hs Data/HList/File2.hs -- > 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. -- you need Cabal >= 1.18 since that's around when cabal repl got added.
main :: IO ()
main = do main = do
as <- getArgs -- Get files to run on.
o <- readProcess args <- getArgs
"cabal" ["repl","--ghc-options","-v0 -w"]
":show packages\n:show language"
let flags = words $ unlines $ filter ((=="-") . take 1 . dropWhile isSpace)
$ lines o
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"] [] -> ["Main.hs"]
_ -> as _ -> args
putStrLn "Testing:\n--------"
mapM_ putStrLn files
putStr "\n"
doctest $ "-i.": "-idist/build/autogen": doctest $ "-i.": "-idist/build/autogen":
"-optP-include": "-optP-include":
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment