intero 0.1.17 → 0.1.18
raw patch · 5 files changed
+476/−372 lines, 5 files
Files
- CHANGELOG +4/−0
- elisp/intero.el +25/−22
- intero.cabal +1/−1
- src/InteractiveUI.hs +3/−1
- src/test/Main.hs +443/−348
CHANGELOG view
@@ -1,3 +1,7 @@+0.1.18:+ * Completion in the REPL gets updated properly when imports+ added/removed https://github.com/commercialhaskell/intero/issues/112+ 0.1.17: * :unset -XFoo now works
elisp/intero.el view
@@ -575,27 +575,28 @@ "Generate completions for SOURCE-BUFFER based on PREFIX-INFO and call CONT on the results." (cl-destructuring-bind (beg end prefix type) prefix-info- (or (cl-case type- (haskell-completions-module-name-prefix- (intero-get-repl-completions source-buffer (concat "import " prefix) cont))- (haskell-completions-identifier-prefix- (intero-get-completions source-buffer beg end cont))- (haskell-completions-language-extension-prefix- (intero-get-repl-completions- source-buffer- (concat ":set -X" prefix)- (-partial (lambda (cont results)- (funcall cont- (mapcar (lambda (x)- (replace-regexp-in-string "^-X" "" x))- results)))- cont)))- (haskell-completions-pragma-name-prefix- (funcall cont- (cl-remove-if-not- (lambda (candidate)- (string-match (concat "^" prefix) candidate))- intero-pragmas))))+ (or (and (bound-and-true-p intero-mode)+ (cl-case type+ (haskell-completions-module-name-prefix+ (intero-get-repl-completions source-buffer (concat "import " prefix) cont))+ (haskell-completions-identifier-prefix+ (intero-get-completions source-buffer beg end cont))+ (haskell-completions-language-extension-prefix+ (intero-get-repl-completions+ source-buffer+ (concat ":set -X" prefix)+ (-partial (lambda (cont results)+ (funcall cont+ (mapcar (lambda (x)+ (replace-regexp-in-string "^-X" "" x))+ results)))+ cont)))+ (haskell-completions-pragma-name-prefix+ (funcall cont+ (cl-remove-if-not+ (lambda (candidate)+ (string-match (concat "^" prefix) candidate))+ intero-pragmas))))) (intero-get-repl-completions source-buffer prefix cont)))) (defun intero-completions-grab-prefix (&optional minlen)@@ -875,7 +876,9 @@ (add-hook 'comint-output-filter-functions 'intero-linkify-process-output t)- (setq-local comint-prompt-read-only t))+ (setq-local comint-prompt-read-only t)+ (add-to-list (make-local-variable 'company-backends) 'company-intero)+ (company-mode)) (defun intero-repl-mode-start (backend-buffer targets prompt-options) "Start the process for the repl in the current buffer.
intero.cabal view
@@ -1,7 +1,7 @@ name: intero version:- 0.1.17+ 0.1.18 synopsis: Complete interactive development program for Haskell license:
src/InteractiveUI.hs view
@@ -2271,7 +2271,9 @@ then iidecls ++ [implicitPreludeImport] else iidecls -- XXX put prel at the end, so that guessCurrentModule doesn't pick it up.-+ -- Get the names in scope+ names <- GHC.getRdrNamesInScope+ modifyGHCiState (\s -> s { rdrNamesInScope = names }) -- ----------------------------------------------------------------------------- -- Utils on InteractiveImport
src/test/Main.hs view
@@ -21,413 +21,508 @@ -- | Test suite. spec :: Spec-spec =- do argsparser- basics- load- types- alltypes- use- definition- bytecode- completion+spec = do+ argsparser+ basics+ load+ types+ alltypes+ use+ definition+ bytecode+ completion -- | 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/commercialhaskell/intero/issues/25"- (atFile ":type-at"- "Foo Bar.hs"- "x = 'a'"- (1,1,1,1,"x")- id- "x :: Char\n")- issue ":type-at"- "https://github.com/commercialhaskell/intero/issues/28"- (eval ":type-at"- "\n<no location info>: Expected a span: \"<module-name/filepath>\" <start line> <start column> <end line> <end column> \"<sample string>\"\n"))+ describe+ "Arguments parser"+ (do issue+ ":type-at \"Foo Bar.hs\" 1 1 1 1"+ "https://github.com/commercialhaskell/intero/issues/25"+ (atFile+ ":type-at"+ "Foo Bar.hs"+ "x = 'a'"+ (1, 1, 1, 1, "x")+ id+ "x :: Char\n")+ issue+ ":type-at"+ "https://github.com/commercialhaskell/intero/issues/28"+ (eval+ ":type-at"+ "\n<no location info>: Expected a span: \"<module-name/filepath>\" <start line> <start column> <end line> <end column> \"<sample string>\"\n")) -- | Basic commands that should work out of the box. basics :: Spec basics =- describe "Basics"- (do it ":t 1" (eval ":t 1 :: Num a => a" "1 :: Num a => a :: Num a => a\n")- it ":i Nothing"- (do reply <-- withIntero []- (\_ repl -> repl ":i Nothing")- shouldBe (subRegex (mkRegex "Data.Maybe") reply "GHC.Base")- "data Maybe a = Nothing | ... \t-- Defined in ‘GHC.Base’\n")- it ":k Just" (eval ":k Maybe" "Maybe :: * -> *\n"))+ describe+ "Basics"+ (do it ":t 1" (eval ":t 1 :: Num a => a" "1 :: Num a => a :: Num a => a\n")+ it+ ":i Nothing"+ (do reply <- withIntero [] (\_ repl -> repl ":i Nothing")+ shouldBe+ (subRegex (mkRegex "Data.Maybe") reply "GHC.Base")+ "data Maybe a = Nothing | ... \t-- Defined in ‘GHC.Base’\n")+ it ":k Just" (eval ":k Maybe" "Maybe :: * -> *\n")) -- | Loading files and seeing the results. load :: Spec load =- describe "Load"- (do it ":l X.hs"- (do result <-- withIntero- []- (\dir repl ->- do writeFile (dir ++ "/X.hs") "x = 'a'"- repl (":l X.hs"))- shouldBe result- (unlines ["[1 of 1] Compiling Main ( X.hs, interpreted )"- ,"Ok, modules loaded: Main."- ,"Collecting type info for 1 module(s) ... "]))- it ":l NonExistent.hs"- (do result <-- withIntero []- (\_ repl -> repl (":l NonExistent.hs"))- shouldBe (stripError result)- (unlines ["Failed, modules loaded: none."- ,""- ,"<no location info>: can't find file: NonExistent.hs"])))- where stripError = \i -> subRegex (mkRegex "error: ") i ""+ describe+ "Load"+ (do it+ ":l X.hs"+ (do result <-+ withIntero+ []+ (\dir repl -> do+ writeFile (dir ++ "/X.hs") "x = 'a'"+ repl (":l X.hs"))+ shouldBe+ result+ (unlines+ [ "[1 of 1] Compiling Main ( X.hs, interpreted )"+ , "Ok, modules loaded: Main."+ , "Collecting type info for 1 module(s) ... "]))+ it+ ":l NonExistent.hs"+ (do result <- withIntero [] (\_ repl -> repl (":l NonExistent.hs"))+ shouldBe+ (stripError result)+ (unlines+ [ "Failed, modules loaded: none."+ , ""+ , "<no location info>: can't find file: NonExistent.hs"])))+ where+ stripError = \i -> subRegex (mkRegex "error: ") i "" -- | Check things when in -fbyte-code mode. bytecode :: Spec bytecode =- describe "Bytecode"- (do it ":set -fobject-code ; :l X.hs; :set -byte-code; :l X.hs"- (do result <-- withIntero- []- (\dir repl ->- do _ <- repl (":set -fobject-code")- writeFile (dir ++ "/X.hs") "x = 'a'"- _ <- repl (":l X.hs")- _ <- repl (":set -fbyte-code")- writeFile (dir ++ "/X.hs") "x = 123"- repl (":l X.hs"))- shouldBe (unlines (reverse (take 2 (reverse (lines result)))))- (unlines ["Ok, modules loaded: Main."- ,"Collecting type info for 1 module(s) ... "])))+ describe+ "Bytecode"+ (do it+ ":set -fobject-code ; :l X.hs; :set -byte-code; :l X.hs"+ (do result <-+ withIntero+ []+ (\dir repl -> do+ _ <- repl (":set -fobject-code")+ writeFile (dir ++ "/X.hs") "x = 'a'"+ _ <- repl (":l X.hs")+ _ <- repl (":set -fbyte-code")+ writeFile (dir ++ "/X.hs") "x = 123"+ repl (":l X.hs"))+ shouldBe+ (unlines (reverse (take 2 (reverse (lines result)))))+ (unlines+ [ "Ok, modules loaded: Main."+ , "Collecting type info for 1 module(s) ... "]))) -- | Get type information of file contents. types :: Spec types =- 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]"- (typeAt "x = 'a' : x" (1,11,1,12,"x") "x :: [Char]\n")- it ":type-at X.hs 1 11 1 12 y -- [Char] (internal variable)"- (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/commercialhaskell/intero/issues/14"- (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/commercialhaskell/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/commercialhaskell/intero/issues/29"- (typeAt testFile (1,29,1,32,"\" \"") "\" \" :: [Char] -> [Char]\n")- issue ":type-at funtion + half of its first argument"- "https://github.com/commercialhaskell/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/commercialhaskell/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/commercialhaskell/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/commercialhaskell/intero/issues/29"- (typeAt testFile (4,8,4,10," 1") " 1 :: IO ()\n")- issue ":type-at part of a line within a do block (2)"- "https://github.com/commercialhaskell/intero/issues/29"- (typeAt testFile (4,9,4,10,"1") "1 :: Integer\n")- issue ":type-at with operator resolution"- "https://github.com/commercialhaskell/intero/issues/47"- (typeAt (unlines ["data X = X"- ,"instance Show X where"- ," show _ = show (1::Int,())"- ,"p s = id s * s == id s * s"])- (3,18,3,19,"1")- "1 :: Int\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"- ,""]+ 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]"+ (typeAt "x = 'a' : x" (1, 11, 1, 12, "x") "x :: [Char]\n")+ it+ ":type-at X.hs 1 11 1 12 y -- [Char] (internal variable)"+ (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/commercialhaskell/intero/issues/14"+ (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/commercialhaskell/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/commercialhaskell/intero/issues/29"+ (typeAt testFile (1, 29, 1, 32, "\" \"") "\" \" :: [Char] -> [Char]\n")+ issue+ ":type-at funtion + half of its first argument"+ "https://github.com/commercialhaskell/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/commercialhaskell/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/commercialhaskell/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/commercialhaskell/intero/issues/29"+ (typeAt testFile (4, 8, 4, 10, " 1") " 1 :: IO ()\n")+ issue+ ":type-at part of a line within a do block (2)"+ "https://github.com/commercialhaskell/intero/issues/29"+ (typeAt testFile (4, 9, 4, 10, "1") "1 :: Integer\n")+ issue+ ":type-at with operator resolution"+ "https://github.com/commercialhaskell/intero/issues/47"+ (typeAt+ (unlines+ [ "data X = X"+ , "instance Show X where"+ , " show _ = show (1::Int,())"+ , "p s = id s * s == id s * s"])+ (3, 18, 3, 19, "1")+ "1 :: Int\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"])))+ 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 =- describe "Uses"- (do it ":uses X.hs 1 1 1 1 x -- from definition site"- (uses "x = 'a' : x"- (1,1,1,1,"x")- id- (unlines ["X.hs:(1,1)-(1,2)"- ,"X.hs:(1,1)-(1,2)"- ,"X.hs:(1,11)-(1,12)"]))- it ":uses X.hs 1 11 1 12 x -- from use site"- (uses "x = 'a' : x"- (1,11,1,12,"x")- id- (unlines ["X.hs:(1,1)-(1,2)","X.hs:(1,11)-(1,12)"]))- it ":uses X.hs 1 5 1 6 id -- package definition"- (uses "x = id"- (1,5,1,6,"id")- (\i ->- subRegex (mkRegex "-[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+") i "")- (unlines ["base:GHC.Base"]))- it ":uses X.hs 1 5 1 6 id -- shadowed package definition"- (uses "x = id where id = ()"- (1,5,1,7,"id")- id- (unlines ["X.hs:(1,14)-(1,16)"- ,"X.hs:(1,14)-(1,16)"- ,"X.hs:(1,5)-(1,7)"]))- issue ":uses on type constructor (in data decl)"- "https://github.com/commercialhaskell/intero/issues/3"- (uses (unlines ["data X = X","foo :: X -> X","foo x = X"])- (1,6,1,7,"X")- lines- ["X.hs:(1,1)-(1,11)"])- issue ":uses on type constructor (in sig)"- "https://github.com/commercialhaskell/intero/issues/3"- (uses (unlines ["data X = X","foo :: X -> X","foo x = X"])- (2,8,2,9,"X")- lines- ["X.hs:(1,1)-(1,11)"])- issue ":uses on data constructor (in expression)"- "https://github.com/commercialhaskell/intero/issues/3"- (uses (unlines ["data X = X","foo :: X -> X","foo x = X"])- (3,9,3,10,"X")- lines- ["X.hs:(1,10)-(1,11)","X.hs:(3,9)-(3,10)"]))+ describe+ "Uses"+ (do it+ ":uses X.hs 1 1 1 1 x -- from definition site"+ (uses+ "x = 'a' : x"+ (1, 1, 1, 1, "x")+ id+ (unlines+ ["X.hs:(1,1)-(1,2)", "X.hs:(1,1)-(1,2)", "X.hs:(1,11)-(1,12)"]))+ it+ ":uses X.hs 1 11 1 12 x -- from use site"+ (uses+ "x = 'a' : x"+ (1, 11, 1, 12, "x")+ id+ (unlines ["X.hs:(1,1)-(1,2)", "X.hs:(1,11)-(1,12)"]))+ it+ ":uses X.hs 1 5 1 6 id -- package definition"+ (uses+ "x = id"+ (1, 5, 1, 6, "id")+ (\i -> subRegex (mkRegex "-[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+") i "")+ (unlines ["base:GHC.Base"]))+ it+ ":uses X.hs 1 5 1 6 id -- shadowed package definition"+ (uses+ "x = id where id = ()"+ (1, 5, 1, 7, "id")+ id+ (unlines+ ["X.hs:(1,14)-(1,16)", "X.hs:(1,14)-(1,16)", "X.hs:(1,5)-(1,7)"]))+ issue+ ":uses on type constructor (in data decl)"+ "https://github.com/commercialhaskell/intero/issues/3"+ (uses+ (unlines ["data X = X", "foo :: X -> X", "foo x = X"])+ (1, 6, 1, 7, "X")+ lines+ ["X.hs:(1,1)-(1,11)"])+ issue+ ":uses on type constructor (in sig)"+ "https://github.com/commercialhaskell/intero/issues/3"+ (uses+ (unlines ["data X = X", "foo :: X -> X", "foo x = X"])+ (2, 8, 2, 9, "X")+ lines+ ["X.hs:(1,1)-(1,11)"])+ issue+ ":uses on data constructor (in expression)"+ "https://github.com/commercialhaskell/intero/issues/3"+ (uses+ (unlines ["data X = X", "foo :: X -> X", "foo x = X"])+ (3, 9, 3, 10, "X")+ lines+ ["X.hs:(1,10)-(1,11)", "X.hs:(3,9)-(3,10)"])) -- | Find loc-ats of a variable. definition :: Spec definition =- describe "Definition location"- (do it ":loc-at X.hs 1 1 1 1 x -- from definition site"- (locAt "x = 'a' : x"- (1,1,1,1,"x")- (unlines ["X.hs:(1,1)-(1,2)"]))- it ":loc-at X.hs 1 11 1 12 x -- from use site"- (locAt "x = 'a' : x"- (1,11,1,12,"x")- (unlines ["X.hs:(1,1)-(1,12)"]))- it ":loc-at X.hs 1 11 1 12 x -- to function argument"- (locAt "f x = 'a' : x"- (1,13,1,14,"x")- (unlines ["X.hs:(1,3)-(1,4)"]))- it ":loc-at X.hs 1 11 1 12 x -- to pattern match"- (locAt "f (Just x) = 'a' : x"- (1,20,1,21,"x")- (unlines ["X.hs:(1,9)-(1,10)"])))+ describe+ "Definition location"+ (do it+ ":loc-at X.hs 1 1 1 1 x -- from definition site"+ (locAt "x = 'a' : x" (1, 1, 1, 1, "x") (unlines ["X.hs:(1,1)-(1,2)"]))+ it+ ":loc-at X.hs 1 11 1 12 x -- from use site"+ (locAt+ "x = 'a' : x"+ (1, 11, 1, 12, "x")+ (unlines ["X.hs:(1,1)-(1,12)"]))+ it+ ":loc-at X.hs 1 11 1 12 x -- to function argument"+ (locAt+ "f x = 'a' : x"+ (1, 13, 1, 14, "x")+ (unlines ["X.hs:(1,3)-(1,4)"]))+ it+ ":loc-at X.hs 1 11 1 12 x -- to pattern match"+ (locAt+ "f (Just x) = 'a' : x"+ (1, 20, 1, 21, "x")+ (unlines ["X.hs:(1,9)-(1,10)"]))) -- | Test interactive completions. completion :: Spec-completion =- do describe "Complete basic Prelude identifiers"- (issue ":complete repl \"put\""- "https://github.com/commercialhaskell/intero/issues/34"- (eval ":complete repl \"put\""- (unlines ["3 3 \"\""- ,"\"putChar\""- ,"\"putStr\""- ,"\"putStrLn\""])))- describe "Completion in module context"- (do it ":complete-at for put*"- (atFile ":complete-at"- "X.hs"- "module X () where\nx = undefined"- (4,5,0,0,"put")- lines- ["putChar","putStr","putStrLn"])- it ":complete-at for locally imported"- (atFile ":complete-at"- "X.hs"- "module X () where\nimport Data.List\nx = undefined"- (3,5,0,0,"sor")- (take 2 . lines)- ["sort","sortBy"])- it ":complete-at for module-locally defined"- (atFile ":complete-at"- "X.hs"- "module X () where\nx = undefined\nmodlocal = ()"- (2,5,0,0,"modl")- lines- ["modlocal"])- it ":complete-at for definition-locally defined"- (atFile ":complete-at"- "X.hs"- "module X () where\nx = undefined where locally = let p = 123 in p"- (2,5,0,0,"loc")- lines- ["locally"]))+completion = do+ describe+ "Completion in REPL"+ (do issue+ ":complete repl \"put\""+ "https://github.com/commercialhaskell/intero/issues/34"+ (eval+ ":complete repl \"put\""+ (unlines ["3 3 \"\"", "\"putChar\"", "\"putStr\"", "\"putStrLn\""]))+ issue+ ":complete repl \"sor\""+ "https://github.com/commercialhaskell/intero/issues/34"+ (do reply <-+ withIntero+ []+ (\_ repl -> do+ let req = ":complete repl \"sor\""+ reply <- repl req+ if reply == "0 0 \"\"\n"+ then do+ _ <- repl "import Data.List"+ repl req+ else return ("First step failed: " ++ reply))+ shouldBe+ reply+ (unlines ["3 3 \"\"", "\"sort\"", "\"sortBy\"", "\"sortOn\""])))+ describe+ "Completion in module context"+ (do it+ ":complete-at for put*"+ (atFile+ ":complete-at"+ "X.hs"+ "module X () where\nx = undefined"+ (4, 5, 0, 0, "put")+ lines+ ["putChar", "putStr", "putStrLn"])+ it+ ":complete-at for locally imported"+ (atFile+ ":complete-at"+ "X.hs"+ "module X () where\nimport Data.List\nx = undefined"+ (3, 5, 0, 0, "sor")+ (take 2 . lines)+ ["sort", "sortBy"])+ it+ ":complete-at for module-locally defined"+ (atFile+ ":complete-at"+ "X.hs"+ "module X () where\nx = undefined\nmodlocal = ()"+ (2, 5, 0, 0, "modl")+ lines+ ["modlocal"])+ it+ ":complete-at for definition-locally defined"+ (atFile+ ":complete-at"+ "X.hs"+ "module X () where\nx = undefined where locally = let p = 123 in p"+ (2, 5, 0, 0, "loc")+ lines+ ["locally"])) -------------------------------------------------------------------------------- -- Combinators for running and interacting with intero -- | Find the definition for the thing at point.-locAt- :: String -> (Int,Int,Int,Int,String) -> String -> Expectation-locAt file (line,col,line',col',name) expected =- do result <-- withIntero- []- (\dir repl ->- do writeFile (dir ++ "/X.hs") file- _ <- repl (":l X.hs")- repl (":loc-at X.hs " ++- unwords (map show [line,col,line',col']) ++ " " ++ name))- shouldBe result expected- let x = return ()- x+locAt :: String -> (Int, Int, Int, Int, String) -> String -> Expectation+locAt file (line,col,line',col',name) expected = do+ result <-+ withIntero+ []+ (\dir repl -> do+ writeFile (dir ++ "/X.hs") file+ _ <- repl (":l X.hs")+ 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- :: (Eq a,Show a)- => String -> (Int,Int,Int,Int,String) -> (String -> a) -> a -> Expectation-uses file (line,col,line',col',name) preprocess expected =- do result <-- withIntero- []- (\dir repl ->- do writeFile (dir ++ "/X.hs") file- _ <- repl (":l X.hs")- repl (":uses X.hs " ++- unwords (map show [line,col,line',col']) ++ " " ++ name))- shouldBe (preprocess result) expected+ :: (Eq a, Show a)+ => String -> (Int, Int, Int, Int, String) -> (String -> a) -> a -> Expectation+uses file (line,col,line',col',name) preprocess expected = do+ result <-+ withIntero+ []+ (\dir repl -> do+ writeFile (dir ++ "/X.hs") file+ _ <- repl (":l X.hs")+ repl+ (":uses X.hs " +++ unwords (map show [line, col, line', col']) ++ " " ++ name))+ shouldBe (preprocess result) expected -- | Test the type at the given place.-typeAt :: String- -> (Int,Int,Int,Int,String)- -> String- -> Expectation-typeAt a b c = do atFile ":type-at" "X.hs" a b id c+typeAt :: String -> (Int, Int, Int, Int, String) -> String -> Expectation+typeAt a b c = do+ atFile ":type-at" "X.hs" a b id c -- | Test the type at the given place (with the given filename).-atFile :: (Eq a,Show a)- => String- -> String- -> String- -> (Int,Int,Int,Int,String)- -> (String -> a)- -> a- -> Expectation-atFile cmd fname file (line,col,line',col',name) preprocess expected =- do result <-- withIntero- []- (\dir repl ->- do writeFile (dir ++ "/" ++ fname) file- _ <- repl (":l " ++ show fname)- repl (cmd ++ " " ++- (if any isSpace fname- then show fname- else fname) ++- " " ++- unwords (map show [line,col,line',col']) ++- (if null name- then ""- else " " ++ show name)))- shouldBe (preprocess result) expected+atFile+ :: (Eq a, Show a)+ => String+ -> String+ -> String+ -> (Int, Int, Int, Int, String)+ -> (String -> a)+ -> a+ -> Expectation+atFile cmd fname file (line,col,line',col',name) preprocess expected = do+ result <-+ withIntero+ []+ (\dir repl -> do+ writeFile (dir ++ "/" ++ fname) file+ _ <- repl (":l " ++ show fname)+ repl+ (cmd +++ " " +++ (if any isSpace fname+ then show fname+ else fname) +++ " " +++ unwords (map show [line, col, line', col']) +++ (if null name+ then ""+ else " " ++ show name)))+ shouldBe (preprocess result) expected -- | Make a quick interaction with intero. eval :: String -- ^ Input. -> String -- ^ Expected output. -> Expectation-eval send recv =- do reply <-- withIntero []- (\_ repl -> repl send)- shouldBe reply recv+eval send recv = do+ reply <- withIntero [] (\_ repl -> repl send)+ shouldBe reply recv -- | Launch an interactive intero process. Creates a temporary -- directory in which the computation can work.-withIntero :: MonadIO m => [String] -> (FilePath -> (String -> IO String) -> IO a) -> m a+withIntero+ :: MonadIO m+ => [String] -> (FilePath -> (String -> IO String) -> IO a) -> m a withIntero arguments cont =- liftIO (withSystemTempDirectory- "withIntero"- (\dir ->- do (inp,out,err,pid) <-- catch (runInteractiveProcess- "intero"- ("-ignore-dot-ghci" : arguments)- (Just dir)- Nothing)- (\(_ :: IOException) ->- error "Couldn't launch intero process.")- hSetBuffering inp NoBuffering- hSetBuffering out NoBuffering- hSetBuffering err NoBuffering- let repl instr =- do catch (do hPutStrLn inp instr- let getReply =- do mc <-- catch (fmap Just (hGetChar out))- (\(_ :: IOException) ->- return Nothing)- case mc of- Nothing -> hGetAvailable err- Just '\4' -> hGetAvailable err- Just c ->- do cs <- getReply- return (c : cs)- getReply)- (\(_ :: IOException) -> return "")- _ <- repl ":set prompt \"\\4\""- finally (cont dir repl)- (do ignored (hClose inp)- ignored (hClose out)- ignored (hClose err)- ignored (terminateProcess pid))))- where ignored m = catch m (\(_ :: IOException) -> return ())- hGetAvailable h =- do available <-- catch (hReady h)- (\(_ :: IOException) -> return False)- if available- then catch (do c <- hGetChar h- cs <- hGetAvailable h- return (c : cs))- (\(_ :: IOException) -> return [])- else return []+ liftIO+ (withSystemTempDirectory+ "withIntero"+ (\dir -> do+ (inp,out,err,pid) <-+ catch+ (runInteractiveProcess+ "intero"+ ("-ignore-dot-ghci" : arguments)+ (Just dir)+ Nothing)+ (\(_ :: IOException) -> error "Couldn't launch intero process.")+ hSetBuffering inp NoBuffering+ hSetBuffering out NoBuffering+ hSetBuffering err NoBuffering+ let repl instr = do+ catch+ (do hPutStrLn inp instr+ let getReply = do+ mc <-+ catch+ (fmap Just (hGetChar out))+ (\(_ :: IOException) -> return Nothing)+ case mc of+ Nothing -> hGetAvailable err+ Just '\4' -> hGetAvailable err+ Just c -> do+ cs <- getReply+ return (c : cs)+ getReply)+ (\(_ :: IOException) -> return "")+ _ <- repl ":set prompt \"\\4\""+ finally+ (cont dir repl)+ (do ignored (hClose inp)+ ignored (hClose out)+ ignored (hClose err)+ ignored (terminateProcess pid))))+ where+ ignored m = catch m (\(_ :: IOException) -> return ())+ hGetAvailable h = do+ available <- catch (hReady h) (\(_ :: IOException) -> return False)+ if available+ then catch+ (do c <- hGetChar h+ cs <- hGetAvailable h+ return (c : cs))+ (\(_ :: IOException) -> return [])+ else return [] -------------------------------------------------------------------------------- -- Spec combinators -- | Specify an issue that needs to be regression tested.-issue :: Example a => String -> t -> a -> SpecWith (Arg a)+issue+ :: Example a+ => String -> t -> a -> SpecWith (Arg a) issue label _link expectation = it label expectation