diff --git a/doc/haskell-mode.texi b/doc/haskell-mode.texi index 068bff8ae..bd2f0780d 100644 --- a/doc/haskell-mode.texi +++ b/doc/haskell-mode.texi @@ -74,6 +74,7 @@ interpreter (e.g. GHCi). * Aligning code:: Aligning code using @code{align-regexp} * Rectangular commands:: Manage indentation manually * REPL:: GHCi REPL +* Global-Eldoc:: Shows documentation at point * Collapsing Haskell code:: View more code on screen * Getting Help and Reporting Bugs:: How to improve Haskell Mode * Concept index:: Index of Haskell Mode concepts @@ -1151,1154 +1152,116 @@ same customized compile command, invoke @code{recompile} (bound to @node Interactive Haskell @chapter Interactive Haskell -An alternative mode providing a @acronym{REPL,read–eval–print loop} via -GHCi sessions is called @code{haskell-interactive-mode}, which -effectively replaces @code{inferior-haskell-mode}, but comes with a -different set of features: +@code{interactive-haskell-mode} is the minor mode that provides interactive +editing features. Most of these features are provided by querying the haskell +REPL processes. -@itemize -@item -Separate sessions per Cabal project @file{haskell-session.el}. -@item -A new inferior Haskell process handling code @file{haskell-process.el}. -@item -New REPL implementation similiar to SLIME/IELM -@item -Navigatable error overlays -@file{haskell-interactive-mode.el}. -@end itemize - -With @code{haskell-interactive-mode}, each Haskell source buffer is -associated with at most one GHCi session, so when you call -@code{haskell-process-load-file} for a Haskell source buffer which has -no session associated yet, you're asked which GHCi session to create or -associate with. - -@section Goto Error - -In a Haskell source buffer associated with a GHCi session, errors that -prevent the file from loading are highlighted with -@code{haskell-error-face}. You can move between these error lines with - -@table @kbd -@item M-n -is bound to @code{haskell-goto-next-error} -@item M-p -is bound to @code{haskell-goto-prev-error} -@item C-c M-p -is bound to @code{haskell-goto-first-error} -@end table - -@section Using GHCi 8+ or GHCi-ng - -If you use either of the above, then you can use these functions: - -@lisp -(define-key interactive-haskell-mode-map (kbd "M-.") 'haskell-mode-goto-loc) -(define-key interactive-haskell-mode-map (kbd "C-c C-t") 'haskell-mode-show-type-at) -@end lisp - -You have to load the module before it works, after that it will remember -for the current GHCi session. - -@section Customizing - -@cindex customizing -What kind of Haskell REPL @code{haskell-interactive-mode} will start up -depends on the value of @code{haskell-process-type}. This can be one of the -symbols @code{auto}, @code{ghci}, @code{cabal-repl}, @code{cabal-new-repl}, or -@code{stack-ghci}. If it's @code{auto}, the directory contents and available -programs will be used to make a best guess at the process type. The actual -process type will then determine which variables -@code{haskell-interactive-mode} will access to determine the program to start -and its arguments: - -@itemize -@item -If it's @code{ghci}, @code{haskell-process-path-ghci} and -@code{haskell-process-args-ghci} will be used. -@item -If it's @code{cabal-repl}, @code{haskell-process-path-cabal} and -@code{haskell-process-args-cabal-repl}. -@item -If it's @code{cabal-new-repl}, @code{haskell-process-path-cabal} and -@code{haskell-process-args-cabal-new-repl}. -@item -If it's @code{stack-ghci}, @code{haskell-process-path-stack} and -@code{haskell-process-args-stack-ghci} will be used. -@end itemize - -With each of these pairs, the the @code{haskell-process-path-...} -variable needs to be a string specifying the program path, or a list of -strings where the first element is the program path and the rest are -initial arguments. The @code{haskell-process-args-...} is a list of -strings specifying (further) command-line arguments. - -@vindex haskell-process-type -@vindex haskell-process-path-ghci -@vindex haskell-process-path-cabal -@vindex haskell-process-path-stack -@vindex haskell-process-args-ghci -@vindex haskell-process-args-cabal-repl -@vindex haskell-process-args-cabal-new-repl -@vindex haskell-process-args-stack-ghci - -@section Haskell Interactive Mode Setup - -The most straight-forward way to get setup with Interactive Mode is to -bind the right keybindings and set some customizations. This page -contains a good base setup. - -To enable the minor mode which activates keybindings associated with interactive mode, use: - -@lisp -(require 'haskell-interactive-mode) -(require 'haskell-process) -(add-hook 'haskell-mode-hook 'interactive-haskell-mode) -@end lisp - -@subsection Customizations - -This enables some handy and benign features. - -@lisp -(custom-set-variables - '(haskell-process-suggest-remove-import-lines t) - '(haskell-process-auto-import-loaded-modules t) - '(haskell-process-log t)) -@end lisp - - -@subsection Haskell-mode bindings - -This gives the basic ways to start a session. In a Haskell buffer: - -@itemize -@item -Run @kbd{C-`} to make a REPL open, this will create a -session, start GHCi, and open the REPL. -@item -Or: run @kbd{C-c C-l} to load the file. This will first try to start a -session as the previous command does. -@item -Or: run any command which requires a running session. It will always -prompt to create one if there isn't one already for the current project. -@end itemize - -@lisp -(define-key haskell-mode-map (kbd "C-c C-l") 'haskell-process-load-or-reload) -(define-key haskell-mode-map (kbd "C-`") 'haskell-interactive-bring) -(define-key haskell-mode-map (kbd "C-c C-t") 'haskell-process-do-type) -(define-key haskell-mode-map (kbd "C-c C-i") 'haskell-process-do-info) -(define-key haskell-mode-map (kbd "C-c C-c") 'haskell-process-cabal-build) -(define-key haskell-mode-map (kbd "C-c C-k") 'haskell-interactive-mode-clear) -(define-key haskell-mode-map (kbd "C-c c") 'haskell-process-cabal) -@end lisp - - -@subsection Cabal-mode bindings - -The below commands pretty much match the ones above, but are handy to -have in cabal-mode, too: - -@lisp -(define-key haskell-cabal-mode-map (kbd "C-`") 'haskell-interactive-bring) -(define-key haskell-cabal-mode-map (kbd "C-c C-k") 'haskell-interactive-mode-clear) -(define-key haskell-cabal-mode-map (kbd "C-c C-c") 'haskell-process-cabal-build) -(define-key haskell-cabal-mode-map (kbd "C-c c") 'haskell-process-cabal) -@end lisp - -@subsection GHCi process type - -By default @code{haskell-process-type} is set to @code{auto}. It is -smart enough to pick the right type based on your project structure and -installed tools, but in case something goes funky or you want to -explicitly set the process type and ignore the inferred type, you can -customize this setting by running @kbd{M-x} @code{customize-variable} -@kbd{RET} @code{haskell-process-type} @kbd{RET}, or by setting the code: - -@lisp -(custom-set-variables - '(haskell-process-type 'cabal-repl)) -@end lisp - -Here is a list of available process types: - -@itemize -@item ghci -@item cabal-repl -@item cabal-new-repl -@item cabal-dev -@item cabal-ghci -@item stack-ghci -@end itemize - -Please, check the documentation for @code{haskell-process-type} to see how -the real type is guessed, when it's set to @code{auto}. - -@subsection Troubleshooting - -Launching your GHCi process can fail when you're first getting setup, -depending on the type you choose. If it does fail to launch, switch to -the buffer @code{*haskell-process-log*} and see what's up. The buffer -contains a log of incoming/outgoing messages to the GHCi process. - -@section Haskell Interactive Mode Tags Using GHCi - -You can bind the following to use GHCi to find definitions of things: - -@lisp -(define-key haskell-mode-map (kbd "M-.") 'haskell-mode-jump-to-def) -@end lisp - -The one problem with this approach is that if your code doesn't compile, -GHCi doesn't give any location info. So you need to make sure your code -compiles and the modules you want to jump to are loaded byte-compiled. - -Note: I think that when you restart GHCi you lose location -information, even if you have the @file{.o} and @file{.hi} files lying around. I'm not -sure. But sometimes @code{:i foo} will give @code{foo is defined in Bar} rather -than @code{foo is defined in /foo/Bar.hs:123:23}. - -Alternatively, you can use tags generation, which doesn't require a -valid compile. - -@subsection Tags Setup - -Make sure to install @file{hasktags}. - -@example - $ cabal install hasktags -@end example - -Then add the customization variable to enable tags generation on save: - -@lisp -(custom-set-variables - '(haskell-tags-on-save t)) -@end lisp - -And make sure @file{hasktags} is in your @code{$PATH} which Emacs can see. - -@subsection Generating tags - -Now, every time you run @code{save-buffer} (@kbd{C-x C-s}), there is a -hook that will run and generate Emacs @xref{Tags,,,emacs} for the whole -project directory. The resulting file will be called @file{TAGS}. - -WARNING: You should be careful that your project root isn't your -home directory or something, otherwise it will traverse all the way -down and take an impossibly long time. - -@subsection Jumping to tags - -Bind the following keybinding: - -@lisp -(define-key haskell-mode-map (kbd "M-.") 'haskell-mode-tag-find) -@end lisp - -To jump to the location of the top-level identifier at point, run -@kbd{M-x} @code{haskell-mode-tag-find} or @kbd{M-.}. - -@subsection Hybrid: GHCi and fallback to tags - -To use GHCi first and then if that fails to fallback to tags for jumping, use: - -@lisp -(define-key haskell-mode-map (kbd "M-.") 'haskell-mode-jump-to-def-or-tag) -@end lisp - -@subsection Troubleshooting tags - -Sometimes a @file{TAGS} file is deleted (by you or some other -process). Emacs will complain that it doesn't exist anymore. To -resolve this simply do @kbd{M-x} @code{tags-reset-tags-tables}. - -@section Sessions - -All commands in Haskell Interactive Mode work within a session. Consider -it like a “project” or a “solution” in popular IDEs. It tracks the root -of your project and an associated process and REPL. - -@subsection Start a session - -To start a session run the following steps: - -@itemize -@item -Open some Cabal or Haskell file. -@item -Run @kbd{C-`} to make a REPL open, this will create a session, start -GHCi, and open the REPL. -@item -Or: run @kbd{C-c C-l} to load the file. This will first try to start a -session as the previous command does. -@item -Or: run any command which requires a running session. It will always -prompt to create one if there isn't one already for the current project. -@end itemize - -It will prompt for a Cabal directory and a current directory. It figures -out where the cabal directory is and defaults for the current directory, -so you should be able to just hit RET twice. - -@subsection Switch a session - -Sometimes a particular file is used in two different -sessions/projects. You can run - -@example - M-x haskell-session-change -@end example - -If it prompts you to make a new session, tell it no (that's a -bug). It will ask you to choose from a list of sessions. - -@subsection Killing a session - -To kill a session you can run - -@example - M-x haskell-session-kill -@end example - -Which will prompt to kill all associated buffers, too. Hit `n` to -retain them. - -Alternatively, you can switch to the REPL and just kill the buffer -normally with @kbd{C-x k RET}. It will prompt - -@example - Kill the whole session (y or n)? -@end example - -You can choose @kbd{y} to kill the session itself, or @kbd{n} to just -kill the REPL buffer. You can bring it back with @kbd{M-x} -@code{haskell-interactive-bring}. - -@subsection Menu - -To see a list of all sessions you have open with some simple -statistics about memory usage, etc. run - -@example - M-x haskell-menu -@end example - -For example: - -@example - foo 14648 08:21:42 214MB /path/to/fpco/foo/ /path/to/fpco/foo/ ghci - bar 29119 00:22:03 130MB /path/to/bar/ /path/to/bar/ ghci - mu 22575 08:48:20 73MB /path/to/fpco/mu/ /path/to/fpco/mu/ ghci -@end example - - -@section Compiling - -There are a bunch of ways to compile Haskell modules. This page covers -a few of them. - -@subsection Load into GHCi - -To compile and load a Haskell module into GHCi, run the following - -@example - M-x haskell-process-load -@end example - -Or @kbd{C-c C-l}. You'll see any compile errors in the REPL window. - -@subsection Build the Cabal project - -To compile the whole Cabal project, run the following - -@example - M-x haskell-process-cabal-build -@end example - -Or @kbd{C-c C-c}. You'll see any compile errors in the REPL window. - -@subsection Reloading modules - -To reload the current module, even when you're in other modules, you can -run @kbd{C-u M-x} @code{haskell-process-load-or-reload} or @kbd{C-u C-c -C-l}. It will now reload that module whenever you run @kbd{C-c C-l} in -the future from whatever module you're in. To disable this mode, just -run @kbd{C-u C-c C-l} again. - -@subsection Jumping to compile errors - -You can use the standard compile error navigation function @kbd{C-x `} — -jump to the next error. - -Or you can move your cursor to an error in the REPL and hit @kbd{RET} to -jump to it. - -@subsection Auto-removing imports - -If the customization variable -@code{haskell-process-suggest-remove-import-lines} is enabled. - -@lisp -(custom-set-variables - '(haskell-process-suggest-remove-import-lines t)) -@end lisp - -Building and loading modules which output warnings like, - -@example - Warning: The import of `Control.Monad' is redundant - except perhaps to import instances from `Control.Monad' - To import instances alone, use: import Control.Monad() -@end example - -will prompt the user with - -@example -> The import line `Control.Monad' is redundant. Remove? (y, n, c: comment out) -@end example - -If you answer - -@itemize -@item -@kbd{y}: it will delete the import, but leave the empty line remaining -(this avoids messing with line positions in subsequent error messages). -@item -@kbd{n}: it will leave the import. -@item -@kbd{c}: it will comment out the import (this is handy for when you just -want to temporarily hide an import). -@end itemize - -@subsection Auto-adding of modules to import - -Enable the customization variable -@code{haskell-process-suggest-hoogle-imports}. - -@lisp -(custom-set-variables - '(haskell-process-suggest-hoogle-imports t)) -@end lisp - -Whenever GHC says something is not in scope, it will hoogle that -symbol. If there are results, it will prompt to add one of the modules -from Hoogle's results. - -You need to make sure you've generated your Hoogle database properly. - -@subsection Auto-adding of extensions - -It you use an extension which is not enabled, GHC will often inform -you. For example, if you write: - -@example -newtype X a = X (IO a) - deriving (Monad) -@end example - - -Then you'll see a message like: - -@example - x.hs:13:13: Can't make a derived instance of `Monad X': … - `Monad' is not a derivable class - Try -XGeneralizedNewtypeDeriving for GHC's newtype-deriving extension - In the newtype declaration for `X' -@end example - -This @code{-XFoo} pattern will be picked up and you will be prompted: - -@example -> Add `@{-# LANGUAGE GeneralizedNewtypeDeriving #-@}` to the top of the -> file? (y or n) -@end example - -If you answer `y`, it will temporarily jump to the buffer and it to -the top of the file. - -@subsection Orphan instances - -If GHC complains about orphan instances, you usually are doing it -intentionally, so it prompts to add @code{-fno-warn-orphans} to the top of -the file with an @kbd{OPTIONS} pragma. - -@subsection Auto-adding of dependencies - -When doing a build, you will sometimes get a message from GHC like: - -@example - src/ACE/Tokenizer.hs:11:18: Could not find module `Data.Attoparsec.Text' … - It is a member of the hidden package `attoparsec-0.11.1.0'. -@end example - -This message contains all the necessary information to add this to -your .cabal file, so you will be prompted to add it to your .cabal -file: - -@example - Add `attoparsec' to ace.cabal? (y or n) y -@end example - -If you hit @kbd{y}, it will prompt with this: - -@example - attoparsec >= 0.11.1.0 -@end example - -Which you can edit (e.g. do some PVP decision or remove constraints -entirely), and then it will open up your @file{.cabal} file and go -through each section: - -@example - Add to library? (y or n) y -@end example - -This will add it to the top of the @code{build-depends} field in your -library section. If you have any executables, it will go through each -of those, prompting, too. - -Now you can rebuild with @kbd{C-c C-c} again. - -@section Haskell Interactive Mode REPL - -When GHCi has been launched, it works on a read-eval-print basis. So -you will be presented with the prompt: - -@example - The lambdas must flow. - Changed directory: /path/to/your/project/ - λ> -@end example - -@subsection Changing REPL target - -@findex haskell-session-change-target -@vindex haskell-interactive-mode-hook - -With @code{haskell-session-change-target} you can change the target for -REPL session. - - -After REPL session started, in @code{haskell-interactive-mode} buffer invoke the -@code{haskell-session-change-target} and select from available targets for - -@cindex testing -- Testing - -@cindex benchmarking -- Benchmark - -- Executable - -- Library - -Answer ``yes'' to restart the session and run your tests, benchmarks, executables. - - -TODO/WRITEME - - -@subsection Bringing the REPL - -If you don't know where the REPL buffer is, you can always bring it -with: - -@example - M-x haskell-interactive-bring -@end example - -Or @kbd{C-`}. - -@subsection Evaluating expressions - -To evaluate expressions, simply type one out and hit `RET`. - -@example - λ> 123 - 123 -@end example - -@subsection Evaluating multiline expressions - -GHCi features two ways to evaluate multiline expressions. You can use -@code{:set +m} to -enable @uref{https://www.haskell.org/ghc/docs/latest/html/users_guide/ghci.html#multiline-input, -multiline input} for all expressions, or you can wrap your expression in -@code{:@{} and @code{:@}} (they have to be on their own lines). - -The prompt will change to indicate that you're inputting a multiline -expression: - -@example -λ> :@{ -λ| let a = 10 -λ| b = 20 -λ| c = 30 -λ| :@} -@end example - -You can also simulate multiline mode by having your input contain -newline characters. You can input a literal newline character with -@kbd{C-q C-j}, or you can use: - -@example - M-x haskell-interactive-mode-newline-indent -@end example - -which is bound to @kbd{C-j}. This command indents after the newline. You -can simulate the above example like so: - -@example -λ> let a = 10 - b = 20 - c = 30 -@end example - -@subsection Type of expressions +@section Enable this mode -You can use normal @code{:type} which is part of GHCi to get the type of -something: +Run the function @kbd{M-x interactive-haskell-mode} -@example - λ> :t id - id :: a -> a -@end example - -But you can also just write out the value directly, - -@example - λ> id - id :: a -> a -@end example - -and because there's no @code{Show} instance for @code{(a -> a)}. This would -normally yield a compile error: - -@example - No instance for (Show (a0 -> a0)) - arising from a use of `print' - Possible fix: add an instance declaration for (Show (a0 -> a0)) - In a stmt of an interactive GHCi command: print it -@end example - -It will run @code{:type id} in the background and print out the -result. The same is true for ambiguous things: - -@example - λ> :t read "a" - read "a" :: Read a => a -@end example - -Because this would normally be an ambiguous constraint: - -@example - Ambiguous type variable `a0' in the constraint: - (Read a0) arising from a use of `read' - Probable fix: add a type signature that fixes these type variable(s) - In the expression: read \"a\" - In an equation for `it': it = read \"a\" -@end example - -Which is less useful than just printing the type out. - -You can disable this behaviour by disabling the customization option: - -@lisp -(custom-set-variables - '(haskell-interactive-types-for-show-ambiguous nil)) -@end lisp - -@subsection Printing mode - -You can choose between printing modes used for the results of -evaluating expressions. To do that, configure the variable -@code{haskell-interactive-mode-eval-mode}. Example: - -@lisp -(setq haskell-interactive-mode-eval-mode 'haskell-mode) -@end lisp - - -A handy function you can use is: - -@lisp -(defun haskell-interactive-toggle-print-mode () - (interactive) - (setq haskell-interactive-mode-eval-mode - (intern - (ido-completing-read "Eval result mode: " - '("fundamental-mode" - "haskell-mode" - "espresso-mode" - "ghc-core-mode" - "org-mode"))))) -@end lisp - -(Add whichever modes you want to use.) - -And then run - -@example - M-x haskell-interactive-toggle-print-mode -@end example - -Or @kbd{C-c C-v}: - -@lisp -(define-key haskell-interactive-mode-map (kbd "C-c C-v") - 'haskell-interactive-toggle-print-mode) -@end lisp - -There you can choose `haskell-mode`, for example, to pretty print the -output as Haskell. - -@subsection Presentations - -If you have the @file{present} package installed, you can use the following -syntax to print anything which is an instance of @code{Data}: - -@example - λ> :present 123 - 123 -@end example - -It will print data structures lazily: - -@example - λ> :present [1..] - [1 - ,[Integer]] -@end example - -It shows types when there is an unevaluated field in a constructor. You -can click the @code{[Integer]} or press @kbd{RET} on it to expand -further: - -@example - λ> :present [1..] - [1 - ,2 - ,[Integer]] -@end example - -Etc. Remember: this only works for instances of @code{Data.Data.Data}. - -@subsection History - -A history is maintained for the duration of the REPL buffer. To go up -and down in the history, run @kbd{M-p} for previous and @kbd{M-n} for -next. - -@subsection Cancelling commands - -To cancel a running REPL command, run @kbd{C-c C-c}. - -@subsection Clear the REPL - -Run @kbd{C-c C-k} to clear the REPL. - - -@subsection Trick: Put Interactive REPL in Separate Frame - - -The following @code{create-haskell-interactive-frame} is a quick hack to -move the repl to a separate frame, for those that want a more -predictable layout of windows in Emacs. - -@lisp -(defun create-unfocused-frame () - (let* - ((prv (window-frame)) - (created (make-frame))) - (select-frame-set-input-focus prv) created)) - -(defun create-haskell-interactive-frame () - (interactive) - (haskell-interactive-bring) - (create-unfocused-frame) - (delete-window)) - -@end lisp - -@subsection Troubleshooting - -If the REPL ever goes funny, you can clear the command queue via: - -@example - M-x haskell-process-clear -@end example - -Alternatively, you can just restart the process: - -@example - M-x haskell-process-restart -@end example - -You can also switch to the buffer @code{*haskell-process-log*}, which can -be enabled and disabled with the customization variable -`haskell-process-log`, to see what the cause of your troubles are. - -If the process fails and nothing unusual is in the process log, the -following command can dump the @code{haskell-process} state: - -@example - M-: (haskell-process) -@end example - -The output can be copied from the @code{*Messages*} buffer. - -@section Haskell Interactive Mode Querying - -There a few ways GHCi lets you query information about your code. - -@subsection Get identifer type - -To print the type of the top-level identifier at point in the REPL and -in the message buffer, run the following command: - -@example - M-x haskell-process-do-type -@end example - -or @kbd{C-c C-t}. - -@subsection Insert identifier's type as type signature - -To print the type of the top-level identifier at point, run the -following command: - -@example - C-u M-x haskell-process-do-type -@end example - -or @kbd{C-u C-c C-t}. - -@subsection Get identifier info - -To print the info of the identifier at point, run the following -command: - -@example - M-x haskell-process-do-info -@end example - -or @kbd{C-c C-i}. - -@subsection Presentation mode - -When using @kbd{C-c C-i} or @kbd{C-c C-t} it will open a buffer in -haskell-presentation-mode. You can hit @kbd{q} to close the buffer. - -But you can also continue to use @kbd{C-c C-i} inside the buffer to -drill further down data types and classes. - -E.g. if you go to @code{Ord} in your code buffer and @kbd{C-c C-i}, it -will popup a buffer containing - -@example -class Eq a => Ord a where - compare :: a -> a -> Ordering - (<) :: a -> a -> Bool - (>=) :: a -> a -> Bool - (>) :: a -> a -> Bool - (<=) :: a -> a -> Bool - max :: a -> a -> a - min :: a -> a -> a - -- Defined in `GHC.Classes' -@end example - -And all the instances of that class. But then you can also move your -cursor to @code{Ordering} and hit @kbd{C-c C-i} again to get another -popup: - -@example -data Ordering = LT | EQ | GT -- Defined in `GHC.Types' -instance Bounded Ordering -- Defined in `GHC.Enum' -instance Enum Ordering -- Defined in `GHC.Enum' -instance Eq Ordering -- Defined in `GHC.Classes' -instance Ord Ordering -- Defined in `GHC.Classes' -instance Read Ordering -- Defined in `GHC.Read' -instance Show Ordering -- Defined in `GHC.Show' -@end example - -And so on. It's a very good way of exploring a new codebase. - -@subsection Browse import's module - -To print all exported identifiers of the module imported by the import -line at point, run the following command: - -@example - M-x haskell-process-do-info -@end example - -or @kbd{C-c C-i}. It will print all exports by running @code{:browse -The.Module} in the GHCi process. - -@section Haskell Interactive Mode Cabal integration - -There's some integration with Cabal in Haskell Interactive Mode. Once -you've started a session, the features below are available. - -@subsection Cabal building - -The most common Cabal action is building, so that has a specific command: - -@example - M-x haskell-process-cabal-build -@end example - -Or @kbd{C-c C-c}. When building, it will hide unneccessary output. - -For example, to build the `ace` package, the output is simply: - -@example - Compiling: ACE.Types.Tokens - Compiling: ACE.Combinators - Compiling: ACE.Tokenizer - Compiling: ACE.Parsers - Compiling: ACE.Pretty - Compiling: ACE - Complete: cabal build (0 compiler messages) -@end example - -Whereas the complete output is normally: - -@example - Building ace-0.5... - Preprocessing library ace-0.5... - [4 of 9] Compiling ACE.Types.Tokens ( src/ACE/Types/Tokens.hs, dist/build/ACE/Types/Tokens.o ) - [5 of 9] Compiling ACE.Combinators ( src/ACE/Combinators.hs, dist/build/ACE/Combinators.o ) [ACE.Types.Tokens changed] - [6 of 9] Compiling ACE.Tokenizer ( src/ACE/Tokenizer.hs, dist/build/ACE/Tokenizer.o ) [ACE.Types.Tokens changed] - [7 of 9] Compiling ACE.Parsers ( src/ACE/Parsers.hs, dist/build/ACE/Parsers.o ) - [8 of 9] Compiling ACE.Pretty ( src/ACE/Pretty.hs, dist/build/ACE/Pretty.o ) - [9 of 9] Compiling ACE ( src/ACE.hs, dist/build/ACE.o ) [ACE.Tokenizer changed] - In-place registering ace-0.5... -@end example - -Which is considerably more verbose but rarely useful or interesting. - -@subsection Arbitrary cabal commands - -To run an arbitrary Cabal command: - -@example - C-u M-x haskell-process-cabal -@end example - -Or run @kbd{C-u C-c c}. - -It will prompt for an input, so you can write @code{configure -fdev}, -for example. - -@subsection Completing cabal commands - -To run some common Cabal commands, just run: - -@example - M-x haskell-process-cabal -@end example - -Or @kbd{C-c c}. This is commonly used to do @code{install}, -@code{haddock}, @code{configure}, etc. - -@section Haskell Interactive Mode Debugger - -There is limited support for debugging in GHCi. Haskell Interactive Mode -provides an interface for interacting with this. - -@subsection Opening the debug buffer - -To open the debug buffer run the following command from any buffer -associated with a session: - -@example - M-x haskell-debug -@end example - -It will open a buffer that looks like this: - -@example - Debugging haskell - - You have to load a module to start debugging. - - g - refresh - - Modules - - No loaded modules. -@end example - - -@subsection Loading modules - -To debug anything you need to load something into GHCi. Switch to a -normal file, for example: - -@example -main = do putStrLn "Hello!" - putStrLn "World" -@end example - -and load it into GHCi (@kbd{C-c C-l}). Now when you hit @kbd{g} -(to refresh) in the debugging buffer, you'll see something like: - -@example - - Debugging haskell - - b - breakpoint, g - refresh - - Context - - Not debugging right now. - - Breakpoints - - No active breakpoints. - - Modules - - Main - hello.hs -@end example - -@subsection Setting a breakpoint - -To set a breakpoint hit @kbd{b} in the debugger buffer. It will prompt -for a name. Enter @code{main} and hit @kbd{RET}. - -Now the buffer will look like this: +If you want to enable this mode permanently, then hook this mode to @code{haskell-mode} by +putting this line in your @code{.emacs} file: @example - Debugging haskell - - s - step into an expression, b - breakpoint - d - delete breakpoint, g - refresh - - Context - - Not debugging right now. - - Breakpoints - - 0 - Main (1:8) - - Modules - - Main - hello.hs +(add-hook 'haskell-mode-hook 'interactive-haskell-mode) @end example -@subsection Start stepping - -Hit @kbd{s} to step through an expression: it will prompt for an -expression to evaluate and step through. Enter @code{main} and hit -@kbd{RET}. Now the buffer will look like this: - -@example - Debugging haskell - - s - step into an expression, b - breakpoint - d - delete breakpoint, a - abandon context, c - continue - p - previous step, n - next step - g - refresh - - Context - - main - hello.hs (stopped) +@section Related key binding - do putStrLn "Hello!" - putStrLn "World" +@multitable @columnfractions 0.3 0.2 0.2 0.3 +@headitem Function @tab Args @tab Key bindings @tab Description - _result :: IO () = _ +@item @code{haskell-process-load-file} +@tab nil +@tab @kbd{C-c C-l}, @kbd{C-c C-r} +@tab Load or reload the file in current buffer, errors that might arise are put in the `*haskell-compilation*' buffer. - 1 do putStrLn "Hello!" putStrLn "World" +@item @code{haskell-mode-jump-to-def-or-tag} +@tab nil +@tab @kbd{M-.} +@tab Jump to the definition. - Breakpoints +@item @code{haskell-cabal-visit-file} +@tab nil +@tab @kbd{C-c v c} +@tab Locate and visit package description file for file visited by current buffer. - 0 - Main (1:8) +@item @code{haskell-process-cabal} +@tab nil +@tab @kbd{C-c C-x} +@tab Prompts for a Cabal command to run. - Modules +@item @code{run-haskell}, @code{switch-to-haskell} +@tab nil +@tab @kbd{C-c C-b}, @kbd{C-c C-z} +@tab Show the inf-haskell buffer. Start the process if needed. - Main - hello.hs -@end example - -What we see here is the current expression being evaluated: +@item @code{haskell-compile} +@tab nil +@tab @kbd{C-c C-c} +@tab Compile the Haskell program including the current buffer. -@example -do putStrLn "Hello!" - putStrLn "World" -@end example +@item @code{haskell-process-cabal-build} +@tab nil +@tab nil +@tab Run the command @code{cabal build} +@end multitable -And we see the type of it: +@section More on @code{M-.} -@example -_result :: IO () = _ -@end example +The @code{M-.} functionality works if the file in the buffer is loaded into +the REPL (@kbd{C-c C-l}). The file in the current buffer can only be loaded +if the code doesn't contain errors. When we can succesfully load the file in +the current buffer into REPL, we can get accurate go-to function definition +with @kbd{M-.} -And we see a backtrace of steps so far: +@subsection @code{M-.} with hasktags -@example -1 do putStrLn "Hello!" putStrLn "World" -@end example +Sometimes we might want to use the @kbd{M-.} functionality even when the +code doesn't compile. This is when we use TAGS. -@subsection Continue stepping +First install @code{hasktags}. -To continue stepping, just hit @kbd{s} again. Now the context will change -to: +You can run either @example -main - hello.hs (stopped) - -putStrLn "Hello!" - -_result :: IO () = _ - - 1 do putStrLn "Hello!" putStrLn "World" +$ cabal install hasktags @end example - -Hitting @kbd{s} once more, we see the context change to: +or @example -putStrLn "World" - -_result :: IO () = _ - - 2 putStrLn "Hello!" - 1 do putStrLn "Hello!" putStrLn "World" +$ stack install hasktags @end example -Finally hitting @kbd{s} again will say "Computation finished". Hitting -@kbd{s} a final time will change the display back to: +Then we run @kbd{M-x haskell-mode-generate-tags} to generate tags. Now +we can use @kbd{M-.} functionality even when the code doesn't compile. -@example - Debugging haskell - - s - step into an expression, b - breakpoint - d - delete breakpoint, g - refresh - - Context - - Finished debugging. +But running @kbd{M-x haskell-mode-generate-tags} everytime can be a too much +typing to do just a @kbd{M-.}. We set @code{haskell-tags-on-save} to @code{t} +and the TAGS will be generated on saving the file in buffer. - 2 putStrLn "Hello!" - 1 do putStrLn "Hello!" putStrLn "World" +@section Related defcustoms - Breakpoints +@multitable @columnfractions .40 .20 .40 +@headitem Defcustom @tab Default value @tab Possible values - 1 - Main (1:8) +@item @code{haskell-tags-on-save} @tab nil @tab @code{nil}, @code{t} +@item @code{haskell-process-type} @tab @code{'auto} @tab @code{'stack-ghci, 'cabal-repl, 'ghci, 'auto} +@item @code{haskell-process-path-ghci} @tab @code{ghci} @tab - +@item @code{haskell-process-args-ghci} @tab @code{-ferror-spans} @tab - +@item @code{haskell-process-path-cabal} @tab @code{cabal} @tab - +@item @code{haskell-process-args-cabal-repl} @tab @code{--ghc-option=-ferror-spans} @tab - +@item @code{haskell-process-path-stack} @tab @code{stack} @tab - +@item @code{haskell-process-args-stack-ghci} @tab @code{--ghci-options=-ferror-spans --no-build --no-load} @tab - - Modules +@end multitable - Main - hello.hs -@end example -And you're done debugging. +@section Add Hooks +None @node Editing Cabal files @chapter Editing Cabal files @@ -2632,7 +1595,7 @@ invokes @kbd{comint-write-output}. Write output from interpreter since last input to FILENAME. Any prompt at the end of the output is not written. @end table -@section Relevant defcustoms: +@section Relevant defcustoms @multitable @columnfractions .40 .20 .40 @headitem Interpreter (defcustom) @tab Default Value @tab Possible Values @@ -2672,6 +1635,69 @@ preference is followed. @code{cabal.sandbox.config} > @code{stack.yaml} > @code{*.cabal} +@node Global-Eldoc +@chapter Shows documentation at point + +@code{haskell-doc-mode} (enabled by default) shows the Type of an identifier at +point (if it exists). The type of functions/operators in Prelude are shown by +default. Other information such as the structure of @code{import}, @code{if}, +@code{do} etc. is also shown. + +If you want this to work with other imported modules as well, then +load the file into the repl. This can be done by pressing @kbd{C-c C-l} +from the the current buffer, provided you have @code{interactive-haskell} +minor mode enabled. Then when you place the point +on a text for more than 0.5 seconds, the type information or other +documentation information is shown. + +To show type information for modules other than @code{Prelude}, we +query the comint based @code{GHCi} process for type information. + +@section Related defcustoms + +@multitable @columnfractions .40 .20 .40 +@headitem Defcustom @tab Default value @tab Description + +@item @code{haskell-doc-prettify-types} +@tab t +@tab Replace some parts of types with Unicode characters like @code{::} with +@code{∷} when showing type information about symbols. + +@item @code{haskell-doc-show-global-types} +@tab nil +@tab If non-nil, search for the types of global functions by loading the files. +This variable is buffer-local. + +@item @code{haskell-doc-show-reserved} +@tab t +@tab If non-nil, show a documentation string for reserved ids. +This variable is buffer-local. + +@item @code{haskell-doc-show-strategy} +@tab t +@tab If non-nil, show a documentation string for strategies. +This variable is buffer-local. + +@item @code{haskell-doc-show-user-defined} +@tab t +@tab If non-nil, show a documentation string for user defined ids. +This variable is buffer-local. + +@item @code{haskell-doc-chop-off-context} +@tab t +@tab If non-nil eliminate the context part in a Haskell type. + +@item @code{haskell-doc-chop-off-fctname} +@tab nil +@tab If non-nil omit the function name and show only the type. + +@end multitable + +@section Adding hook + +Add your hooks to @code{haskell-doc-mode-hook}. By default, nothing is +hooked to @code{haskell-doc-mode-hook}. + @node Collapsing Haskell code @chapter Collapsing Haskell code diff --git a/ghci-script-mode.el b/ghci-script-mode.el index 2ec905cd1..00cf70b24 100644 --- a/ghci-script-mode.el +++ b/ghci-script-mode.el @@ -1,6 +1,7 @@ ;;; ghci-script-mode.el --- GHCi scripts major mode -*- lexical-binding: t -*- ;; Copyright (c) 2014 Chris Done. All rights reserved. +;; Copyright (c) 2017 Vasantha Ganesh Kanniappan ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -17,7 +18,7 @@ ;;; Code: -(require 'haskell) +(require 'inf-haskell) (defvar ghci-script-mode-keywords ;; The comment syntax can't be described simply in syntax-table. @@ -55,12 +56,9 @@ (defun ghci-script-mode-load () "Load the current script file into the GHCi session." (interactive) - (let ((buffer (haskell-session-interactive-buffer (haskell-session))) - (filename (buffer-file-name))) + (let ((filename (buffer-file-name))) (save-buffer) - (with-current-buffer buffer - (set-marker haskell-interactive-mode-prompt-start (point-max)) - (haskell-interactive-mode-run-expr - (concat ":script " filename))))) + (inferior-haskell-get-result (concat ":script " filename)) + (message (format "Loaded %s" filename)))) (provide 'ghci-script-mode) diff --git a/haskell-commands.el b/haskell-commands.el index 17b9cdf5f..8c6010fed 100644 --- a/haskell-commands.el +++ b/haskell-commands.el @@ -2,7 +2,7 @@ ;;; Commentary: -;;; This module provides varoius `haskell-mode' and `haskell-interactive-mode' +;;; This module provides varoius `haskell-mode' ;;; specific commands such as show type signature, show info, haskell process ;;; commands and etc. @@ -28,168 +28,26 @@ (require 'etags) (require 'haskell-mode) (require 'haskell-compat) -(require 'haskell-process) (require 'haskell-font-lock) -(require 'haskell-interactive-mode) -(require 'haskell-session) (require 'haskell-string) -(require 'haskell-presentation-mode) (require 'haskell-utils) (require 'highlight-uses-mode) (require 'haskell-cabal) +(require 'inf-haskell) +(require 'json) (defcustom haskell-mode-stylish-haskell-path "stylish-haskell" "Path to `stylish-haskell' executable." :group 'haskell :type 'string) -(defcustom haskell-interactive-set-+c - t - "Issue ':set +c' in interactive session to support type introspection." - :group 'haskell-interactive - :type 'boolean) - -;;;###autoload -(defun haskell-process-restart () - "Restart the inferior Haskell process." - (interactive) - (haskell-process-reset (haskell-interactive-process)) - (haskell-process-set (haskell-interactive-process) 'command-queue nil) - (haskell-process-start (haskell-interactive-session))) - -(defun haskell-process-start (session) - "Start the inferior Haskell process with a given SESSION. -You can create new session using function `haskell-session-make'." - (let ((existing-process (get-process (haskell-session-name (haskell-interactive-session))))) - (when (processp existing-process) - (haskell-interactive-mode-echo session "Restarting process ...") - (haskell-process-set (haskell-session-process session) 'is-restarting t) - (delete-process existing-process))) - (let ((process (or (haskell-session-process session) - (haskell-process-make (haskell-session-name session)))) - (old-queue (haskell-process-get (haskell-session-process session) - 'command-queue))) - (haskell-session-set-process session process) - (haskell-process-set-session process session) - (haskell-process-set-cmd process nil) - (haskell-process-set (haskell-session-process session) 'is-restarting nil) - (let ((default-directory (haskell-session-cabal-dir session)) - (log-and-command (haskell-process-compute-process-log-and-command session (haskell-process-type)))) - (haskell-session-prompt-set-current-dir session (not haskell-process-load-or-reload-prompt)) - (haskell-process-set-process - process - (progn - (haskell-process-log (propertize (format "%S" log-and-command))) - (apply #'start-process (cdr log-and-command))))) - (progn (set-process-sentinel (haskell-process-process process) 'haskell-process-sentinel) - (set-process-filter (haskell-process-process process) 'haskell-process-filter)) - (haskell-process-send-startup process) - (unless (or (eq 'cabal-repl (haskell-process-type)) - (eq 'cabal-new-repl (haskell-process-type)) - (eq 'stack-ghci (haskell-process-type))) ;; Both "cabal repl" and "stack ghci" set the proper CWD. - (haskell-process-change-dir session - process - (haskell-session-current-dir session))) - (haskell-process-set process 'command-queue - (append (haskell-process-get (haskell-session-process session) - 'command-queue) - old-queue)) - process)) - -(defun haskell-process-send-startup (process) - "Send the necessary start messages to haskell PROCESS." - (haskell-process-queue-command - process - (make-haskell-command - :state process - - :go (lambda (process) - ;; We must set the prompt last, so that this command as a - ;; whole produces only one prompt marker as a response. - (haskell-process-send-string process - (mapconcat #'identity - (append '("Prelude.putStrLn \"\"" - ":set -v1") - (when haskell-interactive-set-+c - '(":set +c"))) ; :type-at in GHC 8+ - "\n")) - (haskell-process-send-string process ":set prompt \"\\4\"") - (haskell-process-send-string process (format ":set prompt2 \"%s\"" - haskell-interactive-prompt2))) - - :live (lambda (process buffer) - (when (haskell-process-consume - process - "^\*\*\* WARNING: \\(.+\\) is writable by someone else, IGNORING!$") - (let ((path (match-string 1 buffer))) - (haskell-session-modify - (haskell-process-session process) - 'ignored-files - (lambda (files) - (cl-remove-duplicates (cons path files) :test 'string=))) - (haskell-interactive-mode-compile-warning - (haskell-process-session process) - (format "GHCi is ignoring: %s (run M-x haskell-process-unignore)" - path))))) - - :complete (lambda (process _) - (haskell-interactive-mode-echo - (haskell-process-session process) - (concat (nth (random (length haskell-process-greetings)) - haskell-process-greetings) - (when haskell-process-show-debug-tips - " -If I break, you can: - 1. Restart: M-x haskell-process-restart - 2. Configure logging: C-h v haskell-process-log (useful for debugging) - 3. General config: M-x customize-mode - 4. Hide these tips: C-h v haskell-process-show-debug-tips"))) - (with-current-buffer (haskell-interactive-buffer) - (goto-char haskell-interactive-mode-prompt-start)))))) - -(defun haskell-commands-process () - "Get the Haskell session, throws an error if not available." - (or (haskell-session-process (haskell-session-maybe)) - (error "No Haskell session/process associated with this - buffer. Maybe run M-x haskell-session-change?"))) - -;;;###autoload -(defun haskell-process-clear () - "Clear the current process." - (interactive) - (haskell-process-reset (haskell-commands-process)) - (haskell-process-set (haskell-commands-process) 'command-queue nil)) - -;;;###autoload -(defun haskell-process-interrupt () - "Interrupt the process (SIGINT)." - (interactive) - (interrupt-process (haskell-process-process (haskell-commands-process)))) - -(defun haskell-process-reload-with-fbytecode (process module-buffer) - "Query a PROCESS to reload MODULE-BUFFER with -fbyte-code set. -Restores -fobject-code after reload finished. -MODULE-BUFFER is the actual Emacs buffer of the module being loaded." - (haskell-process-queue-without-filters process ":set -fbyte-code") - ;; We prefix the module's filename with a "*", which asks ghci to - ;; ignore any existing object file and interpret the module. - ;; Dependencies will still use their object files as usual. - (haskell-process-queue-without-filters - process - (format ":load \"*%s\"" - (replace-regexp-in-string - "\"" - "\\\\\"" - (buffer-file-name module-buffer)))) - (haskell-process-queue-without-filters process ":set -fobject-code")) - (defvar url-http-response-status) (defvar url-http-end-of-headers) (defvar haskell-cabal-targets-history nil "History list for session targets.") (defun haskell-process-hayoo-ident (ident) - "Hayoo for IDENT, return a list of modules" + "Hayoo for IDENT, return a list of modules." ;; We need a real/simulated closure, because otherwise these ;; variables will be unbound when the url-retrieve callback is ;; called. @@ -240,18 +98,6 @@ MODULE-BUFFER is the actual Emacs buffer of the module being loaded." "--modules" ident))) "\n"))) -(defun haskell-process-import-modules (process modules) - "Query PROCESS `:m +' command to import MODULES." - (when haskell-process-auto-import-loaded-modules - (haskell-process-queue-command - process - (make-haskell-command - :state (cons process modules) - :go (lambda (state) - (haskell-process-send-string - (car state) - (format ":m + %s" (mapconcat 'identity (cdr state) " ")))))))) - ;;;###autoload (defun haskell-describe (ident) "Describe the given identifier IDENT." @@ -301,7 +147,7 @@ Prompts for an arbitrary regexp given a prefix arg PROMPT." (haskell-ident-at-point)))) (rgrep sym "*.hs *.lhs *.hsc *.chs *.hs-boot *.lhs-boot" - (haskell-session-current-dir (haskell-interactive-session))))) + inferior-haskell-root-dir))) ;;;###autoload (defun haskell-process-do-info (&optional prompt-value) @@ -318,45 +164,19 @@ If PROMPT-VALUE is non-nil, request identifier via mini-buffer." at-point))) (modname (unless prompt-value (haskell-utils-parse-import-statement-at-point))) - (command (cond - (modname - (format ":browse! %s" modname)) - ((string= ident "") ; For the minibuffer input case - nil) - (t (format (if (string-match "^[a-zA-Z_]" ident) - ":info %s" - ":info (%s)") - (or ident - at-point)))))) - (when command - (haskell-process-show-repl-response command)))))) - -;;;###autoload -(defun haskell-process-do-type (&optional insert-value) - "Print the type of the given expression. - -Given INSERT-VALUE prefix indicates that result type signature -should be inserted." - (interactive "P") - (if insert-value - (haskell-process-insert-type) - (let* ((expr - (if (use-region-p) - (buffer-substring-no-properties (region-beginning) (region-end)) - (haskell-ident-at-point))) - (expr-okay (and expr - (not (string-match-p "\\`[[:space:]]*\\'" expr)) - (not (string-match-p "\n" expr))))) - ;; No newlines in expressions, and surround with parens if it - ;; might be a slice expression - (when expr-okay - (haskell-process-show-repl-response - (format - (if (or (string-match-p "\\`(" expr) - (string-match-p "\\`[_[:alpha:]]" expr)) - ":type %s" - ":type (%s)") - expr)))))) + (ghci-response + (cond + (modname (inferior-haskell-get-result + (format ":browse! %s" modname))) + ((string= ident "") nil) + (t (inferior-haskell-get-result + (format (if (string-match "^[a-zA-Z_]" ident) + ":info %s" + ":info (%s)") + (or ident + at-point))))))) + (when ghci-response + (haskell-mode-message-line ghci-response)))))) ;;;###autoload (defun haskell-mode-jump-to-def-or-tag (&optional _next-p) @@ -372,7 +192,7 @@ If the definition or tag is found, the location from which you jumped will be pushed onto `xref--marker-ring', so you can return to that position with `xref-pop-marker-stack'." (interactive "P") - (if (haskell-session-maybe) + (if inferior-haskell-buffer (let ((initial-loc (point-marker)) (loc (haskell-mode-find-def (haskell-ident-at-point)))) (haskell-mode-handle-generic-loc loc) @@ -393,39 +213,11 @@ Requires the :loc-at command from GHCi." "Jump to the SPAN, whatever file and line and column it needs to get there." (xref-push-marker-stack) (find-file (expand-file-name (plist-get span :path) - (haskell-session-cabal-dir (haskell-interactive-session)))) + inferior-haskell-root-dir)) (goto-char (point-min)) (forward-line (1- (plist-get span :start-line))) (forward-char (plist-get span :start-col))) -(defun haskell-process-insert-type () - "Get the identifier at the point and insert its type. -Use GHCi's :type if it's possible." - (let ((ident (haskell-ident-at-point))) - (when ident - (let ((process (haskell-interactive-process)) - (query (format (if (string-match "^[_[:lower:][:upper:]]" ident) - ":type %s" - ":type (%s)") - ident))) - (haskell-process-queue-command - process - (make-haskell-command - :state (list process query (current-buffer)) - :go (lambda (state) - (haskell-process-send-string (nth 0 state) - (nth 1 state))) - :complete (lambda (state response) - (cond - ;; TODO: Generalize this into a function. - ((or (string-match "^Top level" response) - (string-match "^" response)) - (message "%s" response)) - (t - (with-current-buffer (nth 2 state) - (goto-char (line-beginning-position)) - (insert (format "%s\n" (replace-regexp-in-string "\n$" "" response))))))))))))) - (defun haskell-mode-find-def (ident) ;; TODO Check if it possible to exploit `haskell-process-do-info' "Find definition location of identifier IDENT. @@ -439,8 +231,7 @@ Returns: (module ) nil" (when (stringp ident) - (let ((reply (haskell-process-queue-sync-request - (haskell-interactive-process) + (let ((reply (inferior-haskell-get-result (format (if (string-match "^[a-zA-Z_]" ident) ":info %s" ":info (%s)") @@ -453,7 +244,7 @@ Returns: (match (list 'file (expand-file-name (match-string 1 defined) - (haskell-session-current-dir (haskell-interactive-session))) + inferior-haskell-root-dir) (string-to-number (match-string 2 defined)) (string-to-number (match-string 3 defined)))) (t @@ -504,8 +295,7 @@ Requires the :loc-at command from GHCi." (cons (point) (point))))) (when pos - (let ((reply (haskell-process-queue-sync-request - (haskell-interactive-process) + (let ((reply (inferior-haskell-get-result (save-excursion (format ":loc-at %s %d %d %d %d %s" (buffer-file-name) @@ -531,278 +321,12 @@ Requires the :loc-at command from GHCi." (error (propertize "No reply. Is :loc-at supported?" 'face 'compilation-error))))))) -;;;###autoload -(defun haskell-process-cd (&optional _not-interactive) - ;; FIXME optional arg is not used - "Change directory." - (interactive) - (let* ((session (haskell-interactive-session)) - (dir (haskell-session-prompt-set-current-dir session))) - (haskell-process-log - (propertize (format "Changing directory to %s ...\n" dir) - 'face font-lock-comment-face)) - (haskell-process-change-dir session - (haskell-interactive-process) - dir))) - -(defun haskell-session-buffer-default-dir (session &optional buffer) - "Try to deduce a sensible default directory for SESSION and BUFFER, -of which the latter defaults to the current buffer." - (or (haskell-session-get session 'current-dir) - (haskell-session-get session 'cabal-dir) - (if (buffer-file-name buffer) - (file-name-directory (buffer-file-name buffer)) - "~/"))) - -(defun haskell-session-prompt-set-current-dir (session &optional use-default) - "Prompt for the current directory. -Return current working directory for SESSION." - (let ((default (haskell-session-buffer-default-dir session))) - (haskell-session-set-current-dir - session - (if use-default - default - (haskell-utils-read-directory-name "Set current directory: " default)))) - (haskell-session-get session 'current-dir)) - -(defun haskell-process-change-dir (session process dir) - "Change SESSION's current directory. -Query PROCESS to `:cd` to directory DIR." - (haskell-process-queue-command - process - (make-haskell-command - :state (list session process dir) - :go - (lambda (state) - (haskell-process-send-string - (cadr state) (format ":cd %s" (cl-caddr state)))) - - :complete - (lambda (state _) - (haskell-session-set-current-dir (car state) (cl-caddr state)) - (haskell-interactive-mode-echo (car state) - (format "Changed directory: %s" - (cl-caddr state))))))) - -;;;###autoload -(defun haskell-process-cabal-macros () - "Send the cabal macros string." - (interactive) - (haskell-process-queue-without-filters (haskell-interactive-process) - ":set -optP-include -optPdist/build/autogen/cabal_macros.h")) - -(defun haskell-process-do-try-info (sym) - "Get info of SYM and echo in the minibuffer." - (let ((process (haskell-interactive-process))) - (haskell-process-queue-command - process - (make-haskell-command - :state (cons process sym) - :go (lambda (state) - (haskell-process-send-string - (car state) - (if (string-match "^[A-Za-z_]" (cdr state)) - (format ":info %s" (cdr state)) - (format ":info (%s)" (cdr state))))) - :complete (lambda (_state response) - (unless (or (string-match "^Top level" response) - (string-match "^" response)) - (haskell-mode-message-line response))))))) - -(defun haskell-process-do-try-type (sym) - "Get type of SYM and echo in the minibuffer." - (let ((process (haskell-interactive-process))) - (haskell-process-queue-command - process - (make-haskell-command - :state (cons process sym) - :go (lambda (state) - (haskell-process-send-string - (car state) - (if (string-match "^[A-Za-z_]" (cdr state)) - (format ":type %s" (cdr state)) - (format ":type (%s)" (cdr state))))) - :complete (lambda (_state response) - (unless (or (string-match "^Top level" response) - (string-match "^" response)) - (haskell-mode-message-line response))))))) - -;;;###autoload -(defun haskell-mode-show-type-at (&optional insert-value) - "Show type of the thing at point or within active region asynchronously. -This function requires GHCi 8+ or GHCi-ng. - -\\ -To make this function works sometimes you need to load the file in REPL -first using command `haskell-process-load-file' bound to -\\[haskell-process-load-file]. - -Optional argument INSERT-VALUE indicates that -recieved type signature should be inserted (but only if nothing -happened since function invocation)." - (interactive "P") - (let* ((pos (haskell-command-capture-expr-bounds)) - (req (haskell-utils-compose-type-at-command pos)) - (process (haskell-interactive-process)) - (buf (current-buffer)) - (pos-reg (cons pos (region-active-p)))) - (haskell-process-queue-command - process - (make-haskell-command - :state (list process req buf insert-value pos-reg) - :go - (lambda (state) - (let* ((prc (car state)) - (req (nth 1 state))) - (haskell-utils-async-watch-changes) - (haskell-process-send-string prc req))) - :complete - (lambda (state response) - (let* ((init-buffer (nth 2 state)) - (insert-value (nth 3 state)) - (pos-reg (nth 4 state)) - (wrap (cdr pos-reg)) - (min-pos (caar pos-reg)) - (max-pos (cdar pos-reg)) - (sig (haskell-utils-reduce-string response)) - (res-type (haskell-utils-repl-response-error-status sig))) - - (cl-case res-type - ;; neither popup presentation buffer - ;; nor insert response in error case - ('unknown-command - (message "This command requires GHCi 8+ or GHCi-ng. Please read command description for details.")) - ('option-missing - (message "Could not infer type signature. You need to load file first. Also :set +c is required, see customization `haskell-interactive-set-+c'. Please read command description for details.")) - ('interactive-error (message "Wrong REPL response: %s" sig)) - (otherwise - (if insert-value - ;; Only insert type signature and do not present it - (if (= (length haskell-utils-async-post-command-flag) 1) - (if wrap - ;; Handle region case - (progn - (deactivate-mark) - (save-excursion - (delete-region min-pos max-pos) - (goto-char min-pos) - (insert (concat "(" sig ")")))) - ;; Non-region cases - (haskell-command-insert-type-signature sig)) - ;; Some commands registered, prevent insertion - (message "Type signature insertion was prevented. These commands were registered: %s" - (cdr (reverse haskell-utils-async-post-command-flag)))) - ;; Present the result only when response is valid and not asked - ;; to insert result - (haskell-command-echo-or-present response))) - - (haskell-utils-async-stop-watching-changes init-buffer)))))))) - -(make-obsolete 'haskell-process-generate-tags - 'haskell-mode-generate-tags - "2016-03-14") -(defun haskell-process-generate-tags (&optional and-then-find-this-tag) - "Regenerate the TAGS table. -If optional AND-THEN-FIND-THIS-TAG argument is present it is used with -function `xref-find-definitions' after new table was generated." - (interactive) - (let ((process (haskell-interactive-process))) - (haskell-process-queue-command - process - (make-haskell-command - :state (cons process and-then-find-this-tag) - :go - (lambda (state) - (let* ((process (car state)) - (cabal-dir (haskell-session-cabal-dir - (haskell-process-session process))) - (command (haskell-cabal--compose-hasktags-command cabal-dir))) - (haskell-process-send-string process command))) - :complete (lambda (state _response) - (when (cdr state) - (let ((tags-file-name - (haskell-session-tags-filename - (haskell-process-session (car state))))) - (xref-find-definitions (cdr state)))) - (haskell-mode-message-line "Tags generated.")))))) - -(defun haskell-process-add-cabal-autogen () - "Add cabal's autogen dir to the GHCi search path. -Add /dist/build/autogen/ to GHCi seatch path. -This allows modules such as 'Path_...', generated by cabal, to be -loaded by GHCi." - (unless (or (eq 'cabal-repl (haskell-process-type)) - (eq 'cabal-new-repl (haskell-process-type))) ;; redundant with "cabal repl" - (let* - ((session (haskell-interactive-session)) - (cabal-dir (haskell-session-cabal-dir session)) - (ghci-gen-dir (format "%sdist/build/autogen/" cabal-dir))) - (haskell-process-queue-without-filters - (haskell-interactive-process) - (format ":set -i%s" ghci-gen-dir))))) - -;;;###autoload -(defun haskell-process-unignore () - "Unignore any ignored files. -Do not ignore files that were specified as being ignored by the -inferior GHCi process." - (interactive) - (let ((session (haskell-interactive-session)) - (changed nil)) - (if (null (haskell-session-get session 'ignored-files)) - (message "Nothing to unignore!") - (cl-loop for file in (haskell-session-get session 'ignored-files) - do - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (progn - (cl-case - (read-event - (propertize - (format "Set permissions? %s (y, n, v: stop and view file)" - file) - 'face - 'minibuffer-prompt)) - (?y - (haskell-process-unignore-file session file) - (setq changed t)) - (?v - (find-file file) - (cl-return))) - (when (and changed - (y-or-n-p "Restart GHCi process now? ")) - (haskell-process-restart))) - ;; unwind - (haskell-mode-toggle-interactive-prompt-state t)))))) - -;;;###autoload -(defun haskell-session-change-target (target) - "Set the build TARGET for cabal REPL." - (interactive - (list - (completing-read "New build target: " - (haskell-cabal-enum-targets (haskell-process-type)) - nil - nil - nil - 'haskell-cabal-targets-history))) - (let* ((session haskell-session) - (old-target (haskell-session-get session 'target))) - (when session - (haskell-session-set-target session target) - (when (not (string= old-target target)) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (when (y-or-n-p "Target changed, restart haskell process?") - (haskell-process-start session))) - (haskell-mode-toggle-interactive-prompt-state t))))) - ;;;###autoload (defun haskell-mode-stylish-buffer () "Apply stylish-haskell to the current buffer. Use `haskell-mode-stylish-haskell-path' to know where to find -stylish-haskell executable. This function tries to preserve +stylish-haskell executable. This function tries to preserve cursor position and markers by using `haskell-mode-buffer-apply-command'." (interactive) @@ -874,16 +398,17 @@ output. If CMD fails the buffer remains unchanged." (defun haskell-mode-uses-at () "Get the locations of use cases for the ident at point. -Requires the :uses command from GHCi." +Requires the :uses command from GHCi. +Requires :set +c to be set" (let ((pos (or (when (region-active-p) (cons (region-beginning) (region-end))) (haskell-ident-pos-at-point) (cons (point) (point))))) + (haskell-set+c) (when pos - (let ((reply (haskell-process-queue-sync-request - (haskell-interactive-process) + (let ((reply (inferior-haskell-get-result (save-excursion (format ":uses %s %d %d %d %d %s" (buffer-file-name) @@ -914,44 +439,5 @@ Requires the :uses command from GHCi." (error (propertize "No reply. Is :uses supported?" 'face 'compilation-error))))))) -(defun haskell-command-echo-or-present (msg) - "Present message in some manner depending on configuration. -If variable `haskell-process-use-presentation-mode' is NIL it will output -modified message MSG to echo area." - (if haskell-process-use-presentation-mode - (let ((session (haskell-process-session (haskell-interactive-process)))) - (haskell-presentation-present session msg)) - (let ((m (haskell-utils-reduce-string msg))) - (message "%s" m)))) - -(defun haskell-command-capture-expr-bounds () - "Capture position bounds of expression at point. -If there is an active region then it returns region -bounds. Otherwise it uses `haskell-spanable-pos-at-point` to -capture identifier bounds. If latter function returns NIL this function -will return cons cell where min and max positions both are equal -to point." - (or (when (region-active-p) - (cons (region-beginning) - (region-end))) - (haskell-spanable-pos-at-point) - (cons (point) (point)))) - -(defun haskell-command-insert-type-signature (signature) - "Insert type signature. -In case of active region is present, wrap it by parentheses and -append SIGNATURE to original expression. Otherwise tries to -carefully insert SIGNATURE above identifier at point. Removes -newlines and extra whitespace in signature before insertion." - (let* ((ident-pos (or (haskell-ident-pos-at-point) - (cons (point) (point)))) - (min-pos (car ident-pos)) - (sig (haskell-utils-reduce-string signature))) - (save-excursion - (goto-char min-pos) - (let ((col (current-column))) - (insert sig "\n") - (indent-to col))))) - (provide 'haskell-commands) ;;; haskell-commands.el ends here diff --git a/haskell-completions.el b/haskell-completions.el index c7bf914f3..ca43e6b8c 100644 --- a/haskell-completions.el +++ b/haskell-completions.el @@ -37,8 +37,7 @@ ;;; Code: (require 'haskell-mode) -(require 'haskell-process) -(require 'haskell-interactive-mode) +(require 'inf-haskell) ;;;###autoload (defgroup haskell-completions nil @@ -361,16 +360,9 @@ Returns nil if no completions available." ;; and haskell-completions-identifier-prefix (let* ((is-import (eql typ 'haskell-completions-module-name-prefix)) (candidates - (when (and (haskell-session-maybe) - (not (haskell-process-cmd - (haskell-interactive-process))) - ;; few possible extra checks would be: - ;; (haskell-process-get 'is-restarting) - ;; (haskell-process-get 'evaluating) - ) - ;; if REPL is available and not busy try to query it for - ;; completions list in case of module name or identifier - ;; prefixes + (progn + (if (not inferior-haskell-buffer) + (switch-to-haskell)) (haskell-completions-sync-complete-repl pfx is-import)))) ;; append candidates with keywords (list beg end (append @@ -382,11 +374,33 @@ Returns nil if no completions available." When optional IMPORT argument is non-nil complete PREFIX prepending \"import \" keyword (useful for module names). This function is supposed for internal use." - (haskell-process-get-repl-completions - (haskell-interactive-process) - (if import - (concat "import " prefix) - prefix))) + (inferior-haskell-get-completions + (if import + (concat "import " prefix) + prefix))) + +(defun inferior-haskell-get-result-list (prefix) + "Get the completions from ghci using `:complete' and split by \n (and trim white spaces)" + (haskell-string-split-to-lines + (inferior-haskell-get-result + (concat + (format ":complete repl \"%s\"" + prefix))))) + +(defun inferior-haskell-get-completions (unsanitized-completions) + "gets the completions result list sanitizes and returns it, the first result +is meta data so we remove it" + (when (stringp unsanitized-completions) + (cdr (cl-mapcar #'inferior-haskell-sanitize + (inferior-haskell-get-result-list unsanitized-completions))))) + +(defun inferior-haskell-sanitize (txt) + "the completions from ghci (using `:complete') are of the form +\"SomeCompletion1\" +\"SomeCompletion2\" +etc. So we trim the double quotes from the completion to get the string" + (when (stringp txt) + (haskell-string-trim-prefix "\"" (haskell-string-trim-suffix "\"" txt)))) (provide 'haskell-completions) ;;; haskell-completions.el ends here diff --git a/haskell-debug.el b/haskell-debug.el deleted file mode 100644 index 38a6859bb..000000000 --- a/haskell-debug.el +++ /dev/null @@ -1,757 +0,0 @@ -;;; haskell-debug.el --- Debugging mode via GHCi -*- lexical-binding: t -*- - -;; Copyright © 2014 Chris Done. All rights reserved. -;; 2016 Arthur Fayzrakhmanov - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'haskell-session) -(require 'haskell-process) -(require 'haskell-interactive-mode) -(require 'haskell-font-lock) -(require 'haskell-utils) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration - -;;;###autoload -(defgroup haskell-debug nil - "Settings for debugging support." - :link '(custom-manual "(haskell-mode)haskell-debug") - :group 'haskell) - -;;;###autoload -(defface haskell-debug-warning-face - '((t :inherit 'compilation-warning)) - "Face for warnings." - :group 'haskell-debug) - -;;;###autoload -(defface haskell-debug-trace-number-face - '((t :weight bold :background "#f5f5f5")) - "Face for numbers in backtrace." - :group 'haskell-debug) - -;;;###autoload -(defface haskell-debug-newline-face - '((t :weight bold :background "#f0f0f0")) - "Face for newlines in trace steps." - :group 'haskell-debug) - -;;;###autoload -(defface haskell-debug-keybinding-face - '((t :inherit 'font-lock-type-face :weight bold)) - "Face for keybindings." - :group 'haskell-debug) - -;;;###autoload -(defface haskell-debug-heading-face - '((t :inherit 'font-lock-keyword-face)) - "Face for headings." - :group 'haskell-debug) - -;;;###autoload -(defface haskell-debug-muted-face - '((t :foreground "#999")) - "Face for muteds." - :group 'haskell-debug) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Mode - -(defvar haskell-debug-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "g") 'haskell-debug/refresh) - (define-key map (kbd "s") 'haskell-debug/step) - (define-key map (kbd "t") 'haskell-debug/trace) - (define-key map (kbd "d") 'haskell-debug/delete) - (define-key map (kbd "b") 'haskell-debug/break-on-function) - (define-key map (kbd "a") 'haskell-debug/abandon) - (define-key map (kbd "c") 'haskell-debug/continue) - (define-key map (kbd "p") 'haskell-debug/previous) - (define-key map (kbd "n") 'haskell-debug/next) - (define-key map (kbd "RET") 'haskell-debug/select) - map) - "Keymap for `haskell-debug-mode'.") - -(define-derived-mode haskell-debug-mode - text-mode "Debug" - "Major mode for debugging Haskell via GHCi.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Globals - -(defvar haskell-debug-history-cache nil - "Cache of the tracing history.") - -(defvar haskell-debug-bindings-cache nil - "Cache of the current step's bindings.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Macros - -(defmacro haskell-debug-with-breakpoints (&rest body) - "Breakpoints need to exist to start stepping." - `(if (haskell-debug-get-breakpoints) - ,@body - (error "No breakpoints to step into!"))) - -(defmacro haskell-debug-with-modules (&rest body) - "Modules need to exist to do debugging stuff." - `(if (haskell-debug-get-modules) - ,@body - (error "No modules loaded!"))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Interactive functions - -(defun haskell-debug/select () - "Select whatever is at point." - (interactive) - (cond - ((get-text-property (point) 'break) - (let ((break (get-text-property (point) 'break))) - (haskell-debug-highlight (plist-get break :path) - (plist-get break :span)))) - ((get-text-property (point) 'module) - (let ((break (get-text-property (point) 'module))) - (haskell-debug-highlight (plist-get break :path)))))) - -(defun haskell-debug/abandon () - "Abandon the current computation." - (interactive) - (haskell-debug-with-breakpoints - (haskell-process-queue-sync-request (haskell-debug-process) ":abandon") - (message "Computation abandoned.") - (setq haskell-debug-history-cache nil) - (setq haskell-debug-bindings-cache nil) - (haskell-debug/refresh))) - -(defun haskell-debug/continue () - "Continue the current computation." - (interactive) - (haskell-debug-with-breakpoints - (haskell-process-queue-sync-request (haskell-debug-process) ":continue") - (message "Computation continued.") - (setq haskell-debug-history-cache nil) - (setq haskell-debug-bindings-cache nil) - (haskell-debug/refresh))) - -(defun haskell-debug/break-on-function () - "Break on function IDENT." - (interactive) - (haskell-debug-with-modules - (let ((ident (read-from-minibuffer "Function: " - (haskell-ident-at-point)))) - (haskell-process-queue-sync-request - (haskell-debug-process) - (concat ":break " - ident)) - (message "Breaking on function: %s" ident) - (haskell-debug/refresh)))) - -(defun haskell-debug/start-step (expr) - "Start stepping EXPR." - (interactive (list (read-from-minibuffer "Expression to step through: "))) - (haskell-debug/step expr)) - -(defun haskell-debug/breakpoint-numbers () - "List breakpoint numbers." - (interactive) - (let ((breakpoints (mapcar (lambda (breakpoint) - (number-to-string (plist-get breakpoint :number))) - (haskell-debug-get-breakpoints)))) - (if (null breakpoints) - (message "No breakpoints.") - (message "Breakpoint(s): %s" - (mapconcat #'identity - breakpoints - ", "))))) - -(defun haskell-debug/next () - "Go to next step to inspect bindings." - (interactive) - (haskell-debug-with-breakpoints - (haskell-debug-navigate "forward"))) - -(defun haskell-debug/previous () - "Go to previous step to inspect the bindings." - (interactive) - (haskell-debug-with-breakpoints - (haskell-debug-navigate "back"))) - -(defun haskell-debug/refresh () - "Refresh the debugger buffer." - (interactive) - (with-current-buffer (haskell-debug-buffer-name (haskell-debug-session)) - (cd (haskell-session-current-dir (haskell-debug-session))) - (let ((inhibit-read-only t) - (p (point))) - (erase-buffer) - (insert (propertize (concat "Debugging " - (haskell-session-name (haskell-debug-session)) - "\n\n") - 'face `((:weight bold)))) - (let ((modules (haskell-debug-get-modules)) - (breakpoints (haskell-debug-get-breakpoints)) - (context (haskell-debug-get-context)) - (history (haskell-debug-get-history))) - (unless modules - (insert (propertize "You have to load a module to start debugging." - 'face - 'haskell-debug-warning-face) - "\n\n")) - (haskell-debug-insert-bindings modules breakpoints context) - (when modules - (haskell-debug-insert-current-context context history) - (haskell-debug-insert-breakpoints breakpoints)) - (haskell-debug-insert-modules modules)) - (insert "\n") - (goto-char (min (point-max) p))))) - -(defun haskell-debug/delete () - "Delete whatever's at the point." - (interactive) - (cond - ((get-text-property (point) 'break) - (let ((break (get-text-property (point) 'break))) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (when (y-or-n-p (format "Delete breakpoint #%d?" - (plist-get break :number))) - (haskell-process-queue-sync-request - (haskell-debug-process) - (format ":delete %d" - (plist-get break :number))) - (haskell-debug/refresh)) - (haskell-mode-toggle-interactive-prompt-state t)))))) - -(defun haskell-debug/trace () - "Trace the expression." - (interactive) - (haskell-debug-with-modules - (haskell-debug-with-breakpoints - (let ((expr (read-from-minibuffer "Expression to trace: " - (haskell-ident-at-point)))) - (haskell-process-queue-sync-request - (haskell-debug-process) - (concat ":trace " expr)) - (message "Tracing expression: %s" expr) - (haskell-debug/refresh))))) - -(defun haskell-debug/step (&optional expr) - "Step into the next function." - (interactive) - (haskell-debug-with-breakpoints - (let* ((breakpoints (haskell-debug-get-breakpoints)) - (context (haskell-debug-get-context)) - (string - (haskell-process-queue-sync-request - (haskell-debug-process) - (if expr - (concat ":step " expr) - ":step")))) - (cond - ((string= string "not stopped at a breakpoint\n") - (if haskell-debug-bindings-cache - (progn (setq haskell-debug-bindings-cache nil) - (haskell-debug/refresh)) - (call-interactively 'haskell-debug/start-step))) - (t (let ((maybe-stopped-at (haskell-debug-parse-stopped-at string))) - (cond - (maybe-stopped-at - (setq haskell-debug-bindings-cache - maybe-stopped-at) - (message "Computation paused.") - (haskell-debug/refresh)) - (t - (if context - (message "Computation finished.") - (progn - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (when (y-or-n-p "Computation completed without breaking. Reload the module and retry?") - (message "Reloading and resetting breakpoints...") - (haskell-interactive-mode-reset-error (haskell-debug-session)) - (cl-loop for break in breakpoints - do (haskell-process-queue-sync-request - (haskell-debug-process) - (concat ":load " (plist-get break :path)))) - (cl-loop for break in breakpoints - do (haskell-debug-break break)) - (haskell-debug/step expr)) - (haskell-mode-toggle-interactive-prompt-state t)))))))))) - (haskell-debug/refresh))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Internal functions - -(defun haskell-debug-session () - "Get the Haskell session." - (or (haskell-session-maybe) - (error "No Haskell session associated with this debug - buffer. Please just close the buffer and start again."))) - -(defun haskell-debug-process () - "Get the Haskell session." - (or (haskell-session-process (haskell-session-maybe)) - (error "No Haskell session associated with this debug - buffer. Please just close the buffer and start again."))) - -(defun haskell-debug-buffer-name (session) - "The debug buffer name for the current session." - (format "*debug:%s*" - (haskell-session-name session))) - -(defun haskell-debug-get-breakpoints () - "Get the list of breakpoints currently set." - (let ((string (haskell-process-queue-sync-request - (haskell-debug-process) - ":show breaks"))) - (if (string= string "No active breakpoints.\n") - (list) - (mapcar #'haskell-debug-parse-break-point - (haskell-debug-split-string string))))) - -(defun haskell-debug-get-modules () - "Get the list of modules currently set." - (let ((string (haskell-process-queue-sync-request - (haskell-debug-process) - ":show modules"))) - (if (string= string "") - (list) - (mapcar #'haskell-debug-parse-module - (haskell-debug-split-string string))))) - -(defun haskell-debug-get-context () - "Get the current context." - (let ((string (haskell-process-queue-sync-request - (haskell-debug-process) - ":show context"))) - (if (string= string "") - nil - (haskell-debug-parse-context string)))) - -(defun haskell-debug-get-history () - "Get the step history." - (let ((string (haskell-process-queue-sync-request - (haskell-debug-process) - ":history"))) - (if (or (string= string "") - (string= string "Not stopped at a breakpoint\n")) - nil - (if (string= string "Empty history. Perhaps you forgot to use :trace?\n") - nil - (let ((entries (mapcar #'haskell-debug-parse-history-entry - (cl-remove-if (lambda (line) (or (string= "" line) - (string= "..." line))) - (haskell-debug-split-string string))))) - (setq haskell-debug-history-cache - entries) - entries))))) - -(defun haskell-debug-insert-bindings (modules breakpoints context) - "Insert a list of bindings." - (if breakpoints - (progn (haskell-debug-insert-binding "t" "trace an expression") - (haskell-debug-insert-binding "s" "step into an expression") - (haskell-debug-insert-binding "b" "breakpoint" t)) - (progn - (when modules - (haskell-debug-insert-binding "b" "breakpoint")) - (when breakpoints - (haskell-debug-insert-binding "s" "step into an expression" t)))) - (when breakpoints - (haskell-debug-insert-binding "d" "delete breakpoint")) - (when context - (haskell-debug-insert-binding "a" "abandon context") - (haskell-debug-insert-binding "c" "continue" t)) - (when context - (haskell-debug-insert-binding "p" "previous step") - (haskell-debug-insert-binding "n" "next step" t)) - (haskell-debug-insert-binding "g" "refresh" t) - (insert "\n")) - -(defun haskell-debug-insert-current-context (context history) - "Insert the current context." - (haskell-debug-insert-header "Context") - (if context - (haskell-debug-insert-context context history) - (haskell-debug-insert-debug-finished)) - (insert "\n")) - -(defun haskell-debug-insert-breakpoints (breakpoints) - "insert the list of breakpoints." - (haskell-debug-insert-header "Breakpoints") - (if (null breakpoints) - (haskell-debug-insert-muted "No active breakpoints.") - (cl-loop for break in breakpoints - do (insert (propertize (format "%d" - (plist-get break :number)) - 'face `((:weight bold)) - 'break break) - (haskell-debug-muted " - ") - (propertize (plist-get break :module) - 'break break - 'break break) - (haskell-debug-muted - (format " (%d:%d)" - (plist-get (plist-get break :span) :start-line) - (plist-get (plist-get break :span) :start-col))) - "\n"))) - (insert "\n")) - -(defun haskell-debug-insert-modules (modules) - "Insert the list of modules." - (haskell-debug-insert-header "Modules") - (if (null modules) - (haskell-debug-insert-muted "No loaded modules.") - (progn (cl-loop for module in modules - do (insert (propertize (plist-get module :module) - 'module module - 'face `((:weight bold))) - (haskell-debug-muted " - ") - (propertize (file-name-nondirectory (plist-get module :path)) - 'module module)) - do (insert "\n"))))) - -(defun haskell-debug-split-string (string) - "Split GHCi's line-based output, stripping the trailing newline." - (split-string string "\n" t)) - -(defun haskell-debug-parse-context (string) - "Parse the context." - (cond - ((string-match "^--> \\(.+\\)\n \\(.+\\)" string) - (let ((name (match-string 1 string)) - (stopped (haskell-debug-parse-stopped-at (match-string 2 string)))) - (list :name name - :path (plist-get stopped :path) - :span (plist-get stopped :span)))))) - -(defun haskell-debug-insert-binding (binding desc &optional end) - "Insert a helpful keybinding." - (insert (propertize binding 'face 'haskell-debug-keybinding-face) - (haskell-debug-muted " - ") - desc - (if end - "\n" - (haskell-debug-muted ", ")))) - -(defun haskell-debug-insert-header (title) - "Insert a header title." - (insert (propertize title - 'face 'haskell-debug-heading-face) - "\n\n")) - -(defun haskell-debug-insert-context (context history) - "Insert the context and history." - (when context - (insert (propertize (plist-get context :name) 'face `((:weight bold))) - (haskell-debug-muted " - ") - (file-name-nondirectory (plist-get context :path)) - (haskell-debug-muted " (stopped)") - "\n")) - (when haskell-debug-bindings-cache - (insert "\n") - (let ((bindings haskell-debug-bindings-cache)) - (insert - (haskell-debug-get-span-string - (plist-get bindings :path) - (plist-get bindings :span))) - (insert "\n\n") - (cl-loop for binding in (plist-get bindings :types) - do (insert (haskell-fontify-as-mode binding 'haskell-mode) - "\n")))) - (let ((history (or history - (list (haskell-debug-make-fake-history context))))) - (when history - (insert "\n") - (haskell-debug-insert-history history)))) - -(defun haskell-debug-insert-debug-finished () - "Insert message that no debugging is happening, but if there is -some old history, then display that." - (if haskell-debug-history-cache - (progn (haskell-debug-insert-muted "Finished debugging.") - (insert "\n") - (haskell-debug-insert-history haskell-debug-history-cache)) - (haskell-debug-insert-muted "Not debugging right now."))) - -(defun haskell-debug-insert-muted (text) - "Insert some muted text." - (insert (haskell-debug-muted text) - "\n")) - -(defun haskell-debug-muted (text) - "Make some muted text." - (propertize text 'face 'haskell-debug-muted-face)) - -(defun haskell-debug-parse-logged (string) - "Parse the logged breakpoint." - (cond - ((string= "no more logged breakpoints\n" string) - nil) - ((string= "already at the beginning of the history\n" string) - nil) - (t - (with-temp-buffer - (insert string) - (goto-char (point-min)) - (list :path (progn (search-forward " at ") - (buffer-substring-no-properties - (point) - (1- (search-forward ":")))) - :span (haskell-debug-parse-span - (buffer-substring-no-properties - (point) - (line-end-position))) - :types (progn (forward-line) - (haskell-debug-split-string - (buffer-substring-no-properties - (point) - (point-max))))))))) - -(defun haskell-debug-parse-stopped-at (string) - "Parse the location stopped at from the given string. - -For example: - -Stopped at /home/foo/project/src/x.hs:6:25-36 - -" - (let ((index (string-match "Stopped at \\([^:]+\\):\\(.+\\)\n?" - string))) - (when index - (list :path (match-string 1 string) - :span (haskell-debug-parse-span (match-string 2 string)) - :types (cdr (haskell-debug-split-string (substring string index))))))) - -(defun haskell-debug-get-span-string (path span) - "Get the string from the PATH and the SPAN." - (save-window-excursion - (find-file path) - (buffer-substring - (save-excursion - (goto-char (point-min)) - (forward-line (1- (plist-get span :start-line))) - (forward-char (1- (plist-get span :start-col))) - (point)) - (save-excursion - (goto-char (point-min)) - (forward-line (1- (plist-get span :end-line))) - (forward-char (plist-get span :end-col)) - (point))))) - -(defun haskell-debug-make-fake-history (context) - "Make a fake history item." - (list :index -1 - :path (plist-get context :path) - :span (plist-get context :span))) - -(defun haskell-debug-insert-history (history) - "Insert tracing HISTORY." - (let ((i (length history))) - (cl-loop for span in history - do (let ((string (haskell-debug-get-span-string - (plist-get span :path) - (plist-get span :span)))) - (insert (propertize (format "%4d" i) - 'face 'haskell-debug-trace-number-face) - " " - (haskell-debug-preview-span - (plist-get span :span) - string - t) - "\n") - (setq i (1- i)))))) - -(defun haskell-debug-parse-span (string) - "Parse a source span from a string. - -Examples: - - (5,1)-(6,37) - 6:25-36 - 5:20 - -People like to make other people's lives interesting by making -variances in source span notation." - (cond - ((string-match "\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)" - string) - (list :start-line (string-to-number (match-string 1 string)) - :start-col (string-to-number (match-string 2 string)) - :end-line (string-to-number (match-string 1 string)) - :end-col (string-to-number (match-string 3 string)))) - ((string-match "\\([0-9]+\\):\\([0-9]+\\)" - string) - (list :start-line (string-to-number (match-string 1 string)) - :start-col (string-to-number (match-string 2 string)) - :end-line (string-to-number (match-string 1 string)) - :end-col (string-to-number (match-string 2 string)))) - ((string-match "(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))" - string) - (list :start-line (string-to-number (match-string 1 string)) - :start-col (string-to-number (match-string 2 string)) - :end-line (string-to-number (match-string 3 string)) - :end-col (string-to-number (match-string 4 string)))) - (t (error "Unable to parse source span from string: %s" - string)))) - -(defun haskell-debug-preview-span (span string &optional collapsed) - "Make a one-line preview of the given expression." - (with-temp-buffer - (haskell-mode) - (insert string) - (when (/= 0 (plist-get span :start-col)) - (indent-rigidly (point-min) - (point-max) - 1)) - (if (fboundp 'font-lock-ensure) - (font-lock-ensure) - (with-no-warnings (font-lock-fontify-buffer))) - (when (/= 0 (plist-get span :start-col)) - (indent-rigidly (point-min) - (point-max) - -1)) - (goto-char (point-min)) - (if collapsed - (replace-regexp-in-string - "\n[ ]*" - (propertize " " 'face 'haskell-debug-newline-face) - (buffer-substring (point-min) - (point-max))) - (buffer-string)))) - -(defun haskell-debug-start (session) - "Start the debug mode." - (setq buffer-read-only t) - (haskell-session-assign session) - (haskell-debug/refresh)) - -(defun haskell-debug () - "Start the debugger for the current Haskell (GHCi) session." - (interactive) - (let ((session (haskell-debug-session))) - (switch-to-buffer-other-window (haskell-debug-buffer-name session)) - (unless (eq major-mode 'haskell-debug-mode) - (haskell-debug-mode) - (haskell-debug-start session)))) - -(defun haskell-debug-break (break) - "Set BREAK breakpoint in module at line/col." - (haskell-process-queue-without-filters - (haskell-debug-process) - (format ":break %s %s %d" - (plist-get break :module) - (plist-get (plist-get break :span) :start-line) - (plist-get (plist-get break :span) :start-col)))) - -(defun haskell-debug-navigate (direction) - "Navigate in DIRECTION \"back\" or \"forward\"." - (let ((string (haskell-process-queue-sync-request - (haskell-debug-process) - (concat ":" direction)))) - (let ((bindings (haskell-debug-parse-logged string))) - (setq haskell-debug-bindings-cache - bindings) - (when (not bindings) - (message "No more %s results!" direction))) - (haskell-debug/refresh))) - -(defun haskell-debug-session-debugging-p (session) - "Does the session have a debugging buffer open?" - (not (not (get-buffer (haskell-debug-buffer-name session))))) - -(defun haskell-debug-highlight (path &optional span) - "Highlight the file at span." - (let ((p (make-overlay - (line-beginning-position) - (line-end-position)))) - (overlay-put p 'face `((:background "#eee"))) - (with-current-buffer - (if span - (save-window-excursion - (find-file path) - (current-buffer)) - (find-file path) - (current-buffer)) - (let ((o (when span - (make-overlay - (save-excursion - (goto-char (point-min)) - (forward-line (1- (plist-get span :start-line))) - (forward-char (1- (plist-get span :start-col))) - (point)) - (save-excursion - (goto-char (point-min)) - (forward-line (1- (plist-get span :end-line))) - (forward-char (plist-get span :end-col)) - (point)))))) - (when o - (overlay-put o 'face `((:background "#eee")))) - (sit-for 0.5) - (when o - (delete-overlay o)) - (delete-overlay p))))) - -(defun haskell-debug-parse-history-entry (string) - "Parse a history entry." - (if (string-match "^\\([-0-9]+\\)[ ]+:[ ]+\\([A-Za-z0-9_':]+\\)[ ]+(\\([^:]+\\):\\(.+?\\))$" - string) - (list :index (string-to-number (match-string 1 string)) - :name (match-string 2 string) - :path (match-string 3 string) - :span (haskell-debug-parse-span (match-string 4 string))) - (error "Unable to parse history entry: %s" string))) - -(defun haskell-debug-parse-module (string) - "Parse a module and path. - -For example: - -X ( /home/foo/X.hs, interpreted ) -Main ( /home/foo/X.hs, /home/foo/X.o ) -" - (if (string-match "\\([^ ]+\\)[ ]+( \\([^ ]+?\\), [/a-zA-Z0-9\.]+ )$" - string) - (list :module (match-string 1 string) - :path (match-string 2 string)) - (error "Unable to parse module from string: %s" - string))) - -(defun haskell-debug-parse-break-point (string) - "Parse a breakpoint number, module and location from a string. - -For example: - -[13] Main /home/foo/src/x.hs:(5,1)-(6,37) - -" - (if (string-match "^\\[\\([0-9]+\\)\\] \\([^ ]+\\) \\([^:]+\\):\\(.+\\)$" - string) - (list :number (string-to-number (match-string 1 string)) - :module (match-string 2 string) - :path (match-string 3 string) - :span (haskell-debug-parse-span (match-string 4 string))) - (error "Unable to parse breakpoint from string: %s" - string))) - -(provide 'haskell-debug) - -;;; haskell-debug.el ends here diff --git a/haskell-doc.el b/haskell-doc.el index 5ac49b8f8..04e9367b6 100644 --- a/haskell-doc.el +++ b/haskell-doc.el @@ -3,6 +3,7 @@ ;; Copyright © 2004, 2005, 2006, 2007, 2009, 2016 Free Software Foundation, Inc. ;; Copyright © 1997 Hans-Wolfgang Loidl ;; 2016 Arthur Fayzrakhmanov +;; Copyright © 2017 Vasantha Ganesh Kanniappan ;; Author: Hans-Wolfgang Loidl ;; Temporary Maintainer and Hacker: Graeme E Moss @@ -301,10 +302,10 @@ ;;; Code: (require 'haskell-mode) -(require 'haskell-process) -(require 'haskell) (require 'haskell-utils) (require 'inf-haskell) +(require 'haskell-collapse) +(require 'haskell) (require 'imenu) (require 'eldoc) @@ -314,7 +315,6 @@ :group 'haskell :prefix "haskell-doc-") - (defvar-local haskell-doc-mode nil "*If non-nil, show the type of the function near point or a related comment. @@ -398,11 +398,6 @@ This variable is buffer-local." :group 'haskell-doc :type 'boolean) -(defcustom haskell-doc-use-inf-haskell nil - "If non-nil use inf-haskell.el to get type and kind information." - :group 'haskell-doc - :type 'boolean) - (defvar haskell-doc-search-distance 40 ; distance in characters "*How far to search when looking for the type declaration of fct under cursor.") @@ -414,12 +409,6 @@ last input, no documentation will be printed. If this variable is set to 0, no idle time is required.") -(defvar haskell-doc-argument-case 'identity ; 'upcase - "Case in which to display argument names of functions, as a symbol. -This has two preferred values: `upcase' or `downcase'. -Actually, any name of a function which takes a string as an argument and -returns another string is acceptable.") - (defvar haskell-doc-mode-message-commands nil "*Obarray of command names where it is appropriate to print in the echo area. @@ -1416,10 +1405,14 @@ Meant for `eldoc-documentation-function'." ;; There are a number of possible documentation functions. ;; Some of them are asynchronous. (when (haskell-doc-in-code-p) - (let ((msg (or - (haskell-doc-current-info--interaction) - (haskell-doc-sym-doc (haskell-ident-at-point))))) - (unless (symbolp msg) msg)))) + (let* ((msg (or (haskell-doc-sym-doc (haskell-ident-at-point)) + (haskell-doc-current-info--interaction))) + (sanitized-msg (if (stringp msg) + (haskell-mode-one-line msg)))) + (unless (symbolp sanitized-msg) + (if haskell-doc-prettify-types + (haskell-doc-prettify-types sanitized-msg) + sanitized-msg))))) (defun haskell-doc-ask-mouse-for-type (event) "Read the identifier under the mouse and echo its type. @@ -1450,123 +1443,92 @@ current buffer." (unless sym (setq sym (haskell-ident-at-point))) ;; if printed before do not print it again (unless (string= sym (car haskell-doc-last-data)) - (let ((doc (or (haskell-doc-current-info--interaction t) - (haskell-doc-sym-doc sym)))) + (let* ((doc (or (haskell-doc-sym-doc sym) + (haskell-doc-current-info--interaction))) + (sanitized-doc (haskell-mode-one-line doc))) (when (and doc (haskell-doc-in-code-p)) ;; In Emacs 19.29 and later, and XEmacs 19.13 and later, all ;; messages are recorded in a log. Do not put haskell-doc messages ;; in that log since they are legion. (let ((message-log-max nil)) - (message "%s" doc)))))) + (message + (format "%s" (if haskell-doc-prettify-types + (haskell-doc-prettify-types sanitized-doc) + sanitized-doc)))))))) -(defvar haskell-doc-current-info--interaction-last nil - "Async message stack. -If non-nil, a previous eldoc message from an async call, that -hasn't been displayed yet.") - -(defun haskell-doc-current-info--interaction (&optional sync) - "Asynchronous call to `haskell-process-get-type'. -Suitable for use in the eldoc function `haskell-doc-current-info'. - -If SYNC is non-nil, the call will be synchronous instead, and -instead of calling `eldoc-print-current-symbol-info', the result +(defun haskell-doc-current-info--interaction () + "call will be synchronous, and, the result will be returned directly." - ;; Return nil if nothing is available, or 'async if something might - ;; be available, but asynchronously later. This will call - ;; `eldoc-print-current-symbol-info' later. (when (haskell-doc-in-code-p) ;; do nothing when inside string or comment (let (sym prev-message) (cond - ((setq prev-message haskell-doc-current-info--interaction-last) - (setq haskell-doc-current-info--interaction-last nil) - (cdr prev-message)) + ((cdr prev-message)) ((setq sym (if (use-region-p) (buffer-substring-no-properties (region-beginning) (region-end)) (haskell-ident-at-point))) - (if sync - (haskell-process-get-type sym #'identity t) - (haskell-process-get-type - sym (lambda (response) - (setq haskell-doc-current-info--interaction-last - (cons 'async response)) - (eldoc-print-current-symbol-info))))))))) - -(defun haskell-process-get-type (expr-string &optional callback sync) - "Asynchronously get the type of a given string. - -EXPR-STRING should be an expression passed to :type in ghci. - -CALLBACK will be called with a formatted type string. - -If SYNC is non-nil, make the call synchronously instead." - (unless callback (setq callback (lambda (response) (message "%s" response)))) - (let ((process (and (haskell-session-maybe) - (haskell-session-process (haskell-session-maybe)))) - ;; Avoid passing bad strings to ghci - (expr-okay - (and (not (string-match-p "\\`[[:space:]]*\\'" expr-string)) - (not (string-match-p "\n" expr-string)))) - (ghci-command (concat ":type " expr-string)) - (process-response - (lambda (response) - ;; Responses with empty first line are likely errors - (if (string-match-p (rx string-start line-end) response) - (setq response nil) - ;; Remove a newline at the end - (setq response (replace-regexp-in-string "\n\\'" "" response)) - ;; Propertize for eldoc - (save-match-data - (when (string-match " :: " response) - ;; Highlight type - (let ((name (substring response 0 (match-end 0))) - (type (propertize - (substring response (match-end 0)) - 'face 'eldoc-highlight-function-argument))) - (setq response (concat name type))))) - (when haskell-doc-prettify-types - (dolist (re '(("::" . "∷") ("=>" . "⇒") ("->" . "→"))) - (setq response - (replace-regexp-in-string (car re) (cdr re) response)))) - response)))) - (when (and process expr-okay) - (if sync - (let ((response (haskell-process-queue-sync-request process ghci-command))) - (funcall callback (funcall process-response response))) - (haskell-process-queue-command - process - (make-haskell-command - :go (lambda (_) (haskell-process-send-string process ghci-command)) - :complete - (lambda (_ response) - (funcall callback (funcall process-response response))))) - 'async)))) + (haskell-process-get-type sym)))))) + +(defun haskell-doc-prettify-types (response) + "Prettify the output in the minibuffer while printing the types" + (if (string-match-p (rx string-start line-end) response) + (setq response nil) + ;; Remove a newline at the end + (setq response (replace-regexp-in-string "\n\\'" "" response)) + ;; Propertize for eldoc + (save-match-data + (when (string-match " :: " response) + ;; Highlight type + (let ((name (substring response 0 (match-end 0))) + (type (propertize + (substring response (match-end 0)) + 'face 'eldoc-highlight-function-argument))) + (setq response (concat name type))))) + (dolist (re '(("::" . "∷") ("=>" . "⇒") ("->" . "→"))) + (setq response + (replace-regexp-in-string (car re) (cdr re) response))) + response)) + +(defun haskell-process-do-type (expr) + "return type of the given expression." + (let* ((expr-okay (and expr + (not (string-match-p "\\`[[:space:]]*\\'" expr)) + (not (string-match-p "\n" expr))))) + ;; No newlines in expressions, and surround with parens if it + ;; might be a slice expression + (when (and expr-okay + inferior-haskell-buffer) + (cond ((and (equal (buffer-file-name) + (car haskell-process-loaded-file-status)) + (cdr haskell-process-loaded-file-status)) + (inferior-haskell-get-result + (format (if (or (string-match-p "\\`(" expr) + (string-match-p "\\`[_[:alpha:]]" expr)) + ":type %s" + ":type (%s)") + expr))) + (t (inferior-haskell-get-result + (haskell-utils-compose-type-at-command + (haskell-indented-block)))))))) + +(defun haskell-process-get-type (expr-string) + "synchronously get the type of a given string. +EXPR-STRING should be an expression passed to `:type' in ghci. +prettifies the type output if `haskell-doc-prettify-types' is set" + (if inferior-haskell-buffer + (let ((response (haskell-process-do-type expr-string))) + (unless (haskell-utils-repl-response-error-p response) + response)))) (defun haskell-doc-sym-doc (sym) "Show the type of given symbol SYM. For the function under point, show the type in the echo area. This information is extracted from the `haskell-doc-prelude-types' alist of prelude functions and their types, or from the local functions in the -current buffer. -If `haskell-doc-use-inf-haskell' is non-nil, this function will consult -the inferior Haskell process for type/kind information, rather than using -the haskell-doc database." - (if haskell-doc-use-inf-haskell - (unless (or (null sym) (string= "" sym)) - (let* ((message-log-max nil) - (result (ignore-errors - (unwind-protect - (inferior-haskell-type sym) - (message ""))))) - (if (and result (string-match " :: " result)) - result - (setq result (unwind-protect - (inferior-haskell-kind sym) - (message ""))) - (and result (string-match " :: " result) result)))) - (let ((i-am-prelude nil) +current buffer." + (let ((i-am-prelude nil) (i-am-fct nil) (type nil) (is-reserved (haskell-doc-is-of sym haskell-doc-reserved-ids)) @@ -1616,8 +1578,7 @@ the haskell-doc database." (format "%s" type)))) ) (if i-am-prelude (add-text-properties 0 (length str) '(face bold) str)) - str))))) - + str)))) ;; ToDo: define your own notion of `near' to find surrounding fct ;;(defun haskell-doc-fnsym-in-current-sexp () @@ -1848,14 +1809,6 @@ This function switches to and potentially loads many buffers." ;; return the result doc )))) -(defun inferior-haskell-kind (sym) - "Find the kind of SYM with `:kind' ghci feature." - (inferior-haskell-get-result (format ":kind %s" sym))) - -(defun inferior-haskell-type (sym) - "Find the type of SYM with `:type' ghci feature." - (inferior-haskell-get-result (format ":type (%s)" sym))) - (provide 'haskell-doc) ;;; haskell-doc.el ends here diff --git a/haskell-interactive-mode.el b/haskell-interactive-mode.el deleted file mode 100644 index c218c6c3f..000000000 --- a/haskell-interactive-mode.el +++ /dev/null @@ -1,1129 +0,0 @@ -;;; haskell-interactive-mode.el --- The interactive Haskell mode -*- lexical-binding: t -*- - -;; Copyright © 2011-2012 Chris Done -;; 2016 Arthur Fayzrakhmanov - -;; Author: Chris Done - -;; This file is not part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Todo: - -;;; Code: - -(require 'haskell-mode) -(require 'haskell-compile) -(require 'haskell-process) -(require 'haskell-session) -(require 'haskell-font-lock) -(require 'haskell-presentation-mode) -(require 'haskell-utils) -(require 'haskell-string) -(require 'ansi-color) -(require 'cl-lib) -(require 'etags) - -(defvar-local haskell-interactive-mode-history-index 0) - -(defvar-local haskell-interactive-mode-history (list)) - -(defvar-local haskell-interactive-mode-old-prompt-start nil - "Mark used for the old beginning of the prompt.") - -(defun haskell-interactive-prompt-regex () - "Generate a regex for searching for any occurence of the prompt\ -at the beginning of the line. This should prevent any -interference with prompts that look like haskell expressions." - (concat "^" (regexp-quote haskell-interactive-prompt))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Globals used internally - -(declare-function haskell-interactive-kill "haskell") - -(defvar haskell-interactive-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'haskell-interactive-mode-return) - (define-key map (kbd "SPC") 'haskell-interactive-mode-space) - (define-key map (kbd "C-j") 'haskell-interactive-mode-newline-indent) - (define-key map (kbd "C-a") 'haskell-interactive-mode-beginning) - (define-key map (kbd "") 'haskell-interactive-mode-beginning) - (define-key map (kbd "C-c C-k") 'haskell-interactive-mode-clear) - (define-key map (kbd "C-c C-c") 'haskell-process-interrupt) - (define-key map (kbd "C-c C-f") 'next-error-follow-minor-mode) - (define-key map (kbd "C-c C-z") 'haskell-interactive-switch-back) - (define-key map (kbd "M-p") 'haskell-interactive-mode-history-previous) - (define-key map (kbd "M-n") 'haskell-interactive-mode-history-next) - (define-key map (kbd "C-c C-p") 'haskell-interactive-mode-prompt-previous) - (define-key map (kbd "C-c C-n") 'haskell-interactive-mode-prompt-next) - (define-key map (kbd "C-") 'haskell-interactive-mode-history-previous) - (define-key map (kbd "C-") 'haskell-interactive-mode-history-next) - (define-key map (kbd "TAB") 'haskell-interactive-mode-tab) - (define-key map (kbd "") 'haskell-interactive-mode-kill-whole-line) - map) - "Keymap used in `haskell-interactive-mode'.") - -(define-derived-mode haskell-interactive-mode fundamental-mode "Interactive-Haskell" - "Interactive mode for Haskell. - -Key bindings: -\\{haskell-interactive-mode-map}" - :group 'haskell-interactive - :syntax-table haskell-mode-syntax-table - - (setq haskell-interactive-mode-history (list)) - (setq haskell-interactive-mode-history-index 0) - - (setq next-error-function #'haskell-interactive-next-error-function) - (add-hook 'completion-at-point-functions - #'haskell-interactive-mode-completion-at-point-function nil t) - (add-hook 'kill-buffer-hook #'haskell-interactive-kill nil t) - (haskell-interactive-mode-prompt)) - -(defvar haskell-interactive-mode-prompt-start - nil - "Mark used for the beginning of the prompt.") - -(defvar haskell-interactive-mode-result-end - nil - "Mark used to figure out where the end of the current result output is. -Used to distinguish betwen user input.") - -(defvar-local haskell-interactive-previous-buffer nil - "Records the buffer to which `haskell-interactive-switch-back' should jump. -This is set by `haskell-interactive-switch', and should otherwise -be nil.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Hooks - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Mode - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Faces - -;;;###autoload -(defface haskell-interactive-face-prompt - '((t :inherit font-lock-function-name-face)) - "Face for the prompt." - :group 'haskell-interactive) - -;;;###autoload -(defface haskell-interactive-face-prompt2 - '((t :inherit font-lock-keyword-face)) - "Face for the prompt2 in multi-line mode." - :group 'haskell-interactive) - -;;;###autoload -(defface haskell-interactive-face-compile-error - '((t :inherit compilation-error)) - "Face for compile errors." - :group 'haskell-interactive) - -;;;###autoload -(defface haskell-interactive-face-compile-warning - '((t :inherit compilation-warning)) - "Face for compiler warnings." - :group 'haskell-interactive) - -;;;###autoload -(defface haskell-interactive-face-result - '((t :inherit font-lock-string-face)) - "Face for the result." - :group 'haskell-interactive) - -;;;###autoload -(defface haskell-interactive-face-garbage - '((t :inherit font-lock-string-face)) - "Face for trailing garbage after a command has completed." - :group 'haskell-interactive) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Actions - -(defun haskell-interactive-mode-newline-indent () - "Make newline and indent." - (interactive) - (newline) - (indent-to (length haskell-interactive-prompt)) - (indent-relative)) - -(defun haskell-interactive-mode-kill-whole-line () - "Kill the whole REPL line." - (interactive) - (kill-region haskell-interactive-mode-prompt-start - (line-end-position))) - -(defun haskell-interactive-switch-back () - "Switch back to the buffer from which this interactive buffer was reached." - (interactive) - (if haskell-interactive-previous-buffer - (switch-to-buffer-other-window haskell-interactive-previous-buffer) - (message "No previous buffer."))) - -(defun haskell-interactive-copy-to-prompt () - "Copy the current line to the prompt, overwriting the current prompt." - (interactive) - (let ((l (buffer-substring-no-properties (line-beginning-position) - (line-end-position)))) - ;; If it looks like the prompt is at the start of the line, chop - ;; it off. - (when (and (>= (length l) (length haskell-interactive-prompt)) - (string= (substring l 0 (length haskell-interactive-prompt)) - haskell-interactive-prompt)) - (setq l (substring l (length haskell-interactive-prompt)))) - - (haskell-interactive-mode-set-prompt l))) - -(defun haskell-interactive-mode-space (n) - "Handle the space key." - (interactive "p") - (if (and (bound-and-true-p god-local-mode) - (fboundp 'god-mode-self-insert)) - (call-interactively 'god-mode-self-insert) - (if (haskell-interactive-at-compile-message) - (next-error-no-select 0) - (self-insert-command n)))) - -(defun haskell-interactive-at-prompt (&optional end-line) - "If at prompt, return start position of user-input, otherwise return nil. -If END-LINE is non-nil, then return non-nil when the end of line -is at the prompt." - (if (>= (if end-line (line-end-position) (point)) - haskell-interactive-mode-prompt-start) - haskell-interactive-mode-prompt-start - nil)) - -(define-derived-mode haskell-error-mode - special-mode "Error" - "Major mode for viewing Haskell compile errors.") - -;; (define-key haskell-error-mode-map (kbd "q") 'quit-window) - -(defun haskell-interactive-mode-handle-h () - "Handle ^H in output." - (let ((bound (point-min)) - (inhibit-read-only t)) - (save-excursion - (while (search-backward "\b" bound t 1) - (save-excursion - (forward-char) - (let ((end (point))) - (if (search-backward-regexp "[^\b]" bound t 1) - (forward-char) - (goto-char (point-min))) - (let ((start (point))) - (delete-region (max (- (point) (- end start)) - (point-min)) - end)))))))) - -(defun haskell-interactive-mode-multi-line (expr) - "If a multi-line expression EXPR has been entered, then reformat it to be: - -:{ -do the - multi-liner - expr -:}" - (if (not (string-match-p "\n" expr)) - expr - (let ((pre (format "^%s" (regexp-quote haskell-interactive-prompt))) - (lines (split-string expr "\n"))) - (cl-loop for elt on (cdr lines) do - (setcar elt (replace-regexp-in-string pre "" (car elt)))) - ;; Temporarily set prompt2 to be empty to avoid unwanted output - (concat ":set prompt2 \"\"\n" - ":{\n" - (mapconcat #'identity lines "\n") - "\n:}\n" - (format ":set prompt2 \"%s\"" haskell-interactive-prompt2))))) - -(defun haskell-interactive-mode-line-is-query (line) - "Is LINE actually a :t/:k/:i?" - (and (string-match "^:[itk] " line) - t)) - -(defun haskell-interactive-mode-beginning () - "Go to the start of the line." - (interactive) - (if (haskell-interactive-at-prompt) - (goto-char haskell-interactive-mode-prompt-start) - (move-beginning-of-line nil))) - -(defun haskell-interactive-mode-input-partial () - "Get the interactive mode input up to point." - (let ((input-start (haskell-interactive-at-prompt))) - (unless input-start - (error "not at prompt")) - (buffer-substring-no-properties input-start (point)))) - -(defun haskell-interactive-mode-input () - "Get the interactive mode input." - (buffer-substring-no-properties - haskell-interactive-mode-prompt-start - (point-max))) - -(defun haskell-interactive-mode-prompt (&optional session) - "Show a prompt at the end of the REPL buffer. -If SESSION is non-nil, use the REPL buffer associated with -SESSION, otherwise operate on the current buffer." - (with-current-buffer (if session - (haskell-session-interactive-buffer session) - (current-buffer)) - (save-excursion - (goto-char (point-max)) - (let ((prompt (propertize haskell-interactive-prompt - 'font-lock-face 'haskell-interactive-face-prompt - 'prompt t - 'read-only haskell-interactive-prompt-read-only - 'rear-nonsticky t))) - ;; At the time of writing, front-stickying the first char gives an error - ;; Has unfortunate side-effect of being able to insert before the prompt - (insert (substring prompt 0 1) - (propertize (substring prompt 1) - 'front-sticky t))) - (let ((marker (setq-local haskell-interactive-mode-prompt-start (make-marker)))) - (set-marker marker (point)))) - (when (haskell-interactive-at-prompt t) - (haskell-interactive-mode-scroll-to-bottom)))) - -(defun haskell-interactive-mode-eval-result (session text) - "Insert the result of an eval as plain text." - (with-current-buffer (haskell-session-interactive-buffer session) - (let ((at-end (eobp)) - (prop-text (propertize text - 'font-lock-face 'haskell-interactive-face-result - 'front-sticky t - 'prompt t - 'read-only haskell-interactive-mode-read-only - 'rear-nonsticky t - 'result t))) - (save-excursion - (goto-char (point-max)) - (when (string= text haskell-interactive-prompt2) - (setq prop-text - (propertize prop-text - 'font-lock-face 'haskell-interactive-face-prompt2 - 'read-only haskell-interactive-prompt-read-only))) - (insert (ansi-color-apply prop-text)) - (haskell-interactive-mode-handle-h) - (let ((marker (setq-local haskell-interactive-mode-result-end (make-marker)))) - (set-marker marker (point)))) - (when at-end - (haskell-interactive-mode-scroll-to-bottom))))) - -(defun haskell-interactive-mode-scroll-to-bottom () - "Scroll to bottom." - (let ((w (get-buffer-window (current-buffer)))) - (when w - (goto-char (point-max)) - (set-window-point w (point))))) - -(defun haskell-interactive-mode-compile-error (session message) - "Echo an error." - (haskell-interactive-mode-compile-message - session message 'haskell-interactive-face-compile-error)) - -(defun haskell-interactive-mode-compile-warning (session message) - "Warning message." - (haskell-interactive-mode-compile-message - session message 'haskell-interactive-face-compile-warning)) - -(defun haskell-interactive-mode-compile-message (session message type) - "Echo a compiler warning." - (with-current-buffer (haskell-session-interactive-buffer session) - (setq next-error-last-buffer (current-buffer)) - (save-excursion - (haskell-interactive-mode-goto-end-point) - (let ((lines (string-match "^\\(.*\\)\n\\([[:unibyte:][:nonascii:]]+\\)" message))) - (if lines - (progn - (insert (propertize (concat (match-string 1 message) " …\n") - 'expandable t - 'font-lock-face type - 'front-sticky t - 'read-only haskell-interactive-mode-read-only - 'rear-nonsticky t)) - (insert (propertize (concat (match-string 2 message) "\n") - 'collapsible t - 'font-lock-face type - 'front-sticky t - 'invisible haskell-interactive-mode-hide-multi-line-errors - 'message-length (length (match-string 2 message)) - 'read-only haskell-interactive-mode-read-only - 'rear-nonsticky t))) - (insert (propertize (concat message "\n") - 'font-lock-face type - 'front-sticky t - 'read-only haskell-interactive-mode-read-only - 'rear-nonsticky t))))))) - -(defun haskell-interactive-mode-insert (session message) - "Echo a read only piece of text before the prompt." - (with-current-buffer (haskell-session-interactive-buffer session) - (save-excursion - (haskell-interactive-mode-goto-end-point) - (insert (propertize message - 'front-sticky t - 'read-only t - 'rear-nonsticky t))))) - -(defun haskell-interactive-mode-goto-end-point () - "Go to the 'end' of the buffer (before the prompt)." - (goto-char haskell-interactive-mode-prompt-start) - (goto-char (line-beginning-position))) - -(defun haskell-interactive-mode-history-add (input) - "Add INPUT to the history." - (setq haskell-interactive-mode-history - (cons "" - (cons input - (cl-remove-if (lambda (i) (or (string= i input) (string= i ""))) - haskell-interactive-mode-history)))) - (setq haskell-interactive-mode-history-index - 0)) - -(defun haskell-interactive-mode-tab () - "Do completion if at prompt or else try collapse/expand." - (interactive) - (cond - ((haskell-interactive-at-prompt) - (completion-at-point)) - ((get-text-property (point) 'collapsible) - (let ((column (current-column))) - (search-backward-regexp "^[^ ]") - (haskell-interactive-mode-tab-expand) - (goto-char (+ column (line-beginning-position))))) - (t (haskell-interactive-mode-tab-expand)))) - -(defun haskell-interactive-mode-tab-expand () - "Expand the rest of the message." - (cond ((get-text-property (point) 'expandable) - (let* ((pos (1+ (line-end-position))) - (visibility (get-text-property pos 'invisible)) - (length (1+ (get-text-property pos 'message-length)))) - (let ((inhibit-read-only t)) - (put-text-property pos - (+ pos length) - 'invisible - (not visibility))))))) - -(defconst haskell-interactive-mode-error-regexp - "^\\(\\(?:[A-Z]:\\)?[^ \r\n:][^\r\n:]*\\):\\([0-9()-:]+\\):?") - -(defun haskell-interactive-at-compile-message () - "Am I on a compile message?" - (and (not (haskell-interactive-at-prompt)) - (save-excursion - (goto-char (line-beginning-position)) - (looking-at haskell-interactive-mode-error-regexp)))) - -(defun haskell-interactive-mode-error-backward (&optional count) - "Go backward to the previous error." - (interactive) - (search-backward-regexp haskell-interactive-mode-error-regexp nil t count)) - -(defun haskell-interactive-mode-error-forward (&optional count) - "Go forward to the next error, or return to the REPL." - (interactive) - (goto-char (line-end-position)) - (if (search-forward-regexp haskell-interactive-mode-error-regexp nil t count) - (progn (goto-char (line-beginning-position)) - t) - (progn (goto-char (point-max)) - nil))) - -(defun haskell-interactive-mode-delete-compile-messages (session &optional file-name) - "Delete compile messages in REPL buffer. -If FILE-NAME is non-nil, restrict to removing messages concerning -FILE-NAME only." - (with-current-buffer (haskell-session-interactive-buffer session) - (save-excursion - (goto-char (point-min)) - (when (search-forward-regexp "^Compilation failed.$" nil t 1) - (let ((inhibit-read-only t)) - (delete-region (line-beginning-position) - (1+ (line-end-position)))) - (goto-char (point-min))) - (while (when (re-search-forward haskell-interactive-mode-error-regexp nil t) - (let ((msg-file-name (match-string-no-properties 1)) - (msg-startpos (line-beginning-position))) - ;; skip over hanging continuation message lines - (while (progn (forward-line) (looking-at "^[ ]+"))) - - (when (or (not file-name) (string= file-name msg-file-name)) - (let ((inhibit-read-only t)) - (set-text-properties msg-startpos (point) nil)) - (delete-region msg-startpos (point)) - )) - t))))) - -;;;###autoload -(defun haskell-interactive-mode-reset-error (session) - "Reset the error cursor position." - (interactive) - (with-current-buffer (haskell-session-interactive-buffer session) - (haskell-interactive-mode-goto-end-point) - (let ((mrk (point-marker))) - (haskell-session-set session 'next-error-locus nil) - (haskell-session-set session 'next-error-region (cons mrk (copy-marker mrk t)))) - (goto-char (point-max)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Misc - -(declare-function haskell-interactive-switch "haskell") -(declare-function haskell-session "haskell") - -(defun haskell-session-interactive-buffer (s) - "Get the session interactive buffer." - (let ((buffer (haskell-session-get s 'interactive-buffer))) - (if (and buffer (buffer-live-p buffer)) - buffer - (let ((buffer-name (format "*%s*" (haskell-session-name s))) - (index 0)) - (while (get-buffer buffer-name) - (setq buffer-name (format "*%s <%d>*" (haskell-session-name s) index)) - (setq index (1+ index))) - (let ((buffer (get-buffer-create buffer-name))) - (haskell-session-set-interactive-buffer s buffer) - (with-current-buffer buffer - (haskell-interactive-mode) - (haskell-session-assign s)) - (haskell-interactive-switch) - buffer))))) - -(defun haskell-interactive-buffer () - "Get the interactive buffer of the session." - (haskell-session-interactive-buffer (haskell-session))) - -(defun haskell-process-cabal-live (state buffer) - "Do live updates for Cabal processes." - (haskell-interactive-mode-insert - (haskell-process-session (cadr state)) - (replace-regexp-in-string - haskell-process-prompt-regex - "" - (substring buffer (cl-cadddr state)))) - (setf (cl-cdddr state) (list (length buffer))) - nil) - -(defun haskell-process-parse-error (string) - "Parse the line number from the error string STRING." - (let ((span nil)) - (cl-loop for regex - in haskell-compilation-error-regexp-alist - do (when (string-match (car regex) string) - (setq span - (list :file (match-string 1 string) - :line (string-to-number (match-string 2 string)) - :col (string-to-number (match-string 4 string)) - :line2 (when (match-string 3 string) - (string-to-number (match-string 3 string))) - :col2 (when (match-string 5 string) - (string-to-number (match-string 5 string))))))) - span)) - -(defun haskell-process-suggest-add-package (session msg) - "Add the (matched) module to your cabal file. -Cabal file is selected using SESSION's name, module matching is done in MSG." - (let* ((suggested-package (match-string 1 msg)) - (package-name (replace-regexp-in-string "-[^-]+$" "" suggested-package)) - (version (progn (string-match "\\([^-]+\\)$" suggested-package) - (match-string 1 suggested-package))) - (cabal-file (concat (haskell-session-name session) - ".cabal"))) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (when (y-or-n-p - (format "Add `%s' to %s?" - package-name - cabal-file)) - (haskell-cabal-add-dependency package-name version nil t) - (when (y-or-n-p (format "Enable -package %s in the GHCi session?" package-name)) - (haskell-process-queue-without-filters - (haskell-session-process session) - (format ":set -package %s" package-name)))) - (haskell-mode-toggle-interactive-prompt-state t)))) - -(defun haskell-process-suggest-remove-import (session file import line) - "Suggest removing or commenting out import statement. -Asks user to handle redundant import statement using interactive -SESSION in specified FILE to remove IMPORT on given LINE." - (let ((first t)) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (cl-case (read-event - (propertize (format "%sThe import line `%s' is redundant. Remove? (y, n, c: comment out) " - (if (not first) - "Please answer n, y or c: " - "") - import) - 'face - 'minibuffer-prompt)) - (?y - (haskell-process-find-file session file) - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (goto-char (line-beginning-position)) - (delete-region (line-beginning-position) - (line-end-position)))) - (?n - (message "Ignoring redundant import %s" import)) - (?c - (haskell-process-find-file session file) - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (goto-char (line-beginning-position)) - (insert "-- ")))) - ;; unwind - (haskell-mode-toggle-interactive-prompt-state t)))) - -(defun haskell-process-find-file (session file) - "Find the given file in the project." - (find-file (cond ((file-exists-p (concat (haskell-session-current-dir session) "/" file)) - (concat (haskell-session-current-dir session) "/" file)) - ((file-exists-p (concat (haskell-session-cabal-dir session) "/" file)) - (concat (haskell-session-cabal-dir session) "/" file)) - (t file)))) - -(defun haskell-process-suggest-pragma (session pragma extension file) - "Suggest to add something to the top of the file. -SESSION is used to search given file. Adds PRAGMA and EXTENSION -wrapped in compiler directive at the top of FILE." - (let ((string (format "{-# %s %s #-}" pragma extension))) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (when (y-or-n-p (format "Add %s to the top of the file? " string)) - (haskell-process-find-file session file) - (save-excursion - (goto-char (point-min)) - (insert (concat string "\n")))) - (haskell-mode-toggle-interactive-prompt-state t)))) - -(defun haskell-interactive-mode-insert-error (response) - "Insert an error message." - (insert "\n" - (haskell-fontify-as-mode - response - 'haskell-mode)) - (haskell-interactive-mode-prompt)) - -(defun haskell-interactive-popup-error (response) - "Popup an error." - (if haskell-interactive-popup-errors - (let ((buf (get-buffer-create "*HS-Error*"))) - (pop-to-buffer buf nil t) - (with-current-buffer buf - - (haskell-error-mode) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (propertize response - 'font-lock-face - 'haskell-interactive-face-compile-error)) - (goto-char (point-min)) - (delete-blank-lines) - (insert (propertize "-- Hit `q' to close this window.\n\n" - 'font-lock-face 'font-lock-comment-face)) - (save-excursion - (goto-char (point-max)) - (insert (propertize "\n-- To disable popups, customize `haskell-interactive-popup-errors'.\n\n" - 'font-lock-face 'font-lock-comment-face)))))) - (haskell-interactive-mode-insert-error response))) - -(defun haskell-interactive-next-error-function (&optional n reset) - "See `next-error-function' for more information." - - (let* ((session (haskell-interactive-session)) - (next-error-region (haskell-session-get session 'next-error-region)) - (next-error-locus (haskell-session-get session 'next-error-locus)) - (reset-locus nil)) - - (when (and next-error-region (or reset (and (/= n 0) (not next-error-locus)))) - (goto-char (car next-error-region)) - (unless (looking-at haskell-interactive-mode-error-regexp) - (haskell-interactive-mode-error-forward)) - - (setq reset-locus t) - (unless (looking-at haskell-interactive-mode-error-regexp) - (error "no errors found"))) - - ;; move point if needed - (cond - (reset-locus nil) - ((> n 0) (unless (haskell-interactive-mode-error-forward n) - (error "no more errors"))) - - ((< n 0) (unless (haskell-interactive-mode-error-backward (- n)) - (error "no more errors")))) - - (let ((orig-line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) - - (when (string-match haskell-interactive-mode-error-regexp orig-line) - (let* ((msgmrk (set-marker (make-marker) (line-beginning-position))) - (location (haskell-process-parse-error orig-line)) - (file (plist-get location :file)) - (line (plist-get location :line)) - (col1 (plist-get location :col)) - (col2 (plist-get location :col2)) - - (cabal-relative-file (expand-file-name file (haskell-session-cabal-dir session))) - (src-relative-file (expand-file-name file (haskell-session-current-dir session))) - - (real-file (cond ((file-exists-p cabal-relative-file) cabal-relative-file) - ((file-exists-p src-relative-file) src-relative-file)))) - - (haskell-session-set session 'next-error-locus msgmrk) - - (if real-file - (let ((m1 (make-marker)) - (m2 (make-marker))) - (with-current-buffer (find-file-noselect real-file) - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (set-marker m1 (+ col1 (point) -1)) - - (when col2 - (set-marker m2 (- (point) col2))))) - ;; ...finally select&hilight error locus - (compilation-goto-locus msgmrk m1 (and (marker-position m2) m2))) - (error "don't know where to find %S" file))))))) - -(defun haskell-interactive-session () - "Get the `haskell-session', throw an error if it's not available." - (or (haskell-session-maybe) - (haskell-session-assign - (or (haskell-session-from-buffer) - (haskell-session-choose) - (error "No session associated with this buffer. Try M-x haskell-session-change or report this as a bug."))))) - -(defun haskell-interactive-process () - "Get the Haskell session." - (or (haskell-session-process (haskell-interactive-session)) - (error "No Haskell session/process associated with this - buffer. Maybe run M-x haskell-process-restart?"))) - -(defun haskell-interactive-mode-do-presentation (expr) - "Present the given expression EXPR. -Requires the `present' package to be installed. -Will automatically import it qualified as Present." - (let ((p (haskell-interactive-process))) - ;; If Present.code isn't available, we probably need to run the - ;; setup. - (unless (string-match "^Present" (haskell-process-queue-sync-request p ":t Present.encode")) - (haskell-interactive-mode-setup-presentation p)) - ;; Happily, let statements don't affect the `it' binding in any - ;; way, so we can fake it, no pun intended. - (let ((error (haskell-process-queue-sync-request - p (concat "let it = Present.asData (" expr ")")))) - (if (not (string= "" error)) - (haskell-interactive-mode-eval-result (haskell-interactive-session) (concat error "\n")) - (let ((hash (haskell-interactive-mode-presentation-hash))) - (haskell-process-queue-sync-request - p (format "let %s = Present.asData (%s)" hash expr)) - (let* ((presentation (haskell-interactive-mode-present-id - hash - (list 0)))) - (insert "\n") - (haskell-interactive-mode-insert-presentation hash presentation) - (haskell-interactive-mode-eval-result (haskell-interactive-session) "\n")))) - (haskell-interactive-mode-prompt (haskell-interactive-session))))) - -(defun haskell-interactive-mode-present-id (hash id) - "Generate a presentation for the current expression at ID." - ;; See below for commentary of this statement. - (let ((p (haskell-interactive-process))) - (haskell-process-queue-without-filters - p "let _it = it") - (let* ((text (haskell-process-queue-sync-request - p - (format "Present.putStr (Present.encode (Present.fromJust (Present.present (Present.fromJust (Present.fromList [%s])) %s)))" - (mapconcat 'identity (mapcar 'number-to-string id) ",") - hash))) - (reply - (if (string-match "^*** " text) - '((rep nil)) - (read text)))) - ;; Not necessary, but nice to restore it to the expression that - ;; the user actually typed in. - (haskell-process-queue-without-filters - p "let it = _it") - reply))) - -(defun haskell-presentation-present-slot (btn) - "The callback to evaluate the slot and present it in place of the button BTN." - (let ((id (button-get btn 'presentation-id)) - (hash (button-get btn 'hash)) - (parent-rep (button-get btn 'parent-rep)) - (continuation (button-get btn 'continuation))) - (let ((point (point))) - (button-put btn 'invisible t) - (delete-region (button-start btn) (button-end btn)) - (haskell-interactive-mode-insert-presentation - hash - (haskell-interactive-mode-present-id hash id) - parent-rep - continuation) - (when (> (point) point) - (goto-char (1+ point)))))) - -(defun haskell-interactive-mode-presentation-slot (hash slot parent-rep &optional continuation) - "Make a slot at point, pointing to ID." - (let ((type (car slot)) - (id (cadr slot))) - (if (member (intern type) '(Integer Char Int Float Double)) - (haskell-interactive-mode-insert-presentation - hash - (haskell-interactive-mode-present-id hash id) - parent-rep - continuation) - (haskell-interactive-mode-presentation-slot-button slot parent-rep continuation hash)))) - -(defun haskell-interactive-mode-presentation-slot-button (slot parent-rep continuation hash) - (let ((start (point)) - (type (car slot)) - (id (cadr slot))) - (insert (propertize type 'font-lock-face '(:height 0.8 :underline t :inherit font-lock-comment-face))) - (let ((button (make-text-button start (point) - :type 'haskell-presentation-slot-button))) - (button-put button 'hide-on-click t) - (button-put button 'presentation-id id) - (button-put button 'parent-rep parent-rep) - (button-put button 'continuation continuation) - (button-put button 'hash hash)))) - -(defun haskell-interactive-mode-insert-presentation (hash presentation &optional parent-rep continuation) - "Insert the presentation, hooking up buttons for each slot." - (let* ((rep (cadr (assoc 'rep presentation))) - (text (cadr (assoc 'text presentation))) - (slots (cadr (assoc 'slots presentation))) - (nullary (null slots))) - (cond - ((string= "integer" rep) - (insert (propertize text 'font-lock-face 'font-lock-constant))) - ((string= "floating" rep) - (insert (propertize text 'font-lock-face 'font-lock-constant))) - ((string= "char" rep) - (insert (propertize - (if (string= "string" parent-rep) - (replace-regexp-in-string "^'\\(.+\\)'$" "\\1" text) - text) - 'font-lock-face 'font-lock-string-face))) - ((string= "tuple" rep) - (insert "(") - (let ((first t)) - (cl-loop for slot in slots - do (unless first (insert ",")) - do (haskell-interactive-mode-presentation-slot hash slot rep) - do (setq first nil))) - (insert ")")) - ((string= "list" rep) - (if (null slots) - (if continuation - (progn (delete-char -1) - (delete-indentation)) - (insert "[]")) - (let ((i 0)) - (unless continuation - (insert "[")) - (let ((start-column (current-column))) - (cl-loop for slot in slots - do (haskell-interactive-mode-presentation-slot - hash - slot - rep - (= i (1- (length slots)))) - do (when (not (= i (1- (length slots)))) - (insert "\n") - (indent-to (1- start-column)) - (insert ",")) - do (setq i (1+ i)))) - (unless continuation - (insert "]"))))) - ((string= "string" rep) - (unless (string= "string" parent-rep) - (insert (propertize "\"" 'font-lock-face 'font-lock-string-face))) - (cl-loop for slot in slots - do (haskell-interactive-mode-presentation-slot hash slot rep)) - (unless (string= "string" parent-rep) - (insert (propertize "\"" 'font-lock-face 'font-lock-string-face)))) - ((string= "alg" rep) - (when (and parent-rep - (not nullary) - (not (string= "list" parent-rep))) - (insert "(")) - (let ((start-column (current-column))) - (insert (propertize text 'font-lock-face 'font-lock-type-face)) - (cl-loop for slot in slots - do (insert "\n") - do (indent-to (+ 2 start-column)) - do (haskell-interactive-mode-presentation-slot hash slot rep))) - (when (and parent-rep - (not nullary) - (not (string= "list" parent-rep))) - (insert ")"))) - ((string= "record" rep) - (let ((start-column (current-column))) - (insert (propertize text 'font-lock-face 'font-lock-type-face) - " { ") - (cl-loop for field in slots - do (insert "\n") - do (indent-to (+ 2 start-column)) - do (let ((name (nth 0 field)) - (slot (nth 1 field))) - (insert name " = ") - (haskell-interactive-mode-presentation-slot hash slot rep))) - (insert "\n") - (indent-to start-column) - (insert "}"))) - ((eq rep nil) - (insert (propertize "?" 'font-lock-face 'font-lock-warning))) - (t - (let ((err "Unable to present! This very likely means Emacs -is out of sync with the `present' package. You should make sure -they're both up to date, or report a bug.")) - (insert err) - (error err)))))) - -(defun haskell-interactive-mode-setup-presentation (p) - "Setup the GHCi REPL for using presentations. - -Using asynchronous queued commands as opposed to sync at this -stage, as sync would freeze up the UI a bit, and we actually -don't care when the thing completes as long as it's soonish." - ;; Import dependencies under Present.* namespace - (haskell-process-queue-without-filters p "import qualified Data.Maybe as Present") - (haskell-process-queue-without-filters p "import qualified Data.ByteString.Lazy as Present") - (haskell-process-queue-without-filters p "import qualified Data.AttoLisp as Present") - (haskell-process-queue-without-filters p "import qualified Present.ID as Present") - (haskell-process-queue-without-filters p "import qualified Present as Present") - ;; Make a dummy expression to avoid "Loading package" nonsense - (haskell-process-queue-without-filters - p "Present.present (Present.fromJust (Present.fromList [0])) ()")) - -(defvar haskell-interactive-mode-presentation-hash 0 - "Counter for the hash.") - -(defun haskell-interactive-mode-presentation-hash () - "Generate a presentation hash." - (format "_present_%s" - (setq haskell-interactive-mode-presentation-hash - (1+ haskell-interactive-mode-presentation-hash)))) - -(define-button-type 'haskell-presentation-slot-button - 'action 'haskell-presentation-present-slot - 'follow-link t - 'help-echo "Click to expand…") - -(defun haskell-interactive-mode-history-toggle (n) - "Toggle the history N items up or down." - (unless (null haskell-interactive-mode-history) - (setq haskell-interactive-mode-history-index - (mod (+ haskell-interactive-mode-history-index n) - (length haskell-interactive-mode-history))) - (unless (zerop haskell-interactive-mode-history-index) - (message "History item: %d" haskell-interactive-mode-history-index)) - (haskell-interactive-mode-set-prompt - (nth haskell-interactive-mode-history-index - haskell-interactive-mode-history)))) - -(defun haskell-interactive-mode-set-prompt (p) - "Set (and overwrite) the current prompt." - (with-current-buffer (haskell-session-interactive-buffer (haskell-interactive-session)) - (goto-char haskell-interactive-mode-prompt-start) - (delete-region (point) (point-max)) - (insert p))) - -(defun haskell-interactive-mode-history-previous (arg) - "Cycle backwards through input history." - (interactive "*p") - (when (haskell-interactive-at-prompt) - (if (not (zerop arg)) - (haskell-interactive-mode-history-toggle arg) - (setq haskell-interactive-mode-history-index 0) - (haskell-interactive-mode-history-toggle 1)))) - -(defun haskell-interactive-mode-history-next (arg) - "Cycle forward through input history." - (interactive "*p") - (when (haskell-interactive-at-prompt) - (if (not (zerop arg)) - (haskell-interactive-mode-history-toggle (- arg)) - (setq haskell-interactive-mode-history-index 0) - (haskell-interactive-mode-history-toggle -1)))) - -(defun haskell-interactive-mode-prompt-previous () - "Jump to the previous prompt." - (interactive) - (let ((prev-prompt-pos - (save-excursion - (beginning-of-line) ;; otherwise prompt at current line matches - (and (search-backward-regexp (haskell-interactive-prompt-regex) nil t) - (match-end 0))))) - (when prev-prompt-pos (goto-char prev-prompt-pos)))) - -(defun haskell-interactive-mode-prompt-next () - "Jump to the next prompt." - (interactive) - (search-forward-regexp (haskell-interactive-prompt-regex) nil t)) - -(defun haskell-interactive-mode-clear () - "Clear the screen and put any current input into the history." - (interactive) - (let ((session (haskell-interactive-session))) - (with-current-buffer (haskell-session-interactive-buffer session) - (let ((inhibit-read-only t)) - (set-text-properties (point-min) (point-max) nil)) - (delete-region (point-min) (point-max)) - (remove-overlays) - (haskell-interactive-mode-prompt session) - (haskell-session-set session 'next-error-region nil) - (haskell-session-set session 'next-error-locus nil)) - (with-current-buffer (get-buffer-create "*haskell-process-log*") - (let ((inhibit-read-only t)) - (delete-region (point-min) (point-max))) - (remove-overlays)))) - -(defun haskell-interactive-mode-completion-at-point-function () - "Offer completions for partial expression between prompt and point. -This completion function is used in interactive REPL buffer itself." - (when (haskell-interactive-at-prompt) - (let* ((process (haskell-interactive-process)) - (inp (haskell-interactive-mode-input-partial)) - (resp2 (haskell-process-get-repl-completions process inp)) - (rlen (- (length inp) (length (car resp2)))) - (coll (append (if (string-prefix-p inp "import") '("import")) - (if (string-prefix-p inp "let") '("let")) - (cdr resp2)))) - (list (- (point) rlen) (point) coll)))) - -(defun haskell-interactive-mode-trigger-compile-error (state response) - "Look for an compile error. -If there is one, pop that up in a buffer, similar to `debug-on-error'." - (when (and haskell-interactive-types-for-show-ambiguous - (string-match "^\n:[-0-9]+:[-0-9]+:" response) - (not (string-match "^\n:[-0-9]+:[-0-9]+:[\n ]+[Ww]arning:" response))) - (let ((inhibit-read-only t)) - (delete-region haskell-interactive-mode-prompt-start (point)) - (set-marker haskell-interactive-mode-prompt-start - haskell-interactive-mode-old-prompt-start) - (goto-char (point-max))) - (cond - ((and (not (haskell-interactive-mode-line-is-query (elt state 2))) - (or (string-match "No instance for (?Show[ \n]" response) - (string-match "Ambiguous type variable " response))) - (haskell-process-reset (haskell-interactive-process)) - (let ((resp (haskell-process-queue-sync-request - (haskell-interactive-process) - (concat ":t " - (buffer-substring-no-properties - haskell-interactive-mode-prompt-start - (point-max)))))) - (cond - ((not (string-match ":" resp)) - (haskell-interactive-mode-insert-error resp)) - (t (haskell-interactive-popup-error response))))) - (t (haskell-interactive-popup-error response) - t)) - t)) - -;;;###autoload -(defun haskell-interactive-mode-echo (session message &optional mode) - "Echo a read only piece of text before the prompt." - (with-current-buffer (haskell-session-interactive-buffer session) - (save-excursion - (haskell-interactive-mode-goto-end-point) - (insert (if mode - (haskell-fontify-as-mode - (concat message "\n") - mode) - (propertize (concat message "\n") - 'front-sticky t - 'read-only t - 'rear-nonsticky t)))))) - -(defun haskell-interactive-mode-splices-buffer (session) - "Get the splices buffer for the current SESSION." - (get-buffer-create (haskell-interactive-mode-splices-buffer-name session))) - -(defun haskell-interactive-mode-splices-buffer-name (session) - (format "*%s:splices*" (haskell-session-name session))) - -(defun haskell-interactive-mode-compile-splice (session message) - "Echo a compiler splice." - (with-current-buffer (haskell-interactive-mode-splices-buffer session) - (unless (eq major-mode 'haskell-mode) - (haskell-mode)) - (let* ((parts (split-string message "\n ======>\n")) - (file-and-decl-lines (split-string (nth 0 parts) "\n")) - (file (nth 0 file-and-decl-lines)) - (decl (mapconcat #'identity (cdr file-and-decl-lines) "\n")) - (output (nth 1 parts))) - (insert "-- " file "\n") - (let ((start (point))) - (insert decl "\n") - (indent-rigidly start (point) -4)) - (insert "-- =>\n") - (let ((start (point))) - (insert output "\n") - (indent-rigidly start (point) -4))))) - -(defun haskell-interactive-mode-insert-garbage (session message) - "Echo a read only piece of text before the prompt." - (with-current-buffer (haskell-session-interactive-buffer session) - (save-excursion - (haskell-interactive-mode-goto-end-point) - (insert (propertize message - 'front-sticky t - 'font-lock-face 'haskell-interactive-face-garbage - 'read-only t - 'rear-nonsticky t))))) - -;;;###autoload -(defun haskell-process-show-repl-response (line) - "Send LINE to the GHCi process and echo the result in some fashion. -Result will be printed in the minibuffer or presented using -function `haskell-presentation-present', depending on variable -`haskell-process-use-presentation-mode'." - (let ((process (haskell-interactive-process))) - (haskell-process-queue-command - process - (make-haskell-command - :state (cons process line) - :go (lambda (state) - (haskell-process-send-string (car state) (cdr state))) - :complete (lambda (state response) - (if haskell-process-use-presentation-mode - (haskell-presentation-present - (haskell-process-session (car state)) - response) - (haskell-mode-message-line response))))))) - -(provide 'haskell-interactive-mode) - -;;; haskell-interactive-mode.el ends here diff --git a/haskell-load.el b/haskell-load.el deleted file mode 100644 index 88968a0d1..000000000 --- a/haskell-load.el +++ /dev/null @@ -1,624 +0,0 @@ -;;; haskell-load.el --- Compiling and loading modules in the GHCi process -*- lexical-binding: t -*- - -;; Copyright © 2014 Chris Done. All rights reserved. -;; 2016 Arthur Fayzrakhmanov - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;;; Code: - -(require 'cl-lib) -(require 'haskell-mode) -(require 'haskell-process) -(require 'haskell-interactive-mode) -(require 'haskell-modules) -(require 'haskell-commands) -(require 'haskell-session) -(require 'haskell-string) - -(defun haskell-process-look-config-changes (session) - "Check whether a cabal configuration file has changed. -Restarts the SESSION's process if that is the case." - (let ((current-checksum (haskell-session-get session 'cabal-checksum)) - (new-checksum (haskell-cabal-compute-checksum - (haskell-session-get session 'cabal-dir)))) - (when (not (string= current-checksum new-checksum)) - (haskell-interactive-mode-echo - session - (format "Cabal file changed: %s" new-checksum)) - (haskell-session-set-cabal-checksum - session - (haskell-session-get session 'cabal-dir)) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (unless - (and haskell-process-prompt-restart-on-cabal-change - (not - (y-or-n-p "Cabal file changed. Restart GHCi process? "))) - (haskell-process-start (haskell-interactive-session))) - (haskell-mode-toggle-interactive-prompt-state t))))) - -(defun haskell-process-live-build (process buffer echo-in-repl) - "Show live updates for loading files." - (cond - ((haskell-process-consume - process - (concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]" - " Compiling \\([^ ]+\\)[ ]+" - "( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+")) - (haskell-process-echo-load-message process buffer echo-in-repl nil) - t) - ((haskell-process-consume - process - (concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]" - " Compiling \\[TH\\] \\([^ ]+\\)[ ]+" - "( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+")) - (haskell-process-echo-load-message process buffer echo-in-repl t) - t) - ((haskell-process-consume - process - "Loading package \\([^ ]+\\) ... linking ... done.\n") - (haskell-mode-message-line - (format "Loading: %s" - (match-string 1 buffer))) - t) - ((haskell-process-consume - process - "^Preprocessing executables for \\(.+?\\)\\.\\.\\.") - (let ((msg (format "Preprocessing: %s" (match-string 1 buffer)))) - (haskell-interactive-mode-echo (haskell-process-session process) msg) - (haskell-mode-message-line msg))) - ((haskell-process-consume process "Linking \\(.+?\\) \\.\\.\\.") - (let ((msg (format "Linking: %s" (match-string 1 buffer)))) - (haskell-interactive-mode-echo (haskell-process-session process) msg) - (haskell-mode-message-line msg))) - ((haskell-process-consume process "\nBuilding \\(.+?\\)\\.\\.\\.") - (let ((msg (format "Building: %s" (match-string 1 buffer)))) - (haskell-interactive-mode-echo (haskell-process-session process) msg) - (haskell-mode-message-line msg))) - ((string-match "Collecting type info for [[:digit:]]+ module(s) \\.\\.\\." - (haskell-process-response process) - (haskell-process-response-cursor process)) - (haskell-mode-message-line (match-string 0 buffer)) - ;; Do not consume "Ok, modules loaded" that goes before - ;; "Collecting type info...", just exit. - nil))) - -(defun haskell-process-load-complete (session process buffer reload module-buffer &optional cont) - "Handle the complete loading response. BUFFER is the string of -text being sent over the process pipe. MODULE-BUFFER is the -actual Emacs buffer of the module being loaded." - (when (get-buffer (format "*%s:splices*" (haskell-session-name session))) - (with-current-buffer (haskell-interactive-mode-splices-buffer session) - (erase-buffer))) - (let* ((ok (cond - ((haskell-process-consume - process - "Ok, modules loaded: \\(.+\\)\\.$") - t) - ((haskell-process-consume - process - "Failed, modules loaded: \\(.+\\)\\.$") - nil) - (t - (error (message "Unexpected response from haskell process."))))) - (modules (haskell-process-extract-modules buffer)) - (cursor (haskell-process-response-cursor process)) - (warning-count 0)) - (haskell-process-set-response-cursor process 0) - (haskell-check-remove-overlays module-buffer) - (while - (haskell-process-errors-warnings module-buffer session process buffer) - (setq warning-count (1+ warning-count))) - (haskell-process-set-response-cursor process cursor) - (if (and (not reload) - haskell-process-reload-with-fbytecode) - (haskell-process-reload-with-fbytecode process module-buffer) - (haskell-process-import-modules process (car modules))) - (if ok - (haskell-mode-message-line (if reload "Reloaded OK." "OK.")) - (haskell-interactive-mode-compile-error session "Compilation failed.")) - (when cont - (condition-case-unless-debug e - (funcall cont ok) - (error (message "%S" e)) - (quit nil))))) - -(defun haskell-process-suggest-imports (session file modules ident) - "Suggest add missed imports to file. -Asks user to add to SESSION's FILE missed import. MODULES is a -list of modules where missed IDENT was found." - (cl-assert session) - (cl-assert file) - (cl-assert ident) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (let* ((process (haskell-session-process session)) - (suggested-already (haskell-process-suggested-imports process)) - (module - (cond - ((> (length modules) 1) - (when (y-or-n-p - (format - "Identifier `%s' not in scope, choose module to import?" - ident)) - (haskell-complete-module-read "Module: " modules))) - ((= (length modules) 1) - (let ((module (car modules))) - (unless (member module suggested-already) - (haskell-process-set-suggested-imports - process - (cons module suggested-already)) - (when (y-or-n-p - (format "Identifier `%s' not in scope, import `%s'?" - ident - module)) - module))))))) - (when module - (haskell-process-find-file session file) - (haskell-add-import module))) - (haskell-mode-toggle-interactive-prompt-state t))) - -(defun haskell-process-trigger-suggestions (session msg file line) - "Trigger prompting to add any extension suggestions." - (cond ((let ((case-fold-search nil)) - (or - (and (string-match " -X\\([A-Z][A-Za-z]+\\)" msg) - (not (string-match "\\([A-Z][A-Za-z]+\\) is deprecated" msg))) - (string-match "Use \\([A-Z][A-Za-z]+\\) to permit this" msg) - (string-match "Use \\([A-Z][A-Za-z]+\\) to allow" msg) - (string-match "Use \\([A-Z][A-Za-z]+\\) to enable" msg) - (string-match - "Use \\([A-Z][A-Za-z]+\\) if you want to disable this" - msg) - (string-match "use \\([A-Z][A-Za-z]+\\)" msg) - (string-match "You need \\([A-Z][A-Za-z]+\\)" msg))) - (when haskell-process-suggest-language-pragmas - (haskell-process-suggest-pragma - session - "LANGUAGE" - (match-string 1 msg) - file))) - ((string-match - " The \\(qualified \\)?import of[ ][‘`‛]\\([^ ]+\\)['’] is redundant" - msg) - (when haskell-process-suggest-remove-import-lines - (haskell-process-suggest-remove-import - session - file - (match-string 2 msg) - line))) - ((string-match "[Ww]arning: orphan instance: " msg) - (when haskell-process-suggest-no-warn-orphans - (haskell-process-suggest-pragma - session - "OPTIONS" "-fno-warn-orphans" - file))) - ((or (string-match "against inferred type [‘`‛]\\[Char\\]['’]" msg) - (string-match "with actual type [‘`‛]\\[Char\\]['’]" msg)) - (when haskell-process-suggest-overloaded-strings - (haskell-process-suggest-pragma - session - "LANGUAGE" "OverloadedStrings" - file))) - ((string-match "^Not in scope: .*[‘`‛]\\(.+\\)['’]$" msg) - (let* ((match1 (match-string 1 msg)) - (ident (if (string-match "^[A-Za-z0-9_'.]+\\.\\(.+\\)$" match1) - ;; Skip qualification. - (match-string 1 match1) - match1))) - (when haskell-process-suggest-hoogle-imports - (let ((modules (haskell-process-hoogle-ident ident))) - (haskell-process-suggest-imports session file modules ident))) - (when haskell-process-suggest-haskell-docs-imports - (let ((modules (haskell-process-haskell-docs-ident ident))) - (haskell-process-suggest-imports session file modules ident))) - (when haskell-process-suggest-hayoo-imports - (let ((modules (haskell-process-hayoo-ident ident))) - (haskell-process-suggest-imports session file modules ident))))) - ((string-match "^[ ]+It is a member of the hidden package [‘`‛]\\([^@\r\n]+\\).*['’].$" msg) - (when haskell-process-suggest-add-package - (haskell-process-suggest-add-package session msg))))) - -(defun haskell-process-do-cabal (command) - "Run a Cabal command." - (let ((process (ignore-errors - (haskell-interactive-process)))) - (cond - ((or (eq process nil) - (let ((child (haskell-process-process process))) - (not (equal 'run (process-status child))))) - (message "Process is not running, so running directly.") - (shell-command (concat "cabal " command) - (get-buffer-create "*haskell-process-log*") - (get-buffer-create "*haskell-process-log*")) - (switch-to-buffer-other-window (get-buffer "*haskell-process-log*"))) - (t (haskell-process-queue-command - process - (make-haskell-command - :state (list (haskell-interactive-session) process command 0) - :go - (lambda (state) - (haskell-process-send-string - (cadr state) - (format haskell-process-do-cabal-format-string - (haskell-session-cabal-dir (car state)) - (format "%s %s" - (cl-ecase (haskell-process-type) - ('ghci haskell-process-path-cabal) - ('cabal-repl haskell-process-path-cabal) - ('cabal-new-repl haskell-process-path-cabal) - ('cabal-ghci haskell-process-path-cabal) - ('stack-ghci haskell-process-path-stack)) - (cl-caddr state))))) - :live - (lambda (state buffer) - (let ((cmd (replace-regexp-in-string "^\\([a-z]+\\).*" - "\\1" - (cl-caddr state)))) - (cond ((or (string= cmd "build") - (string= cmd "install")) - (haskell-process-live-build (cadr state) buffer t)) - (t - (haskell-process-cabal-live state buffer))))) - :complete - (lambda (state response) - (let* ((process (cadr state)) - (session (haskell-process-session process)) - (message-count 0) - (cursor (haskell-process-response-cursor process))) - ;; XXX: what the hell about the rampant code duplication? - (haskell-process-set-response-cursor process 0) - (while (haskell-process-errors-warnings nil session process response) - (setq message-count (1+ message-count))) - (haskell-process-set-response-cursor process cursor) - (let ((msg (format "Complete: cabal %s (%s compiler messages)" - (cl-caddr state) - message-count))) - (haskell-interactive-mode-echo session msg) - (when (= message-count 0) - (haskell-interactive-mode-echo - session - "No compiler messages, dumping complete output:") - (haskell-interactive-mode-echo session response)) - (haskell-mode-message-line msg) - (when (and haskell-notify-p - (fboundp 'notifications-notify)) - (notifications-notify - :title (format "*%s*" (haskell-session-name (car state))) - :body msg - :app-name (cl-ecase (haskell-process-type) - ('ghci haskell-process-path-cabal) - ('cabal-repl haskell-process-path-cabal) - ('cabal-new-repl haskell-process-path-cabal) - ('cabal-ghci haskell-process-path-cabal) - ('stack-ghci haskell-process-path-stack)) - :app-icon haskell-process-logo))))))))))) - -(defun haskell-process-echo-load-message (process buffer echo-in-repl th) - "Echo a load message." - (let ((session (haskell-process-session process)) - (module-name (match-string 3 buffer)) - (file-name (match-string 4 buffer))) - (haskell-interactive-show-load-message - session - 'compiling - module-name - (haskell-session-strip-dir session file-name) - echo-in-repl - th))) - -(defun haskell-process-extract-modules (buffer) - "Extract the modules from the process buffer." - (let* ((modules-string (match-string 1 buffer)) - (modules (split-string modules-string ", "))) - (cons modules modules-string))) - -;;;###autoload -(defface haskell-error-face - '((((supports :underline (:style wave))) - :underline (:style wave :color "#dc322f")) - (t - :inherit error)) - "Face used for marking error lines." - :group 'haskell-mode) - -;;;###autoload -(defface haskell-warning-face - '((((supports :underline (:style wave))) - :underline (:style wave :color "#b58900")) - (t - :inherit warning)) - "Face used for marking warning lines." - :group 'haskell-mode) - -;;;###autoload -(defface haskell-hole-face - '((((supports :underline (:style wave))) - :underline (:style wave :color "#6c71c4")) - (t - :inherit warning)) - "Face used for marking hole lines." - :group 'haskell-mode) - -(defvar haskell-check-error-fringe (propertize "!" 'display '(left-fringe exclamation-mark))) -(defvar haskell-check-warning-fringe (propertize "?" 'display '(left-fringe question-mark))) -(defvar haskell-check-hole-fringe (propertize "_" 'display '(left-fringe horizontal-bar))) - -(defun haskell-check-overlay-p (ovl) - (overlay-get ovl 'haskell-check)) - -(defun haskell-check-filter-overlays (xs) - (cl-remove-if-not 'haskell-check-overlay-p xs)) - -(defun haskell-check-remove-overlays (buffer) - (with-current-buffer buffer - (remove-overlays (point-min) (point-max) 'haskell-check t))) - -(defmacro with-overlay-properties (proplist ovl &rest body) - "Evaluate BODY with names in PROPLIST bound to the values of -correspondingly-named overlay properties of OVL." - (let ((ovlvar (cl-gensym "OVL-"))) - `(let* ((,ovlvar ,ovl) - ,@(mapcar (lambda (p) `(,p (overlay-get ,ovlvar ',p))) proplist)) - ,@body))) - -(defun overlay-start> (o1 o2) - (> (overlay-start o1) (overlay-start o2))) -(defun overlay-start< (o1 o2) - (< (overlay-start o1) (overlay-start o2))) - -(defun first-overlay-in-if (test beg end) - (let ((ovls (cl-remove-if-not test (overlays-in beg end)))) - (cl-first (sort (cl-copy-list ovls) 'overlay-start<)))) - -(defun last-overlay-in-if (test beg end) - (let ((ovls (cl-remove-if-not test (overlays-in beg end)))) - (cl-first (sort (cl-copy-list ovls) 'overlay-start>)))) - -(defun haskell-error-overlay-briefly (ovl) - (with-overlay-properties - (haskell-msg haskell-msg-type) ovl - (cond - ((not (eq haskell-msg-type 'warning)) - haskell-msg) - ((string-prefix-p "[Ww]arning:\n " haskell-msg) - (cl-subseq haskell-msg 13)) - (t - (error - "Invariant failed: a warning message from GHC has unexpected form: %s." - haskell-msg))))) - -(defun haskell-goto-error-overlay (ovl) - (cond (ovl - (goto-char (overlay-start ovl)) - (haskell-mode-message-line (haskell-error-overlay-briefly ovl))) - (t - (message "No further notes from Haskell compiler.")))) - -(defun haskell-goto-first-error () - (interactive) - (haskell-goto-error-overlay - (first-overlay-in-if 'haskell-check-overlay-p - (buffer-end 0) (buffer-end 1)))) - -(defun haskell-goto-prev-error () - (interactive) - (haskell-goto-error-overlay - (let ((ovl-at - (cl-first (haskell-check-filter-overlays (overlays-at (point)))))) - (or (last-overlay-in-if 'haskell-check-overlay-p - (point-min) - (if ovl-at (overlay-start ovl-at) (point))) - ovl-at)))) - -(defun haskell-goto-next-error () - (interactive) - (haskell-goto-error-overlay - (let ((ovl-at - (cl-first (haskell-check-filter-overlays (overlays-at (point)))))) - (or (first-overlay-in-if - 'haskell-check-overlay-p - (if ovl-at (overlay-end ovl-at) (point)) (point-max)) - ovl-at)))) - -(defun haskell-check-paint-overlay - (buffer error-from-this-file-p line msg file type hole coln) - (with-current-buffer buffer - (let (beg end) - (goto-char (point-min)) - ;; XXX: we can avoid excess buffer walking by relying on the maybe-fact - ;; that GHC sorts error messages by line number, maybe. - (cond - (error-from-this-file-p - (forward-line (1- line)) - (forward-char (1- coln)) - (setq beg (point)) - (if (eq type 'hole) - (forward-char (length hole)) - (skip-chars-forward "^[:space:]" (line-end-position))) - (setq end (point))) - (t - (setq beg (point)) - (forward-line) - (setq end (point)))) - (let ((ovl (make-overlay beg end))) - (overlay-put ovl 'haskell-check t) - (overlay-put ovl 'haskell-file file) - (overlay-put ovl 'haskell-msg msg) - (overlay-put ovl 'haskell-msg-type type) - (overlay-put ovl 'help-echo msg) - (overlay-put ovl 'haskell-hole hole) - (cl-destructuring-bind - (face fringe) - (cl-case type - (warning - (list 'haskell-warning-face haskell-check-warning-fringe)) - (hole - (list 'haskell-hole-face haskell-check-hole-fringe)) - (error - (list 'haskell-error-face haskell-check-error-fringe))) - (overlay-put ovl 'before-string fringe) - (overlay-put ovl 'face face)))))) - -(defun haskell-process-errors-warnings - (module-buffer session process buffer &optional return-only) - "Trigger handling type errors or warnings. -Either prints the messages in the interactive buffer or if CONT -is specified, passes the error onto that. - -When MODULE-BUFFER is non-NIL, paint error overlays." - (save-excursion - (cond - ((haskell-process-consume - process - "\\(Module imports form a cycle:[ \n]+module [^ ]+ ([^)]+)[[:unibyte:][:nonascii:]]+?\\)\nFailed") - (let ((err (match-string 1 buffer))) - (if (string-match "module [`'‘‛]\\([^ ]+\\)['’`] (\\([^)]+\\))" err) - (let* ((default-directory (haskell-session-current-dir session)) - (module (match-string 1 err)) - (file (match-string 2 err)) - (relative-file-name (file-relative-name file))) - (unless return-only - (haskell-interactive-show-load-message - session - 'import-cycle - module - relative-file-name - nil - nil) - (haskell-interactive-mode-compile-error - session - (format "%s:1:0: %s" - relative-file-name - err))) - (list :file file :line 1 :col 0 :msg err :type 'error)) - t))) - ((haskell-process-consume - process - (concat "[\r\n]\\([A-Z]?:?[^ \r\n:][^:\n\r]+\\):\\([0-9()-:]+\\):" - "[ \n\r]+\\([[:unibyte:][:nonascii:]]+?\\)\n[^ ]")) - (haskell-process-set-response-cursor - process - (- (haskell-process-response-cursor process) 1)) - (let* ((buffer (haskell-process-response process)) - (file (match-string 1 buffer)) - (location-raw (match-string 2 buffer)) - (error-msg (match-string 3 buffer)) - (type (cond ((string-match "^[Ww]arning:" error-msg) 'warning) - ((string-match "^Splicing " error-msg) 'splice) - (t 'error))) - (critical (not (eq type 'warning))) - ;; XXX: extract hole information, pass down to - ;; `haskell-check-paint-overlay' - (final-msg (format "%s:%s: %s" - (haskell-session-strip-dir session file) - location-raw - error-msg)) - (location (haskell-process-parse-error - (concat file ":" location-raw ": x"))) - (line (plist-get location :line)) - (col1 (plist-get location :col))) - (when module-buffer - (haskell-check-paint-overlay - module-buffer - (string= (file-truename (buffer-file-name module-buffer)) - (file-truename file)) - line error-msg file type nil col1)) - (if return-only - (list :file file :line line :col col1 :msg error-msg :type type) - (progn (funcall (cl-case type - (warning 'haskell-interactive-mode-compile-warning) - (splice 'haskell-interactive-mode-compile-splice) - (error 'haskell-interactive-mode-compile-error)) - session final-msg) - (when critical - (haskell-mode-message-line final-msg)) - (haskell-process-trigger-suggestions - session - error-msg - file - line) - t))))))) - -(defun haskell-interactive-show-load-message (session type module-name file-name echo th) - "Show the '(Compiling|Loading) X' message." - (let ((msg (concat - (cl-ecase type - ('compiling - (if haskell-interactive-mode-include-file-name - (format "Compiling: %s (%s)" module-name file-name) - (format "Compiling: %s" module-name))) - ('loading (format "Loading: %s" module-name)) - ('import-cycle - (format "Module has an import cycle: %s" module-name))) - (if th " [TH]" "")))) - (haskell-mode-message-line msg) - (when haskell-interactive-mode-delete-superseded-errors - (haskell-interactive-mode-delete-compile-messages session file-name)) - (when echo - (haskell-interactive-mode-echo session msg)))) - -;;;###autoload -(defun haskell-process-reload-devel-main () - "Reload the module `DevelMain' and then run `DevelMain.update'. - -This is for doing live update of the code of servers or GUI -applications. Put your development version of the program in -`DevelMain', and define `update' to auto-start the program on a -new thread, and use the `foreign-store' package to access the -running context across :load/:reloads in GHCi." - (interactive) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (with-current-buffer - (or (get-buffer "DevelMain.hs") - (if (y-or-n-p - "You need to open a buffer named DevelMain.hs. Find now?") - (ido-find-file) - (error "No DevelMain.hs buffer."))) - (let ((session (haskell-interactive-session))) - (let ((process (haskell-interactive-process))) - (haskell-process-queue-command - process - (make-haskell-command - :state (list :session session - :process process - :buffer (current-buffer)) - :go (lambda (state) - (haskell-process-send-string (plist-get state ':process) - ":l DevelMain")) - :live (lambda (state buffer) - (haskell-process-live-build (plist-get state ':process) - buffer - nil)) - :complete (lambda (state response) - (haskell-process-load-complete - (plist-get state ':session) - (plist-get state ':process) - response - nil - (plist-get state ':buffer) - (lambda (ok) - (when ok - (haskell-process-queue-without-filters - (haskell-interactive-process) - "DevelMain.update") - (message "DevelMain updated.")))))))))) - (haskell-mode-toggle-interactive-prompt-state t))) - -(provide 'haskell-load) -;;; haskell-load.el ends here diff --git a/haskell-menu.el b/haskell-menu.el deleted file mode 100644 index 7e1f1b0b7..000000000 --- a/haskell-menu.el +++ /dev/null @@ -1,162 +0,0 @@ -;;; haskell-menu.el --- A Haskell sessions menu -*- lexical-binding: t -*- - -;; Copyright (C) 2013 Chris Done - -;; Author: Chris Done - -;; This file is not part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Todo: - -;;; Code: - -(require 'cl-lib) -(require 'haskell-compat) -(require 'haskell-session) -(require 'haskell-process) -(require 'haskell-interactive-mode) - -(defcustom haskell-menu-buffer-name "*haskell-menu*" - "The name of the Haskell session menu buffer" - :group 'haskell-interactive - :type 'string) - -;;;###autoload -(defun haskell-menu () - "Launch the Haskell sessions menu." - (interactive) - (or (get-buffer haskell-menu-buffer-name) - (with-current-buffer (get-buffer-create haskell-menu-buffer-name) - (haskell-menu-mode))) - (switch-to-buffer-other-window (get-buffer haskell-menu-buffer-name)) - (haskell-menu-revert-function nil nil)) - -(defvar haskell-menu-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "n") 'next-line) - (define-key map (kbd "p") 'previous-line) - (define-key map (kbd "RET") 'haskell-menu-mode-ret) - map) - "Keymap for `haskell-menu-mode'.") - -(define-derived-mode haskell-menu-mode special-mode "Haskell Session Menu" - "Major mode for managing Haskell sessions. -Each line describes one session. -Letters do not insert themselves; instead, they are commands." - (setq buffer-read-only t) - (setq-local revert-buffer-function 'haskell-menu-revert-function) - (setq truncate-lines t) - (haskell-menu-revert-function nil t)) - -(suppress-keymap haskell-menu-mode-map t) - -(defun haskell-menu-revert-function (_arg1 _arg2) - "Function to refresh the display." - (let ((buffer-read-only nil) - (orig-line (line-number-at-pos)) - (orig-col (current-column))) - (or (eq buffer-undo-list t) - (setq buffer-undo-list nil)) - (erase-buffer) - (haskell-menu-insert-menu) - (goto-char (point-min)) - (forward-line (1- orig-line)) - (forward-char orig-col))) - -(defun haskell-menu-insert-menu () - "Insert the Haskell sessions menu to the current buffer." - (if (null haskell-sessions) - (insert "No Haskell sessions.") - (haskell-menu-tabulate - (list "Name" "PID" "Time" "RSS" "Cabal directory" "Working directory" "Command") - (mapcar (lambda (session) - (let ((process (haskell-process-process (haskell-session-process session)))) - (cond - (process - (let ((id (process-id process))) - (list (propertize (haskell-session-name session) 'face 'buffer-menu-buffer) - (if (process-live-p process) (number-to-string id) "-") - (if (process-live-p process) - (format-time-string "%H:%M:%S" - (encode-time (cl-caddr (assoc 'etime (process-attributes id))) - 0 0 0 0 0)) - "-") - (if (process-live-p process) - (concat (number-to-string (/ (cdr (assoc 'rss (process-attributes id))) - 1024)) - "MB") - "-") - (haskell-session-cabal-dir session) - (haskell-session-current-dir session) - (mapconcat 'identity (process-command process) " ")))) - (t (list (propertize (haskell-session-name session) 'face 'buffer-menu-buffer) - "—" - "—" - "—" - (haskell-session-cabal-dir session) - (haskell-session-current-dir session)))))) - haskell-sessions)))) - -(defun haskell-menu-tabulate (headings rows) - "Prints a list of lists as a formatted table to the current buffer." - (let* ((columns (length headings)) - (widths (make-list columns 0))) - ;; Calculate column widths. This is kind of hideous. - (dolist (row rows) - (setq widths - (let ((list (list))) - (dotimes (i columns) - (setq list (cons (max (nth i widths) - (1+ (length (nth i row))) - (1+ (length (nth i headings)))) - list))) - (reverse list)))) - ;; Print headings. - (let ((heading (propertize " " 'display '(space :align-to 0)))) - (dotimes (i columns) - (setq heading (concat heading - (format (concat "%-" (number-to-string (nth i widths)) "s") - (nth i headings))))) - (setq header-line-format heading)) - ;; Print tabulated rows. - (dolist (row rows) - (dotimes (i columns) - (insert (format (concat "%-" (number-to-string (nth i widths)) "s") - (nth i row)))) - (insert "\n")))) - -(defun haskell-menu-mode-ret () - "Handle RET key." - (interactive) - (let* ((name (save-excursion - (goto-char (line-beginning-position)) - (buffer-substring-no-properties (point) - (progn (search-forward " ") - (forward-char -1) - (point))))) - (session (car (cl-remove-if-not (lambda (session) - (string= (haskell-session-name session) - name)) - haskell-sessions)))) - (switch-to-buffer (haskell-session-interactive-buffer session)))) - -(provide 'haskell-menu) - -;;; haskell-menu.el ends here diff --git a/haskell-modules.el b/haskell-modules.el deleted file mode 100644 index cb4e841d6..000000000 --- a/haskell-modules.el +++ /dev/null @@ -1,117 +0,0 @@ -;;; haskell-modules.el --- -*- lexical-binding: t -*- - -;; Copyright (c) 2014 Chris Done. All rights reserved. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'haskell-sort-imports) -(require 'haskell-align-imports) -(require 'haskell-session) -(require 'haskell-navigate-imports) -(require 'haskell-complete-module) -(require 'haskell-sandbox) -(require 'haskell-customize) - -(defun haskell-add-import (&optional module) - "Add an import to the import list. Sorts and aligns imports, -unless `haskell-stylish-on-save' is set, in which case we defer -to stylish-haskell." - (interactive) - (save-excursion - (goto-char (point-max)) - (haskell-navigate-imports) - (insert (haskell-import-for-module - (or module - (haskell-complete-module-read - "Module: " - (haskell-session-all-modules (haskell-modules-session)))))) - (unless haskell-stylish-on-save (haskell-sort-imports) - (haskell-align-imports)))) - -(defun haskell-import-for-module (module) - "Get import statements for the given module." - (let ((mapping (assoc module haskell-import-mapping))) - (if mapping - (cdr mapping) - (concat (read-from-minibuffer "Import line: " - (format "import %s" module)) - "\n")))) - -;;;###autoload -(defun haskell-session-installed-modules (_session &optional _dontcreate) - "Get the modules installed in the current package set." - ;; TODO: Again, this makes HEAVY use of unix utilities. It'll work - ;; fine in Linux, probably okay on OS X, and probably not at all on - ;; Windows. Again, if someone wants to test on Windows and come up - ;; with alternatives that's OK. - ;; - ;; Ideally all these package queries can be provided by a Haskell - ;; program based on the Cabal API. Possibly as a nice service. Such - ;; a service could cache and do nice things like that. For now, this - ;; simple shell script takes us far. - ;; - ;; Probably also we can take the code from inferior-haskell-mode. - ;; - ;; Ugliness aside, if it saves us time to type it's a winner. - ;; - ;; FIXME/TODO: add support for (eq 'cabal-repl (haskell-process-type)) - (let ((session (haskell-session-maybe))) - (when session - (let ((modules (shell-command-to-string - (format "%s 2> /dev/null | %s | %s" - (cond - ((haskell-sandbox-exists-p session) - (concat "ghc-pkg dump -f " - (shell-quote-argument (haskell-sandbox-pkgdb session)))) - (t "ghc-pkg dump")) - "egrep '^(exposed-modules: | )[A-Z]'" - "cut -c18-")))) - (split-string modules))))) - -;;;###autoload -(defun haskell-session-all-modules (session &optional dontcreate) - "Get all modules -- installed or in the current project. -If DONTCREATE is non-nil don't create a new session." - (append (haskell-session-installed-modules session dontcreate) - (haskell-session-project-modules session dontcreate))) - -;;;###autoload -(defun haskell-session-project-modules (session &optional dontcreate) - "Get the modules of the current project. -If DONTCREATE is non-nil don't create a new session." - (if (or (not dontcreate) (haskell-session-maybe)) - (let* ((modules - (shell-command-to-string - (format "%s && %s" - (format "cd %s" (haskell-session-cabal-dir session)) - ;; TODO: Use a different, better source. Possibly hasktags or some such. - ;; TODO: At least make it cross-platform. Linux - ;; (and possibly OS X) have egrep, Windows - ;; doesn't -- or does it via Cygwin or MinGW? - ;; This also doesn't handle module\nName. But those gits can just cut it out! - "egrep '^module[\t\r ]+[^(\t\r ]+' . -r -I --include='*.*hs' --include='*.hsc' -s -o -h | sed 's/^module[\t\r ]*//' | sort | uniq")))) - (split-string modules)))) - -(defun haskell-modules-session () - "Get the `haskell-session', throw an error if it's not - available." - (or (haskell-session-maybe) - (haskell-session-assign - (or (haskell-session-from-buffer) - (haskell-session-choose) - (error "No session associated with this buffer. Try M-x haskell-session-change or report this as a bug."))))) - -(provide 'haskell-modules) diff --git a/haskell-presentation-mode.el b/haskell-presentation-mode.el deleted file mode 100644 index c1d3fad72..000000000 --- a/haskell-presentation-mode.el +++ /dev/null @@ -1,104 +0,0 @@ -;;; haskell-presentation-mode.el --- Presenting Haskell things -*- lexical-binding: t -*- - -;; Copyright (C) 2013 Chris Done - -;; Author: Chris Done - -;; This file is not part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'haskell-mode) -(require 'haskell-session) - -(defvar haskell-presentation-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "q") 'quit-window) - (define-key map (kbd "c") 'haskell-presentation-clear) - map) - "Keymap for `haskell-presentation-mode'.") - -(define-derived-mode haskell-presentation-mode - haskell-mode "Presentation" - "Major mode for viewing Haskell snippets. - \\{hypertext-mode-map}" - (setq case-fold-search nil)) - -(defconst haskell-presentation-buffer-name - "*Haskell Presentation*" - "Haskell Presentation buffer name.") - -(defconst haskell-presentation-hint-message - "-- Hit `q' to close this window; `c' to clear.\n\n" - "Hint message appered in Haskell Presentation buffer.") - -(defun haskell-presentation-buffer () - "Return Haskell Presentaion buffer. -Return current presenation buffer or create new one if absent. -Never returns nil." - ;; TODO Provide interactive calling options: when called interactively make - ;; the presentation buffer current. - (let ((may-buffer (get-buffer haskell-presentation-buffer-name))) - (if may-buffer - may-buffer - (let ((buffer (generate-new-buffer haskell-presentation-buffer-name))) - (with-current-buffer buffer - (insert haskell-presentation-hint-message) - (haskell-presentation-mode) - (setq buffer-read-only t)) - buffer)))) - -(defun haskell-presentation-clear () - "Clear Haskell Presentation buffer." - (interactive) - (let ((hp-buf (get-buffer haskell-presentation-buffer-name))) - (when hp-buf - (with-current-buffer hp-buf - (let ((buffer-read-only nil)) - (erase-buffer) - (insert haskell-presentation-hint-message)))))) - -(defun haskell-presentation-present (session code &optional clear) - "Present given code in a popup buffer. -Creates temporal Haskell Presentation buffer and assigns it to -given haskell SESSION; presented CODE will be fontified as -haskell code. Give an optional non-nil CLEAR arg to clear the -buffer before presenting message." - (let ((buffer (haskell-presentation-buffer))) - (with-current-buffer buffer - - (when (boundp 'shm-display-quarantine) - (setq-local shm-display-quarantine nil)) - - (when clear (haskell-presentation-clear)) - (haskell-session-assign session) - (goto-char (point-min)) - (forward-line 2) - (save-excursion - (let ((buffer-read-only nil)) - (insert code "\n\n")))) - - (if (eq major-mode 'haskell-presentation-mode) - (switch-to-buffer buffer) - (pop-to-buffer buffer)))) - -(provide 'haskell-presentation-mode) - -;;; haskell-presentation-mode.el ends here diff --git a/haskell-process.el b/haskell-process.el deleted file mode 100644 index 6e922c61c..000000000 --- a/haskell-process.el +++ /dev/null @@ -1,510 +0,0 @@ -;;; haskell-process.el --- Communicating with the inferior Haskell process -*- lexical-binding: t -*- - -;; Copyright (C) 2011 Chris Done - -;; Author: Chris Done - -;; This file is not part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Code: - -(require 'cl-lib) -(require 'json) -(require 'url-util) -(require 'haskell-compat) -(require 'haskell-session) -(require 'haskell-customize) -(require 'haskell-string) - -(defconst haskell-process-prompt-regex "\4" - "Used for delimiting command replies. 4 is End of Transmission.") - -(defvar haskell-reload-p nil - "Used internally for `haskell-process-loadish'.") - -(defconst haskell-process-greetings - (list "Hello, Haskell!" - "The lambdas must flow." - "Hours of hacking await!" - "The next big Haskell project is about to start!" - "Your wish is my IO ().") - "Greetings for when the Haskell process starts up.") - -(defconst haskell-process-logo - (expand-file-name "logo.svg" haskell-mode-pkg-base-dir) - "Haskell logo for notifications.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Accessing commands -- using cl 'defstruct' - -(cl-defstruct haskell-command - "Data structure representing a command to be executed when with - a custom state and three callback." - ;; hold the custom command state - ;; state :: a - state - ;; called when to execute a command - ;; go :: a -> () - go - ;; called whenever output was collected from the haskell process - ;; live :: a -> Response -> Bool - live - ;; called when the output from the haskell process indicates that the command - ;; is complete - ;; complete :: a -> Response -> () - complete) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Building the process - -(defun haskell-process-compute-process-log-and-command (session hptype) - "Compute the log and process to start command for the SESSION from the HPTYPE. -Do not actually start any process. -HPTYPE is the result of calling `'haskell-process-type`' function." - (let ((session-name (haskell-session-name session))) - (cl-ecase hptype - ('ghci - (append (list (format "Starting inferior GHCi process %s ..." - haskell-process-path-ghci) - session-name - nil) - (apply haskell-process-wrapper-function - (list - (append (haskell-process-path-to-list haskell-process-path-ghci) - haskell-process-args-ghci))))) - ('cabal-new-repl - (append (list (format "Starting inferior `cabal new-repl' process using %s ..." - haskell-process-path-cabal) - session-name - nil) - (apply haskell-process-wrapper-function - (list - (append - (haskell-process-path-to-list haskell-process-path-cabal) - (list "new-repl") - haskell-process-args-cabal-new-repl - (let ((target (haskell-session-target session))) - (if target (list target) nil))))))) - ('cabal-repl - (append (list (format "Starting inferior `cabal repl' process using %s ..." - haskell-process-path-cabal) - session-name - nil) - (apply haskell-process-wrapper-function - (list - (append - (haskell-process-path-to-list haskell-process-path-cabal) - (list "repl") - haskell-process-args-cabal-repl - (let ((target (haskell-session-target session))) - (if target (list target) nil))))))) - ('stack-ghci - (append (list (format "Starting inferior stack GHCi process using %s" haskell-process-path-stack) - session-name - nil) - (apply haskell-process-wrapper-function - (list - (append - (haskell-process-path-to-list haskell-process-path-stack) - (list "ghci") - (let ((target (haskell-session-target session))) - (if target (list target) nil)) - haskell-process-args-stack-ghci)))))))) - -(defun haskell-process-path-to-list (path) - "Convert a path (which may be a string or a list) to a list." - (if (stringp path) - (list path) - path)) - -(defun haskell-process-make (name) - "Make an inferior Haskell process." - (list (cons 'name name))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Process communication - -(defun haskell-process-sentinel (proc event) - "The sentinel for the process pipe." - (let ((session (haskell-process-project-by-proc proc))) - (when session - (let* ((process (haskell-session-process session))) - (unless (haskell-process-restarting process) - (haskell-process-log - (propertize (format "Event: %S\n" event) - 'face '((:weight bold)))) - (haskell-process-log - (propertize "Process reset.\n" - 'face 'font-lock-comment-face)) - (run-hook-with-args 'haskell-process-ended-functions process)))))) - -(defun haskell-process-filter (proc response) - "The filter for the process pipe." - (let ((i 0)) - (cl-loop for line in (split-string response "\n") - do (haskell-process-log - (concat (if (= i 0) - (propertize "<- " 'face 'font-lock-comment-face) - " ") - (propertize line 'face 'haskell-interactive-face-compile-warning))) - do (setq i (1+ i)))) - (let ((session (haskell-process-project-by-proc proc))) - (when session - (if (haskell-process-cmd (haskell-session-process session)) - (haskell-process-collect session - response - (haskell-session-process session)))))) - -(defun haskell-process-log (msg) - "Effective append MSG to the process log (if enabled)." - (when haskell-process-log - (let* ((append-to (get-buffer-create "*haskell-process-log*"))) - (with-current-buffer append-to - ;; point should follow insertion so that it stays at the end - ;; of the buffer - (setq-local window-point-insertion-type t) - (let ((buffer-read-only nil)) - (insert msg "\n")))))) - -(defun haskell-process-project-by-proc (proc) - "Find project by process." - (cl-find-if (lambda (project) - (string= (haskell-session-name project) - (process-name proc))) - haskell-sessions)) - -(defun haskell-process-collect (_session response process) - "Collect input for the response until receives a prompt." - (haskell-process-set-response process - (concat (haskell-process-response process) response)) - (while (haskell-process-live-updates process)) - (when (string-match haskell-process-prompt-regex - (haskell-process-response process)) - (haskell-command-exec-complete - (haskell-process-cmd process) - (replace-regexp-in-string - haskell-process-prompt-regex - "" - (haskell-process-response process))) - (haskell-process-reset process) - (haskell-process-trigger-queue process))) - -(defun haskell-process-reset (process) - "Reset the process's state, ready for the next send/reply." - (progn (haskell-process-set-response-cursor process 0) - (haskell-process-set-response process "") - (haskell-process-set-cmd process nil))) - -(defun haskell-process-consume (process regex) - "Consume a regex from the response and move the cursor along if succeed." - (when (string-match regex - (haskell-process-response process) - (haskell-process-response-cursor process)) - (haskell-process-set-response-cursor process (match-end 0)) - t)) - -(defun haskell-process-send-string (process string) - "Try to send a string to the process's process. Ask to restart if it's not running." - (let ((child (haskell-process-process process))) - (if (equal 'run (process-status child)) - (let ((out (concat string "\n"))) - (let ((i 0)) - (cl-loop for line in (split-string out "\n") - do (unless (string-equal "" line) - (haskell-process-log - (concat (if (= i 0) - (propertize "-> " 'face 'font-lock-comment-face) - " ") - (propertize line 'face 'font-lock-string-face)))) - do (setq i (1+ i)))) - (process-send-string child out)) - (unless (haskell-process-restarting process) - (run-hook-with-args 'haskell-process-ended-functions process))))) - -(defun haskell-process-live-updates (process) - "Process live updates." - (haskell-command-exec-live (haskell-process-cmd process) - (haskell-process-response process))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Making commands - -(defun haskell-process-queue-without-filters (process line) - "Queue LINE to be sent to PROCESS without bothering to look at -the response." - (haskell-process-queue-command - process - (make-haskell-command - :state (cons process line) - :go (lambda (state) - (haskell-process-send-string (car state) - (cdr state)))))) - - -(defun haskell-process-queue-command (process command) - "Add a command to the process command queue." - (haskell-process-cmd-queue-add process command) - (haskell-process-trigger-queue process)) - -(defun haskell-process-trigger-queue (process) - "Trigger the next command in the queue to be ran if there is no current command." - (if (and (haskell-process-process process) - (process-live-p (haskell-process-process process))) - (unless (haskell-process-cmd process) - (let ((cmd (haskell-process-cmd-queue-pop process))) - (when cmd - (haskell-process-set-cmd process cmd) - (haskell-command-exec-go cmd)))) - (progn (haskell-process-reset process) - (haskell-process-set process 'command-queue nil) - (run-hook-with-args 'haskell-process-ended-functions process)))) - -(defun haskell-process-queue-flushed-p (process) - "Return t if command queue has been completely processed." - (not (or (haskell-process-cmd-queue process) - (haskell-process-cmd process)))) - -(defun haskell-process-queue-flush (process) - "Block till PROCESS' command queue has been completely processed. -This uses `accept-process-output' internally." - (while (not (haskell-process-queue-flushed-p process)) - (haskell-process-trigger-queue process) - (accept-process-output (haskell-process-process process) 1))) - -(defun haskell-process-queue-sync-request (process reqstr) - "Queue submitting REQSTR to PROCESS and return response blockingly." - (let ((cmd (make-haskell-command - :state (cons nil process) - :go `(lambda (s) (haskell-process-send-string (cdr s) ,reqstr)) - :complete 'setcar))) - (haskell-process-queue-command process cmd) - (haskell-process-queue-flush process) - (car-safe (haskell-command-state cmd)))) - -(defun haskell-process-get-repl-completions (process inputstr &optional limit) - "Query PROCESS with `:complete repl ...' for INPUTSTR. -Give optional LIMIT arg to limit completion candidates count, -zero, negative values, and nil means all possible completions. -Returns NIL when no completions found." - (let* ((mlimit (if (and limit (> limit 0)) - (concat " " (number-to-string limit) " ") - " ")) - (reqstr (concat ":complete repl" - mlimit - (haskell-string-literal-encode inputstr))) - (rawstr (haskell-process-queue-sync-request process reqstr)) - (response-status (haskell-utils-repl-response-error-status rawstr))) - (if (eq 'unknown-command response-status) - (error - "GHCi lacks `:complete' support (try installing GHC 7.8+ or ghci-ng)") - (when rawstr - ;; parse REPL response if any - (let* ((s1 (split-string rawstr "\r?\n" t)) - (cs (mapcar #'haskell-string-literal-decode (cdr s1))) - (h0 (car s1))) ;; " " - (unless (string-match - "\\`\\([0-9]+\\) \\([0-9]+\\) \\(\".*\"\\)\\'" - h0) - (error "Invalid `:complete' response")) - (let ((cnt1 (match-string 1 h0)) - (h1 (haskell-string-literal-decode (match-string 3 h0)))) - (unless (= (string-to-number cnt1) (length cs)) - (error "Lengths inconsistent in `:complete' reponse")) - (cons h1 cs))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Accessing the process - -(defun haskell-process-get (process key) - "Get the PROCESS's KEY value. -Returns nil if KEY not set." - (cdr (assq key process))) - -(defun haskell-process-set (process key value) - "Set the PROCESS's KEY to VALUE. -Returns newly set VALUE." - (if process - (let ((cell (assq key process))) - (if cell - (setcdr cell value) ; modify cell in-place - (setcdr process (cons (cons key value) (cdr process))) ; new cell - value)) - (display-warning 'haskell-interactive - "`haskell-process-set' called with nil process"))) - -;; Wrappers using haskell-process-{get,set} - -(defun haskell-process-set-sent-stdin (p v) - "We've sent stdin, so let's not clear the output at the end." - (haskell-process-set p 'sent-stdin v)) - -(defun haskell-process-sent-stdin-p (p) - "Did we send any stdin to the process during evaluation?" - (haskell-process-get p 'sent-stdin)) - -(defun haskell-process-set-suggested-imports (p v) - "Remember what imports have been suggested, to avoid -re-asking about the same imports." - (haskell-process-set p 'suggested-imported v)) - -(defun haskell-process-suggested-imports (p) - "Get what modules have already been suggested and accepted." - (haskell-process-get p 'suggested-imported)) - -(defun haskell-process-set-evaluating (p v) - "Set status of evaluating to be on/off." - (haskell-process-set p 'evaluating v)) - -(defun haskell-process-evaluating-p (p) - "Get status of evaluating (on/off)." - (haskell-process-get p 'evaluating)) - -(defun haskell-process-set-process (p v) - "Set the process's inferior process." - (haskell-process-set p 'inferior-process v)) - -(defun haskell-process-process (p) - "Get the process child." - (haskell-process-get p 'inferior-process)) - -(defun haskell-process-name (p) - "Get the process name." - (haskell-process-get p 'name)) - -(defun haskell-process-cmd (p) - "Get the process's current command. -Return nil if no current command." - (haskell-process-get p 'current-command)) - -(defun haskell-process-set-cmd (p v) - "Set the process's current command." - (haskell-process-set-evaluating p nil) - (haskell-process-set-sent-stdin p nil) - (haskell-process-set-suggested-imports p nil) - (haskell-process-set p 'current-command v)) - -(defun haskell-process-response (p) - "Get the process's current response." - (haskell-process-get p 'current-response)) - -(defun haskell-process-session (p) - "Get the process's current session." - (haskell-process-get p 'session)) - -(defun haskell-process-set-response (p v) - "Set the process's current response." - (haskell-process-set p 'current-response v)) - -(defun haskell-process-set-session (p v) - "Set the process's current session." - (haskell-process-set p 'session v)) - -(defun haskell-process-response-cursor (p) - "Get the process's current response cursor." - (haskell-process-get p 'current-response-cursor)) - -(defun haskell-process-set-response-cursor (p v) - "Set the process's response cursor." - (haskell-process-set p 'current-response-cursor v)) - -;; low-level command queue operations - -(defun haskell-process-restarting (process) - "Is the PROCESS restarting?" - (haskell-process-get process 'is-restarting)) - -(defun haskell-process-cmd-queue (process) - "Get the PROCESS' command queue. -New entries get added to the end of the list. Use -`haskell-process-cmd-queue-add' and -`haskell-process-cmd-queue-pop' to modify the command queue." - (haskell-process-get process 'command-queue)) - -(defun haskell-process-cmd-queue-add (process cmd) - "Add CMD to end of PROCESS's command queue." - (cl-check-type cmd haskell-command) - (haskell-process-set process - 'command-queue - (append (haskell-process-cmd-queue process) - (list cmd)))) - -(defun haskell-process-cmd-queue-pop (process) - "Pop the PROCESS' next entry from command queue. -Returns nil if queue is empty." - (let ((queue (haskell-process-cmd-queue process))) - (when queue - (haskell-process-set process 'command-queue (cdr queue)) - (car queue)))) - - -(defun haskell-process-unignore-file (session file) - " - -Note to Windows Emacs hackers: - -chmod is how to change the mode of files in POSIX -systems. This will not work on your operating -system. - -There is a command a bit like chmod called \"Calcs\" -that you can try using here: - -http://technet.microsoft.com/en-us/library/bb490872.aspx - -If it works, you can submit a patch to this -function and remove this comment. -" - (shell-command (read-from-minibuffer "Permissions command: " - (concat "chmod 700 " - file))) - (haskell-session-modify - session - 'ignored-files - (lambda (files) - (cl-remove-if (lambda (path) - (string= path file)) - files)))) - -(defun haskell-command-exec-go (command) - "Call the command's go function." - (let ((go-func (haskell-command-go command))) - (when go-func - (funcall go-func (haskell-command-state command))))) - -(defun haskell-command-exec-complete (command response) - "Call the command's complete function." - (let ((comp-func (haskell-command-complete command))) - (when comp-func - (condition-case-unless-debug e - (funcall comp-func - (haskell-command-state command) - response) - (quit (message "Quit")) - (error (message "Haskell process command errored with: %S" e)))))) - -(defun haskell-command-exec-live (command response) - "Trigger the command's live updates callback." - (let ((live-func (haskell-command-live command))) - (when live-func - (funcall live-func - (haskell-command-state command) - response)))) - -(provide 'haskell-process) - -;;; haskell-process.el ends here diff --git a/haskell-repl.el b/haskell-repl.el deleted file mode 100644 index fe811ee1d..000000000 --- a/haskell-repl.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; haskell-repl.el --- REPL evaluation -*- lexical-binding: t -*- - -;; Copyright (c) 2014 Chris Done. All rights reserved. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'haskell-interactive-mode) -(require 'haskell-collapse) - -(defun haskell-interactive-handle-expr () - "Handle an inputted expression at the REPL." - (let ((expr (haskell-interactive-mode-input))) - (if (string= "" (replace-regexp-in-string " " "" expr)) - ;; Just make a new prompt on space-only input - (progn - (goto-char (point-max)) - (insert "\n") - (haskell-interactive-mode-prompt)) - (when (haskell-interactive-at-prompt) - (cond - ;; If already evaluating, then the user is trying to send - ;; input to the REPL during evaluation. Most likely in - ;; response to a getLine-like function. - ((and (haskell-process-evaluating-p (haskell-interactive-process)) - (= (line-end-position) (point-max))) - (goto-char (point-max)) - (let ((process (haskell-interactive-process)) - (string (buffer-substring-no-properties - haskell-interactive-mode-result-end - (point)))) - ;; here we need to go to end of line again as evil-mode - ;; might have managed to put us one char back - (goto-char (point-max)) - (insert "\n") - ;; Bring the marker forward - (setq haskell-interactive-mode-result-end - (point-max)) - (haskell-process-set-sent-stdin process t) - (haskell-process-send-string process string))) - ;; Otherwise we start a normal evaluation call. - (t (setq haskell-interactive-mode-old-prompt-start - (copy-marker haskell-interactive-mode-prompt-start)) - (set-marker haskell-interactive-mode-prompt-start (point-max)) - (haskell-interactive-mode-history-add expr) - (haskell-interactive-mode-do-expr expr))))))) - -(defun haskell-interactive-mode-do-expr (expr) - (cond - ((string-match "^:present " expr) - (haskell-interactive-mode-do-presentation (replace-regexp-in-string "^:present " "" expr))) - (t - (haskell-interactive-mode-run-expr expr)))) - -(defun haskell-interactive-mode-run-expr (expr) - "Run the given expression." - (let ((session (haskell-interactive-session)) - (process (haskell-interactive-process))) - (haskell-process-queue-command - process - (make-haskell-command - :state (list session process expr 0) - :go (lambda (state) - (goto-char (point-max)) - (insert "\n") - (setq haskell-interactive-mode-result-end - (point-max)) - (haskell-process-send-string (cadr state) - (haskell-interactive-mode-multi-line (cl-caddr state))) - (haskell-process-set-evaluating (cadr state) t)) - :live (lambda (state buffer) - (unless (and (string-prefix-p ":q" (cl-caddr state)) - (string-prefix-p (cl-caddr state) ":quit")) - (let* ((cursor (cl-cadddr state)) - (next (replace-regexp-in-string - haskell-process-prompt-regex - "" - (substring buffer cursor)))) - (haskell-interactive-mode-eval-result (car state) next) - (setf (cl-cdddr state) (list (length buffer))) - nil))) - :complete - (lambda (state response) - (haskell-process-set-evaluating (cadr state) nil) - (unless (haskell-interactive-mode-trigger-compile-error state response) - (haskell-interactive-mode-expr-result state response))))))) - -(defun haskell-interactive-mode-expr-result (state response) - "Print the result of evaluating the expression." - (let ((response - (with-temp-buffer - (insert response) - (haskell-interactive-mode-handle-h) - (buffer-string)))) - (when haskell-interactive-mode-eval-mode - (unless (haskell-process-sent-stdin-p (cadr state)) - (haskell-interactive-mode-eval-as-mode (car state) response)))) - (haskell-interactive-mode-prompt (car state))) - -(defun haskell-interactive-mode-eval-as-mode (session text) - "Insert TEXT font-locked according to `haskell-interactive-mode-eval-mode'." - (with-current-buffer (haskell-session-interactive-buffer session) - (let ((inhibit-read-only t)) - (delete-region (1+ haskell-interactive-mode-prompt-start) (point)) - (goto-char (point-max)) - (insert (haskell-fontify-as-mode text - haskell-interactive-mode-eval-mode)) - (when haskell-interactive-mode-collapse - (haskell-hide-toggle))))) - -(provide 'haskell-repl) diff --git a/haskell-sandbox.el b/haskell-sandbox.el deleted file mode 100644 index ba605fd66..000000000 --- a/haskell-sandbox.el +++ /dev/null @@ -1,41 +0,0 @@ -;;; haskell-sandbox.el --- Support for sandboxes -*- lexical-binding: t -*- - -;; Copyright (c) 2014 Chris Done. All rights reserved. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'haskell-session) - -(defun haskell-sandbox-path (session) - "If there is a haskell-session, return the path to the usual sandbox location." - (concat (haskell-session-cabal-dir session) - "/.cabal-sandbox")) - -(defun haskell-sandbox-exists-p (session) - "Is there a cabal sandbox?" - (file-exists-p (haskell-sandbox-path session))) - -(defun haskell-sandbox-pkgdb (session) - "Get the package database of the sandbox." - (let* ((files (directory-files (haskell-sandbox-path session))) - (dir (car (cl-remove-if-not (lambda (file) - (string-match ".conf.d$" file)) - files)))) - (when dir - (concat (haskell-sandbox-path session) "/" dir)))) - -(provide 'haskell-sandbox) diff --git a/haskell-session.el b/haskell-session.el deleted file mode 100644 index 2c5344d13..000000000 --- a/haskell-session.el +++ /dev/null @@ -1,227 +0,0 @@ -;;; haskell-session.el --- Haskell sessions -*- lexical-binding: t -*- - -;; Copyright (C) 2011-2012 Chris Done - -;; Author: Chris Done - -;; This file is not part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Todo: - -;;; Code: - -(require 'cl-lib) -(require 'haskell-cabal) -(require 'haskell-customize) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Globals - -;; Used internally -(defvar-local haskell-session nil) - -(defvar haskell-sessions (list) - "All Haskell sessions in the Emacs session.") - -(defun haskell-session-tags-filename (session) - "Get the filename for the TAGS file." - (concat (haskell-session-cabal-dir session) "/TAGS")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Finding/clearing the session - -;;;###autoload -(defun haskell-session-maybe () - "Maybe get the Haskell session, return nil if there isn't one." - (if (default-boundp 'haskell-session) - haskell-session - (setq haskell-session nil))) - -(defun haskell-session-from-buffer () - "Get the session based on the buffer." - (when (and (buffer-file-name) - (consp haskell-sessions)) - (cl-reduce (lambda (acc a) - (let ((dir (haskell-session-get a 'cabal-dir))) - (if dir - (if (string-prefix-p dir - (file-name-directory (buffer-file-name))) - (if acc - (if (and - (> (length (haskell-session-get a 'cabal-dir)) - (length (haskell-session-get acc 'cabal-dir)))) - a - acc) - a) - acc) - acc))) - haskell-sessions - :initial-value nil))) - -(defun haskell-session-default-name () - "Generate a default project name for the new project prompt." - (let ((file (haskell-cabal-find-file))) - (or (when file - (downcase (file-name-sans-extension - (file-name-nondirectory file)))) - "haskell"))) - -(defun haskell-session-assign (session) - "Assing current buffer to SESSION. - -This could be helpful for temporary or auxiliary buffers such as -presentation mode buffers (e.g. in case when session is killed -with all relevant buffers)." - (setq-local haskell-session session)) - -(defun haskell-session-choose () - "Find a session by choosing from a list of the current sessions." - (when haskell-sessions - (let* ((session-name (funcall haskell-completing-read-function - "Choose Haskell session: " - (cl-remove-if (lambda (name) - (and haskell-session - (string= (haskell-session-name haskell-session) - name))) - (mapcar 'haskell-session-name haskell-sessions)))) - (session (cl-find-if (lambda (session) - (string= (haskell-session-name session) - session-name)) - haskell-sessions))) - session))) - -(defun haskell-session-clear () - "Clear the buffer of any Haskell session choice." - (setq-local haskell-session nil)) - -(defun haskell-session-lookup (name) - "Get the session by name." - (cl-remove-if-not (lambda (s) - (string= name (haskell-session-name s))) - haskell-sessions)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Session modules - -(defun haskell-session-strip-dir (session file) - "Strip the load dir from the file path." - (let ((cur-dir (haskell-session-current-dir session))) - (if (> (length file) (length cur-dir)) - (if (string= (substring file 0 (length cur-dir)) - cur-dir) - (replace-regexp-in-string - "^[/\\]" "" - (substring file - (length cur-dir))) - file) - file))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Accessing the session - -(defun haskell-session-current-dir (s) - "Get the session current directory." - (let ((dir (haskell-session-get s 'current-dir))) - (or dir - (error "No current directory.")))) - -(defun haskell-session-name (s) - "Get the session name." - (haskell-session-get s 'name)) - -(defun haskell-session-target (s) - "Get the session build target. -If `haskell-process-load-or-reload-prompt' is nil, accept `default'." - (let* ((maybe-target (haskell-session-get s 'target)) - (target (if maybe-target maybe-target - (let ((new-target - (if haskell-process-load-or-reload-prompt - (read-string "build target (empty for default):") - ""))) - (haskell-session-set-target s new-target))))) - (if (not (string= target "")) target nil))) - -(defun haskell-session-set-target (s target) - "Set the session build target." - (haskell-session-set s 'target target)) - -(defun haskell-session-set-interactive-buffer (s v) - "Set the session interactive buffer." - (haskell-session-set s 'interactive-buffer v)) - -(defun haskell-session-set-process (s v) - "Set the session process." - (haskell-session-set s 'process v)) - -;;;###autoload -(defun haskell-session-process (s) - "Get the session process." - (haskell-session-get s 'process)) - -(defun haskell-session-set-cabal-dir (s v) - "Set the session cabal-dir." - (let ((true-path (file-truename v))) - (haskell-session-set s 'cabal-dir true-path) - (haskell-session-set-cabal-checksum s true-path))) - -(defun haskell-session-set-current-dir (s v) - "Set the session current directory." - (let ((true-path (file-truename v))) - (haskell-session-set s 'current-dir true-path))) - -(defun haskell-session-set-cabal-checksum (s cabal-dir) - "Set the session checksum of .cabal files" - (haskell-session-set s 'cabal-checksum - (haskell-cabal-compute-checksum cabal-dir))) - -(defun haskell-session-cabal-dir (s) - "Get the session cabal-dir." - (or (haskell-session-get s 'cabal-dir) - (let ((set-dir (haskell-cabal-get-dir (not haskell-process-load-or-reload-prompt)))) - (if set-dir - (progn (haskell-session-set-cabal-dir s set-dir) - set-dir) - (haskell-session-cabal-dir s))))) - -(defun haskell-session-modify (session key update) - "Update the value at KEY in SESSION with UPDATE." - (haskell-session-set - session - key - (funcall update - (haskell-session-get session key)))) - -(defun haskell-session-get (session key) - "Get the SESSION's KEY value. -Returns nil if KEY not set." - (cdr (assq key session))) - -(defun haskell-session-set (session key value) - "Set the SESSION's KEY to VALUE. -Returns newly set VALUE." - (let ((cell (assq key session))) - (if cell - (setcdr cell value) ; modify cell in-place - (setcdr session (cons (cons key value) (cdr session))) ; new cell - value))) - -(provide 'haskell-session) - -;;; haskell-session.el ends here diff --git a/haskell-utils.el b/haskell-utils.el index 1126a2614..05de2a08c 100644 --- a/haskell-utils.el +++ b/haskell-utils.el @@ -29,7 +29,7 @@ ;; When possible, functions in this module shall be accompanied by ;; ERT-based unit tests. ;; -;; See also `haskell-str.el' for string utility functions. +;; See also `haskell-string.el' for string utility functions. ;; ;; All symbols in this module have a `haskell-utils-' prefix. @@ -113,14 +113,12 @@ characters." (let ((s (replace-regexp-in-string "^\s+" " " str))) (replace-regexp-in-string "\r?\n" "" s))) -(defun haskell-utils-repl-response-error-status (response) +(defun haskell-utils-repl-response-error-p (response) "Parse response REPL's RESPONSE for errors. Returns one of the following symbols: -+ unknown-command -+ option-missing -+ interactive-error -+ no-error +t if no error +nil if error exists *Warning*: this funciton covers only three kind of responses: @@ -129,29 +127,19 @@ Returns one of the following symbols: * \":3:5: …\" interactive REPL error * \"Couldn't guess that module name. Does it exist?\" - (:type-at and maybe some other commands error) -* *all other reposnses* are treated as success reposneses and - 'no-error is returned." + (:type-at and maybe some other commands error)" (if response - (let ((first-line (car (split-string response "\n" t)))) - (cond - ((null first-line) 'no-error) - ((string-match-p "^unknown command" first-line) - 'unknown-command) - ((string-match-p - "^Couldn't guess that module name. Does it exist?" - first-line) - 'option-missing) - ((string-match-p "^:" first-line) - 'interactive-error) - (t 'no-error))) - ;; in case of nil-ish reponse it's not clear is it error response or not - 'no-error)) + (when (or (string-match-p "^unknown command" response) + (string-match-p + "^Couldn't guess that module name. Does it exist?" + response) + (string-match-p "^:" response)) + t))) (defun haskell-utils-compose-type-at-command (pos) "Prepare :type-at command to be send to haskell process. POS is a cons cell containing min and max positions, i.e. target -expression bounds." +expression bounds. Must use `:set +c' in ghci for this to work." (save-excursion (let ((start-p (car pos)) (end-p (cdr pos)) @@ -189,5 +177,12 @@ expression bounds." If given DISABLED argument sets variable value to nil, otherwise to t." (setq haskell-mode-interactive-prompt-state (not disabled))) +(defun haskell-utils-compile-error-p () + "Return t if an error (ghci's) is found in current buffer." + (search-forward-regexp "^\\(\\(?:[A-Z]:\\)?[^ \r\n:][^\r\n:]*\\):\\([0-9()-:]+\\):?" + nil + (lambda () nil) + 1)) + (provide 'haskell-utils) ;;; haskell-utils.el ends here diff --git a/haskell.el b/haskell.el index 513cd9f34..aa3d7b613 100644 --- a/haskell.el +++ b/haskell.el @@ -1,7 +1,8 @@ -;;; haskell.el --- Top-level Haskell package -*- lexical-binding: t -*- +;; haskell.el --- Top-level Haskell package -*- lexical-binding: t -*- ;; Copyright © 2014 Chris Done. All rights reserved. ;; 2016 Arthur Fayzrakhmanov +;; 2017 Vasantha Ganesh Kanniappan ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -21,33 +22,25 @@ ;;; Code: (require 'cl-lib) -(require 'haskell-mode) (require 'haskell-hoogle) -(require 'haskell-process) -(require 'haskell-debug) -(require 'haskell-interactive-mode) -(require 'haskell-repl) -(require 'haskell-load) (require 'haskell-commands) -(require 'haskell-modules) (require 'haskell-string) (require 'haskell-completions) (require 'haskell-utils) (require 'haskell-customize) +(require 'haskell-compile) (defvar interactive-haskell-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-l") 'haskell-process-load-file) - (define-key map (kbd "C-c C-r") 'haskell-process-reload) - (define-key map (kbd "C-c C-t") 'haskell-process-do-type) + (define-key map (kbd "C-c C-r") 'haskell-process-load-file) (define-key map (kbd "C-c C-i") 'haskell-process-do-info) - (define-key map (kbd "M-.") 'haskell-mode-jump-to-def-or-tag) - (define-key map (kbd "C-c C-k") 'haskell-interactive-mode-clear) - (define-key map (kbd "C-c C-c") 'haskell-process-cabal-build) + (define-key map (kbd "M-.") 'haskell-mode-jump-to-def-or-tag) (define-key map (kbd "C-c v c") 'haskell-cabal-visit-file) (define-key map (kbd "C-c C-x") 'haskell-process-cabal) - (define-key map (kbd "C-c C-b") 'haskell-interactive-switch) - (define-key map (kbd "C-c C-z") 'haskell-interactive-switch) + (define-key map (kbd "C-c C-b") 'switch-to-haskell) + (define-key map (kbd "C-c C-z") 'switch-to-haskell) + (define-key map (kbd "C-c C-c") 'haskell-compile) map) "Keymap for using `interactive-haskell-mode'.") @@ -61,274 +54,6 @@ nil t)) -(make-obsolete 'haskell-process-completions-at-point - 'haskell-completions-sync-repl-completion-at-point - "June 19, 2015") - -(defun haskell-process-completions-at-point () - "A `completion-at-point' function using the current haskell process." - (when (haskell-session-maybe) - (let ((process (haskell-process)) - symbol-bounds) - (cond - ;; ghci can complete module names, but it needs the "import " - ;; string at the beginning - ((looking-back (rx line-start - "import" (1+ space) - (? "qualified" (1+ space)) - (group (? (char upper) ; modid - (* (char alnum ?' ?.))))) - (line-beginning-position)) - (let ((text (match-string-no-properties 0)) - (start (match-beginning 1)) - (end (match-end 1))) - (list start end - (haskell-process-get-repl-completions process text)))) - ;; Complete OPTIONS, a completion list comes from variable - ;; `haskell-ghc-supported-options' - ((and (nth 4 (syntax-ppss)) - (save-excursion - (let ((p (point))) - (and (search-backward "{-#" nil t) - (search-forward-regexp "\\_" p t)))) - (looking-back - (rx symbol-start "-" (* (char alnum ?-))) - (line-beginning-position))) - (list (match-beginning 0) (match-end 0) haskell-ghc-supported-options)) - ;; Complete LANGUAGE, a list of completions comes from variable - ;; `haskell-ghc-supported-extensions' - ((and (nth 4 (syntax-ppss)) - (save-excursion - (let ((p (point))) - (and (search-backward "{-#" nil t) - (search-forward-regexp "\\_" p t)))) - (setq symbol-bounds (bounds-of-thing-at-point 'symbol))) - (list (car symbol-bounds) (cdr symbol-bounds) - haskell-ghc-supported-extensions)) - ((setq symbol-bounds (haskell-ident-pos-at-point)) - (cl-destructuring-bind (start . end) symbol-bounds - (list start end - (haskell-process-get-repl-completions - process (buffer-substring-no-properties start end))))))))) - -;;;###autoload -(defun haskell-interactive-mode-return () - "Handle the return key." - (interactive) - (cond - ;; At a compile message, jump to the location of the error in the - ;; source. - ((haskell-interactive-at-compile-message) - (next-error-internal)) - ;; At the input prompt, handle the expression in the usual way. - ((haskell-interactive-at-prompt) - (haskell-interactive-handle-expr)) - ;; At any other location in the buffer, copy the line to the - ;; current prompt. - (t - (haskell-interactive-copy-to-prompt)))) - -;;;###autoload -(defun haskell-session-kill (&optional leave-interactive-buffer) - "Kill the session process and buffer, delete the session. -0. Prompt to kill all associated buffers. -1. Kill the process. -2. Kill the interactive buffer unless LEAVE-INTERACTIVE-BUFFER is not given. -3. Walk through all the related buffers and set their haskell-session to nil. -4. Remove the session from the sessions list." - (interactive) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (let* ((session (haskell-session)) - (name (haskell-session-name session)) - (also-kill-buffers - (and haskell-ask-also-kill-buffers - (y-or-n-p - (format "Killing `%s'. Also kill all associated buffers?" - name))))) - (haskell-kill-session-process session) - (unless leave-interactive-buffer - (kill-buffer (haskell-session-interactive-buffer session))) - (cl-loop for buffer in (buffer-list) - do (with-current-buffer buffer - (when (and (boundp 'haskell-session) - (string= (haskell-session-name haskell-session) - name)) - (setq haskell-session nil) - (when also-kill-buffers - (kill-buffer))))) - (setq haskell-sessions - (cl-remove-if (lambda (session) - (string= (haskell-session-name session) - name)) - haskell-sessions))) - (haskell-mode-toggle-interactive-prompt-state t))) - -;;;###autoload -(defun haskell-interactive-kill () - "Kill the buffer and (maybe) the session." - (interactive) - (when (eq major-mode 'haskell-interactive-mode) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (when (and (boundp 'haskell-session) - haskell-session - (y-or-n-p "Kill the whole session?")) - (haskell-session-kill t))) - (haskell-mode-toggle-interactive-prompt-state t))) - -(defun haskell-session-make (name) - "Make a Haskell session." - (when (haskell-session-lookup name) - (error "Session of name %s already exists!" name)) - (let ((session (setq haskell-session - (list (cons 'name name))))) - (add-to-list 'haskell-sessions session) - (haskell-process-start session) - session)) - -(defun haskell-session-new-assume-from-cabal () - "Prompt to create a new project based on a guess from the nearest Cabal file. -If `haskell-process-load-or-reload-prompt' is nil, accept `default'." - (let ((name (haskell-session-default-name))) - (unless (haskell-session-lookup name) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (if (or (not haskell-process-load-or-reload-prompt) - (y-or-n-p (format "Start a new project named “%s”? " name))) - (haskell-session-make name)) - (haskell-mode-toggle-interactive-prompt-state t))))) - -;;;###autoload -(defun haskell-session () - "Get the Haskell session, prompt if there isn't one or fail." - (or (haskell-session-maybe) - (haskell-session-assign - (or (haskell-session-from-buffer) - (haskell-session-new-assume-from-cabal) - (haskell-session-choose) - (haskell-session-new))))) - -;;;###autoload -(defun haskell-interactive-switch () - "Switch to the interactive mode for this session." - (interactive) - (let ((initial-buffer (current-buffer)) - (buffer (haskell-session-interactive-buffer (haskell-session)))) - (with-current-buffer buffer - (setq haskell-interactive-previous-buffer initial-buffer)) - (unless (eq buffer (window-buffer)) - (switch-to-buffer-other-window buffer)))) - -(defun haskell-session-new () - "Make a new session." - (let ((name (read-from-minibuffer "Project name: " (haskell-session-default-name)))) - (when (not (string= name "")) - (let ((session (haskell-session-lookup name))) - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (if session - (when - (y-or-n-p - (format "Session %s already exists. Use it?" name)) - session) - (haskell-session-make name))) - (haskell-mode-toggle-interactive-prompt-state t))))) - -;;;###autoload -(defun haskell-session-change () - "Change the session for the current buffer." - (interactive) - (haskell-session-assign (or (haskell-session-new-assume-from-cabal) - (haskell-session-choose) - (haskell-session-new)))) - -(defun haskell-process-prompt-restart (process) - "Prompt to restart the died PROCESS." - (let ((process-name (haskell-process-name process)) - (cursor-in-echo-area t)) - (if haskell-process-suggest-restart - (progn - (haskell-mode-toggle-interactive-prompt-state) - (unwind-protect - (cond - ((string-match "You need to re-run the 'configure' command." - (haskell-process-response process)) - (cl-case (read-char-choice - (concat - "The Haskell process ended. Cabal wants you to run " - (propertize "cabal configure" - 'face - 'font-lock-keyword-face) - " because there is a version mismatch. Re-configure (y, n, l: view log)?" - "\n\n" - "Cabal said:\n\n" - (propertize (haskell-process-response process) - 'face - 'font-lock-comment-face)) - '(?l ?n ?y)) - (?y (let ((default-directory - (haskell-session-cabal-dir - (haskell-process-session process)))) - (message "%s" - (shell-command-to-string "cabal configure")))) - (?l (let* ((response (haskell-process-response process)) - (buffer (get-buffer "*haskell-process-log*"))) - (if buffer - (switch-to-buffer buffer) - (progn (switch-to-buffer - (get-buffer-create "*haskell-process-log*")) - (insert response))))) - (?n))) - (t - (cl-case (read-char-choice - (propertize - (format "The Haskell process `%s' has died. Restart? (y, n, l: show process log) " - process-name) - 'face - 'minibuffer-prompt) - '(?l ?n ?y)) - (?y (haskell-process-start (haskell-process-session process))) - (?l (let* ((response (haskell-process-response process)) - (buffer (get-buffer "*haskell-process-log*"))) - (if buffer - (switch-to-buffer buffer) - (progn (switch-to-buffer - (get-buffer-create "*haskell-process-log*")) - (insert response))))) - (?n)))) - ;; unwind - (haskell-mode-toggle-interactive-prompt-state t))) - (message "The Haskell process `%s' is dearly departed." process-name)))) - -(defun haskell-process () - "Get the current process from the current session." - (haskell-session-process (haskell-session))) - -;;;###autoload -(defun haskell-kill-session-process (&optional session) - "Kill the process." - (interactive) - (let* ((session (or session (haskell-session))) - (existing-process (get-process (haskell-session-name session)))) - (when (processp existing-process) - (haskell-interactive-mode-echo session "Killing process ...") - (haskell-process-set (haskell-session-process session) 'is-restarting t) - (delete-process existing-process)))) - -;;;###autoload -(defun haskell-interactive-mode-visit-error () - "Visit the buffer of the current (or last) error message." - (interactive) - (with-current-buffer (haskell-session-interactive-buffer (haskell-session)) - (if (progn (goto-char (line-beginning-position)) - (looking-at haskell-interactive-mode-error-regexp)) - (progn (forward-line -1) - (haskell-interactive-jump-to-error-line)) - (progn (goto-char (point-max)) - (haskell-interactive-mode-error-backward) - (haskell-interactive-jump-to-error-line))))) - (defvar xref-prompt-for-identifier nil) ;;;###autoload @@ -373,73 +98,69 @@ Give optional NEXT-P parameter to override value of (1- (progn (forward-char 1) (search-forward-regexp "\"" (line-end-position) nil 1)))))) (fp (expand-file-name string - (haskell-session-cabal-dir (haskell-session))))) + inferior-haskell-root-dir))) (find-file (read-file-name "" fp fp)))) -;;;###autoload -(defun haskell-interactive-bring () - "Bring up the interactive mode for this session." - (interactive) - (let* ((session (haskell-session)) - (buffer (haskell-session-interactive-buffer session))) - (pop-to-buffer buffer))) +(defvar haskell-process-loaded-file-status (cons "" nil) + "cons with CAR as the name of the file loaded and +the CDR is the status of the loaded file; i.e. t for success and nil +for failure.") ;;;###autoload (defun haskell-process-load-file () - "Load the current buffer file." - (interactive) - (save-buffer) - (haskell-interactive-mode-reset-error (haskell-session)) - (haskell-process-file-loadish (format "load \"%s\"" (replace-regexp-in-string - "\"" - "\\\\\"" - (buffer-file-name))) - nil - (current-buffer))) - -;;;###autoload -(defun haskell-process-reload () - "Re-load the current buffer file." + "Load or reload the file in current buffer with the help of `:load' or +`:reload' functionality that comes with ghci. +Errors that might arise are put in the `*haskell-compilation*' buffer." (interactive) - (save-buffer) - (haskell-interactive-mode-reset-error (haskell-session)) - (haskell-process-file-loadish "reload" t (current-buffer))) - -;;;###autoload -(defun haskell-process-reload-file () (haskell-process-reload)) - -(make-obsolete 'haskell-process-reload-file 'haskell-process-reload - "2015-11-14") - -;;;###autoload -(defun haskell-process-load-or-reload (&optional toggle) - "Load or reload. Universal argument toggles which." - (interactive "P") - (if toggle - (progn (setq haskell-reload-p (not haskell-reload-p)) - (message "%s (No action taken this time)" - (if haskell-reload-p - "Now running :reload." - "Now running :load ."))) - (if haskell-reload-p (haskell-process-reload) (haskell-process-load-file)))) - -(make-obsolete 'haskell-process-load-or-reload 'haskell-process-load-file - "2015-11-14") + (save-some-buffers (not compilation-ask-about-save) + compilation-save-buffers-predicate) + (let ((filename (buffer-file-name))) + (cond ((equal filename (car haskell-process-loaded-file-status)) + (let ((load-status (haskell-compile-load + (inferior-haskell-get-result + ":reload!")))) + (setq haskell-process-loaded-file-status + (cons filename load-status)) + (message (format "Reloaded %s" filename)))) + (t + (let ((load-status (haskell-compile-load + (inferior-haskell-get-result + (format ":load \"%s\"" filename))))) + (setq haskell-process-loaded-file-status + (cons filename load-status )) + (message (format "Loaded %s" filename))))))) + +(defun haskell-compile-load (haskell-load-traceback) + "A `*haskell-compilation*' buffer is created if it does not exist, +then the traceback from GHCi is displayed. Returns t if no errors else +returns nil." + (pop-to-buffer "*haskell-compilation*") + (with-current-buffer "*haskell-compilation*" + (setq inhibit-read-only t) + (erase-buffer) + (insert haskell-load-traceback) + (haskell-compilation-mode) + (save-excursion + (goto-char (point-min)) + (cond ((haskell-utils-compile-error-p) (compilation-handle-exit 'exit 1 "failed") + nil) + (t (compilation-handle-exit 'exit 0 "finished") + t))))) ;;;###autoload (defun haskell-process-cabal-build () "Build the Cabal project." (interactive) - (haskell-process-do-cabal "build") - (haskell-process-add-cabal-autogen)) + (haskell-process-do-cabal "build")) ;;;###autoload (defun haskell-process-cabal (p) - "Prompts for a Cabal command to run." + "Prompts for a Cabal command to run. +Argument P is the command to run." (interactive "P") (if p (haskell-process-do-cabal @@ -449,80 +170,12 @@ Give optional NEXT-P parameter to override value of (append haskell-cabal-commands (list "build --ghc-options=-fforce-recomp")))))) -(defun haskell-process-file-loadish (command reload-p module-buffer) - "Run a loading-ish COMMAND that wants to pick up type errors\ -and things like that. RELOAD-P indicates whether the notification -should say 'reloaded' or 'loaded'. MODULE-BUFFER may be used -for various things, but is optional." - (let ((session (haskell-session))) - (haskell-session-current-dir session) - (when haskell-process-check-cabal-config-on-load - (haskell-process-look-config-changes session)) - (let ((process (haskell-process))) - (haskell-process-queue-command - process - (make-haskell-command - :state (list session process command reload-p module-buffer) - :go (lambda (state) - (haskell-process-send-string - (cadr state) (format ":%s" (cl-caddr state)))) - :live (lambda (state buffer) - (haskell-process-live-build - (cadr state) buffer nil)) - :complete (lambda (state response) - (haskell-process-load-complete - (car state) - (cadr state) - response - (cl-cadddr state) - (cl-cadddr (cdr state))))))))) - -;;;###autoload -(defun haskell-process-minimal-imports () - "Dump minimal imports." - (interactive) - (unless (> (save-excursion - (goto-char (point-min)) - (haskell-navigate-imports-go) - (point)) - (point)) - (goto-char (point-min)) - (haskell-navigate-imports-go)) - (haskell-process-queue-sync-request (haskell-process) - ":set -ddump-minimal-imports") - (haskell-process-load-file) - (insert-file-contents-literally - (concat (haskell-session-current-dir (haskell-session)) - "/" - (haskell-guess-module-name-from-file-name (buffer-file-name)) - ".imports"))) - -(defun haskell-interactive-jump-to-error-line () - "Jump to the error line." - (let ((orig-line (buffer-substring-no-properties (line-beginning-position) - (line-end-position)))) - (and (string-match "^\\([^:]+\\):\\([0-9]+\\):\\([0-9]+\\)\\(-[0-9]+\\)?:" orig-line) - (let* ((file (match-string 1 orig-line)) - (line (match-string 2 orig-line)) - (col (match-string 3 orig-line)) - (session (haskell-interactive-session)) - (cabal-path (haskell-session-cabal-dir session)) - (src-path (haskell-session-current-dir session)) - (cabal-relative-file (expand-file-name file cabal-path)) - (src-relative-file (expand-file-name file src-path))) - (let ((file (cond ((file-exists-p cabal-relative-file) - cabal-relative-file) - ((file-exists-p src-relative-file) - src-relative-file)))) - (when file - (other-window 1) - (find-file file) - (haskell-interactive-bring) - (goto-char (point-min)) - (forward-line (1- (string-to-number line))) - (goto-char (+ (point) (string-to-number col) -1)) - (haskell-mode-message-line orig-line) - t)))))) +(defun haskell-process-do-cabal (command) + "Run a Cabal COMMAND." + (shell-command (concat "cabal " command) + (get-buffer-create "*haskell-process-log*") + (get-buffer-create "*haskell-process-log*")) + (switch-to-buffer-other-window (get-buffer "*haskell-process-log*"))) (provide 'haskell) ;;; haskell.el ends here diff --git a/tests/haskell-completions-tests.el b/tests/haskell-completions-tests.el index 6a2c5aa6a..54b860843 100644 --- a/tests/haskell-completions-tests.el +++ b/tests/haskell-completions-tests.el @@ -396,52 +396,39 @@ on `haskell-completions-sync-repl-completion-at-point'." (prefix &optional import)) nil) (ad-activate 'haskell-completions-sync-complete-repl-mock) - - ;; Mock `haskell-session-maybe' - (defadvice haskell-session-maybe-mock (around haskell-session-maybe) - t) - (ad-activate 'haskell-session-maybe-mock) - - ;; Mock `haskell-process-cmd' - (defadvice haskell-process-cmd-mock (around haskell-process-cmd - (P)) - nil) - (ad-activate 'haskell-process-cmd-mock) - - ;; Mock `haskell-interactive-process' - (defadvice haskell-interactive-process-mock (around haskell-interactive-process) - nil) - (ad-activate 'haskell-interactive-process-mock) - + (haskell-unconditional-kill-buffer "*haskell*") + (switch-to-haskell) ;;; Tests - (unwind-protect - (let (expected) - (with-temp-buffer - (haskell-mode) - - (insert "import qualified Data.List as L\n\n") - (insert "test = L") - (let* ((haskell-completions-complete-operators nil)) - (setq expected (nth 2 (haskell-completions-sync-repl-completion-at-point))) - (should expected)) - (let* ((haskell-completions-complete-operators t)) - (setq expected (nth 2 (haskell-completions-sync-repl-completion-at-point))) - (should expected)) - - (insert ".") - (let* ((haskell-completions-complete-operators nil)) - (setq expected (nth 2 (haskell-completions-sync-repl-completion-at-point))) - (should-not expected)) - (let* ((haskell-completions-complete-operators t)) - (setq expected (nth 2 (haskell-completions-sync-repl-completion-at-point))) - (should expected)))) - (progn - ;; Remove mocks - (ad-deactivate 'haskell-completions-sync-complete-repl-mock) - (ad-deactivate 'haskell-session-maybe-mock) - (ad-deactivate 'haskell-process-cmd-mock) - (ad-deactivate 'haskell-interactive-process-mock)))) + (let* ((ans nil) + (times 5)) + (while (and (not ans) + (> times 0)) + (unwind-protect + (let (expected) + (setq ans t) + (setq times (1- times)) + (with-temp-buffer + (haskell-mode) + (insert "import qualified Data.List as L\n\n") + (insert "test = L") + (let* ((haskell-completions-complete-operators nil)) + (setq expected (nth 2 (haskell-completions-sync-repl-completion-at-point))) + (setq ans (and ans expected))) + (let* ((haskell-completions-complete-operators t)) + (setq expected (nth 2 (haskell-completions-sync-repl-completion-at-point))) + (setq ans (and ans expected))) + (insert ".") + (let* ((haskell-completions-complete-operators nil)) + (setq expected (nth 2 (haskell-completions-sync-repl-completion-at-point))) + (setq ans (and ans (not expected)))) + (let* ((haskell-completions-complete-operators t)) + (setq expected (nth 2 (haskell-completions-sync-repl-completion-at-point))) + (setq ans (and ans expected))))) + (progn + ;; Remove mocks + (ad-deactivate 'haskell-completions-sync-complete-repl-mock)))) + (should ans))) (provide 'haskell-completions-tests) ;;; haskell-completions-tests.el ends here diff --git a/tests/haskell-load-tests.el b/tests/haskell-load-tests.el index f29e46ba8..479cacd48 100644 --- a/tests/haskell-load-tests.el +++ b/tests/haskell-load-tests.el @@ -4,86 +4,7 @@ (require 'cl-lib) (require 'ert) -(require 'haskell-test-utils) - -(require 'haskell-load) - -(defun insert-errors () - (insert "import Control.Applicativ\nimport Data.Mayb\nimport Data.String") - (goto-char 1) - (let ((applicativ (progn - (search-forward "Control.Applicativ") - (make-overlay (match-beginning 0) (match-end 0))))) - (overlay-put applicativ 'haskell-check t) - (overlay-put applicativ 'haskell-msg-type 'error) - (overlay-put applicativ 'haskell-msg "Could not find module ‘Control.Applicativ’\n Perhaps you meant Control.Applicative (from base-4.8.1.0)\n Use -v to see a list of the files searched for.")) - (let ((mayb (progn - (search-forward "Data.Mayb") - (make-overlay (match-beginning 0) (match-end 0))))) - (overlay-put mayb 'haskell-check t) - (overlay-put mayb 'haskell-msg-type 'error) - (overlay-put mayb 'haskell-msg "Could not find module ‘Data.Mayb’\n Perhaps you meant\n Data.Maybe (from base-4.8.1.0)\n Data.Map (from containers-0.5.6.2@conta_LKCPrTJwOTOLk4OU37YmeN)\n Use -v to see a list of the files searched for.")) - (goto-char 1)) - -(ert-deftest goto-first-error-before () - (with-temp-switch-to-buffer - (insert-errors) - (haskell-goto-first-error) - (should (looking-at-p "Control.Applicativ")))) - -(ert-deftest goto-first-error-after () - (with-temp-switch-to-buffer - (insert-errors) - (search-forward "Data.String") - (haskell-goto-first-error) - (should (looking-at-p "Control.Applicativ")))) - -(ert-deftest goto-first-error-between () - (with-temp-switch-to-buffer - (insert-errors) - (search-forward "import Data.Mayb") - (haskell-goto-first-error) - (should (looking-at-p "Control.Applicativ")))) - -(ert-deftest goto-next-error-before () - (with-temp-switch-to-buffer - (insert-errors) - (haskell-goto-next-error) - (should (looking-at-p "Control.Applicativ")))) - -(ert-deftest goto-next-error-between () - (with-temp-switch-to-buffer - (insert-errors) - (search-forward "import" nil nil 2) - (haskell-goto-next-error) - (should (looking-at-p "Data.Mayb")))) - -(ert-deftest goto-next-error-after () - (with-temp-switch-to-buffer - (insert-errors) - (search-forward "import" nil nil 3) - (haskell-goto-next-error) - (should (looking-at-p " Data.String")))) - -(ert-deftest goto-prev-error-before () - (with-temp-switch-to-buffer - (insert-errors) - (haskell-goto-prev-error) - (should (looking-at-p "import Control.Applicativ")))) - -(ert-deftest goto-prev-error-between () - (with-temp-switch-to-buffer - (insert-errors) - (search-forward "import" nil nil 2) - (haskell-goto-prev-error) - (should (looking-at-p "Control.Applicativ")))) - -(ert-deftest goto-prev-error-after () - (with-temp-switch-to-buffer - (insert-errors) - (search-forward "import Data.String") - (haskell-goto-prev-error) - (should (looking-at-p "Data.Mayb")))) +(require 'haskell) (ert-deftest do-cabal-no-process () "Ensure that haskell-process-do-cabal can call cabal directly. diff --git a/tests/haskell-mode-tests.el b/tests/haskell-mode-tests.el index d31fe5570..824491e46 100644 --- a/tests/haskell-mode-tests.el +++ b/tests/haskell-mode-tests.el @@ -19,6 +19,7 @@ (require 'ert) (require 'haskell-mode) +(require 'haskell) (require 'haskell-test-utils) (ert-deftest haskell-mode-ident-at-point-empty () diff --git a/tests/haskell-process-tests.el b/tests/haskell-process-tests.el deleted file mode 100644 index b6b47ec10..000000000 --- a/tests/haskell-process-tests.el +++ /dev/null @@ -1,64 +0,0 @@ -;;; haskell-process-tests.el -*- lexical-binding: t -*- - -;;; Code: - -(require 'ert) -(require 'cl-lib) -(require 'haskell-process) - -(ert-deftest haskell-process-wrapper-command-function-identity () - "No wrapper, return directly the command." - (should (equal '("ghci") - (progn - (custom-set-variables '(haskell-process-wrapper-function #'identity)) - (apply haskell-process-wrapper-function (list '("ghci"))))))) - -(ert-deftest haskell-process-wrapper-function-non-identity () - "Wrapper as a string, return the wrapping command as a string." - (should (equal '("nix-shell" "default.nix" "--command" "cabal\\ run") - (progn - (custom-set-variables '(haskell-process-wrapper-function (lambda (argv) - (append '("nix-shell" "default.nix" "--command") - (list (shell-quote-argument argv)))))) - (apply haskell-process-wrapper-function (list "cabal run")))))) - -(ert-deftest test-haskell-process--compute-process-log-and-command-ghci () - (should (equal '("Starting inferior GHCi process ghci ..." "dumses1" nil "ghci" "-ferror-spans") - (let ((haskell-process-path-ghci "ghci") - (haskell-process-args-ghci '("-ferror-spans"))) - (custom-set-variables '(haskell-process-wrapper-function #'identity)) - (cl-letf (((symbol-function 'haskell-session-name) (lambda (session) "dumses1"))) - (haskell-process-compute-process-log-and-command "dummy-session" 'ghci)))))) - -(ert-deftest test-haskell-process--with-wrapper-compute-process-log-and-command-ghci () - (should (equal '("Starting inferior GHCi process ghci ..." "dumses1" nil "nix-shell" "default.nix" "--command" "ghci\\ -ferror-spans") - (let ((haskell-process-path-ghci "ghci") - (haskell-process-args-ghci '("-ferror-spans"))) - (custom-set-variables '(haskell-process-wrapper-function - (lambda (argv) (append (list "nix-shell" "default.nix" "--command" ) - (list (shell-quote-argument (mapconcat 'identity argv " "))))))) - (cl-letf (((symbol-function 'haskell-session-name) (lambda (session) "dumses1"))) - (haskell-process-compute-process-log-and-command "dummy-session" 'ghci)))))) - -(ert-deftest test-haskell-process--compute-process-log-and-command-cabal-repl () - (should (equal '("Starting inferior `cabal repl' process using cabal ..." "dumses2" nil "cabal" "repl" "--ghc-option=-ferror-spans" "dumdum-session") - (let ((haskell-process-path-cabal "cabal") - (haskell-process-args-cabal-repl '("--ghc-option=-ferror-spans"))) - (custom-set-variables '(haskell-process-wrapper-function #'identity)) - (cl-letf (((symbol-function 'haskell-session-name) (lambda (session) "dumses2")) - ((symbol-function 'haskell-session-target) (lambda (session) "dumdum-session"))) - (haskell-process-compute-process-log-and-command "dummy-session2" 'cabal-repl)))))) - -(ert-deftest test-haskell-process--with-wrapper-compute-process-log-and-command-cabal-repl () - (should (equal '("Starting inferior `cabal repl' process using cabal ..." "dumses2" nil "nix-shell" "default.nix" "--command" "cabal\\ repl\\ --ghc-option\\=-ferror-spans\\ dumdum-session") - (let ((haskell-process-path-cabal "cabal") - (haskell-process-args-cabal-repl '("--ghc-option=-ferror-spans"))) - (custom-set-variables '(haskell-process-wrapper-function - (lambda (argv) (append (list "nix-shell" "default.nix" "--command" ) - (list (shell-quote-argument (mapconcat 'identity argv " "))))))) - (cl-letf (((symbol-function 'haskell-session-name) (lambda (session) "dumses2")) - ((symbol-function 'haskell-session-target) (lambda (session) "dumdum-session"))) - (haskell-process-compute-process-log-and-command "dummy-session2" 'cabal-repl)))))) - - -;;; haskell-process-tests.el ends here diff --git a/tests/haskell-test-utils.el b/tests/haskell-test-utils.el index 9a11d4836..260fa80ab 100644 --- a/tests/haskell-test-utils.el +++ b/tests/haskell-test-utils.el @@ -269,6 +269,14 @@ Whole hierarchy is removed after BODY finishes and value of ,@body)) (delete-directory tmpdir t))) +(ert-deftest haskell-with-temp-dir-structure () + (setq cur-haskell-dir default-directory) + (with-temp-dir-structure + (("a.hs" . "-- Empty file") + ("faza" . (("b.hs" . "-- Empty file")))) + (cd "faza")) + (should (eq default-directory cur-haskell-dir))) + (defun haskell-bypass-confirmation (function &rest args) "Call FUNCTION with ARGS, bypassing all prompts. This includes both `y-or-n-p' and `yes-or-no-p'. diff --git a/tests/haskell-utils-tests.el b/tests/haskell-utils-tests.el index 75168244f..ff08d0336 100644 --- a/tests/haskell-utils-tests.el +++ b/tests/haskell-utils-tests.el @@ -171,28 +171,21 @@ strings will change in future." (should (string-prefix-p ":type-at nil 7 3 8 16" test-b-result))))) (ert-deftest parse-repl-response () - "Test `haskell-utils-repl-response-error-status' function." + "Test `haskell-utils-repl-response-error-p' function." (let* ((t1-str "unknown command ':type-at'\nuse :? for help.") (t2-str "\n:3:5: Not in scope: ‘x’") (t3-str "Couldn't guess that module name. Does it exist?") (t4-str "Hello World!") - (t5-str " ") - (t6-str "") + (t5-str "") + (t6-str " ") (t7-str "\n\n\n\n") - (r1 (haskell-utils-repl-response-error-status t1-str)) - (r2 (haskell-utils-repl-response-error-status t2-str)) - (r3 (haskell-utils-repl-response-error-status t3-str)) - (r4 (haskell-utils-repl-response-error-status t4-str)) - (r5 (haskell-utils-repl-response-error-status t5-str)) - (r6 (haskell-utils-repl-response-error-status t6-str)) - (r7 (haskell-utils-repl-response-error-status t7-str))) - (should (equal r1 'unknown-command)) - (should (equal r2 'interactive-error)) - (should (equal r3 'option-missing)) - (should (equal r4 'no-error)) - (should (equal r5 'no-error)) - (should (equal r6 'no-error)) - (should (equal r7 'no-error)))) + (should (haskell-utils-repl-response-error-p t1-str)) + (should (haskell-utils-repl-response-error-p t2-str)) + (should (haskell-utils-repl-response-error-p t3-str)) + (should (not (haskell-utils-repl-response-error-p t4-str))) + (should (not (haskell-utils-repl-response-error-p t5-str))) + (should (not (haskell-utils-repl-response-error-p t6-str))) + (should (not (haskell-utils-repl-response-error-p t7-str)))))) (ert-deftest reduce-strign () "Test `haskell-utils-reduce-strign' command. @@ -244,4 +237,39 @@ Tests flag updates and `post-command-hook' cleanup." post-command-hook :test #'equal))))) +(ert-deftest haskell-interactive-error-regexp-test-1 () + "Tests the regexp `haskell-interactive-mode-error-regexp'" + (with-temp-buffer + (insert "/home/user/Test.hs:24:30:") + (goto-char (point-min)) + (should (haskell-utils-compile-error-p)))) + +(ert-deftest haskell-interactive-error-regexp-test-2 () + "Tests the regexp `haskell-utils-compile-error-p'" + (with-temp-buffer + (insert " Test.hs:8:9:") + (goto-char (point-min)) + (should (not (haskell-utils-compile-error-p))))) + +(ert-deftest haskell-interactive-error-regexp-test-3 () + "Tests the regexp `haskell-utils-compile-error-p'" + (with-temp-buffer + (insert "Test.hs:5:18:") + (goto-char (point-min)) + (should (haskell-utils-compile-error-p)))) + +(ert-deftest haskell-interactive-error-regexp-test-4 () + "Tests the regexp `haskell-utils-compile-error-p'" + (with-temp-buffer + (insert "Test.hs:7:6: Not in scope: type constructor or class ‘Ty’") + (goto-char (point-min)) + (should (haskell-utils-compile-error-p)))) + +(ert-deftest haskell-interactive-error-regexp-test-5 () + "Tests the regexp `haskell-utils-compile-error-p'" + (with-temp-buffer + (insert "Test.hs:9:5: Not in scope: ‘c’") + (goto-char (point-min)) + (should (haskell-utils-compile-error-p)))) + ;;; haskell-utils-tests.el ends here diff --git a/tests/interactive-haskell-mode-tests.el b/tests/interactive-haskell-mode-tests.el index 4df1eaedd..1c568a6d0 100644 --- a/tests/interactive-haskell-mode-tests.el +++ b/tests/interactive-haskell-mode-tests.el @@ -1,6 +1,7 @@ ;;; interactive-haskell-mode-tests.el --- Tests for Haskell Interactive Mode -*- lexical-binding: t -*- ;; Copyright © 2016 Athur Fayzrakhmanov. All rights reserved. +;; Copyright © 2017 Vasantha Ganesh Kanniappan ;; This file is part of haskell-mode package. ;; You can contact the authors using GitHub issue tracker: @@ -30,22 +31,31 @@ (require 'ert) -(require 'haskell-interactive-mode) - -(defun should-match (str) - (should (eq 0 (string-match-p haskell-interactive-mode-error-regexp str)))) - -(ert-deftest haskell-interactive-error-regexp-test () - "Tests the regexp `haskell-interactive-mode-error-regexp'" - (should (eq 0 (string-match-p haskell-interactive-mode-error-regexp - "/home/user/Test.hs:24:30:"))) - (should (eq 0 (string-match-p haskell-interactive-mode-error-regexp - "Test.hs:5:18:"))) - (should (eq 0 (string-match-p haskell-interactive-mode-error-regexp - "Test.hs:7:6: Not in scope: type constructor or class ‘Ty’"))) - (should (eq 0 (string-match-p haskell-interactive-mode-error-regexp - "Test.hs:9:5: Not in scope: ‘c’"))) - (should (eq nil (string-match-p haskell-interactive-mode-error-regexp - ;; leading space - " Test.hs:8:9:"))) - ) +(require 'haskell-utils) +(require 'haskell-test-utils) + +(ert-deftest test-haskell-process-load-file () + (haskell-unconditional-kill-buffer "*haskell-compilation*") + (haskell-unconditional-kill-buffer "*haskell*") + (find-file-literally (concat default-directory + (file-name-as-directory "tests") + (file-name-as-directory "sample-code") + "fibonoacci.hs")) + (with-current-buffer "fibonoacci.hs" + (haskell-mode) + (haskell-process-load-file) + (should (buffer-live-p (get-buffer "*haskell-compilation*"))))) + +(ert-deftest test-haskell-process-load-file-fail () + (haskell-unconditional-kill-buffer "*haskell-compilation*") + (haskell-unconditional-kill-buffer "*haskell*") + (find-file-literally (concat default-directory + (file-name-as-directory "tests") + (file-name-as-directory "sample-code") + "does_not_compile.hs")) + (with-current-buffer "does_not_compile.hs" + (haskell-mode) + (haskell-process-load-file) + (with-current-buffer "*haskell-compilation*" + (goto-char (point-min)) + (should (haskell-utils-compile-error-p))))) diff --git a/tests/sample-code/does_not_work.hs b/tests/sample-code/does_not_work.hs new file mode 100644 index 000000000..276a88ec6 --- /dev/null +++ b/tests/sample-code/does_not_work.hs @@ -0,0 +1,10 @@ +main = interact $ show . myfib . readInt + +readInt :: String -> Integer +readInt = read + +myfib :: Integer -> Integer +myfib n = (fibs) !! n + +fibs :: [Integer] +fibs = 1 : 1 : zipWith (+) fibs (tail fibs) diff --git a/tests/sample-code/fibonoacci.hs b/tests/sample-code/fibonoacci.hs new file mode 100644 index 000000000..976cf9684 --- /dev/null +++ b/tests/sample-code/fibonoacci.hs @@ -0,0 +1,10 @@ +main = interact $ show . myfib . readInt + +readInt :: String -> Int +readInt = read + +myfib :: Int -> Integer +myfib n = (fibs) !! n + +fibs :: [Integer] +fibs = 1 : 1 : zipWith (+) fibs (tail fibs)