diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,8 @@ +0.1.6: + * Make better, more liberal :type-at (https://github.com/chrisdone/intero/issues/29) + * Better argument parser for :type-at, :loc-at, :uses + * Retain names that were in scope after a successful load for :complete + 0.1.5: * Add upper bound for GHC (https://github.com/chrisdone/intero/issues/27) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,13 +2,25 @@ Complete interactive development program for Haskell +## Features + +It's basically GHCi plus extra features. Those are: + +* [Find uses of an identifier in a module.](https://github.com/chrisdone/intero/blob/28609611c9f7c7d63370ce66e8ebb97676a8374e/src/test/Main.hs#L118) +* [Find definition of an identifier in a module.](https://github.com/chrisdone/intero/blob/28609611c9f7c7d63370ce66e8ebb97676a8374e/src/test/Main.hs#L143) +* [Show the type of an expression or identifier](https://github.com/chrisdone/intero/blob/28609611c9f7c7d63370ce66e8ebb97676a8374e/src/test/Main.hs#L82). +* [List all types of all expressions of all modules loaded.](https://github.com/chrisdone/intero/blob/28609611c9f7c7d63370ce66e8ebb97676a8374e/src/test/Main.hs#L98) + +Probably more to come. + ## Requirements The following dependencies are necessary: * The `tinfo` and `ncurses` library. - * Ubuntu and Debian users can install it using the following command: + * Ubuntu and Debian users can install it using the following + command: $ apt-get install libtinfo-dev $ apt-get install libncurses5-dev @@ -24,6 +36,20 @@ $ git clone https://github.com/chrisdone/intero.git $ cd intero $ stack build intero + +## Running + +To run it plainly use: + + $ stack exec intero + +You'll have to run `stack build intero` within each separate LTS +version you use, this ensures that the intero you launch correctly +matches the GHC version that you're working with. + +To load up your stack project use: + + $ stack ghci --with-ghc intero ## Supported GHC versions diff --git a/intero.cabal b/intero.cabal --- a/intero.cabal +++ b/intero.cabal @@ -1,7 +1,7 @@ name: intero version: - 0.1.5 + 0.1.6 synopsis: Complete interactive development program for Haskell license: @@ -81,7 +81,7 @@ build-depends: unix -test-suite store-test +test-suite intero-test default-language: Haskell2010 type: diff --git a/src/GhciFind.hs b/src/GhciFind.hs --- a/src/GhciFind.hs +++ b/src/GhciFind.hs @@ -36,6 +36,7 @@ -> m (Either String [SrcSpan]) findNameUses infos fp string sl sc el ec = do mname <- guessModule infos fp + case mname of Nothing -> return (Left "Couldn't guess that module name. Does it exist?") @@ -263,11 +264,11 @@ -- | Try to resolve the type display from the given span. resolveSpanInfo :: [SpanInfo] -> Int -> Int -> Int -> Int -> Maybe SpanInfo -resolveSpanInfo spans' sl sc el ec = - find inside (reverse spans') - where inside (SpanInfo sl' sc' el' ec' _ _) = - ((sl' == sl && sc' >= sc) || (sl' > sl)) && - ((el' == el && ec' <= ec) || (el' < el)) +resolveSpanInfo spanList spanSL spanSC spanEL spanEC = + find contains spanList + where contains (SpanInfo ancestorSL ancestorSC ancestorEL ancestorEC _ _) = + ((ancestorSL == spanSL && spanSC >= ancestorSC) || (ancestorSL < spanSL)) && + ((ancestorEL == spanEL && spanEC <= ancestorEC) || (ancestorEL > spanEL)) -- | Guess a module name from a file path. guessModule :: GhcMonad m diff --git a/src/GhciMonad.hs b/src/GhciMonad.hs --- a/src/GhciMonad.hs +++ b/src/GhciMonad.hs @@ -116,7 +116,10 @@ -- help text to display to a user short_help :: String, long_help :: String, - mod_infos :: !(Map ModuleName ModInfo) + + -- stored state + mod_infos :: !(Map ModuleName ModInfo), + rdrNamesInScope :: ![GHC.RdrName] } type TickArray = Array Int [(BreakIndex,SrcSpan)] diff --git a/src/InteractiveUI.hs b/src/InteractiveUI.hs --- a/src/InteractiveUI.hs +++ b/src/InteractiveUI.hs @@ -460,6 +460,7 @@ default_editor <- liftIO $ findEditor + names <- GHC.getRdrNamesInScope startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = default_progname, GhciMonad.args = default_args, @@ -480,7 +481,8 @@ ghc_e = isJust maybe_exprs, short_help = shortHelpText config, long_help = fullHelpText config, - mod_infos = M.empty + mod_infos = M.empty, + rdrNamesInScope = names } return () @@ -1452,14 +1454,19 @@ -- Enable buffering stdout and stderr as we're compiling. Keeping these -- handles unbuffered will just slow the compilation down, especially when -- compiling in parallel. - gbracket (liftIO $ do hSetBuffering stdout LineBuffering - hSetBuffering stderr LineBuffering) - (\_ -> - liftIO $ do hSetBuffering stdout NoBuffering - hSetBuffering stderr NoBuffering) $ \_ -> do + wasok <- gbracket (liftIO $ do hSetBuffering stdout LineBuffering + hSetBuffering stderr LineBuffering) + (\_ -> + liftIO $ do hSetBuffering stdout NoBuffering + hSetBuffering stderr NoBuffering) $ \_ -> do ok <- trySuccess $ GHC.load howmuch afterLoad ok retain_context return ok + case wasok of + Succeeded -> do names <- GHC.getRdrNamesInScope + lift (modifyGHCiState (\s -> s { rdrNamesInScope = names })) + _ -> return () + return wasok afterLoad :: SuccessFlag @@ -1692,25 +1699,31 @@ -- | Parse a span: parseSpan :: String -> Either String (FilePath,Int,Int,Int,Int,String) -parseSpan s = +parseSpan str = case result of - Left err -> Left err + Left {} -> + Left "\n: Expected a span: \"\" \"\"\n" Right r -> Right r where result = - case span (/= ' ') s of + case getString str of (fp,s') -> do (sl,s1) <- extractInt s' (sc,s2) <- extractInt s1 (el,s3) <- extractInt s2 (ec,st) <- extractInt s3 -- GHC exposes a 1-based column number because reasons. - Right (fp,sl,sc-1,el,ec-1,st) + Right (fp,sl,sc - 1,el,ec - 1,maybeStr st) + maybeStr s = case reads s of + [(s',"")] -> s' + _ -> s + getString s = + case reads s of + [(s',rest)] -> (s',rest) + _ -> span (/= ' ') s extractInt s' = case span (/= ' ') (dropWhile1 (== ' ') s') of - (reads -> [(i,_)],s'') -> - Right (i,dropWhile1 (== ' ') s'') - _ -> - Left ("Expected integer in " ++ s') + (reads -> [(i,_)],s'') -> Right (i,dropWhile1 (== ' ') s'') + _ -> Left ("Expected integer in " ++ s') where dropWhile1 _ [] = [] dropWhile1 p xs@(x:xs') | p x = xs' @@ -2377,6 +2390,8 @@ , pkgDatabase = pkgDatabase dflags2 , packageFlags = packageFlags dflags2 } + df <- getDynFlags + liftIO (putStrLn ("Flags: " ++ show (hscTarget df))) return () @@ -2714,7 +2729,7 @@ return (filter (w `isPrefixOf`) (map cmdName cmds)) completeIdentifier = wrapIdentCompleter $ \w -> do - rdrs <- GHC.getRdrNamesInScope + rdrs <- fmap rdrNamesInScope getGHCiState dflags <- GHC.getSessionDynFlags return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs)) diff --git a/src/test/Main.hs b/src/test/Main.hs --- a/src/test/Main.hs +++ b/src/test/Main.hs @@ -5,7 +5,7 @@ import Control.Exception import Control.Monad.IO.Class -import System.Directory +import Data.Char import System.IO import System.IO.Temp import System.Process @@ -21,13 +21,30 @@ -- | Test suite. spec :: Spec spec = - do basics + do argsparser + basics load types + alltypes use definition bytecode +-- | Argument parsing should be user-friendly. +argsparser :: Spec +argsparser = + describe "Arguments parser" + (do issue ":type-at \"Foo Bar.hs\" 1 1 1 1" + "https://github.com/chrisdone/intero/issues/25" + (typeAtFile "Foo Bar.hs" + "x = 'a'" + (1,1,1,1,"x") + "x :: Char\n") + issue ":type-at" + "https://github.com/chrisdone/intero/issues/28" + (eval ":type-at" + "\n: Expected a span: \"\" \"\"\n")) + -- | Basic commands that should work out of the box. basics :: Spec basics = @@ -85,6 +102,8 @@ describe "Types" (do it ":type-at X.hs 1 1 1 1 x -- Char" (typeAt "x = 'a'" (1,1,1,1,"x") "x :: Char\n") + it ":type-at X.hs 1 1 1 1 -- Char (string omitted)" + (typeAt "x = 'a'" (1,1,1,1,"") " :: Char\n") it ":type-at X.hs 1 1 1 1 x -- [Char]" (typeAt "x = 'a' : x" (1,1,1,1,"x") "x :: [Char]\n") it ":type-at X.hs 1 11 1 12 x -- [Char]" @@ -93,8 +112,62 @@ (typeAt "x = 'a' : y where y = x" (1,11,1,12,"y") "y :: [Char]\n") issue ":type-at X.hs 1 1 1 1 f -- Num a => a" "https://github.com/chrisdone/intero/issues/14" - (typeAt "f x = x * 2" (1,1,1,2,"f") "f :: Num a => a -> a\n")) + (typeAt "f x = x * 2" (1,1,1,2,"f") "f :: Num a => a -> a\n") + issue ":type-at X.hs 1 1 1 1 x -- Char (oddly bounded selection)" + "https://github.com/chrisdone/intero/issues/29" + (typeAt "foo = 'a'" (1,1,1,1,"f") "f :: Char\n") + issue ":type-at half of 2 arguments within function call" + "https://github.com/chrisdone/intero/issues/29" + (typeAt testFile (1,29,1,32,"\" \"") "\" \" :: [Char] -> [Char]\n") + issue ":type-at funtion + half of its first argument" + "https://github.com/chrisdone/intero/issues/29" + (typeAt testFile + (1,18,1,28,"concat3 \"a") + "concat3 \"a :: [Char] -> [Char] -> [Char]\n") + issue ":type-at 2 arguments within a function call" + "https://github.com/chrisdone/intero/issues/29" + (typeAt testFile + (1,26,1,35,"\"aa\" \"bb\"") + "\"aa\" \"bb\" :: [Char] -> [Char]\n") + issue ":type-at 2 lines within a do bloc" + "https://github.com/chrisdone/intero/issues/29" + (typeAt testFile (4,8,5,10,"{{multiline}}") "{{multiline}} :: IO ()\n") + issue ":type-at part of a line within a do bloc (1)" + "https://github.com/chrisdone/intero/issues/29" + (typeAt testFile (4,8,4,10," 1") " 1 :: IO ()\n") + issue ":type-at part of a line within a do bloc (2)" + "https://github.com/chrisdone/intero/issues/29" + (typeAt testFile (4,9,4,10,"1") "1 :: Integer\n")) + where testFile :: String + testFile = + unlines ["test = putStrLn (concat3 \"aa\" \"bb\" \"cc\")" + ,"concat3 a b c = a ++ b ++ c" + ,"foo = do" + ," print 1" + ," print 2" + ," print 3" + ,""] +-- | List all types in all modules loaded. +alltypes :: Spec +alltypes = + describe "All Types" + (do it ":all-types" + (do result <- + withIntero + [] + (\dir repl -> + do writeFile (dir ++ "/X.hs") "x = 123\ny = show 'c'" + _ <- repl (":l X.hs") + repl ":all-types") + shouldBe result + (unlines ["X.hs:(2,1)-(2,2): String" + ,"X.hs:(1,1)-(1,2): Integer" + ,"X.hs:(2,5)-(2,9): Char -> String" + ,"X.hs:(2,10)-(2,13): Char" + ,"X.hs:(2,5)-(2,13): String" + ,"X.hs:(1,5)-(1,8): Integer"]))) + -- | Find uses of a variable. use :: Spec use = @@ -157,6 +230,8 @@ repl (":loc-at X.hs " ++ unwords (map show [line,col,line',col']) ++ " " ++ name)) shouldBe result expected + let x = return () + x -- | Find use-sites for the given place. uses @@ -175,15 +250,30 @@ -- | Test the type at the given place. typeAt :: String -> (Int,Int,Int,Int,String) -> String -> Expectation -typeAt file (line,col,line',col',name) expected = +typeAt = do typeAtFile "X.hs" + +-- | Test the type at the given place (with the given filename). +typeAtFile :: String + -> String + -> (Int,Int,Int,Int,String) + -> String + -> Expectation +typeAtFile fname file (line,col,line',col',name) expected = do result <- withIntero [] (\dir repl -> - do writeFile (dir ++ "/X.hs") file - _ <- repl (":l X.hs") - repl (":type-at X.hs " ++ - unwords (map show [line,col,line',col']) ++ " " ++ name)) + do writeFile (dir ++ "/" ++ fname) file + _ <- repl (":l " ++ show fname) + repl (":type-at " ++ + (if any isSpace fname + then show fname + else fname) ++ + " " ++ + unwords (map show [line,col,line',col']) ++ + (if null name + then "" + else " " ++ show name))) shouldBe result expected -- | Make a quick interaction with intero.