packages feed

hls-eval-plugin 1.1.0.0 → 1.1.1.0

raw patch · 163 files changed

+4008/−4049 lines, 163 filesdep +ghc-api-compatdep −lsp-testdep −shakedep ~ghcidenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-api-compat

Dependencies removed: lsp-test, shake

Dependency ranges changed: ghcide

API changes (from Hackage documentation)

Files

LICENSE view
@@ -1,201 +1,201 @@-                                 Apache License
-                           Version 2.0, January 2004
-                        http://www.apache.org/licenses/
-
-   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
-
-   1. Definitions.
-
-      "License" shall mean the terms and conditions for use, reproduction,
-      and distribution as defined by Sections 1 through 9 of this document.
-
-      "Licensor" shall mean the copyright owner or entity authorized by
-      the copyright owner that is granting the License.
-
-      "Legal Entity" shall mean the union of the acting entity and all
-      other entities that control, are controlled by, or are under common
-      control with that entity. For the purposes of this definition,
-      "control" means (i) the power, direct or indirect, to cause the
-      direction or management of such entity, whether by contract or
-      otherwise, or (ii) ownership of fifty percent (50%) or more of the
-      outstanding shares, or (iii) beneficial ownership of such entity.
-
-      "You" (or "Your") shall mean an individual or Legal Entity
-      exercising permissions granted by this License.
-
-      "Source" form shall mean the preferred form for making modifications,
-      including but not limited to software source code, documentation
-      source, and configuration files.
-
-      "Object" form shall mean any form resulting from mechanical
-      transformation or translation of a Source form, including but
-      not limited to compiled object code, generated documentation,
-      and conversions to other media types.
-
-      "Work" shall mean the work of authorship, whether in Source or
-      Object form, made available under the License, as indicated by a
-      copyright notice that is included in or attached to the work
-      (an example is provided in the Appendix below).
-
-      "Derivative Works" shall mean any work, whether in Source or Object
-      form, that is based on (or derived from) the Work and for which the
-      editorial revisions, annotations, elaborations, or other modifications
-      represent, as a whole, an original work of authorship. For the purposes
-      of this License, Derivative Works shall not include works that remain
-      separable from, or merely link (or bind by name) to the interfaces of,
-      the Work and Derivative Works thereof.
-
-      "Contribution" shall mean any work of authorship, including
-      the original version of the Work and any modifications or additions
-      to that Work or Derivative Works thereof, that is intentionally
-      submitted to Licensor for inclusion in the Work by the copyright owner
-      or by an individual or Legal Entity authorized to submit on behalf of
-      the copyright owner. For the purposes of this definition, "submitted"
-      means any form of electronic, verbal, or written communication sent
-      to the Licensor or its representatives, including but not limited to
-      communication on electronic mailing lists, source code control systems,
-      and issue tracking systems that are managed by, or on behalf of, the
-      Licensor for the purpose of discussing and improving the Work, but
-      excluding communication that is conspicuously marked or otherwise
-      designated in writing by the copyright owner as "Not a Contribution."
-
-      "Contributor" shall mean Licensor and any individual or Legal Entity
-      on behalf of whom a Contribution has been received by Licensor and
-      subsequently incorporated within the Work.
-
-   2. Grant of Copyright License. Subject to the terms and conditions of
-      this License, each Contributor hereby grants to You a perpetual,
-      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
-      copyright license to reproduce, prepare Derivative Works of,
-      publicly display, publicly perform, sublicense, and distribute the
-      Work and such Derivative Works in Source or Object form.
-
-   3. Grant of Patent License. Subject to the terms and conditions of
-      this License, each Contributor hereby grants to You a perpetual,
-      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
-      (except as stated in this section) patent license to make, have made,
-      use, offer to sell, sell, import, and otherwise transfer the Work,
-      where such license applies only to those patent claims licensable
-      by such Contributor that are necessarily infringed by their
-      Contribution(s) alone or by combination of their Contribution(s)
-      with the Work to which such Contribution(s) was submitted. If You
-      institute patent litigation against any entity (including a
-      cross-claim or counterclaim in a lawsuit) alleging that the Work
-      or a Contribution incorporated within the Work constitutes direct
-      or contributory patent infringement, then any patent licenses
-      granted to You under this License for that Work shall terminate
-      as of the date such litigation is filed.
-
-   4. Redistribution. You may reproduce and distribute copies of the
-      Work or Derivative Works thereof in any medium, with or without
-      modifications, and in Source or Object form, provided that You
-      meet the following conditions:
-
-      (a) You must give any other recipients of the Work or
-          Derivative Works a copy of this License; and
-
-      (b) You must cause any modified files to carry prominent notices
-          stating that You changed the files; and
-
-      (c) You must retain, in the Source form of any Derivative Works
-          that You distribute, all copyright, patent, trademark, and
-          attribution notices from the Source form of the Work,
-          excluding those notices that do not pertain to any part of
-          the Derivative Works; and
-
-      (d) If the Work includes a "NOTICE" text file as part of its
-          distribution, then any Derivative Works that You distribute must
-          include a readable copy of the attribution notices contained
-          within such NOTICE file, excluding those notices that do not
-          pertain to any part of the Derivative Works, in at least one
-          of the following places: within a NOTICE text file distributed
-          as part of the Derivative Works; within the Source form or
-          documentation, if provided along with the Derivative Works; or,
-          within a display generated by the Derivative Works, if and
-          wherever such third-party notices normally appear. The contents
-          of the NOTICE file are for informational purposes only and
-          do not modify the License. You may add Your own attribution
-          notices within Derivative Works that You distribute, alongside
-          or as an addendum to the NOTICE text from the Work, provided
-          that such additional attribution notices cannot be construed
-          as modifying the License.
-
-      You may add Your own copyright statement to Your modifications and
-      may provide additional or different license terms and conditions
-      for use, reproduction, or distribution of Your modifications, or
-      for any such Derivative Works as a whole, provided Your use,
-      reproduction, and distribution of the Work otherwise complies with
-      the conditions stated in this License.
-
-   5. Submission of Contributions. Unless You explicitly state otherwise,
-      any Contribution intentionally submitted for inclusion in the Work
-      by You to the Licensor shall be under the terms and conditions of
-      this License, without any additional terms or conditions.
-      Notwithstanding the above, nothing herein shall supersede or modify
-      the terms of any separate license agreement you may have executed
-      with Licensor regarding such Contributions.
-
-   6. Trademarks. This License does not grant permission to use the trade
-      names, trademarks, service marks, or product names of the Licensor,
-      except as required for reasonable and customary use in describing the
-      origin of the Work and reproducing the content of the NOTICE file.
-
-   7. Disclaimer of Warranty. Unless required by applicable law or
-      agreed to in writing, Licensor provides the Work (and each
-      Contributor provides its Contributions) on an "AS IS" BASIS,
-      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
-      implied, including, without limitation, any warranties or conditions
-      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
-      PARTICULAR PURPOSE. You are solely responsible for determining the
-      appropriateness of using or redistributing the Work and assume any
-      risks associated with Your exercise of permissions under this License.
-
-   8. Limitation of Liability. In no event and under no legal theory,
-      whether in tort (including negligence), contract, or otherwise,
-      unless required by applicable law (such as deliberate and grossly
-      negligent acts) or agreed to in writing, shall any Contributor be
-      liable to You for damages, including any direct, indirect, special,
-      incidental, or consequential damages of any character arising as a
-      result of this License or out of the use or inability to use the
-      Work (including but not limited to damages for loss of goodwill,
-      work stoppage, computer failure or malfunction, or any and all
-      other commercial damages or losses), even if such Contributor
-      has been advised of the possibility of such damages.
-
-   9. Accepting Warranty or Additional Liability. While redistributing
-      the Work or Derivative Works thereof, You may choose to offer,
-      and charge a fee for, acceptance of support, warranty, indemnity,
-      or other liability obligations and/or rights consistent with this
-      License. However, in accepting such obligations, You may act only
-      on Your own behalf and on Your sole responsibility, not on behalf
-      of any other Contributor, and only if You agree to indemnify,
-      defend, and hold each Contributor harmless for any liability
-      incurred by, or claims asserted against, such Contributor by reason
-      of your accepting any such warranty or additional liability.
-
-   END OF TERMS AND CONDITIONS
-
-   APPENDIX: How to apply the Apache License to your work.
-
-      To apply the Apache License to your work, attach the following
-      boilerplate notice, with the fields enclosed by brackets "[]"
-      replaced with your own identifying information. (Don't include
-      the brackets!)  The text should be enclosed in the appropriate
-      comment syntax for the file format. We also recommend that a
-      file or class name and description of purpose be included on the
-      same "printed page" as the copyright notice for easier
-      identification within third-party archives.
-
-   Copyright [yyyy] [name of copyright owner]
-
-   Licensed under the Apache License, Version 2.0 (the "License");
-   you may not use this file except in compliance with the License.
-   You may obtain a copy of the License at
-
-       http://www.apache.org/licenses/LICENSE-2.0
-
-   Unless required by applicable law or agreed to in writing, software
-   distributed under the License is distributed on an "AS IS" BASIS,
-   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-   See the License for the specific language governing permissions and
-   limitations under the License.
+                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright [yyyy] [name of copyright owner]++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.
README.md view
@@ -1,332 +1,332 @@-# Eval plugin for the [Haskell Language Server](https://github.com/haskell/haskell-language-server#readme)
-
-The Eval plugin evaluates code inserted in comments.
-
-This is mainly useful to test and document functions and to quickly evaluate small expressions.
-
-Every line of code to be evaluated is introduced by __>>>__
-
-A quick calculation:
-
-```
--- >>> 2**4.5/pi
--- 7.202530529256849
-```
-
-A little test for the `double` function:
-
-```
-{- |
-A doubling function.
-
->>> double 11
-22
--}
-double = (2*)
-```
-
-# Demo
-
-![Eval](demo.gif)
-
-# Test Structure
-
-A test is composed by a sequence of contiguous lines, the result of their evaluation is inserted after the test body:
-
-```
->>> "AB" ++ "CD"
->>> "CD" ++ "AB"
-"ABCD"
-"CDAB"
-```
-
-You execute a test by clicking on the _Evaluate_ code lens that appears above it (or _Refresh_, if the test has been run previously).
-
-All tests in the same comment block are executed together.
-
-
-Tests can appear in all kind of comments:
-* plain comments (both single and multi line)
-```
-{-
->>> "ab" ++ "c"
-"abc"
--}
-
--- >>> "ab" ++ "c"
--- "abc"
-```
-* Haddock commands (both single and multi line, forward and backward)
-```
-{-
->>> "ab" ++ "c"
-"abc"
--}
-
--- >>> "ab" ++ "c"
--- "abc"
-
-double a = a + a
--- ^ A doubling function
--- >>> double 11
--- 22
-```
-
-Modules that use CPP and Literate Haskell (Bird-style only) modules are also supported (for GHC >= 8.8).
-
-# Test Components
-
-In general, a test is a sequence of:
-* imports
-* directives
-* statements
-* expressions
-* properties
-
-in no particular order, with every line introduced by __>>>__ (or __prop>__ in the case of properties).
-
-### Imports
-
-```
->>> import Data.List
->>> import GHC.TypeNats
-```
-
-From any package in scope but currently NOT from modules in the same source directory.
-
-### Language Extensions
-
-```
->>> :set -XScopedTypeVariables -XStandaloneDeriving -XDataKinds -XTypeOperators -XExplicitNamespaces
-```
-
-### Statements and Declarations
-
-Function declarations (optionally introduced by __let__):
-
-```
->>> let tuple x = (x,x)
->>> let one=1;two=2
->>> triple x = (x,x,x)
-```
-
-Any other declaration:
-
-```
->>> data TertiumDatur = Truly | Falsely | Other deriving Show
->>> class Display a where display :: a -> String
->>> instance Display TertiumDatur where display = show
-```
-
-Definitions are available to following tests in the __same__ comment:
-
-```
-{-
->>> two = 2
-
->>> two
-2
--}
-
--- >>> two
--- Variable not in scope: two
-```
-
-If you want definitions to be available to all tests in the module, define a setup section:
-
-```
--- $setup
--- >>> eleven = 11
-
-{-
-eleven is now available to any test:
-
->>> eleven*2
-22
--}
-```
-
-
-### Type and Kind directives
-
-```
->>> :type Truly
-Truly :: TertiumDatur
-
->>> :kind TertiumDatur
-TertiumDatur :: *
-
->>> :type 3
-3 :: forall p. Num p => p
-
->>> :type +d 3
-3 :: Integer
-
->>> type N = 1
->>> type M = 40
->>> :kind! N + M + 1
-N + M + 1 :: Nat
-= 42
-```
-
-### Expressions
-
-```
->>> tuple 2
->>> triple 3
->>> display Other
-(2,2)
-(3,3,3)
-"Other"
-```
-
-IO expressions can also be evaluated but their output to stdout/stderr is NOT captured:
-
-```
->>> print "foo"
-()
-```
-
-### Properties
-
-```
-prop> \(l::[Int]) -> reverse (reverse l) == l
-+++ OK, passed 100 tests.
-```
-
-# Haddock vs Plain Comments
-
-There is a conceptual difference between Haddock and plain comments:
-* Haddock comments constitute the external module's documentation, they state the contract between the implementor and the module users (API)
-* Plain comments are internal documentation meant to explain how the code works (implementation).
-
-This conceptual difference is reflected in the way tests results are refreshed by the Eval plugin.
-
-Say that we have defined a `double` function as:
-
-```
-double = (*2)
-```
-
-And, in an Haddock comment, we run the test:
-
-```
-{- |
->>> double 11
-22
--}
-```
-
-We then change the definition to:
-
-```
-double = (*3)
-```
-
-When we refresh the test, its current result is compared with the previous one and differences are displayed (as they change the API):
-
-```
-{- |
->>> double 11
-WAS 22
-NOW 33
--}
-```
-
-On the contrary, if the test were into a plain comment, the result would simply be replaced:
-
-```
-{-
->>> double 11
-33
--}
-```
-
-# Multiline Output
-
-By default, the output of every expression is returned as a single line.
-
-This is a problem if you want, for example, to pretty print a value (in this case using the [pretty-simple](https://hackage.haskell.org/package/pretty-simple) package):
-
-```
->>> import Text.Pretty.Simple
->>> pShowNoColor [1..3]
-"[ 1\n, 2\n, 3\n]"
-```
-
-We could try to print the pretty-print output, but stdout is not captured so we get just a ():
-
-```
->>> print $ pShowNoColor [1..7]
-()
-```
-
-To display it properly, we can exploit the fact that the output of an error is displayed as a multi-line text:
-
-```
->>> import qualified Data.Text.Lazy as TL
->>> import Text.Pretty.Simple
->>> prettyPrint v = error (TL.unpack $ pShowNoColor v) :: IO String
->>> prettyPrint [1..3]
-[ 1
-, 2
-, 3
-]
-```
-
-# Differences with doctest
-
-Though the Eval plugin functionality is quite similar to that of [doctest](https://hackage.haskell.org/package/doctest), some doctest's features are not supported.
-
-### Capturing Stdout
-
-Only the value of an IO expression is spliced in, not its output:
-
-```
->>> print "foo"
-()
-```
-
-### Pattern Matching
-
-The arbitrary content matcher __...__ is unsupported.
-
-### Missing lambda abstractions in property tests
-
-Variables are not automatically introduced:
-
-```
-prop> reverse (reverse l) == (l::[Int])
-Variable not in scope: l :: [Int]
-```
-
-This works:
-
-```
-prop> \(l::[Int]) -> reverse (reverse l) == l
-+++ OK, passed 100 tests.
-```
-
-### Multiline Expressions
-
-```
- >>> :{
-  let
-    x = 1
-    y = 2
-  in x + y + multiline
- :}
-```
-
-# Acknowledgments
-
-Design/features derived from:
-
-* [GHCi](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html)
-
-* [Haddock's](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744) Examples and Properties
-
-* [Doctest](https://hackage.haskell.org/package/doctest)
-
-* the REPLoid feature of [Dante](https://github.com/jyp/dante)
-
+# Eval plugin for the [Haskell Language Server](https://github.com/haskell/haskell-language-server#readme)++The Eval plugin evaluates code inserted in comments.++This is mainly useful to test and document functions and to quickly evaluate small expressions.++Every line of code to be evaluated is introduced by __>>>__++A quick calculation:++```+-- >>> 2**4.5/pi+-- 7.202530529256849+```++A little test for the `double` function:++```+{- |+A doubling function.++>>> double 11+22+-}+double = (2*)+```++# Demo++![Eval](demo.gif)++# Test Structure++A test is composed by a sequence of contiguous lines, the result of their evaluation is inserted after the test body:++```+>>> "AB" ++ "CD"+>>> "CD" ++ "AB"+"ABCD"+"CDAB"+```++You execute a test by clicking on the _Evaluate_ code lens that appears above it (or _Refresh_, if the test has been run previously).++All tests in the same comment block are executed together.+++Tests can appear in all kind of comments:+* plain comments (both single and multi line)+```+{-+>>> "ab" ++ "c"+"abc"+-}++-- >>> "ab" ++ "c"+-- "abc"+```+* Haddock commands (both single and multi line, forward and backward)+```+{-+>>> "ab" ++ "c"+"abc"+-}++-- >>> "ab" ++ "c"+-- "abc"++double a = a + a+-- ^ A doubling function+-- >>> double 11+-- 22+```++Modules that use CPP and Literate Haskell (Bird-style only) modules are also supported (for GHC >= 8.8).++# Test Components++In general, a test is a sequence of:+* imports+* directives+* statements+* expressions+* properties++in no particular order, with every line introduced by __>>>__ (or __prop>__ in the case of properties).++### Imports++```+>>> import Data.List+>>> import GHC.TypeNats+```++From any package in scope but currently NOT from modules in the same source directory.++### Language Extensions++```+>>> :set -XScopedTypeVariables -XStandaloneDeriving -XDataKinds -XTypeOperators -XExplicitNamespaces+```++### Statements and Declarations++Function declarations (optionally introduced by __let__):++```+>>> let tuple x = (x,x)+>>> let one=1;two=2+>>> triple x = (x,x,x)+```++Any other declaration:++```+>>> data TertiumDatur = Truly | Falsely | Other deriving Show+>>> class Display a where display :: a -> String+>>> instance Display TertiumDatur where display = show+```++Definitions are available to following tests in the __same__ comment:++```+{-+>>> two = 2++>>> two+2+-}++-- >>> two+-- Variable not in scope: two+```++If you want definitions to be available to all tests in the module, define a setup section:++```+-- $setup+-- >>> eleven = 11++{-+eleven is now available to any test:++>>> eleven*2+22+-}+```+++### Type and Kind directives++```+>>> :type Truly+Truly :: TertiumDatur++>>> :kind TertiumDatur+TertiumDatur :: *++>>> :type 3+3 :: forall p. Num p => p++>>> :type +d 3+3 :: Integer++>>> type N = 1+>>> type M = 40+>>> :kind! N + M + 1+N + M + 1 :: Nat+= 42+```++### Expressions++```+>>> tuple 2+>>> triple 3+>>> display Other+(2,2)+(3,3,3)+"Other"+```++IO expressions can also be evaluated but their output to stdout/stderr is NOT captured:++```+>>> print "foo"+()+```++### Properties++```+prop> \(l::[Int]) -> reverse (reverse l) == l++++ OK, passed 100 tests.+```++# Haddock vs Plain Comments++There is a conceptual difference between Haddock and plain comments:+* Haddock comments constitute the external module's documentation, they state the contract between the implementor and the module users (API)+* Plain comments are internal documentation meant to explain how the code works (implementation).++This conceptual difference is reflected in the way tests results are refreshed by the Eval plugin.++Say that we have defined a `double` function as:++```+double = (*2)+```++And, in an Haddock comment, we run the test:++```+{- |+>>> double 11+22+-}+```++We then change the definition to:++```+double = (*3)+```++When we refresh the test, its current result is compared with the previous one and differences are displayed (as they change the API):++```+{- |+>>> double 11+WAS 22+NOW 33+-}+```++On the contrary, if the test were into a plain comment, the result would simply be replaced:++```+{-+>>> double 11+33+-}+```++# Multiline Output++By default, the output of every expression is returned as a single line.++This is a problem if you want, for example, to pretty print a value (in this case using the [pretty-simple](https://hackage.haskell.org/package/pretty-simple) package):++```+>>> import Text.Pretty.Simple+>>> pShowNoColor [1..3]+"[ 1\n, 2\n, 3\n]"+```++We could try to print the pretty-print output, but stdout is not captured so we get just a ():++```+>>> print $ pShowNoColor [1..7]+()+```++To display it properly, we can exploit the fact that the output of an error is displayed as a multi-line text:++```+>>> import qualified Data.Text.Lazy as TL+>>> import Text.Pretty.Simple+>>> prettyPrint v = error (TL.unpack $ pShowNoColor v) :: IO String+>>> prettyPrint [1..3]+[ 1+, 2+, 3+]+```++# Differences with doctest++Though the Eval plugin functionality is quite similar to that of [doctest](https://hackage.haskell.org/package/doctest), some doctest's features are not supported.++### Capturing Stdout++Only the value of an IO expression is spliced in, not its output:++```+>>> print "foo"+()+```++### Pattern Matching++The arbitrary content matcher __...__ is unsupported.++### Missing lambda abstractions in property tests++Variables are not automatically introduced:++```+prop> reverse (reverse l) == (l::[Int])+Variable not in scope: l :: [Int]+```++This works:++```+prop> \(l::[Int]) -> reverse (reverse l) == l++++ OK, passed 100 tests.+```++### Multiline Expressions++```+ >>> :{+  let+    x = 1+    y = 2+  in x + y + multiline+ :}+```++# Acknowledgments++Design/features derived from:++* [GHCi](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html)++* [Haddock's](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744) Examples and Properties++* [Doctest](https://hackage.haskell.org/package/doctest)++* the REPLoid feature of [Dante](https://github.com/jyp/dante)+
hls-eval-plugin.cabal view
@@ -1,112 +1,110 @@-cabal-version:      2.4
-name:               hls-eval-plugin
-version:            1.1.0.0
-synopsis:           Eval plugin for Haskell Language Server
-description:
-  Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>
-
-category:           Development
-bug-reports:        https://github.com/haskell/haskell-language-server/issues
-license:            Apache-2.0
-license-file:       LICENSE
-author:
-  https://github.com/haskell/haskell-language-server/contributors
-
-maintainer:
-  https://github.com/haskell/haskell-language-server/contributors
-
-build-type:         Simple
-extra-source-files:
-  LICENSE
-  README.md
-  test/testdata/*.cabal
-  test/testdata/*.expected
-  test/testdata/*.hs
-  test/testdata/*.lhs
-  test/testdata/*.yaml
-
-flag pedantic
-  description: Enable -Werror
-  default:     False
-  manual:      True
-
-source-repository head
-  type:     git
-  location: https://github.com/haskell/haskell-language-server
-
-library
-  exposed-modules:
-    Ide.Plugin.Eval
-    Ide.Plugin.Eval.Types
-
-  hs-source-dirs:     src
-  other-modules:
-    Ide.Plugin.Eval.Code
-    Ide.Plugin.Eval.CodeLens
-    Ide.Plugin.Eval.GHC
-    Ide.Plugin.Eval.Parse.Comments
-    Ide.Plugin.Eval.Parse.Option
-    Ide.Plugin.Eval.Util
-
-  build-depends:
-    , aeson
-    , base                  >=4.12    && <5
-    , containers
-    , deepseq
-    , Diff                  ^>=0.4.0
-    , directory
-    , dlist
-    , extra
-    , filepath
-    , ghc
-    , ghc-boot-th
-    , ghc-paths
-    , ghcide                ^>=1.2
-    , hashable
-    , hls-plugin-api        ^>=1.1
-    , lens
-    , lsp
-    , lsp-types
-    , megaparsec            >=9.0
-    , mtl
-    , parser-combinators
-    , pretty-simple
-    , QuickCheck
-    , safe-exceptions
-    , shake
-    , temporary
-    , text
-    , time
-    , transformers
-    , unliftio
-    , unordered-containers
-
-  ghc-options:
-    -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors
-
-  if flag(pedantic)
-    ghc-options: -Werror
-
-  default-language:   Haskell2010
-  default-extensions:
-    DataKinds
-    TypeOperators
-
-test-suite tests
-  type:             exitcode-stdio-1.0
-  default-language: Haskell2010
-  hs-source-dirs:   test
-  main-is:          Main.hs
-  ghc-options:      -threaded -rtsopts -with-rtsopts=-N
-  build-depends:
-    , aeson
-    , base
-    , directory
-    , extra
-    , filepath
-    , hls-eval-plugin
-    , hls-test-utils   ^>=1.0
-    , lens
-    , lsp-test
-    , lsp-types
-    , text
+cabal-version:      2.4+name:               hls-eval-plugin+version:            1.1.1.0+synopsis:           Eval plugin for Haskell Language Server+description:+  Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>++category:           Development+bug-reports:        https://github.com/haskell/haskell-language-server/issues+license:            Apache-2.0+license-file:       LICENSE+author:+  https://github.com/haskell/haskell-language-server/contributors++maintainer:+  https://github.com/haskell/haskell-language-server/contributors++build-type:         Simple+extra-source-files:+  LICENSE+  README.md+  test/testdata/*.cabal+  test/testdata/*.hs+  test/testdata/*.lhs+  test/testdata/*.yaml+  test/testdata/cabal.project++flag pedantic+  description: Enable -Werror+  default:     False+  manual:      True++source-repository head+  type:     git+  location: https://github.com/haskell/haskell-language-server++library+  exposed-modules:+    Ide.Plugin.Eval+    Ide.Plugin.Eval.Types++  hs-source-dirs:     src+  other-modules:+    Ide.Plugin.Eval.Code+    Ide.Plugin.Eval.CodeLens+    Ide.Plugin.Eval.GHC+    Ide.Plugin.Eval.Parse.Comments+    Ide.Plugin.Eval.Parse.Option+    Ide.Plugin.Eval.Util++  build-depends:+    , aeson+    , base                  >=4.12  && <5+    , containers+    , deepseq+    , Diff                  ^>=0.4.0+    , directory+    , dlist+    , extra+    , filepath+    , ghc+    , ghc-api-compat+    , ghc-boot-th+    , ghc-paths+    , ghcide                >=1.2   && <1.5+    , hashable+    , hls-plugin-api        ^>=1.1+    , lens+    , lsp+    , lsp-types+    , megaparsec            >=9.0+    , mtl+    , parser-combinators+    , pretty-simple+    , QuickCheck+    , safe-exceptions+    , temporary+    , text+    , time+    , transformers+    , unliftio+    , unordered-containers++  ghc-options:+    -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors++  if flag(pedantic)+    ghc-options: -Werror++  default-language:   Haskell2010+  default-extensions:+    DataKinds+    TypeOperators++test-suite tests+  type:             exitcode-stdio-1.0+  default-language: Haskell2010+  hs-source-dirs:   test+  main-is:          Main.hs+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N+  build-depends:+    , aeson+    , base+    , directory+    , extra+    , filepath+    , hls-eval-plugin+    , hls-test-utils   ^>=1.0+    , lens+    , lsp-types
src/Ide/Plugin/Eval.hs view
@@ -1,28 +1,25 @@-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_GHC -Wwarn #-}
-
-{- |
-Eval Plugin entry point.
--}
-module Ide.Plugin.Eval (
-    descriptor,
-) where
-
-import Development.IDE (IdeState)
-import qualified Ide.Plugin.Eval.CodeLens as CL
-import Ide.Types (
-    PluginDescriptor (..),
-    PluginId,
-    defaultPluginDescriptor,
-    mkPluginHandler
- )
-import Language.LSP.Types
-
--- |Plugin descriptor
-descriptor :: PluginId -> PluginDescriptor IdeState
-descriptor plId =
-    (defaultPluginDescriptor plId)
-        { pluginHandlers = mkPluginHandler STextDocumentCodeLens CL.codeLens
-        , pluginCommands = [CL.evalCommand]
-        }
+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# OPTIONS_GHC -Wwarn #-}++{- |+Eval Plugin entry point.+-}+module Ide.Plugin.Eval (+    descriptor,+) where++import           Development.IDE          (IdeState)+import qualified Ide.Plugin.Eval.CodeLens as CL+import           Ide.Types                (PluginDescriptor (..), PluginId,+                                           defaultPluginDescriptor,+                                           mkPluginHandler)+import           Language.LSP.Types++-- |Plugin descriptor+descriptor :: PluginId -> PluginDescriptor IdeState+descriptor plId =+    (defaultPluginDescriptor plId)+        { pluginHandlers = mkPluginHandler STextDocumentCodeLens CL.codeLens+        , pluginCommands = [CL.evalCommand]+        }
src/Ide/Plugin/Eval/Code.hs view
@@ -1,131 +1,131 @@-{-# LANGUAGE LambdaCase        #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -Wwarn -fno-warn-orphans #-}
-
--- | Expression execution
-module Ide.Plugin.Eval.Code (Statement, testRanges, resultRange, evalExtensions, evalSetup, propSetup, testCheck, asStatements,myExecStmt) where
-
-import           Control.Lens                   ((^.))
-import           Data.Algorithm.Diff            (Diff, PolyDiff (..), getDiff)
-import qualified Data.List.NonEmpty             as NE
-import           Data.String                    (IsString)
-import qualified Data.Text                      as T
-import           Development.IDE.Types.Location (Position (..), Range (..))
-import           GHC                            (ExecOptions, ExecResult (..),
-                                                 execStmt)
-import           GHC.LanguageExtensions.Type    (Extension (..))
-import           GhcMonad                       (Ghc, liftIO, modifySession)
-import           HscTypes
-import           Ide.Plugin.Eval.Types          (Language (Plain), Loc,
-                                                 Located (..),
-                                                 Section (sectionLanguage),
-                                                 Test (..), Txt, locate,
-                                                 locate0)
-import           InteractiveEval                (getContext, parseImportDecl,
-                                                 runDecls, setContext)
-import           Language.LSP.Types.Lens        (line, start)
-import           System.IO.Extra                (newTempFile, readFile')
-
--- | Return the ranges of the expression and result parts of the given test
-testRanges :: Test -> (Range, Range)
-testRanges tst =
-    let startLine = testRange tst ^. start.line
-        (exprLines, resultLines) = testLenghts tst
-        resLine = startLine + exprLines
-     in ( Range
-            (Position startLine 0)
-            --(Position (startLine + exprLines + resultLines) 0),
-            (Position resLine 0)
-        , Range (Position resLine 0) (Position (resLine + resultLines) 0)
-        )
-
-{- |The document range where a test is defined
- testRange :: Loc Test -> Range
- testRange = fst . testRanges
--}
-
--- |The document range where the result of the test is defined
-resultRange :: Test -> Range
-resultRange = snd . testRanges
-
--- TODO: handle BLANKLINE
-{-
->>> showDiffs $  getDiff ["abc","def","ghi","end"] ["abc","def","Z","ZZ","end"]
-["abc","def","WAS ghi","NOW Z","NOW ZZ","end"]
--}
-showDiffs :: (Semigroup a, IsString a) => [Diff a] -> [a]
-showDiffs = map showDiff
-
-showDiff :: (Semigroup a, IsString a) => Diff a -> a
-showDiff (First w)  = "WAS " <> w
-showDiff (Second w) = "NOW " <> w
-showDiff (Both w _) = w
-
-testCheck :: (Section, Test) -> [T.Text] -> [T.Text]
-testCheck (section, test) out
-    | null (testOutput test) || sectionLanguage section == Plain = out
-    | otherwise = showDiffs $ getDiff (map T.pack $ testOutput test) out
-
-testLenghts :: Test -> (Int, Int)
-testLenghts (Example e r _)  = (NE.length e, length r)
-testLenghts (Property _ r _) = (1, length r)
-
--- |A one-line Haskell statement
-type Statement = Loc String
-
-asStatements :: Test -> [Statement]
-asStatements lt = locate $ Located (testRange lt ^. start.line) (asStmts lt)
-
-asStmts :: Test -> [Txt]
-asStmts (Example e _ _) = NE.toList e
-asStmts (Property t _ _) =
-    ["prop11 = " ++ t, "(propEvaluation prop11 :: IO String)"]
-
--- |GHC extensions required for expression evaluation
-evalExtensions :: [Extension]
-evalExtensions =
-    [ OverlappingInstances
-    , UndecidableInstances
-    , FlexibleInstances
-    , IncoherentInstances
-    , TupleSections
-    ]
-
--- |GHC declarations required for expression evaluation
-evalSetup :: Ghc ()
-evalSetup = do
-    preludeAsP <- parseImportDecl "import qualified Prelude as P"
-    context <- getContext
-    setContext (IIDecl preludeAsP : context)
-
--- | A wrapper of 'InteractiveEval.execStmt', capturing the execution result
-myExecStmt :: String -> ExecOptions -> Ghc (Either String (Maybe String))
-myExecStmt stmt opts = do
-    (temp, purge) <- liftIO newTempFile
-    evalPrint <- head <$> runDecls ("evalPrint x = P.writeFile "<> show temp <> " (P.show x)")
-    modifySession $ \hsc -> hsc {hsc_IC = setInteractivePrintName (hsc_IC hsc) evalPrint}
-    result <- execStmt stmt opts >>= \case
-              ExecComplete (Left err) _ -> pure $ Left $ show err
-              ExecComplete (Right _) _ -> liftIO $ Right . (\x -> if null x then Nothing else Just x) <$> readFile' temp
-              ExecBreak{} -> pure $ Right $ Just "breakpoints are not supported"
-    liftIO purge
-    pure result
-
-{- |GHC declarations required to execute test properties
-
-Example:
-
-prop> \(l::[Bool]) -> reverse (reverse l) == l
-+++ OK, passed 100 tests.
-
-prop> \(l::[Bool]) -> reverse l == l
-*** Failed! Falsified (after 6 tests and 2 shrinks):
-[True,False]
--}
-propSetup :: [Loc [Char]]
-propSetup =
-    locate0
-        [ ":set -XScopedTypeVariables -XExplicitForAll"
-        , "import qualified Test.QuickCheck as Q11"
-        , "propEvaluation p = Q11.quickCheckWithResult Q11.stdArgs p >>= error . Q11.output" -- uses `error` to get a multi-line display
-        ]
+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wwarn -fno-warn-orphans #-}++-- | Expression execution+module Ide.Plugin.Eval.Code (Statement, testRanges, resultRange, evalExtensions, evalSetup, propSetup, testCheck, asStatements,myExecStmt) where++import           Control.Lens                   ((^.))+import           Data.Algorithm.Diff            (Diff, PolyDiff (..), getDiff)+import qualified Data.List.NonEmpty             as NE+import           Data.String                    (IsString)+import qualified Data.Text                      as T+import           Development.IDE.Types.Location (Position (..), Range (..))+import           GHC                            (ExecOptions, ExecResult (..),+                                                 execStmt)+import           GHC.LanguageExtensions.Type    (Extension (..))+import           GhcMonad                       (Ghc, liftIO, modifySession)+import           HscTypes+import           Ide.Plugin.Eval.Types          (Language (Plain), Loc,+                                                 Located (..),+                                                 Section (sectionLanguage),+                                                 Test (..), Txt, locate,+                                                 locate0)+import           InteractiveEval                (getContext, parseImportDecl,+                                                 runDecls, setContext)+import           Language.LSP.Types.Lens        (line, start)+import           System.IO.Extra                (newTempFile, readFile')++-- | Return the ranges of the expression and result parts of the given test+testRanges :: Test -> (Range, Range)+testRanges tst =+    let startLine = testRange tst ^. start.line+        (exprLines, resultLines) = testLenghts tst+        resLine = startLine + exprLines+     in ( Range+            (Position startLine 0)+            --(Position (startLine + exprLines + resultLines) 0),+            (Position resLine 0)+        , Range (Position resLine 0) (Position (resLine + resultLines) 0)+        )++{- |The document range where a test is defined+ testRange :: Loc Test -> Range+ testRange = fst . testRanges+-}++-- |The document range where the result of the test is defined+resultRange :: Test -> Range+resultRange = snd . testRanges++-- TODO: handle BLANKLINE+{-+>>> showDiffs $  getDiff ["abc","def","ghi","end"] ["abc","def","Z","ZZ","end"]+["abc","def","WAS ghi","NOW Z","NOW ZZ","end"]+-}+showDiffs :: (Semigroup a, IsString a) => [Diff a] -> [a]+showDiffs = map showDiff++showDiff :: (Semigroup a, IsString a) => Diff a -> a+showDiff (First w)  = "WAS " <> w+showDiff (Second w) = "NOW " <> w+showDiff (Both w _) = w++testCheck :: (Section, Test) -> [T.Text] -> [T.Text]+testCheck (section, test) out+    | null (testOutput test) || sectionLanguage section == Plain = out+    | otherwise = showDiffs $ getDiff (map T.pack $ testOutput test) out++testLenghts :: Test -> (Int, Int)+testLenghts (Example e r _)  = (NE.length e, length r)+testLenghts (Property _ r _) = (1, length r)++-- |A one-line Haskell statement+type Statement = Loc String++asStatements :: Test -> [Statement]+asStatements lt = locate $ Located (testRange lt ^. start.line) (asStmts lt)++asStmts :: Test -> [Txt]+asStmts (Example e _ _) = NE.toList e+asStmts (Property t _ _) =+    ["prop11 = " ++ t, "(propEvaluation prop11 :: IO String)"]++-- |GHC extensions required for expression evaluation+evalExtensions :: [Extension]+evalExtensions =+    [ OverlappingInstances+    , UndecidableInstances+    , FlexibleInstances+    , IncoherentInstances+    , TupleSections+    ]++-- |GHC declarations required for expression evaluation+evalSetup :: Ghc ()+evalSetup = do+    preludeAsP <- parseImportDecl "import qualified Prelude as P"+    context <- getContext+    setContext (IIDecl preludeAsP : context)++-- | A wrapper of 'InteractiveEval.execStmt', capturing the execution result+myExecStmt :: String -> ExecOptions -> Ghc (Either String (Maybe String))+myExecStmt stmt opts = do+    (temp, purge) <- liftIO newTempFile+    evalPrint <- head <$> runDecls ("evalPrint x = P.writeFile "<> show temp <> " (P.show x)")+    modifySession $ \hsc -> hsc {hsc_IC = setInteractivePrintName (hsc_IC hsc) evalPrint}+    result <- execStmt stmt opts >>= \case+              ExecComplete (Left err) _ -> pure $ Left $ show err+              ExecComplete (Right _) _ -> liftIO $ Right . (\x -> if null x then Nothing else Just x) <$> readFile' temp+              ExecBreak{} -> pure $ Right $ Just "breakpoints are not supported"+    liftIO purge+    pure result++{- |GHC declarations required to execute test properties++Example:++prop> \(l::[Bool]) -> reverse (reverse l) == l++++ OK, passed 100 tests.++prop> \(l::[Bool]) -> reverse l == l+*** Failed! Falsified (after 6 tests and 2 shrinks):+[True,False]+-}+propSetup :: [Loc [Char]]+propSetup =+    locate0+        [ ":set -XScopedTypeVariables -XExplicitForAll"+        , "import qualified Test.QuickCheck as Q11"+        , "propEvaluation p = Q11.quickCheckWithResult Q11.stdArgs p >>= error . Q11.output" -- uses `error` to get a multi-line display+        ]
src/Ide/Plugin/Eval/CodeLens.hs view
@@ -1,711 +1,750 @@-{-# LANGUAGE DuplicateRecordFields     #-}
-{-# LANGUAGE ExtendedDefaultRules      #-}
-{-# LANGUAGE FlexibleContexts          #-}
-{-# LANGUAGE FlexibleInstances         #-}
-{-# LANGUAGE LambdaCase                #-}
-{-# LANGUAGE NamedFieldPuns            #-}
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE OverloadedStrings         #-}
-{-# LANGUAGE RankNTypes                #-}
-{-# LANGUAGE RecordWildCards           #-}
-{-# LANGUAGE ScopedTypeVariables       #-}
-{-# LANGUAGE TypeApplications          #-}
-{-# LANGUAGE ViewPatterns              #-}
-{-# OPTIONS_GHC -fno-warn-type-defaults #-}
-
-{- |
-A plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.
-
-For a full example see the "Ide.Plugin.Eval.Tutorial" module.
--}
-module Ide.Plugin.Eval.CodeLens (
-    codeLens,
-    evalCommand,
-) where
-
-import           CmdLineParser
-import           Control.Applicative                  (Alternative ((<|>)))
-import           Control.Arrow                        (second, (>>>))
-import           Control.Exception                    (try)
-import qualified Control.Exception                    as E
-import           Control.Lens                         (_1, _3, (%~), (<&>),
-                                                       (^.))
-import           Control.Monad                        (guard, join, void, when)
-import           Control.Monad.IO.Class               (MonadIO (liftIO))
-import           Control.Monad.Trans.Except           (ExceptT (..))
-import           Data.Aeson                           (toJSON)
-import           Data.Char                            (isSpace)
-import qualified Data.DList                           as DL
-import qualified Data.HashMap.Strict                  as HashMap
-import           Data.List                            (dropWhileEnd, find,
-                                                       intercalate)
-import qualified Data.Map.Strict                      as Map
-import           Data.Maybe                           (catMaybes, fromMaybe)
-import           Data.String                          (IsString)
-import           Data.Text                            (Text)
-import qualified Data.Text                            as T
-import           Data.Time                            (getCurrentTime)
-import           Data.Typeable                        (Typeable)
-import           Development.IDE                      (Action,
-                                                       GetDependencies (..),
-                                                       GetModIface (..),
-                                                       GetModSummary (..),
-                                                       GetParsedModuleWithComments (..),
-                                                       GhcSessionIO (..),
-                                                       HiFileResult (hirHomeMod, hirModSummary),
-                                                       HscEnvEq, IdeState,
-                                                       ModSummaryResult (..),
-                                                       evalGhcEnv,
-                                                       hscEnvWithImportPaths,
-                                                       prettyPrint,
-                                                       realSrcSpanToRange,
-                                                       runAction,
-                                                       textToStringBuffer,
-                                                       toNormalizedFilePath',
-                                                       uriToFilePath',
-                                                       useNoFile_,
-                                                       useWithStale_, use_,
-                                                       uses_)
-import           Development.IDE.Core.Compile         (loadModulesHome,
-                                                       setupFinderCache)
-import           Development.IDE.Core.PositionMapping (toCurrentRange)
-import           Development.IDE.Core.Rules           (TransitiveDependencies (transitiveModuleDeps))
-import           Development.IDE.GHC.Compat           (AnnotationComment (AnnBlockComment, AnnLineComment),
-                                                       GenLocated (L),
-                                                       GhcException, HscEnv,
-                                                       ParsedModule (..),
-                                                       SrcSpan (RealSrcSpan, UnhelpfulSpan),
-                                                       setInteractiveDynFlags,
-                                                       srcSpanFile)
-import qualified Development.IDE.GHC.Compat           as SrcLoc
-import           Development.IDE.Types.Options
-import           DynamicLoading                       (initializePlugins)
-import           FastString                           (unpackFS)
-import           GHC                                  (ExecOptions (execLineNumber, execSourceFile),
-                                                       GeneralFlag (..), Ghc,
-                                                       GhcLink (LinkInMemory),
-                                                       GhcMode (CompManager),
-                                                       GhcMonad (getSession),
-                                                       HscTarget (HscInterpreted),
-                                                       LoadHowMuch (LoadAllTargets),
-                                                       ModSummary (ms_hspp_opts),
-                                                       Module (moduleName),
-                                                       SuccessFlag (Failed, Succeeded),
-                                                       TcRnExprMode (..),
-                                                       execOptions, exprType,
-                                                       getInteractiveDynFlags,
-                                                       getSessionDynFlags,
-                                                       isImport, isStmt, load,
-                                                       runDecls, setContext,
-                                                       setLogAction,
-                                                       setSessionDynFlags,
-                                                       setTargets, typeKind)
-import           GhcPlugins                           (DynFlags (..),
-                                                       defaultLogActionHPutStrDoc,
-                                                       gopt_set, gopt_unset,
-                                                       hsc_dflags, interpWays,
-                                                       parseDynamicFlagsCmdLine,
-                                                       targetPlatform,
-                                                       updateWays,
-                                                       wayGeneralFlags,
-                                                       wayUnsetGeneralFlags,
-                                                       xopt_set)
-import           HscTypes                             (InteractiveImport (IIModule),
-                                                       ModSummary (ms_mod),
-                                                       Target (Target),
-                                                       TargetId (TargetFile))
-import           Ide.Plugin.Eval.Code                 (Statement, asStatements,
-                                                       evalExtensions,
-                                                       evalSetup, myExecStmt,
-                                                       propSetup, resultRange,
-                                                       testCheck, testRanges)
-import           Ide.Plugin.Eval.GHC                  (addImport, addPackages,
-                                                       hasPackage, showDynFlags)
-import           Ide.Plugin.Eval.Parse.Comments       (commentsToSections)
-import           Ide.Plugin.Eval.Parse.Option         (parseSetFlags)
-import           Ide.Plugin.Eval.Types
-import           Ide.Plugin.Eval.Util                 (asS, gStrictTry,
-                                                       handleMaybe,
-                                                       handleMaybeM, isLiterate,
-                                                       logWith, response,
-                                                       response', timed)
-import           Ide.Types
-import           Language.LSP.Server
-import           Language.LSP.Types
-import           Language.LSP.Types.Lens              (end, line)
-import           Language.LSP.VFS                     (virtualFileText)
-import           Outputable                           (nest, ppr, showSDoc,
-                                                       text, ($$), (<+>))
-import           System.FilePath                      (takeFileName)
-import           System.IO                            (hClose)
-import           UnliftIO.Temporary                   (withSystemTempFile)
-import           Util                                 (OverridingBool (Never))
-
-{- | Code Lens provider
- NOTE: Invoked every time the document is modified, not just when the document is saved.
--}
-codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens
-codeLens st plId CodeLensParams{_textDocument} =
-    let dbg = logWith st
-        perf = timed dbg
-     in perf "codeLens" $
-            response $ do
-                let TextDocumentIdentifier uri = _textDocument
-                fp <- handleMaybe "uri" $ uriToFilePath' uri
-                let nfp = toNormalizedFilePath' fp
-                    isLHS = isLiterate fp
-                dbg "fp" fp
-                (ParsedModule{..}, posMap) <- liftIO $
-                    runAction "parsed" st $ useWithStale_ GetParsedModuleWithComments nfp
-                let comments = foldMap
-                        ( foldMap $ \case
-                            L (RealSrcSpan real) bdy
-                                | unpackFS (srcSpanFile real) ==
-                                    fromNormalizedFilePath nfp
-                                , let ran0 = realSrcSpanToRange real
-                                , Just curRan <- toCurrentRange posMap ran0
-                                ->
-
-                                    -- since Haddock parsing is unset explicitly in 'getParsedModuleWithComments',
-                                    -- we can concentrate on these two
-                                    case bdy of
-                                        AnnLineComment cmt ->
-                                            mempty { lineComments = Map.singleton curRan (RawLineComment cmt) }
-                                        AnnBlockComment cmt ->
-                                            mempty { blockComments = Map.singleton curRan $ RawBlockComment cmt }
-                                        _ -> mempty
-                            _ -> mempty
-                        )
-                        $ snd pm_annotations
-                dbg "excluded comments" $ show $  DL.toList $
-                    foldMap
-                    (foldMap $ \(L a b) ->
-                        case b of
-                            AnnLineComment{}  -> mempty
-                            AnnBlockComment{} -> mempty
-                            _                 -> DL.singleton (a, b)
-                    )
-                    $ snd pm_annotations
-                dbg "comments" $ show comments
-
-                -- Extract tests from source code
-                let Sections{..} = commentsToSections isLHS comments
-                    tests = testsBySection nonSetupSections
-                    cmd = mkLspCommand plId evalCommandName "Evaluate=..." (Just [])
-                let lenses =
-                        [ CodeLens testRange (Just cmd') Nothing
-                        | (section, ident, test) <- tests
-                        , let (testRange, resultRange) = testRanges test
-                              args = EvalParams (setupSections ++ [section]) _textDocument ident
-                              cmd' =
-                                (cmd :: Command)
-                                    { _arguments = Just (List [toJSON args])
-                                    , _title =
-                                        if trivial resultRange
-                                            then "Evaluate..."
-                                            else "Refresh..."
-                                    }
-                        ]
-
-                perf "tests" $
-                    dbg "Tests" $
-                        unwords
-                            [ show (length tests)
-                            , "tests in"
-                            , show (length nonSetupSections)
-                            , "sections"
-                            , show (length setupSections)
-                            , "setups"
-                            , show (length lenses)
-                            , "lenses."
-                            ]
-
-                return $ List lenses
-  where
-    trivial (Range p p') = p == p'
-
-evalCommandName :: CommandId
-evalCommandName = "evalCommand"
-
-evalCommand :: PluginCommand IdeState
-evalCommand = PluginCommand evalCommandName "evaluate" runEvalCmd
-
-type EvalId = Int
-
-runEvalCmd :: CommandFunction IdeState EvalParams
-runEvalCmd st EvalParams{..} =
-    let dbg = logWith st
-        perf = timed dbg
-        cmd :: ExceptT String (LspM c) WorkspaceEdit
-        cmd = do
-            let tests = map (\(a,_,b) -> (a,b)) $ testsBySection sections
-
-            let TextDocumentIdentifier{_uri} = module_
-            fp <- handleMaybe "uri" $ uriToFilePath' _uri
-            let nfp = toNormalizedFilePath' fp
-            mdlText <- moduleText _uri
-
-            session <- runGetSession st nfp
-
-            ms <- fmap msrModSummary $
-                liftIO $
-                    runAction "runEvalCmd.getModSummary" st $
-                        use_ GetModSummary nfp
-
-            now <- liftIO getCurrentTime
-
-            let modName = moduleName $ ms_mod ms
-                thisModuleTarget =
-                    Target
-                        (TargetFile fp Nothing)
-                        False
-                        (Just (textToStringBuffer mdlText, now))
-
-            -- Setup environment for evaluation
-            hscEnv' <- ExceptT $ fmap join $ withSystemTempFile (takeFileName fp) $ \logFilename logHandle -> liftIO . gStrictTry . evalGhcEnv session $ do
-                env <- getSession
-
-                -- Install the module pragmas and options
-                df <- liftIO $ setupDynFlagsForGHCiLike env $ ms_hspp_opts ms
-
-                -- Restore the original import paths
-                let impPaths = importPaths $ hsc_dflags env
-                df <- return df{importPaths = impPaths}
-
-                -- Set the modified flags in the session
-                _lp <- setSessionDynFlags df
-
-                -- property tests need QuickCheck
-                when (needsQuickCheck tests) $ void $ addPackages ["QuickCheck"]
-                dbg "QUICKCHECK NEEDS" $ needsQuickCheck tests
-                dbg "QUICKCHECK HAS" $ hasQuickCheck df
-
-                -- copy the package state to the interactive DynFlags
-                idflags <- getInteractiveDynFlags
-                df <- getSessionDynFlags
-                setInteractiveDynFlags $
-                    (foldl xopt_set idflags evalExtensions)
-                        { pkgState =
-                            pkgState
-                                df
-                        , pkgDatabase =
-                            pkgDatabase
-                                df
-                        , packageFlags =
-                            packageFlags
-                                df
-                        , useColor = Never
-                        , canUseColor = False
-                        }
-
-                -- set up a custom log action
-                setLogAction $ \_df _wr _sev _span _style _doc ->
-                    defaultLogActionHPutStrDoc _df logHandle _doc _style
-
-                -- Load the module with its current content (as the saved module might not be up to date)
-                -- BUG: this fails for files that requires preprocessors (e.g. CPP) for ghc < 8.8
-                -- see https://gitlab.haskell.org/ghc/ghc/-/issues/17066
-                -- and https://hackage.haskell.org/package/ghc-8.10.1/docs/GHC.html#v:TargetFile
-                eSetTarget <- gStrictTry $ setTargets [thisModuleTarget]
-                dbg "setTarget" eSetTarget
-
-                -- load the module in the interactive environment
-                loadResult <- perf "loadModule" $ load LoadAllTargets
-                dbg "LOAD RESULT" $ asS loadResult
-                case loadResult of
-                    Failed -> liftIO $ do
-                        hClose logHandle
-                        err <- readFile logFilename
-                        dbg "load ERR" err
-                        return $ Left err
-                    Succeeded -> do
-                        -- Evaluation takes place 'inside' the module
-                        setContext [IIModule modName]
-                        Right <$> getSession
-
-            edits <-
-                perf "edits" $
-                    liftIO $
-                        evalGhcEnv hscEnv' $
-                            runTests
-                                (st, fp)
-                                tests
-
-            let workspaceEditsMap = HashMap.fromList [(_uri, List $ addFinalReturn mdlText edits)]
-            let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing
-
-            return workspaceEdits
-     in perf "evalCmd" $
-            withIndefiniteProgress "Evaluating" Cancellable $
-                response' cmd
-
-addFinalReturn :: Text -> [TextEdit] -> [TextEdit]
-addFinalReturn mdlText edits
-    | not (null edits) && not (T.null mdlText) && T.last mdlText /= '\n' =
-        finalReturn mdlText : edits
-    | otherwise = edits
-
-finalReturn :: Text -> TextEdit
-finalReturn txt =
-    let ls = T.lines txt
-        l = length ls -1
-        c = T.length . last $ ls
-        p = Position l c
-     in TextEdit (Range p p) "\n"
-
-moduleText :: (IsString e, MonadLsp c m) => Uri -> ExceptT e m Text
-moduleText uri =
-    handleMaybeM "mdlText" $
-      (virtualFileText <$>)
-          <$> getVirtualFile
-              (toNormalizedUri uri)
-
-testsBySection :: [Section] -> [(Section, EvalId, Test)]
-testsBySection sections =
-    [(section, ident, test)
-    | (ident, section) <- zip [0..] sections
-    , test <- sectionTests section
-    ]
-
-type TEnv = (IdeState, String)
-
-runTests :: TEnv -> [(Section, Test)] -> Ghc [TextEdit]
-runTests e@(_st, _) tests = do
-    df <- getInteractiveDynFlags
-    evalSetup
-    when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals e df propSetup
-
-    mapM (processTest e df) tests
-  where
-    processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit
-    processTest e@(st, fp) df (section, test) = do
-        let dbg = logWith st
-        let pad = pad_ $ (if isLiterate fp then ("> " `T.append`) else id) $ padPrefix (sectionFormat section)
-
-        rs <- runTest e df test
-        dbg "TEST RESULTS" rs
-
-        let checkedResult = testCheck (section, test) rs
-
-        let edit = asEdit (sectionFormat section) test (map pad checkedResult)
-        dbg "TEST EDIT" edit
-        return edit
-
-    -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]
-    runTest _ df test
-        | not (hasQuickCheck df) && isProperty test =
-            return $
-                singleLine
-                    "Add QuickCheck to your cabal dependencies to run this test."
-    runTest e df test = evals e df (asStatements test)
-
-asEdit :: Format -> Test -> [Text] -> TextEdit
-asEdit (MultiLine commRange) test resultLines
-    -- A test in a block comment, ending with @-\}@ without newline in-between.
-    | testRange test ^. end.line == commRange ^. end . line
-    =
-    TextEdit
-        (Range
-            (testRange test ^. end)
-            (resultRange test ^. end)
-        )
-        ("\n" <> T.unlines (resultLines <> ["-}"]))
-asEdit _ test resultLines =
-    TextEdit (resultRange test) (T.unlines resultLines)
-
-{-
-The result of evaluating a test line can be:
-* a value
-* nothing
-* a (possibly multiline) error message
-
-A value is returned for a correct expression.
-
-Either a pure value:
->>> 'h' :"askell"
-"haskell"
-
-Or an 'IO a' (output on stdout/stderr is ignored):
->>> print "OK" >> return "ABC"
-"ABC"
-
-Nothing is returned for a correct directive:
-
->>>:set -XFlexibleInstances
->>> import Data.Maybe
-
-Nothing is returned for a correct declaration (let..,x=, data, class)
-
->>> let x = 11
->>> y = 22
->>> data B = T | F
->>> class C a
-
-Nothing is returned for an empty line:
-
->>>
-
-A, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:
-
->>>:set -XNonExistent
-Unknown extension: "NonExistent"
-
->>> cls C
-Variable not in scope: cls :: t0 -> ()
-Data constructor not in scope: C
-
->>> "A
-lexical error in string/character literal at end of input
-
->>> 3 `div` 0
-divide by zero
-
->>> error "Something went wrong\nbad times" :: E.SomeException
-Something went wrong
-bad times
-
-Or for a value that does not have a Show instance and can therefore not be displayed:
->>> data V = V
->>> V
-No instance for (Show V)
--}
-evals :: TEnv -> DynFlags -> [Statement] -> Ghc [Text]
-evals (st, fp) df stmts = do
-    er <- gStrictTry $ mapM eval stmts
-    return $ case er of
-        Left err -> errorLines err
-        Right rs -> concat . catMaybes $ rs
-  where
-    dbg = logWith st
-    eval :: Statement -> Ghc (Maybe [Text])
-    eval (Located l stmt)
-        | -- GHCi flags
-          Just (words -> flags) <- parseSetFlags stmt = do
-            dbg "{:SET" flags
-            ndf <- getInteractiveDynFlags
-            dbg "pre set" $ showDynFlags ndf
-            eans <-
-                liftIO $ try @GhcException $
-                parseDynamicFlagsCmdLine ndf
-                (map (L $ UnhelpfulSpan "<interactive>") flags)
-            dbg "parsed flags" $ eans
-              <&> (_1 %~ showDynFlags >>> _3 %~ map warnMsg)
-            case eans of
-                Left err -> pure $ Just $ errorLines $ show err
-                Right (df', ignoreds, warns) -> do
-                    let warnings = do
-                            guard $ not $ null warns
-                            pure $ errorLines $
-                                unlines $
-                                map prettyWarn warns
-                        igns = do
-                            guard $ not $ null ignoreds
-                            pure
-                                ["Some flags have not been recognized: "
-                                <> T.pack (intercalate ", " $ map SrcLoc.unLoc ignoreds)
-                                ]
-                    dbg "post set" $ showDynFlags df'
-                    _ <- setSessionDynFlags df'
-                    sessDyns <- getSessionDynFlags
-                    setInteractiveDynFlags sessDyns
-                    pure $ warnings <> igns
-        | -- A type/kind command
-          Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =
-            evalGhciLikeCmd cmd arg
-        | -- A statement
-          isStmt df stmt =
-            do
-                dbg "{STMT " stmt
-                res <- exec stmt l
-                r <- case res of
-                    Left err -> return . Just . errorLines $ err
-                    Right x  -> return $ singleLine <$> x
-                dbg "STMT} -> " r
-                return r
-        | -- An import
-          isImport df stmt =
-            do
-                dbg "{IMPORT " stmt
-                _ <- addImport stmt
-                return Nothing
-        | -- A declaration
-          otherwise =
-            do
-                dbg "{DECL " stmt
-                void $ runDecls stmt
-                return Nothing
-    exec stmt l =
-        let opts = execOptions{execSourceFile = fp, execLineNumber = l}
-         in myExecStmt stmt opts
-
-prettyWarn :: Warn -> String
-prettyWarn Warn{..} =
-    prettyPrint (SrcLoc.getLoc warnMsg) <> ": warning:\n"
-    <> "    " <> SrcLoc.unLoc warnMsg
-
-ghcSessionDepsDefinition :: HscEnvEq -> NormalizedFilePath -> Action HscEnv
-ghcSessionDepsDefinition env file = do
-        let hsc = hscEnvWithImportPaths env
-        deps <- use_ GetDependencies file
-        let tdeps = transitiveModuleDeps deps
-        ifaces <- uses_ GetModIface tdeps
-
-        -- Currently GetDependencies returns things in topological order so A comes before B if A imports B.
-        -- We need to reverse this as GHC gets very unhappy otherwise and complains about broken interfaces.
-        -- Long-term we might just want to change the order returned by GetDependencies
-        let inLoadOrder = reverse (map hirHomeMod ifaces)
-
-        liftIO $ loadModulesHome inLoadOrder <$> setupFinderCache (map hirModSummary ifaces) hsc
-
-runGetSession :: MonadIO m => IdeState -> NormalizedFilePath -> m HscEnv
-runGetSession st nfp = liftIO $ runAction "eval" st $ do
-    -- Create a new GHC Session rather than reusing an existing one
-    -- to avoid interfering with ghcide
-    IdeGhcSession{loadSessionFun} <- useNoFile_ GhcSessionIO
-    let fp = fromNormalizedFilePath nfp
-    ((_, res),_) <- liftIO $ loadSessionFun fp
-    let hscEnv = fromMaybe (error $ "Unknown file: " <> fp) res
-    ghcSessionDepsDefinition hscEnv nfp
-
-needsQuickCheck :: [(Section, Test)] -> Bool
-needsQuickCheck = any (isProperty . snd)
-
-hasQuickCheck :: DynFlags -> Bool
-hasQuickCheck df = hasPackage df "QuickCheck"
-
-singleLine :: String -> [Text]
-singleLine s = [T.pack s]
-
-{- |
- Convert error messages to a list of text lines
- Remove unnecessary information.
--}
-errorLines :: String -> [Text]
-errorLines =
-        dropWhileEnd T.null
-        . takeWhile (not . ("CallStack" `T.isPrefixOf`))
-        . T.lines
-        . T.pack
-
-{- |
->>> map (pad_ (T.pack "--")) (map T.pack ["2+2",""])
-["--2+2","--<BLANKLINE>"]
--}
-pad_ :: Text -> Text -> Text
-pad_ prefix = (prefix `T.append`) . convertBlank
-
-convertBlank :: Text -> Text
-convertBlank x
-    | T.null x = "<BLANKLINE>"
-    | otherwise = x
-
-padPrefix :: IsString p => Format -> p
-padPrefix SingleLine = "-- "
-padPrefix _          = ""
-
-{- | Resulting @Text@ MUST NOT prefix each line with @--@
-   Such comment-related post-process will be taken place
-   solely in 'evalGhciLikeCmd'.
--}
-type GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)
-
--- Should we use some sort of trie here?
-ghciLikeCommands :: [(Text, GHCiLikeCmd)]
-ghciLikeCommands =
-    [("kind", doKindCmd False), ("kind!", doKindCmd True), ("type", doTypeCmd)]
-
-evalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])
-evalGhciLikeCmd cmd arg = do
-    df <- getSessionDynFlags
-    case lookup cmd ghciLikeCommands
-        <|> snd
-        <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of
-        Just hndler ->
-            fmap
-                T.lines
-                <$> hndler df arg
-        _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg
-
-doKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)
-doKindCmd False df arg = do
-    let input = T.strip arg
-    (_, kind) <- typeKind False $ T.unpack input
-    let kindText = text (T.unpack input) <+> "::" <+> ppr kind
-    pure $ Just $ T.pack (showSDoc df kindText)
-doKindCmd True df arg = do
-    let input = T.strip arg
-    (ty, kind) <- typeKind True $ T.unpack input
-    let kindDoc = text (T.unpack input) <+> "::" <+> ppr kind
-        tyDoc = "=" <+> ppr ty
-    pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)
-
-doTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)
-doTypeCmd dflags arg = do
-    let (emod, expr) = parseExprMode arg
-    ty <- exprType emod $ T.unpack expr
-    let rawType = T.strip $ T.pack $ showSDoc dflags $ ppr ty
-        broken = T.any (\c -> c == '\r' || c == '\n') rawType
-    pure $
-        Just $
-            if broken
-                then
-                    T.pack $
-                        showSDoc dflags $
-                            text (T.unpack expr)
-                                $$ nest 2 ("::" <+> ppr ty)
-                else expr <> " :: " <> rawType <> "\n"
-
-parseExprMode :: Text -> (TcRnExprMode, T.Text)
-parseExprMode rawArg = case T.break isSpace rawArg of
-    ("+v", rest) -> (TM_NoInst, T.strip rest)
-    ("+d", rest) -> (TM_Default, T.strip rest)
-    _            -> (TM_Inst, rawArg)
-
-data GhciLikeCmdException = GhciLikeCmdNotImplemented
-    { ghciCmdName :: Text
-    , ghciCmdArg  :: Text
-    }
-    deriving (Typeable)
-
-instance Show GhciLikeCmdException where
-    showsPrec _ GhciLikeCmdNotImplemented{..} =
-        showString "unknown command '"
-            . showString (T.unpack ghciCmdName)
-            . showChar '\''
-
-instance E.Exception GhciLikeCmdException
-
-{-
->>> parseGhciLikeCmd (T.pack ":kind! N + M + 1")
-Just ("kind!","N + M + 1")
->>> parseGhciLikeCmd (T.pack ":kind a")
-Just ("kind","a")
--}
-parseGhciLikeCmd :: Text -> Maybe (Text, Text)
-parseGhciLikeCmd input = do
-    (':', rest) <- T.uncons $ T.stripStart input
-    pure $ second T.strip $ T.break isSpace rest
-
-setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags
-setupDynFlagsForGHCiLike env dflags = do
-    let dflags3 =
-            dflags
-                { hscTarget = HscInterpreted
-                , ghcMode = CompManager
-                , ghcLink = LinkInMemory
-                }
-        platform = targetPlatform dflags3
-        dflags3a = updateWays $ dflags3{ways = interpWays}
-        dflags3b =
-            foldl gopt_set dflags3a $
-                concatMap (wayGeneralFlags platform) interpWays
-        dflags3c =
-            foldl gopt_unset dflags3b $
-                concatMap (wayUnsetGeneralFlags platform) interpWays
-        dflags4 =
-            dflags3c
-                `gopt_set` Opt_ImplicitImportQualified
-                `gopt_set` Opt_IgnoreOptimChanges
-                `gopt_set` Opt_IgnoreHpcChanges
-                `gopt_unset` Opt_DiagnosticsShowCaret
-    initializePlugins env dflags4
+{-# LANGUAGE CPP                       #-}+{-# LANGUAGE DuplicateRecordFields     #-}+{-# LANGUAGE ExtendedDefaultRules      #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE LambdaCase                #-}+{-# LANGUAGE NamedFieldPuns            #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE PatternSynonyms           #-}+{-# LANGUAGE RankNTypes                #-}+{-# LANGUAGE RecordWildCards           #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeApplications          #-}+{-# LANGUAGE ViewPatterns              #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++{- |+A plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.++For a full example see the "Ide.Plugin.Eval.Tutorial" module.+-}+module Ide.Plugin.Eval.CodeLens (+    codeLens,+    evalCommand,+) where++import           CmdLineParser+import           Control.Applicative                  (Alternative ((<|>)))+import           Control.Arrow                        (second, (>>>))+import           Control.Exception                    (try)+import qualified Control.Exception                    as E+import           Control.Lens                         (_1, _3, (%~), (<&>),+                                                       (^.))+import           Control.Monad                        (guard, join, void, when)+import           Control.Monad.IO.Class               (MonadIO (liftIO))+import           Control.Monad.Trans.Except           (ExceptT (..))+import           Data.Aeson                           (toJSON)+import           Data.Char                            (isSpace)+import qualified Data.DList                           as DL+import qualified Data.HashMap.Strict                  as HashMap+import           Data.List                            (dropWhileEnd, find,+                                                       intercalate)+import qualified Data.Map.Strict                      as Map+import           Data.Maybe                           (catMaybes, fromMaybe)+import           Data.String                          (IsString)+import           Data.Text                            (Text)+import qualified Data.Text                            as T+import           Data.Time                            (getCurrentTime)+import           Data.Typeable                        (Typeable)+import           Development.IDE                      (Action,+                                                       GetDependencies (..),+                                                       GetModIface (..),+                                                       GetModSummary (..),+                                                       GetParsedModuleWithComments (..),+                                                       GhcSessionIO (..),+                                                       HiFileResult (hirHomeMod, hirModSummary),+                                                       HscEnvEq, IdeState,+                                                       ModSummaryResult (..),+                                                       evalGhcEnv,+                                                       hscEnvWithImportPaths,+                                                       prettyPrint,+                                                       realSrcSpanToRange,+                                                       runAction,+                                                       textToStringBuffer,+                                                       toNormalizedFilePath',+                                                       uriToFilePath',+                                                       useNoFile_,+                                                       useWithStale_, use_,+                                                       uses_)+import           Development.IDE.Core.Compile         (loadModulesHome,+                                                       setupFinderCache)+import           Development.IDE.Core.PositionMapping (toCurrentRange)+import           Development.IDE.Core.Rules           (TransitiveDependencies (transitiveModuleDeps))+import           Development.IDE.GHC.Compat           (AnnotationComment (AnnBlockComment, AnnLineComment),+                                                       GenLocated (L),+                                                       GhcException, HscEnv,+                                                       ParsedModule (..),+                                                       SrcSpan (UnhelpfulSpan),+                                                       moduleName,+                                                       setInteractiveDynFlags,+                                                       srcSpanFile)+import qualified Development.IDE.GHC.Compat           as SrcLoc+import           Development.IDE.Types.Options+import           DynamicLoading                       (initializePlugins)+import           FastString                           (unpackFS)+import           GHC                                  (ExecOptions (execLineNumber, execSourceFile),+                                                       GeneralFlag (..), Ghc,+                                                       GhcLink (LinkInMemory),+                                                       GhcMode (CompManager),+                                                       GhcMonad (getSession),+                                                       HscTarget (HscInterpreted),+                                                       LoadHowMuch (LoadAllTargets),+                                                       ModSummary (ms_hspp_opts),+                                                       SuccessFlag (Failed, Succeeded),+                                                       TcRnExprMode (..),+                                                       execOptions, exprType,+                                                       getInteractiveDynFlags,+                                                       getSessionDynFlags,+                                                       isImport, isStmt, load,+                                                       runDecls, setContext,+                                                       setLogAction,+                                                       setSessionDynFlags,+                                                       setTargets, typeKind)+import           GhcPlugins                           (DynFlags (..),+                                                       defaultLogActionHPutStrDoc,+                                                       gopt_set, gopt_unset,+                                                       hsc_dflags,+                                                       parseDynamicFlagsCmdLine,+                                                       targetPlatform, xopt_set)+import           HscTypes                             (InteractiveImport (IIModule),+                                                       ModSummary (ms_mod),+                                                       Target (Target),+                                                       TargetId (TargetFile))+import           Ide.Plugin.Eval.Code                 (Statement, asStatements,+                                                       evalExtensions,+                                                       evalSetup, myExecStmt,+                                                       propSetup, resultRange,+                                                       testCheck, testRanges)+import           Ide.Plugin.Eval.GHC                  (addImport, addPackages,+                                                       hasPackage, showDynFlags)+import           Ide.Plugin.Eval.Parse.Comments       (commentsToSections)+import           Ide.Plugin.Eval.Parse.Option         (parseSetFlags)+import           Ide.Plugin.Eval.Types+import           Ide.Plugin.Eval.Util                 (asS, gStrictTry,+                                                       handleMaybe,+                                                       handleMaybeM, isLiterate,+                                                       logWith, response,+                                                       response', timed)+import           Ide.Types+import           Language.LSP.Server+import           Language.LSP.Types+import           Language.LSP.Types.Lens              (end, line)+import           Language.LSP.VFS                     (virtualFileText)+import           Outputable                           (nest, ppr, showSDoc,+                                                       text, ($$), (<+>))+import           System.FilePath                      (takeFileName)+import           System.IO                            (hClose)+import           UnliftIO.Temporary                   (withSystemTempFile)+import           Util                                 (OverridingBool (Never))+++#if MIN_VERSION_ghc(9,0,0)+import           GHC.Parser.Annotation                (ApiAnns (apiAnnComments))+#else+import           GhcPlugins                           (interpWays, updateWays,+                                                       wayGeneralFlags,+                                                       wayUnsetGeneralFlags)+#endif++#if MIN_VERSION_ghc(9,0,0)+pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcLoc.RealSrcSpan+pattern RealSrcSpanAlready x = x+#else+apiAnnComments :: SrcLoc.ApiAnns -> Map.Map SrcSpan [SrcLoc.Located AnnotationComment]+apiAnnComments = snd++pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcSpan+pattern RealSrcSpanAlready x = SrcLoc.RealSrcSpan x+#endif+++{- | Code Lens provider+ NOTE: Invoked every time the document is modified, not just when the document is saved.+-}+codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens+codeLens st plId CodeLensParams{_textDocument} =+    let dbg = logWith st+        perf = timed dbg+     in perf "codeLens" $+            response $ do+                let TextDocumentIdentifier uri = _textDocument+                fp <- handleMaybe "uri" $ uriToFilePath' uri+                let nfp = toNormalizedFilePath' fp+                    isLHS = isLiterate fp+                dbg "fp" fp+                (ParsedModule{..}, posMap) <- liftIO $+                    runAction "parsed" st $ useWithStale_ GetParsedModuleWithComments nfp+                let comments = foldMap+                        ( foldMap $ \case+                            L (RealSrcSpanAlready real) bdy+                                | unpackFS (srcSpanFile real) ==+                                    fromNormalizedFilePath nfp+                                , let ran0 = realSrcSpanToRange real+                                , Just curRan <- toCurrentRange posMap ran0+                                ->++                                    -- since Haddock parsing is unset explicitly in 'getParsedModuleWithComments',+                                    -- we can concentrate on these two+                                    case bdy of+                                        AnnLineComment cmt ->+                                            mempty { lineComments = Map.singleton curRan (RawLineComment cmt) }+                                        AnnBlockComment cmt ->+                                            mempty { blockComments = Map.singleton curRan $ RawBlockComment cmt }+                                        _ -> mempty+                            _ -> mempty+                        )+                        $ apiAnnComments pm_annotations+                dbg "excluded comments" $ show $  DL.toList $+                    foldMap+                    (foldMap $ \(L a b) ->+                        case b of+                            AnnLineComment{}  -> mempty+                            AnnBlockComment{} -> mempty+                            _                 -> DL.singleton (a, b)+                    )+                    $ apiAnnComments pm_annotations+                dbg "comments" $ show comments++                -- Extract tests from source code+                let Sections{..} = commentsToSections isLHS comments+                    tests = testsBySection nonSetupSections+                    cmd = mkLspCommand plId evalCommandName "Evaluate=..." (Just [])+                let lenses =+                        [ CodeLens testRange (Just cmd') Nothing+                        | (section, ident, test) <- tests+                        , let (testRange, resultRange) = testRanges test+                              args = EvalParams (setupSections ++ [section]) _textDocument ident+                              cmd' =+                                (cmd :: Command)+                                    { _arguments = Just (List [toJSON args])+                                    , _title =+                                        if trivial resultRange+                                            then "Evaluate..."+                                            else "Refresh..."+                                    }+                        ]++                perf "tests" $+                    dbg "Tests" $+                        unwords+                            [ show (length tests)+                            , "tests in"+                            , show (length nonSetupSections)+                            , "sections"+                            , show (length setupSections)+                            , "setups"+                            , show (length lenses)+                            , "lenses."+                            ]++                return $ List lenses+  where+    trivial (Range p p') = p == p'++evalCommandName :: CommandId+evalCommandName = "evalCommand"++evalCommand :: PluginCommand IdeState+evalCommand = PluginCommand evalCommandName "evaluate" runEvalCmd++type EvalId = Int++runEvalCmd :: CommandFunction IdeState EvalParams+runEvalCmd st EvalParams{..} =+    let dbg = logWith st+        perf = timed dbg+        cmd :: ExceptT String (LspM c) WorkspaceEdit+        cmd = do+            let tests = map (\(a,_,b) -> (a,b)) $ testsBySection sections++            let TextDocumentIdentifier{_uri} = module_+            fp <- handleMaybe "uri" $ uriToFilePath' _uri+            let nfp = toNormalizedFilePath' fp+            mdlText <- moduleText _uri++            session <- runGetSession st nfp++            ms <- fmap msrModSummary $+                liftIO $+                    runAction "runEvalCmd.getModSummary" st $+                        use_ GetModSummary nfp++            now <- liftIO getCurrentTime++            let modName = moduleName $ ms_mod ms+                thisModuleTarget =+                    Target+                        (TargetFile fp Nothing)+                        False+                        (Just (textToStringBuffer mdlText, now))++            -- Setup environment for evaluation+            hscEnv' <- ExceptT $ fmap join $ withSystemTempFile (takeFileName fp) $ \logFilename logHandle -> liftIO . gStrictTry . evalGhcEnv session $ do+                env <- getSession++                -- Install the module pragmas and options+                df <- liftIO $ setupDynFlagsForGHCiLike env $ ms_hspp_opts ms++                -- Restore the original import paths+                let impPaths = importPaths $ hsc_dflags env+                df <- return df{importPaths = impPaths}++                -- Set the modified flags in the session+                _lp <- setSessionDynFlags df++                -- property tests need QuickCheck+                when (needsQuickCheck tests) $ void $ addPackages ["QuickCheck"]+                dbg "QUICKCHECK NEEDS" $ needsQuickCheck tests+                dbg "QUICKCHECK HAS" $ hasQuickCheck df++                -- copy the package state to the interactive DynFlags+                idflags <- getInteractiveDynFlags+                df <- getSessionDynFlags+                setInteractiveDynFlags $+                    (foldl xopt_set idflags evalExtensions)+#if MIN_VERSION_ghc(9,0,0)+                        { unitState =+                            unitState+                                df+                        , unitDatabases =+                            unitDatabases+                                df+                        , packageFlags =+                            packageFlags+                                df+                        , useColor = Never+                        , canUseColor = False+                        }+#else+                        { pkgState =+                            pkgState+                                df+                        , pkgDatabase =+                            pkgDatabase+                                df+                        , packageFlags =+                            packageFlags+                                df+                        , useColor = Never+                        , canUseColor = False+                        }+#endif++                -- set up a custom log action+#if MIN_VERSION_ghc(9,0,0)+                setLogAction $ \_df _wr _sev _span _doc ->+                    defaultLogActionHPutStrDoc _df logHandle _doc+#else+                setLogAction $ \_df _wr _sev _span _style _doc ->+                    defaultLogActionHPutStrDoc _df logHandle _doc _style+#endif++                -- Load the module with its current content (as the saved module might not be up to date)+                -- BUG: this fails for files that requires preprocessors (e.g. CPP) for ghc < 8.8+                -- see https://gitlab.haskell.org/ghc/ghc/-/issues/17066+                -- and https://hackage.haskell.org/package/ghc-8.10.1/docs/GHC.html#v:TargetFile+                eSetTarget <- gStrictTry $ setTargets [thisModuleTarget]+                dbg "setTarget" eSetTarget++                -- load the module in the interactive environment+                loadResult <- perf "loadModule" $ load LoadAllTargets+                dbg "LOAD RESULT" $ asS loadResult+                case loadResult of+                    Failed -> liftIO $ do+                        hClose logHandle+                        err <- readFile logFilename+                        dbg "load ERR" err+                        return $ Left err+                    Succeeded -> do+                        -- Evaluation takes place 'inside' the module+                        setContext [IIModule modName]+                        Right <$> getSession++            edits <-+                perf "edits" $+                    liftIO $+                        evalGhcEnv hscEnv' $+                            runTests+                                (st, fp)+                                tests++            let workspaceEditsMap = HashMap.fromList [(_uri, List $ addFinalReturn mdlText edits)]+            let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing++            return workspaceEdits+     in perf "evalCmd" $+            withIndefiniteProgress "Evaluating" Cancellable $+                response' cmd++addFinalReturn :: Text -> [TextEdit] -> [TextEdit]+addFinalReturn mdlText edits+    | not (null edits) && not (T.null mdlText) && T.last mdlText /= '\n' =+        finalReturn mdlText : edits+    | otherwise = edits++finalReturn :: Text -> TextEdit+finalReturn txt =+    let ls = T.lines txt+        l = length ls -1+        c = T.length . last $ ls+        p = Position l c+     in TextEdit (Range p p) "\n"++moduleText :: (IsString e, MonadLsp c m) => Uri -> ExceptT e m Text+moduleText uri =+    handleMaybeM "mdlText" $+      (virtualFileText <$>)+          <$> getVirtualFile+              (toNormalizedUri uri)++testsBySection :: [Section] -> [(Section, EvalId, Test)]+testsBySection sections =+    [(section, ident, test)+    | (ident, section) <- zip [0..] sections+    , test <- sectionTests section+    ]++type TEnv = (IdeState, String)++runTests :: TEnv -> [(Section, Test)] -> Ghc [TextEdit]+runTests e@(_st, _) tests = do+    df <- getInteractiveDynFlags+    evalSetup+    when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals e df propSetup++    mapM (processTest e df) tests+  where+    processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit+    processTest e@(st, fp) df (section, test) = do+        let dbg = logWith st+        let pad = pad_ $ (if isLiterate fp then ("> " `T.append`) else id) $ padPrefix (sectionFormat section)++        rs <- runTest e df test+        dbg "TEST RESULTS" rs++        let checkedResult = testCheck (section, test) rs++        let edit = asEdit (sectionFormat section) test (map pad checkedResult)+        dbg "TEST EDIT" edit+        return edit++    -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]+    runTest _ df test+        | not (hasQuickCheck df) && isProperty test =+            return $+                singleLine+                    "Add QuickCheck to your cabal dependencies to run this test."+    runTest e df test = evals e df (asStatements test)++asEdit :: Format -> Test -> [Text] -> TextEdit+asEdit (MultiLine commRange) test resultLines+    -- A test in a block comment, ending with @-\}@ without newline in-between.+    | testRange test ^. end.line == commRange ^. end . line+    =+    TextEdit+        (Range+            (testRange test ^. end)+            (resultRange test ^. end)+        )+        ("\n" <> T.unlines (resultLines <> ["-}"]))+asEdit _ test resultLines =+    TextEdit (resultRange test) (T.unlines resultLines)++{-+The result of evaluating a test line can be:+* a value+* nothing+* a (possibly multiline) error message++A value is returned for a correct expression.++Either a pure value:+>>> 'h' :"askell"+"haskell"++Or an 'IO a' (output on stdout/stderr is ignored):+>>> print "OK" >> return "ABC"+"ABC"++Nothing is returned for a correct directive:++>>>:set -XFlexibleInstances+>>> import Data.Maybe++Nothing is returned for a correct declaration (let..,x=, data, class)++>>> let x = 11+>>> y = 22+>>> data B = T | F+>>> class C a++Nothing is returned for an empty line:++>>>++A, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:++>>>:set -XNonExistent+Unknown extension: "NonExistent"++>>> cls C+Variable not in scope: cls :: t0 -> ()+Data constructor not in scope: C++>>> "A+lexical error in string/character literal at end of input++>>> 3 `div` 0+divide by zero++>>> error "Something went wrong\nbad times" :: E.SomeException+Something went wrong+bad times++Or for a value that does not have a Show instance and can therefore not be displayed:+>>> data V = V+>>> V+No instance for (Show V)+-}+evals :: TEnv -> DynFlags -> [Statement] -> Ghc [Text]+evals (st, fp) df stmts = do+    er <- gStrictTry $ mapM eval stmts+    return $ case er of+        Left err -> errorLines err+        Right rs -> concat . catMaybes $ rs+  where+    dbg = logWith st+    eval :: Statement -> Ghc (Maybe [Text])+    eval (Located l stmt)+        | -- GHCi flags+          Just (words -> flags) <- parseSetFlags stmt = do+            dbg "{:SET" flags+            ndf <- getInteractiveDynFlags+            dbg "pre set" $ showDynFlags ndf+            eans <-+                liftIO $ try @GhcException $+                parseDynamicFlagsCmdLine ndf+                (map (L $ UnhelpfulSpan "<interactive>") flags)+            dbg "parsed flags" $ eans+              <&> (_1 %~ showDynFlags >>> _3 %~ map warnMsg)+            case eans of+                Left err -> pure $ Just $ errorLines $ show err+                Right (df', ignoreds, warns) -> do+                    let warnings = do+                            guard $ not $ null warns+                            pure $ errorLines $+                                unlines $+                                map prettyWarn warns+                        igns = do+                            guard $ not $ null ignoreds+                            pure+                                ["Some flags have not been recognized: "+                                <> T.pack (intercalate ", " $ map SrcLoc.unLoc ignoreds)+                                ]+                    dbg "post set" $ showDynFlags df'+                    _ <- setSessionDynFlags df'+                    sessDyns <- getSessionDynFlags+                    setInteractiveDynFlags sessDyns+                    pure $ warnings <> igns+        | -- A type/kind command+          Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =+            evalGhciLikeCmd cmd arg+        | -- A statement+          isStmt df stmt =+            do+                dbg "{STMT " stmt+                res <- exec stmt l+                r <- case res of+                    Left err -> return . Just . errorLines $ err+                    Right x  -> return $ singleLine <$> x+                dbg "STMT} -> " r+                return r+        | -- An import+          isImport df stmt =+            do+                dbg "{IMPORT " stmt+                _ <- addImport stmt+                return Nothing+        | -- A declaration+          otherwise =+            do+                dbg "{DECL " stmt+                void $ runDecls stmt+                return Nothing+    exec stmt l =+        let opts = execOptions{execSourceFile = fp, execLineNumber = l}+         in myExecStmt stmt opts++prettyWarn :: Warn -> String+prettyWarn Warn{..} =+    prettyPrint (SrcLoc.getLoc warnMsg) <> ": warning:\n"+    <> "    " <> SrcLoc.unLoc warnMsg++ghcSessionDepsDefinition :: HscEnvEq -> NormalizedFilePath -> Action HscEnv+ghcSessionDepsDefinition env file = do+        let hsc = hscEnvWithImportPaths env+        deps <- use_ GetDependencies file+        let tdeps = transitiveModuleDeps deps+        ifaces <- uses_ GetModIface tdeps++        -- Currently GetDependencies returns things in topological order so A comes before B if A imports B.+        -- We need to reverse this as GHC gets very unhappy otherwise and complains about broken interfaces.+        -- Long-term we might just want to change the order returned by GetDependencies+        let inLoadOrder = reverse (map hirHomeMod ifaces)++        liftIO $ loadModulesHome inLoadOrder <$> setupFinderCache (map hirModSummary ifaces) hsc++runGetSession :: MonadIO m => IdeState -> NormalizedFilePath -> m HscEnv+runGetSession st nfp = liftIO $ runAction "eval" st $ do+    -- Create a new GHC Session rather than reusing an existing one+    -- to avoid interfering with ghcide+    IdeGhcSession{loadSessionFun} <- useNoFile_ GhcSessionIO+    let fp = fromNormalizedFilePath nfp+    ((_, res),_) <- liftIO $ loadSessionFun fp+    let hscEnv = fromMaybe (error $ "Unknown file: " <> fp) res+    ghcSessionDepsDefinition hscEnv nfp++needsQuickCheck :: [(Section, Test)] -> Bool+needsQuickCheck = any (isProperty . snd)++hasQuickCheck :: DynFlags -> Bool+hasQuickCheck df = hasPackage df "QuickCheck"++singleLine :: String -> [Text]+singleLine s = [T.pack s]++{- |+ Convert error messages to a list of text lines+ Remove unnecessary information.+-}+errorLines :: String -> [Text]+errorLines =+        dropWhileEnd T.null+        . takeWhile (not . ("CallStack" `T.isPrefixOf`))+        . T.lines+        . T.pack++{- |+>>> map (pad_ (T.pack "--")) (map T.pack ["2+2",""])+["--2+2","--<BLANKLINE>"]+-}+pad_ :: Text -> Text -> Text+pad_ prefix = (prefix `T.append`) . convertBlank++convertBlank :: Text -> Text+convertBlank x+    | T.null x = "<BLANKLINE>"+    | otherwise = x++padPrefix :: IsString p => Format -> p+padPrefix SingleLine = "-- "+padPrefix _          = ""++{- | Resulting @Text@ MUST NOT prefix each line with @--@+   Such comment-related post-process will be taken place+   solely in 'evalGhciLikeCmd'.+-}+type GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)++-- Should we use some sort of trie here?+ghciLikeCommands :: [(Text, GHCiLikeCmd)]+ghciLikeCommands =+    [("kind", doKindCmd False), ("kind!", doKindCmd True), ("type", doTypeCmd)]++evalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])+evalGhciLikeCmd cmd arg = do+    df <- getSessionDynFlags+    case lookup cmd ghciLikeCommands+        <|> snd+        <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of+        Just hndler ->+            fmap+                T.lines+                <$> hndler df arg+        _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg++doKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)+doKindCmd False df arg = do+    let input = T.strip arg+    (_, kind) <- typeKind False $ T.unpack input+    let kindText = text (T.unpack input) <+> "::" <+> ppr kind+    pure $ Just $ T.pack (showSDoc df kindText)+doKindCmd True df arg = do+    let input = T.strip arg+    (ty, kind) <- typeKind True $ T.unpack input+    let kindDoc = text (T.unpack input) <+> "::" <+> ppr kind+        tyDoc = "=" <+> ppr ty+    pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)++doTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)+doTypeCmd dflags arg = do+    let (emod, expr) = parseExprMode arg+    ty <- exprType emod $ T.unpack expr+    let rawType = T.strip $ T.pack $ showSDoc dflags $ ppr ty+        broken = T.any (\c -> c == '\r' || c == '\n') rawType+    pure $+        Just $+            if broken+                then+                    T.pack $+                        showSDoc dflags $+                            text (T.unpack expr)+                                $$ nest 2 ("::" <+> ppr ty)+                else expr <> " :: " <> rawType <> "\n"++parseExprMode :: Text -> (TcRnExprMode, T.Text)+parseExprMode rawArg = case T.break isSpace rawArg of+    ("+v", rest) -> (TM_NoInst, T.strip rest)+    ("+d", rest) -> (TM_Default, T.strip rest)+    _            -> (TM_Inst, rawArg)++data GhciLikeCmdException = GhciLikeCmdNotImplemented+    { ghciCmdName :: Text+    , ghciCmdArg  :: Text+    }+    deriving (Typeable)++instance Show GhciLikeCmdException where+    showsPrec _ GhciLikeCmdNotImplemented{..} =+        showString "unknown command '"+            . showString (T.unpack ghciCmdName)+            . showChar '\''++instance E.Exception GhciLikeCmdException++{-+>>> parseGhciLikeCmd (T.pack ":kind! N + M + 1")+Just ("kind!","N + M + 1")+>>> parseGhciLikeCmd (T.pack ":kind a")+Just ("kind","a")+-}+parseGhciLikeCmd :: Text -> Maybe (Text, Text)+parseGhciLikeCmd input = do+    (':', rest) <- T.uncons $ T.stripStart input+    pure $ second T.strip $ T.break isSpace rest++setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags+setupDynFlagsForGHCiLike env dflags = do+    let dflags3 =+            dflags+                { hscTarget = HscInterpreted+                , ghcMode = CompManager+                , ghcLink = LinkInMemory+                }+        platform = targetPlatform dflags3+        dflags3a = updateWays $ dflags3{ways = interpWays}+        dflags3b =+            foldl gopt_set dflags3a $+                concatMap (wayGeneralFlags platform) interpWays+        dflags3c =+            foldl gopt_unset dflags3b $+                concatMap (wayUnsetGeneralFlags platform) interpWays+        dflags4 =+            dflags3c+                `gopt_set` Opt_ImplicitImportQualified+                `gopt_set` Opt_IgnoreOptimChanges+                `gopt_set` Opt_IgnoreHpcChanges+                `gopt_unset` Opt_DiagnosticsShowCaret+    initializePlugins env dflags4
src/Ide/Plugin/Eval/GHC.hs view
@@ -1,174 +1,171 @@-{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving  #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports -Wno-orphans #-}
-
--- |GHC API utilities
-module Ide.Plugin.Eval.GHC (
-    addExtension,
-    addImport,
-    hasPackage,
-    addPackages,
-    modifyFlags,
-    showDynFlags,
-) where
-
-import           Data.List                   (isPrefixOf)
-import           Data.Maybe                  (mapMaybe)
-import           Data.String                 (fromString)
-import           Development.IDE.GHC.Compat
-import qualified EnumSet
-import           GHC.LanguageExtensions.Type (Extension (..))
-import           GhcMonad                    (modifySession)
-import           GhcPlugins                  (DefUnitId (..),
-                                              InstalledUnitId (..), fsLit,
-                                              hsc_IC, pprHsString)
-import           HscTypes                    (InteractiveContext (ic_dflags))
-import           Ide.Plugin.Eval.Util        (asS, gStrictTry)
-import qualified Lexer
-import           Module                      (UnitId (DefiniteUnitId))
-import           Outputable                  (Outputable (ppr), SDoc,
-                                              showSDocUnsafe, text, vcat, (<+>))
-import qualified Parser
-import           SrcLoc                      (mkRealSrcLoc)
-import           StringBuffer                (stringToStringBuffer)
-
-{- $setup
->>> import GHC
->>> import GHC.Paths
->>> run act = runGhc (Just libdir) (getInteractiveDynFlags >>= act)
->>> libdir
-"/Users/titto/.ghcup/ghc/8.8.4/lib/ghc-8.8.4"
--}
-
-{- | True if specified package is present in DynFlags
-
--- >>> hasPackageTst pkg = run $ \df -> return (hasPackage df pkg)
->>> hasPackageTst pkg = run $ \_ -> addPackages [pkg] >>= return . either Left (\df -> Right (hasPackage df pkg))
-
->>> hasPackageTst "base"
-Right True
-
->>> hasPackageTst "ghc"
-Right True
-
->>> hasPackageTst "extra"
-Left "<command line>: cannot satisfy -package extra\n    (use -v for more information)"
-
->>> hasPackageTst "QuickCheck"
-Left "<command line>: cannot satisfy -package QuickCheck\n    (use -v for more information)"
--}
-hasPackage :: DynFlags -> String -> Bool
-hasPackage df = hasPackage_ (packageFlags df)
-
-hasPackage_ :: [PackageFlag] -> [Char] -> Bool
-hasPackage_ pkgFlags name = any (name `isPrefixOf`) (pkgNames_ pkgFlags)
-
-{- |
->>> run (return . pkgNames)
-[]
--}
-pkgNames :: DynFlags -> [String]
-pkgNames = pkgNames_ . packageFlags
-
-pkgNames_ :: [PackageFlag] -> [String]
-pkgNames_ =
-    mapMaybe
-        ( \case
-            ExposePackage _ (PackageArg n) _                 -> Just n
-            ExposePackage _ (UnitIdArg (DefiniteUnitId n)) _ -> Just $ asS n
-            _                                                -> Nothing
-        )
-
-{- | Expose a list of packages.
->>> addPackagesTest pkgs = run (\_ -> (packageFlags <$>) <$> addPackages pkgs)
-
->>> addPackagesTest []
-Right []
-
->>> addPackagesTest ["base","base","array"]
-Right [-package base{package base True ([])},-package array{package array True ([])}]
-
->>> addPackagesTest ["Cabal"]
-Right [-package Cabal{package Cabal True ([])}]
-
->>> addPackagesTest ["QuickCheck"]
-Left "<command line>: cannot satisfy -package QuickCheck\n    (use -v for more information)"
-
->>> addPackagesTest ["base","notThere"]
-Left "<command line>: cannot satisfy -package notThere\n    (use -v for more information)"
-
-prop> \(x::Int) -> x + x == 2 * x
-+++ OK, passed 100 tests.
--}
-addPackages :: [String] -> Ghc (Either String DynFlags)
-addPackages pkgNames = gStrictTry $
-    modifyFlags $ \df ->
-        df{packageFlags = foldr (\pkgName pf -> if hasPackage_ pf pkgName then pf else expose pkgName : pf) (packageFlags df) pkgNames}
-  where
-    expose name = ExposePackage ("-package " ++ name) (PackageArg name) (ModRenaming True [])
-
-modifyFlags :: GhcMonad m => (DynFlags -> DynFlags) -> m DynFlags
-modifyFlags f = do
-    df <- getSessionDynFlags
-    _ <- setSessionDynFlags (f df)
-    getSessionDynFlags
-
--- modifyFlags f = do
---         modifyDynFlags f
---         getSessionDynFlags
-
-{- | Add import to evaluation context
-
->>> run $ \_ -> addImport "import Data.Maybe"
-Could not find module ‘Data.Maybe’
-Use -v (or `:set -v` in ghci) to see a list of the files searched for.
-
->>> run $ \df -> addPackages ["base"] >> addImport "import Data.Maybe"
-[import Data.Maybe]
-
->>> run $ \df -> addPackages ["base"] >> addImport "import qualified Data.Maybe as M"
-[import qualified Data.Maybe as M]
--}
-addImport :: GhcMonad m => String -> m [InteractiveImport]
-addImport i = do
-    ctx <- getContext
-    -- dbgO "CONTEXT" ctx
-    idecl <- parseImportDecl i
-    setContext $ IIDecl idecl : ctx
-    -- ctx' <- getContext
-    -- dbg "CONTEXT'" ctx'
-    getContext
-
-{- | Add extension to interactive evaluation session
->>> import GHC.LanguageExtensions.Type(Extension(..))
->>> run $ \_ -> addExtension DeriveGeneric
-()
--}
-addExtension :: GhcMonad m => Extension -> m ()
-addExtension ext =
-    modifySession $ \hsc -> hsc{hsc_IC = setExtension (hsc_IC hsc) ext}
-
-setExtension :: InteractiveContext -> Extension -> InteractiveContext
-setExtension ic ext = ic{ic_dflags = xopt_set (ic_dflags ic) ext}
-
-deriving instance Read Extension
-
--- Partial display of DynFlags contents, for testing purposes
-showDynFlags :: DynFlags -> String
-showDynFlags df =
-    showSDocUnsafe . vcat . map (\(n, d) -> text (n ++ ": ") <+> d) $
-        [ ("extensions", ppr . extensions $ df)
-        , ("extensionFlags", ppr . EnumSet.toList . extensionFlags $ df)
-        , ("importPaths", vList $ importPaths df)
-        , ("generalFlags", pprHsString . fromString . show . EnumSet.toList . generalFlags $ df)
-        , -- , ("includePaths", text . show $ includePaths df)
-          -- ("packageEnv", ppr $ packageEnv df)
-          ("pkgNames", vcat . map text $ pkgNames df)
-        , ("packageFlags", vcat . map ppr $ packageFlags df)
-        -- ,("pkgDatabase",(map) (ppr . installedPackageId) . pkgDatabase $ df)
-        -- ("pkgDatabase", text . show <$> pkgDatabase $ df)
-        ]
-
-vList :: [String] -> SDoc
-vList = vcat . map text
+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -Wno-orphans #-}++-- |GHC API utilities+module Ide.Plugin.Eval.GHC (+    addExtension,+    addImport,+    hasPackage,+    addPackages,+    modifyFlags,+    showDynFlags,+) where++import           Data.List                   (isPrefixOf)+import           Data.Maybe                  (mapMaybe)+import           Data.String                 (fromString)+import           Development.IDE.GHC.Compat+import qualified EnumSet+import           GHC.LanguageExtensions.Type (Extension (..))+import           GhcMonad                    (modifySession)+import           GhcPlugins                  (fsLit, hsc_IC, pprHsString)+import           HscTypes                    (InteractiveContext (ic_dflags))+import           Ide.Plugin.Eval.Util        (asS, gStrictTry)+import qualified Lexer+import           Outputable                  (Outputable (ppr), SDoc,+                                              showSDocUnsafe, text, vcat, (<+>))+import qualified Parser+import           SrcLoc                      (mkRealSrcLoc)+import           StringBuffer                (stringToStringBuffer)++{- $setup+>>> import GHC+>>> import GHC.Paths+>>> run act = runGhc (Just libdir) (getInteractiveDynFlags >>= act)+>>> libdir+"/Users/titto/.ghcup/ghc/8.8.4/lib/ghc-8.8.4"+-}++{- | True if specified package is present in DynFlags++-- >>> hasPackageTst pkg = run $ \df -> return (hasPackage df pkg)+>>> hasPackageTst pkg = run $ \_ -> addPackages [pkg] >>= return . either Left (\df -> Right (hasPackage df pkg))++>>> hasPackageTst "base"+Right True++>>> hasPackageTst "ghc"+Right True++>>> hasPackageTst "extra"+Left "<command line>: cannot satisfy -package extra\n    (use -v for more information)"++>>> hasPackageTst "QuickCheck"+Left "<command line>: cannot satisfy -package QuickCheck\n    (use -v for more information)"+-}+hasPackage :: DynFlags -> String -> Bool+hasPackage df = hasPackage_ (packageFlags df)++hasPackage_ :: [PackageFlag] -> [Char] -> Bool+hasPackage_ pkgFlags name = any (name `isPrefixOf`) (pkgNames_ pkgFlags)++{- |+>>> run (return . pkgNames)+[]+-}+pkgNames :: DynFlags -> [String]+pkgNames = pkgNames_ . packageFlags++pkgNames_ :: [PackageFlag] -> [String]+pkgNames_ =+    mapMaybe+        ( \case+            ExposePackage _ (PackageArg n) _                 -> Just n+            ExposePackage _ (UnitIdArg (DefiniteUnitId n)) _ -> Just $ asS n+            _                                                -> Nothing+        )++{- | Expose a list of packages.+>>> addPackagesTest pkgs = run (\_ -> (packageFlags <$>) <$> addPackages pkgs)++>>> addPackagesTest []+Right []++>>> addPackagesTest ["base","base","array"]+Right [-package base{package base True ([])},-package array{package array True ([])}]++>>> addPackagesTest ["Cabal"]+Right [-package Cabal{package Cabal True ([])}]++>>> addPackagesTest ["QuickCheck"]+Left "<command line>: cannot satisfy -package QuickCheck\n    (use -v for more information)"++>>> addPackagesTest ["base","notThere"]+Left "<command line>: cannot satisfy -package notThere\n    (use -v for more information)"++prop> \(x::Int) -> x + x == 2 * x++++ OK, passed 100 tests.+-}+addPackages :: [String] -> Ghc (Either String DynFlags)+addPackages pkgNames = gStrictTry $+    modifyFlags $ \df ->+        df{packageFlags = foldr (\pkgName pf -> if hasPackage_ pf pkgName then pf else expose pkgName : pf) (packageFlags df) pkgNames}+  where+    expose name = ExposePackage ("-package " ++ name) (PackageArg name) (ModRenaming True [])++modifyFlags :: GhcMonad m => (DynFlags -> DynFlags) -> m DynFlags+modifyFlags f = do+    df <- getSessionDynFlags+    _ <- setSessionDynFlags (f df)+    getSessionDynFlags++-- modifyFlags f = do+--         modifyDynFlags f+--         getSessionDynFlags++{- | Add import to evaluation context++>>> run $ \_ -> addImport "import Data.Maybe"+Could not find module ‘Data.Maybe’+Use -v (or `:set -v` in ghci) to see a list of the files searched for.++>>> run $ \df -> addPackages ["base"] >> addImport "import Data.Maybe"+[import Data.Maybe]++>>> run $ \df -> addPackages ["base"] >> addImport "import qualified Data.Maybe as M"+[import qualified Data.Maybe as M]+-}+addImport :: GhcMonad m => String -> m [InteractiveImport]+addImport i = do+    ctx <- getContext+    -- dbgO "CONTEXT" ctx+    idecl <- parseImportDecl i+    setContext $ IIDecl idecl : ctx+    -- ctx' <- getContext+    -- dbg "CONTEXT'" ctx'+    getContext++{- | Add extension to interactive evaluation session+>>> import GHC.LanguageExtensions.Type(Extension(..))+>>> run $ \_ -> addExtension DeriveGeneric+()+-}+addExtension :: GhcMonad m => Extension -> m ()+addExtension ext =+    modifySession $ \hsc -> hsc{hsc_IC = setExtension (hsc_IC hsc) ext}++setExtension :: InteractiveContext -> Extension -> InteractiveContext+setExtension ic ext = ic{ic_dflags = xopt_set (ic_dflags ic) ext}++deriving instance Read Extension++-- Partial display of DynFlags contents, for testing purposes+showDynFlags :: DynFlags -> String+showDynFlags df =+    showSDocUnsafe . vcat . map (\(n, d) -> text (n ++ ": ") <+> d) $+        [ ("extensions", ppr . extensions $ df)+        , ("extensionFlags", ppr . EnumSet.toList . extensionFlags $ df)+        , ("importPaths", vList $ importPaths df)+        , ("generalFlags", pprHsString . fromString . show . EnumSet.toList . generalFlags $ df)+        , -- , ("includePaths", text . show $ includePaths df)+          -- ("packageEnv", ppr $ packageEnv df)+          ("pkgNames", vcat . map text $ pkgNames df)+        , ("packageFlags", vcat . map ppr $ packageFlags df)+        -- ,("pkgDatabase",(map) (ppr . installedPackageId) . pkgDatabase $ df)+        -- ("pkgDatabase", text . show <$> pkgDatabase $ df)+        ]++vList :: [String] -> SDoc+vList = vcat . map text
src/Ide/Plugin/Eval/Parse/Comments.hs view
@@ -1,571 +1,571 @@-{-# LANGUAGE DeriveGeneric      #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE FlexibleInstances  #-}
-{-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE RankNTypes         #-}
-{-# LANGUAGE RecordWildCards    #-}
-{-# LANGUAGE TemplateHaskell    #-}
-{-# LANGUAGE TupleSections      #-}
-
-module Ide.Plugin.Eval.Parse.Comments where
-
-import qualified Control.Applicative.Combinators.NonEmpty as NE
-import           Control.Arrow                            (first, (&&&), (>>>))
-import           Control.Lens                             (lensField, lensRules,
-                                                           view, (.~), (^.))
-import           Control.Lens.Extras                      (is)
-import           Control.Lens.TH                          (makeLensesWith,
-                                                           makePrisms,
-                                                           mappingNamer)
-import           Control.Monad                            (guard, void, when)
-import           Control.Monad.Combinators                ()
-import           Control.Monad.Reader                     (ask)
-import           Control.Monad.Trans.Reader               (Reader, runReader)
-import qualified Data.Char                                as C
-import qualified Data.DList                               as DL
-import qualified Data.Foldable                            as F
-import           Data.Function                            ((&))
-import           Data.Functor                             ((<&>))
-import           Data.Functor.Identity
-import           Data.List.NonEmpty                       (NonEmpty ((:|)))
-import qualified Data.List.NonEmpty                       as NE
-import           Data.Map.Strict                          (Map)
-import qualified Data.Map.Strict                          as Map
-import qualified Data.Text                                as T
-import           Data.Void                                (Void)
-import           Development.IDE                          (Position,
-                                                           Range (Range))
-import           Development.IDE.Types.Location           (Position (..))
-import           GHC.Generics
-import           Ide.Plugin.Eval.Types
-import           Language.LSP.Types.Lens                  (character, end, line,
-                                                           start)
-import           Text.Megaparsec
-import qualified Text.Megaparsec                          as P
-import           Text.Megaparsec.Char                     (alphaNumChar, char,
-                                                           eol, hspace,
-                                                           letterChar)
-
-{-
-We build parsers combining the following three kinds of them:
-
-    *   Line parser - paring a single line into an input,
-        works both for line- and block-comments.
-        A line should be a proper content of lines contained in comment:
-        doesn't include starting @--@ and @{\-@ and no ending @-\}@
-
-    *   Line comment group parser: parses a contiguous group of
-        tuples of position and line comment into sections of line comments.
-        Each input MUST start with @--@.
-
-    *   Block comment parser: Parsing entire block comment into sections.
-        Input must be surrounded by @{\-@ and @-\}@.
--}
-
--- | Line parser
-type LineParser a = forall m. Monad m => ParsecT Void String m a
-
--- | Line comment group parser
-type LineGroupParser = Parsec Void [(Range, RawLineComment)]
-
-data BlockEnv = BlockEnv
-    { isLhs      :: Bool
-    , blockRange :: Range
-    }
-    deriving (Read, Show, Eq, Ord)
-
-makeLensesWith
-    (lensRules & lensField .~ mappingNamer (pure . (++ "L")))
-    ''BlockEnv
-
--- | Block comment parser
-type BlockCommentParser = ParsecT Void String (Reader BlockEnv)
-
--- | Prop line, with "prop>" stripped off
-newtype PropLine = PropLine {getPropLine :: String}
-    deriving (Show)
-
--- | Example line, with @>>>@ stripped off
-newtype ExampleLine = ExampleLine {getExampleLine :: String}
-    deriving (Show)
-
-data TestComment
-    = AProp
-        { testCommentRange :: Range
-        , lineProp         :: PropLine
-        , propResults      :: [String]
-        }
-    | AnExample
-        { testCommentRange :: Range
-        , lineExamples     :: NonEmpty ExampleLine
-        , exampleResults   :: [String]
-        }
-    deriving (Show)
-
--- | Classification of comments
-data CommentFlavour = Vanilla | HaddockNext | HaddockPrev | Named String
-    deriving (Read, Show, Eq, Ord)
-
--- | Single line or block comments?
-data CommentStyle = Line | Block Range
-    deriving (Read, Show, Eq, Ord, Generic)
-
-makePrisms ''CommentStyle
-
-commentsToSections ::
-    -- | True if it is literate Haskell
-    Bool ->
-    Comments ->
-    Sections
-commentsToSections isLHS Comments {..} =
-    let (lineSectionSeeds, lineSetupSeeds) =
-            foldMap
-                ( \lcs ->
-                    let theRan =
-                            Range
-                                (view start $ fst $ NE.head lcs)
-                                (view end $ fst $ NE.last lcs)
-                     in case parseMaybe lineGroupP $ NE.toList lcs of
-                            Nothing -> mempty
-                            Just (mls, rs) ->
-                                ( maybe mempty (uncurry Map.singleton) ((theRan,) <$> mls)
-                                , -- orders setup sections in ascending order
-                                  if null rs
-                                    then mempty
-                                    else
-                                        Map.singleton theRan $
-                                            DL.singleton (Line, rs)
-                                )
-                )
-                $ groupLineComments $
-                    Map.filterWithKey
-                        -- FIXME:
-                        -- To comply with the initial behaviour of
-                        -- Extended Eval Plugin;
-                        -- but it also rejects modules with
-                        -- non-zero base indentation level!
-                        ( \pos _ ->
-                            if isLHS
-                                then pos ^. start . character == 2
-                                else pos ^. start . character == 0
-                        )
-                        lineComments
-        (blockSeed, blockSetupSeeds) =
-            foldMap
-                ( \(ran, lcs) ->
-                    case parseBlockMaybe isLHS ran blockCommentBP $
-                        getRawBlockComment lcs of
-                        Nothing -> mempty
-                        Just (Named "setup", grp) ->
-                            -- orders setup sections in ascending order
-                            ( mempty
-                            , Map.singleton ran $
-                                DL.singleton (Block ran, grp)
-                            )
-                        Just grp ->
-                            ( Map.singleton ran grp
-                            , mempty
-                            )
-                )
-                -- It seems Extended Eval Plugin doesn't constraint
-                -- starting indentation level for block comments.
-                -- Rather, it constrains the indentation level /inside/
-                -- block comment body.
-                $ Map.toList blockComments
-        lineSections =
-            lineSectionSeeds <&> uncurry (testsToSection Line)
-        multilineSections =
-            Map.mapWithKey
-                (uncurry . testsToSection . Block)
-                blockSeed
-        setupSections =
-            -- Setups doesn't need Dummy position
-            map
-                ( \(style, tests) ->
-                    testsToSection
-                        style
-                        (Named "setup")
-                        tests
-                )
-                $ DL.toList $
-                    F.fold $
-                        Map.unionWith (<>) lineSetupSeeds blockSetupSeeds
-        nonSetupSections = F.toList $ lineSections `Map.union` multilineSections
-     in Sections {..}
-
-parseBlockMaybe :: Bool -> Range -> BlockCommentParser a -> String -> Maybe a
-parseBlockMaybe isLhs blockRange p i =
-    case runReader (runParserT p' "" i) BlockEnv {..} of
-        Left {} -> Nothing
-        Right a -> Just a
-    where
-        p' = do
-            updateParserState $ \st ->
-                st
-                    { statePosState =
-                        (statePosState st)
-                            { pstateSourcePos = positionToSourcePos $ blockRange ^. start
-                            }
-                    }
-            p
-
-type CommentRange = Range
-
-type SectionRange = Range
-
-testsToSection ::
-    CommentStyle ->
-    CommentFlavour ->
-    [TestComment] ->
-    Section
-testsToSection style flav tests =
-    let sectionName
-            | Named name <- flav = name
-            | otherwise = ""
-        sectionLanguage = case flav of
-            HaddockNext -> Haddock
-            HaddockPrev -> Haddock
-            _           -> Plain
-        sectionTests = map fromTestComment tests
-        sectionFormat =
-            case style of
-                Line      -> SingleLine
-                Block ran -> MultiLine ran
-     in Section {..}
-
-fromTestComment :: TestComment -> Test
-fromTestComment AProp {..} =
-    Property
-        { testline = getPropLine lineProp
-        , testOutput = propResults
-        , testRange = testCommentRange
-        }
-fromTestComment AnExample {..} =
-    Example
-        { testLines = getExampleLine <$> lineExamples
-        , testOutput = exampleResults
-        , testRange = testCommentRange
-        }
-
--- * Block comment parser
-
-{- $setup
->>> dummyPos = Position 0 0
->>> parseE p = either (error . errorBundlePretty) id . parse p ""
--}
-
--- >>> parseE (blockCommentBP True dummyPos) "{- |\n  >>> 5+5\n  11\n  -}"
--- (HaddockNext,[AnExample {testCommentRange = Position {_line = 1, _character = 0}, lineExamples = ExampleLine {getExampleLine = " 5+5"} :| [], exampleResults = ["  11"]}])
-
-blockCommentBP ::
-    -- | True if Literate Haskell
-    BlockCommentParser (CommentFlavour, [TestComment])
-blockCommentBP = do
-    skipCount 2 anySingle -- "{-"
-    void $ optional $ char ' '
-    flav <- commentFlavourP
-    hit <- skipNormalCommentBlock
-    if hit
-        then do
-            body <-
-                many $
-                    (blockExamples <|> blockProp)
-                        <* skipNormalCommentBlock
-            void takeRest -- just consume the rest
-            pure (flav, body)
-        else pure (flav, [])
-
-skipNormalCommentBlock :: BlockCommentParser Bool
-skipNormalCommentBlock = do
-    BlockEnv {..} <- ask
-    skipManyTill (normalLineP isLhs $ Block blockRange) $
-        False <$ try (optional (chunk "-}") *> eof)
-            <|> True <$ lookAhead (try $ testSymbol isLhs $ Block blockRange)
-
-testSymbol :: Bool -> CommentStyle -> LineParser ()
-testSymbol isLHS style =
-    -- FIXME: To comply with existing Extended Eval Plugin Behaviour;
-    -- it must skip one space after a comment!
-    -- This prevents Eval Plugin from working on
-    -- modules with non-standard base indentation-level.
-    when (isLHS && is _Block style) (void $ count' 0 2 $ char ' ')
-        *> (exampleSymbol <|> propSymbol)
-
-eob :: LineParser ()
-eob = eof <|> try (optional (chunk "-}") *> eof) <|> void eol
-
-blockExamples
-    , blockProp ::
-        BlockCommentParser TestComment
-blockExamples = do
-    BlockEnv {..} <- ask
-    (ran, examples) <- withRange $ NE.some $ exampleLineStrP isLhs $ Block blockRange
-    AnExample ran examples <$> resultBlockP
-blockProp = do
-    BlockEnv {..} <- ask
-    (ran, Identity prop) <- withRange $ fmap Identity $ propLineStrP isLhs $ Block blockRange
-    AProp ran prop <$> resultBlockP
-
-withRange ::
-    (TraversableStream s, Stream s, Monad m, Ord v, Traversable t) =>
-    ParsecT v s m (t (a, Position)) ->
-    ParsecT v s m (Range, t a)
-withRange p = do
-    beg <- sourcePosToPosition <$> getSourcePos
-    as <- p
-    let fin
-            | null as = beg
-            | otherwise = snd $ last $ F.toList as
-    pure (Range beg fin, fst <$> as)
-
-resultBlockP :: BlockCommentParser [String]
-resultBlockP = do
-    BlockEnv {..} <- ask
-    many $
-        fmap fst . nonEmptyNormalLineP isLhs $
-            Block blockRange
-
-positionToSourcePos :: Position -> SourcePos
-positionToSourcePos pos =
-    P.SourcePos
-        { sourceName = "<block comment>"
-        , sourceLine = P.mkPos $ 1 + pos ^. line
-        , sourceColumn = P.mkPos $ 1 + pos ^. character
-        }
-
-sourcePosToPosition :: SourcePos -> Position
-sourcePosToPosition SourcePos {..} =
-    Position (unPos sourceLine - 1) (unPos sourceColumn - 1)
-
--- * Line Group Parser
-
-{- |
-Result: a tuple of ordinary line tests and setting sections.
-
-TODO: Haddock comment can adjacent to vanilla comment:
-
-    @
-        -- Vanilla comment
-        -- Another vanilla
-        -- | This parses as Haddock comment as GHC
-    @
-
-This behaviour is not yet handled correctly in Eval Plugin;
-but for future extension for this, we use a tuple here instead of 'Either'.
--}
-lineGroupP ::
-    LineGroupParser
-        (Maybe (CommentFlavour, [TestComment]), [TestComment])
-lineGroupP = do
-    (_, flav) <- lookAhead $ parseLine (commentFlavourP <* takeRest)
-    case flav of
-        Named "setup" -> (Nothing,) <$> lineCommentSectionsP
-        flav          -> (,mempty) . Just . (flav,) <$> lineCommentSectionsP
-
--- >>>  parse (lineGroupP <*eof) "" $ (dummyPosition, ) . RawLineComment <$> ["-- a", "-- b"]
--- Variable not in scope: dummyPosition :: Position
-
-commentFlavourP :: LineParser CommentFlavour
-commentFlavourP =
-    P.option
-        Vanilla
-        ( HaddockNext <$ char '|'
-            <|> HaddockPrev <$ char '^'
-            <|> Named <$ char '$'
-                <* optional hspace
-                <*> ((:) <$> letterChar <*> P.many alphaNumChar)
-        )
-        <* optional (char ' ')
-
-lineCommentHeadP :: LineParser ()
-lineCommentHeadP = do
-    -- and no operator symbol character follows.
-    void $ chunk "--"
-    skipMany $ char '-'
-    void $ optional $ char ' '
-
-lineCommentSectionsP ::
-    LineGroupParser [TestComment]
-lineCommentSectionsP = do
-    skipMany normalLineCommentP
-    many $
-        exampleLinesGP
-            <|> uncurry AProp <$> propLineGP <*> resultLinesP
-                <* skipMany normalLineCommentP
-
-lexemeLine :: LineGroupParser a -> LineGroupParser a
-lexemeLine p = p <* skipMany normalLineCommentP
-
-resultLinesP :: LineGroupParser [String]
-resultLinesP = many nonEmptyLGP
-
-normalLineCommentP :: LineGroupParser (Range, String)
-normalLineCommentP =
-    parseLine (fst <$ commentFlavourP <*> normalLineP False Line)
-
-nonEmptyLGP :: LineGroupParser String
-nonEmptyLGP =
-    try $
-        fmap snd $
-            parseLine $
-                fst <$ commentFlavourP <*> nonEmptyNormalLineP False Line
-
-exampleLinesGP :: LineGroupParser TestComment
-exampleLinesGP =
-    lexemeLine $
-        uncurry AnExample . first convexHullRange . NE.unzip
-            <$> NE.some exampleLineGP
-            <*> resultLinesP
-
-convexHullRange :: NonEmpty Range -> Range
-convexHullRange nes =
-    Range (NE.head nes ^. start) (NE.last nes ^. end)
-
-exampleLineGP :: LineGroupParser (Range, ExampleLine)
-exampleLineGP =
-    -- In line-comments, indentation-level inside comment doesn't matter.
-    parseLine (fst <$ commentFlavourP <*> exampleLineStrP False Line)
-
-propLineGP :: LineGroupParser (Range, PropLine)
-propLineGP =
-    -- In line-comments, indentation-level inside comment doesn't matter.
-    parseLine (fst <$ commentFlavourP <*> propLineStrP False Line)
-
-{- |
-Turning a line parser into line group parser consuming a single line comment.
-Parses a sinlge line comment, skipping prefix "--[-*]" with optional one horizontal space.
-fails if the input does not start with "--".
-
-__N.B.__ We don't strip comment flavours.
-
->>> pck = (:[]).(:[]) . RawLineComment
-
->>> parseMaybe (parseLine $ takeRest) $ pck "-- >>> A"
-Just [">>> A"]
-
->>> parseMaybe (parseLine $ takeRest) $ pck "---  >>> A"
-Just [" >>> A"]
-
->>> parseMaybe (parseLine takeRest) $ pck ""
-Nothing
--}
-parseLine ::
-    (Ord (f RawLineComment), Traversable f) =>
-    LineParser a ->
-    Parsec Void [f RawLineComment] (f a)
-parseLine p =
-    P.token
-        (mapM $ parseMaybe (lineCommentHeadP *> p) . getRawLineComment)
-        mempty
-
--- * Line Parsers
-
--- | Non-empty normal line.
-nonEmptyNormalLineP ::
-    -- | True if Literate Haskell
-    Bool ->
-    CommentStyle ->
-    LineParser (String, Position)
-nonEmptyNormalLineP isLHS style = try $ do
-    (ln, pos) <- normalLineP isLHS style
-    guard $
-        case style of
-            Block{} -> T.strip (T.pack ln) `notElem` ["{-", "-}", ""]
-            _       -> not $ all C.isSpace ln
-    pure (ln, pos)
-
-{- | Normal line is a line neither a example nor prop.
- Empty line is normal.
--}
-normalLineP ::
-    -- | True if Literate Haskell
-    Bool ->
-    CommentStyle ->
-    LineParser (String, Position)
-normalLineP isLHS style = do
-    notFollowedBy
-        (try $ testSymbol isLHS style)
-    when (isLHS && is _Block style) $
-        void $ count' 0 2 $ char ' '
-    consume style
-
-consume :: CommentStyle -> LineParser (String, Position)
-consume style =
-    case style of
-        Line     -> (,) <$> takeRest <*> getPosition
-        Block {} -> manyTill_ anySingle (getPosition <* eob)
-
-getPosition :: (Ord v, TraversableStream s) => ParsecT v s m Position
-getPosition = sourcePosToPosition <$> getSourcePos
-
--- | Parses example test line.
-exampleLineStrP ::
-    -- | True if Literate Haskell
-    Bool ->
-    CommentStyle ->
-    LineParser (ExampleLine, Position)
-exampleLineStrP isLHS style =
-    try $
-        -- FIXME: To comply with existing Extended Eval Plugin Behaviour;
-        -- it must skip one space after a comment!
-        -- This prevents Eval Plugin from working on
-        -- modules with non-standard base indentation-level.
-        when (isLHS && is _Block style) (void $ count' 0 2 $ char ' ')
-            *> exampleSymbol
-            *> (first ExampleLine <$> consume style)
-
-exampleSymbol :: LineParser ()
-exampleSymbol =
-    chunk ">>>" *> P.notFollowedBy (char '>')
-
-propSymbol :: LineParser ()
-propSymbol = chunk "prop>" *> P.notFollowedBy (char '>')
-
--- | Parses prop test line.
-propLineStrP ::
-    -- | True if Literate HAskell
-    Bool ->
-    CommentStyle ->
-    LineParser (PropLine, Position)
-propLineStrP isLHS style =
-    -- FIXME: To comply with existing Extended Eval Plugin Behaviour;
-    -- it must skip one space after a comment!
-    -- This prevents Eval Plugin from working on
-    -- modules with non-standard base indentation-level.
-    when (isLHS && is _Block style) (void $ count' 0 2 $ char ' ')
-        *> chunk "prop>"
-        *> P.notFollowedBy (char '>')
-        *> (first PropLine <$> consume style)
-
--- * Utilities
-
-{- |
-Given a sequence of tokens increasing in their starting position,
-groups them into sublists consisting of contiguous tokens;
-Two adjacent tokens are considered to be contiguous if
-
-    * line number increases by 1, and
-    * they have same starting column.
-
->>> contiguousGroupOn id [(1,2),(2,2),(3,4),(4,4),(5,4),(7,0),(8,0)]
-[(1,2) :| [(2,2)],(3,4) :| [(4,4),(5,4)],(7,0) :| [(8,0)]]
--}
-contiguousGroupOn :: (a -> (Int, Int)) -> [a] -> [NonEmpty a]
-contiguousGroupOn toLineCol = foldr step []
-    where
-        step a [] = [pure a]
-        step a bss0@((b :| bs) : bss)
-            | let (aLine, aCol) = toLineCol a
-              , let (bLine, bCol) = toLineCol b
-              , aLine + 1 == bLine && aCol == bCol =
-                (a :| b : bs) : bss
-            | otherwise = pure a : bss0
-
-{- | Given a map from positions, divides them into subgroup
- with contiguous line and columns.
--}
-groupLineComments ::
-    Map Range a -> [NonEmpty (Range, a)]
-groupLineComments =
-    contiguousGroupOn (fst >>> view start >>> view line &&& view character)
-        . Map.toList
+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TupleSections      #-}++module Ide.Plugin.Eval.Parse.Comments where++import qualified Control.Applicative.Combinators.NonEmpty as NE+import           Control.Arrow                            (first, (&&&), (>>>))+import           Control.Lens                             (lensField, lensRules,+                                                           view, (.~), (^.))+import           Control.Lens.Extras                      (is)+import           Control.Lens.TH                          (makeLensesWith,+                                                           makePrisms,+                                                           mappingNamer)+import           Control.Monad                            (guard, void, when)+import           Control.Monad.Combinators                ()+import           Control.Monad.Reader                     (ask)+import           Control.Monad.Trans.Reader               (Reader, runReader)+import qualified Data.Char                                as C+import qualified Data.DList                               as DL+import qualified Data.Foldable                            as F+import           Data.Function                            ((&))+import           Data.Functor                             ((<&>))+import           Data.Functor.Identity+import           Data.List.NonEmpty                       (NonEmpty ((:|)))+import qualified Data.List.NonEmpty                       as NE+import           Data.Map.Strict                          (Map)+import qualified Data.Map.Strict                          as Map+import qualified Data.Text                                as T+import           Data.Void                                (Void)+import           Development.IDE                          (Position,+                                                           Range (Range))+import           Development.IDE.Types.Location           (Position (..))+import           GHC.Generics+import           Ide.Plugin.Eval.Types+import           Language.LSP.Types.Lens                  (character, end, line,+                                                           start)+import           Text.Megaparsec+import qualified Text.Megaparsec                          as P+import           Text.Megaparsec.Char                     (alphaNumChar, char,+                                                           eol, hspace,+                                                           letterChar)++{-+We build parsers combining the following three kinds of them:++    *   Line parser - paring a single line into an input,+        works both for line- and block-comments.+        A line should be a proper content of lines contained in comment:+        doesn't include starting @--@ and @{\-@ and no ending @-\}@++    *   Line comment group parser: parses a contiguous group of+        tuples of position and line comment into sections of line comments.+        Each input MUST start with @--@.++    *   Block comment parser: Parsing entire block comment into sections.+        Input must be surrounded by @{\-@ and @-\}@.+-}++-- | Line parser+type LineParser a = forall m. Monad m => ParsecT Void String m a++-- | Line comment group parser+type LineGroupParser = Parsec Void [(Range, RawLineComment)]++data BlockEnv = BlockEnv+    { isLhs      :: Bool+    , blockRange :: Range+    }+    deriving (Read, Show, Eq, Ord)++makeLensesWith+    (lensRules & lensField .~ mappingNamer (pure . (++ "L")))+    ''BlockEnv++-- | Block comment parser+type BlockCommentParser = ParsecT Void String (Reader BlockEnv)++-- | Prop line, with "prop>" stripped off+newtype PropLine = PropLine {getPropLine :: String}+    deriving (Show)++-- | Example line, with @>>>@ stripped off+newtype ExampleLine = ExampleLine {getExampleLine :: String}+    deriving (Show)++data TestComment+    = AProp+        { testCommentRange :: Range+        , lineProp         :: PropLine+        , propResults      :: [String]+        }+    | AnExample+        { testCommentRange :: Range+        , lineExamples     :: NonEmpty ExampleLine+        , exampleResults   :: [String]+        }+    deriving (Show)++-- | Classification of comments+data CommentFlavour = Vanilla | HaddockNext | HaddockPrev | Named String+    deriving (Read, Show, Eq, Ord)++-- | Single line or block comments?+data CommentStyle = Line | Block Range+    deriving (Read, Show, Eq, Ord, Generic)++makePrisms ''CommentStyle++commentsToSections ::+    -- | True if it is literate Haskell+    Bool ->+    Comments ->+    Sections+commentsToSections isLHS Comments {..} =+    let (lineSectionSeeds, lineSetupSeeds) =+            foldMap+                ( \lcs ->+                    let theRan =+                            Range+                                (view start $ fst $ NE.head lcs)+                                (view end $ fst $ NE.last lcs)+                     in case parseMaybe lineGroupP $ NE.toList lcs of+                            Nothing -> mempty+                            Just (mls, rs) ->+                                ( maybe mempty (uncurry Map.singleton) ((theRan,) <$> mls)+                                , -- orders setup sections in ascending order+                                  if null rs+                                    then mempty+                                    else+                                        Map.singleton theRan $+                                            DL.singleton (Line, rs)+                                )+                )+                $ groupLineComments $+                    Map.filterWithKey+                        -- FIXME:+                        -- To comply with the initial behaviour of+                        -- Extended Eval Plugin;+                        -- but it also rejects modules with+                        -- non-zero base indentation level!+                        ( \pos _ ->+                            if isLHS+                                then pos ^. start . character == 2+                                else pos ^. start . character == 0+                        )+                        lineComments+        (blockSeed, blockSetupSeeds) =+            foldMap+                ( \(ran, lcs) ->+                    case parseBlockMaybe isLHS ran blockCommentBP $+                        getRawBlockComment lcs of+                        Nothing -> mempty+                        Just (Named "setup", grp) ->+                            -- orders setup sections in ascending order+                            ( mempty+                            , Map.singleton ran $+                                DL.singleton (Block ran, grp)+                            )+                        Just grp ->+                            ( Map.singleton ran grp+                            , mempty+                            )+                )+                -- It seems Extended Eval Plugin doesn't constraint+                -- starting indentation level for block comments.+                -- Rather, it constrains the indentation level /inside/+                -- block comment body.+                $ Map.toList blockComments+        lineSections =+            lineSectionSeeds <&> uncurry (testsToSection Line)+        multilineSections =+            Map.mapWithKey+                (uncurry . testsToSection . Block)+                blockSeed+        setupSections =+            -- Setups doesn't need Dummy position+            map+                ( \(style, tests) ->+                    testsToSection+                        style+                        (Named "setup")+                        tests+                )+                $ DL.toList $+                    F.fold $+                        Map.unionWith (<>) lineSetupSeeds blockSetupSeeds+        nonSetupSections = F.toList $ lineSections `Map.union` multilineSections+     in Sections {..}++parseBlockMaybe :: Bool -> Range -> BlockCommentParser a -> String -> Maybe a+parseBlockMaybe isLhs blockRange p i =+    case runReader (runParserT p' "" i) BlockEnv {..} of+        Left {} -> Nothing+        Right a -> Just a+    where+        p' = do+            updateParserState $ \st ->+                st+                    { statePosState =+                        (statePosState st)+                            { pstateSourcePos = positionToSourcePos $ blockRange ^. start+                            }+                    }+            p++type CommentRange = Range++type SectionRange = Range++testsToSection ::+    CommentStyle ->+    CommentFlavour ->+    [TestComment] ->+    Section+testsToSection style flav tests =+    let sectionName+            | Named name <- flav = name+            | otherwise = ""+        sectionLanguage = case flav of+            HaddockNext -> Haddock+            HaddockPrev -> Haddock+            _           -> Plain+        sectionTests = map fromTestComment tests+        sectionFormat =+            case style of+                Line      -> SingleLine+                Block ran -> MultiLine ran+     in Section {..}++fromTestComment :: TestComment -> Test+fromTestComment AProp {..} =+    Property+        { testline = getPropLine lineProp+        , testOutput = propResults+        , testRange = testCommentRange+        }+fromTestComment AnExample {..} =+    Example+        { testLines = getExampleLine <$> lineExamples+        , testOutput = exampleResults+        , testRange = testCommentRange+        }++-- * Block comment parser++{- $setup+>>> dummyPos = Position 0 0+>>> parseE p = either (error . errorBundlePretty) id . parse p ""+-}++-- >>> parseE (blockCommentBP True dummyPos) "{- |\n  >>> 5+5\n  11\n  -}"+-- (HaddockNext,[AnExample {testCommentRange = Position {_line = 1, _character = 0}, lineExamples = ExampleLine {getExampleLine = " 5+5"} :| [], exampleResults = ["  11"]}])++blockCommentBP ::+    -- | True if Literate Haskell+    BlockCommentParser (CommentFlavour, [TestComment])+blockCommentBP = do+    skipCount 2 anySingle -- "{-"+    void $ optional $ char ' '+    flav <- commentFlavourP+    hit <- skipNormalCommentBlock+    if hit+        then do+            body <-+                many $+                    (blockExamples <|> blockProp)+                        <* skipNormalCommentBlock+            void takeRest -- just consume the rest+            pure (flav, body)+        else pure (flav, [])++skipNormalCommentBlock :: BlockCommentParser Bool+skipNormalCommentBlock = do+    BlockEnv {..} <- ask+    skipManyTill (normalLineP isLhs $ Block blockRange) $+        False <$ try (optional (chunk "-}") *> eof)+            <|> True <$ lookAhead (try $ testSymbol isLhs $ Block blockRange)++testSymbol :: Bool -> CommentStyle -> LineParser ()+testSymbol isLHS style =+    -- FIXME: To comply with existing Extended Eval Plugin Behaviour;+    -- it must skip one space after a comment!+    -- This prevents Eval Plugin from working on+    -- modules with non-standard base indentation-level.+    when (isLHS && is _Block style) (void $ count' 0 2 $ char ' ')+        *> (exampleSymbol <|> propSymbol)++eob :: LineParser ()+eob = eof <|> try (optional (chunk "-}") *> eof) <|> void eol++blockExamples+    , blockProp ::+        BlockCommentParser TestComment+blockExamples = do+    BlockEnv {..} <- ask+    (ran, examples) <- withRange $ NE.some $ exampleLineStrP isLhs $ Block blockRange+    AnExample ran examples <$> resultBlockP+blockProp = do+    BlockEnv {..} <- ask+    (ran, Identity prop) <- withRange $ fmap Identity $ propLineStrP isLhs $ Block blockRange+    AProp ran prop <$> resultBlockP++withRange ::+    (TraversableStream s, Stream s, Monad m, Ord v, Traversable t) =>+    ParsecT v s m (t (a, Position)) ->+    ParsecT v s m (Range, t a)+withRange p = do+    beg <- sourcePosToPosition <$> getSourcePos+    as <- p+    let fin+            | null as = beg+            | otherwise = snd $ last $ F.toList as+    pure (Range beg fin, fst <$> as)++resultBlockP :: BlockCommentParser [String]+resultBlockP = do+    BlockEnv {..} <- ask+    many $+        fmap fst $ nonEmptyNormalLineP isLhs $+            Block blockRange++positionToSourcePos :: Position -> SourcePos+positionToSourcePos pos =+    P.SourcePos+        { sourceName = "<block comment>"+        , sourceLine = P.mkPos $ 1 + pos ^. line+        , sourceColumn = P.mkPos $ 1 + pos ^. character+        }++sourcePosToPosition :: SourcePos -> Position+sourcePosToPosition SourcePos {..} =+    Position (unPos sourceLine - 1) (unPos sourceColumn - 1)++-- * Line Group Parser++{- |+Result: a tuple of ordinary line tests and setting sections.++TODO: Haddock comment can adjacent to vanilla comment:++    @+        -- Vanilla comment+        -- Another vanilla+        -- | This parses as Haddock comment as GHC+    @++This behaviour is not yet handled correctly in Eval Plugin;+but for future extension for this, we use a tuple here instead of 'Either'.+-}+lineGroupP ::+    LineGroupParser+        (Maybe (CommentFlavour, [TestComment]), [TestComment])+lineGroupP = do+    (_, flav) <- lookAhead $ parseLine (commentFlavourP <* takeRest)+    case flav of+        Named "setup" -> (Nothing,) <$> lineCommentSectionsP+        flav          -> (,mempty) . Just . (flav,) <$> lineCommentSectionsP++-- >>>  parse (lineGroupP <*eof) "" $ (dummyPosition, ) . RawLineComment <$> ["-- a", "-- b"]+-- Variable not in scope: dummyPosition :: Position++commentFlavourP :: LineParser CommentFlavour+commentFlavourP =+    P.option+        Vanilla+        ( HaddockNext <$ char '|'+            <|> HaddockPrev <$ char '^'+            <|> Named <$ char '$'+                <* optional hspace+                <*> ((:) <$> letterChar <*> P.many alphaNumChar)+        )+        <* optional (char ' ')++lineCommentHeadP :: LineParser ()+lineCommentHeadP = do+    -- and no operator symbol character follows.+    void $ chunk "--"+    skipMany $ char '-'+    void $ optional $ char ' '++lineCommentSectionsP ::+    LineGroupParser [TestComment]+lineCommentSectionsP = do+    skipMany normalLineCommentP+    many $+        exampleLinesGP+            <|> uncurry AProp <$> propLineGP <*> resultLinesP+                <* skipMany normalLineCommentP++lexemeLine :: LineGroupParser a -> LineGroupParser a+lexemeLine p = p <* skipMany normalLineCommentP++resultLinesP :: LineGroupParser [String]+resultLinesP = many nonEmptyLGP++normalLineCommentP :: LineGroupParser (Range, String)+normalLineCommentP =+    parseLine (fst <$ commentFlavourP <*> normalLineP False Line)++nonEmptyLGP :: LineGroupParser String+nonEmptyLGP =+    try $+        fmap snd $+            parseLine $+                fst <$ commentFlavourP <*> nonEmptyNormalLineP False Line++exampleLinesGP :: LineGroupParser TestComment+exampleLinesGP =+    lexemeLine $+        uncurry AnExample . first convexHullRange . NE.unzip+            <$> NE.some exampleLineGP+            <*> resultLinesP++convexHullRange :: NonEmpty Range -> Range+convexHullRange nes =+    Range (NE.head nes ^. start) (NE.last nes ^. end)++exampleLineGP :: LineGroupParser (Range, ExampleLine)+exampleLineGP =+    -- In line-comments, indentation-level inside comment doesn't matter.+    parseLine (fst <$ commentFlavourP <*> exampleLineStrP False Line)++propLineGP :: LineGroupParser (Range, PropLine)+propLineGP =+    -- In line-comments, indentation-level inside comment doesn't matter.+    parseLine (fst <$ commentFlavourP <*> propLineStrP False Line)++{- |+Turning a line parser into line group parser consuming a single line comment.+Parses a sinlge line comment, skipping prefix "--[-*]" with optional one horizontal space.+fails if the input does not start with "--".++__N.B.__ We don't strip comment flavours.++>>> pck = (:[]).(:[]) . RawLineComment++>>> parseMaybe (parseLine $ takeRest) $ pck "-- >>> A"+Just [">>> A"]++>>> parseMaybe (parseLine $ takeRest) $ pck "---  >>> A"+Just [" >>> A"]++>>> parseMaybe (parseLine takeRest) $ pck ""+Nothing+-}+parseLine ::+    (Ord (f RawLineComment), Traversable f) =>+    LineParser a ->+    Parsec Void [f RawLineComment] (f a)+parseLine p =+    P.token+        (mapM $ parseMaybe (lineCommentHeadP *> p) . getRawLineComment)+        mempty++-- * Line Parsers++-- | Non-empty normal line.+nonEmptyNormalLineP ::+    -- | True if Literate Haskell+    Bool ->+    CommentStyle ->+    LineParser (String, Position)+nonEmptyNormalLineP isLHS style = try $ do+    (ln, pos) <- normalLineP isLHS style+    guard $+        case style of+            Block{} -> T.strip (T.pack ln) `notElem` ["{-", "-}", ""]+            _       -> not $ all C.isSpace ln+    pure (ln, pos)++{- | Normal line is a line neither a example nor prop.+ Empty line is normal.+-}+normalLineP ::+    -- | True if Literate Haskell+    Bool ->+    CommentStyle ->+    LineParser (String, Position)+normalLineP isLHS style = do+    notFollowedBy+        (try $ testSymbol isLHS style)+    when (isLHS && is _Block style) $+        void $ count' 0 2 $ char ' '+    consume style++consume :: CommentStyle -> LineParser (String, Position)+consume style =+    case style of+        Line     -> (,) <$> takeRest <*> getPosition+        Block {} -> manyTill_ anySingle (getPosition <* eob)++getPosition :: (Ord v, TraversableStream s) => ParsecT v s m Position+getPosition = sourcePosToPosition <$> getSourcePos++-- | Parses example test line.+exampleLineStrP ::+    -- | True if Literate Haskell+    Bool ->+    CommentStyle ->+    LineParser (ExampleLine, Position)+exampleLineStrP isLHS style =+    try $+        -- FIXME: To comply with existing Extended Eval Plugin Behaviour;+        -- it must skip one space after a comment!+        -- This prevents Eval Plugin from working on+        -- modules with non-standard base indentation-level.+        when (isLHS && is _Block style) (void $ count' 0 2 $ char ' ')+            *> exampleSymbol+            *> (first ExampleLine <$> consume style)++exampleSymbol :: LineParser ()+exampleSymbol =+    chunk ">>>" *> P.notFollowedBy (char '>')++propSymbol :: LineParser ()+propSymbol = chunk "prop>" *> P.notFollowedBy (char '>')++-- | Parses prop test line.+propLineStrP ::+    -- | True if Literate HAskell+    Bool ->+    CommentStyle ->+    LineParser (PropLine, Position)+propLineStrP isLHS style =+    -- FIXME: To comply with existing Extended Eval Plugin Behaviour;+    -- it must skip one space after a comment!+    -- This prevents Eval Plugin from working on+    -- modules with non-standard base indentation-level.+    when (isLHS && is _Block style) (void $ count' 0 2 $ char ' ')+        *> chunk "prop>"+        *> P.notFollowedBy (char '>')+        *> (first PropLine <$> consume style)++-- * Utilities++{- |+Given a sequence of tokens increasing in their starting position,+groups them into sublists consisting of contiguous tokens;+Two adjacent tokens are considered to be contiguous if++    * line number increases by 1, and+    * they have same starting column.++>>> contiguousGroupOn id [(1,2),(2,2),(3,4),(4,4),(5,4),(7,0),(8,0)]+[(1,2) :| [(2,2)],(3,4) :| [(4,4),(5,4)],(7,0) :| [(8,0)]]+-}+contiguousGroupOn :: (a -> (Int, Int)) -> [a] -> [NonEmpty a]+contiguousGroupOn toLineCol = foldr step []+    where+        step a [] = [pure a]+        step a bss0@((b :| bs) : bss)+            | let (aLine, aCol) = toLineCol a+              , let (bLine, bCol) = toLineCol b+              , aLine + 1 == bLine && aCol == bCol =+                (a :| b : bs) : bss+            | otherwise = pure a : bss0++{- | Given a map from positions, divides them into subgroup+ with contiguous line and columns.+-}+groupLineComments ::+    Map Range a -> [NonEmpty (Range, a)]+groupLineComments =+    contiguousGroupOn (fst >>> view start >>> view line &&& view character)+        . Map.toList
src/Ide/Plugin/Eval/Parse/Option.hs view
@@ -1,40 +1,40 @@-{-# OPTIONS_GHC -Wwarn #-}
-
--- | GHC language options parser
-module Ide.Plugin.Eval.Parse.Option (
-    langOptions,
-    parseSetFlags,
-) where
-
-import           Control.Arrow        (left)
-import           Data.Void            (Void)
-import           Text.Megaparsec
-import           Text.Megaparsec.Char
-
-{- |
->>> langOptions ":set   -XBinaryLiterals  -XOverloadedStrings "
-Right ["BinaryLiterals","OverloadedStrings"]
-
->>> langOptions ":set"
-Right []
-
->>> langOptions ""
-Left "No match"
--}
-langOptions :: String -> Either String [String]
-langOptions =
-  left errorBundlePretty
-  . parse (space *> languageOpts <* eof) ""
-
-parseSetFlags :: String -> Maybe String
-parseSetFlags = parseMaybe
-    (hspace *> chunk ":set"
-        *> hspace1 *> takeRest
-        :: Parsec Void String String
-    )
-
--- >>> parseMaybe languageOpts ":set -XBinaryLiterals -XOverloadedStrings"
--- Just ["BinaryLiterals","OverloadedStrings"]
-languageOpts :: Parsec Void String [String]
-languageOpts = string ":set" *> space1
-  *> many (string "-X" *> many letterChar <* space)
+{-# OPTIONS_GHC -Wwarn #-}++-- | GHC language options parser+module Ide.Plugin.Eval.Parse.Option (+    langOptions,+    parseSetFlags,+) where++import           Control.Arrow        (left)+import           Data.Void            (Void)+import           Text.Megaparsec+import           Text.Megaparsec.Char++{- |+>>> langOptions ":set   -XBinaryLiterals  -XOverloadedStrings "+Right ["BinaryLiterals","OverloadedStrings"]++>>> langOptions ":set"+Right []++>>> langOptions ""+Left "No match"+-}+langOptions :: String -> Either String [String]+langOptions =+  left errorBundlePretty+  . parse (space *> languageOpts <* eof) ""++parseSetFlags :: String -> Maybe String+parseSetFlags = parseMaybe+    (hspace *> chunk ":set"+        *> hspace1 *> takeRest+        :: Parsec Void String String+    )++-- >>> parseMaybe languageOpts ":set -XBinaryLiterals -XOverloadedStrings"+-- Just ["BinaryLiterals","OverloadedStrings"]+languageOpts :: Parsec Void String [String]+languageOpts = string ":set" *> space1+  *> many (string "-X" *> many letterChar <* space)
src/Ide/Plugin/Eval/Types.hs view
@@ -1,162 +1,162 @@-{-# LANGUAGE DeriveAnyClass             #-}
-{-# LANGUAGE DeriveFunctor              #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE DerivingStrategies         #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE UndecidableInstances       #-}
-{-# OPTIONS_GHC -Wwarn #-}
-
-module Ide.Plugin.Eval.Types
-    ( locate,
-      locate0,
-      Test (..),
-      isProperty,
-      Format (..),
-      Language (..),
-      Section (..),
-      Sections (..),
-      hasTests,
-      hasPropertyTest,
-      splitSections,
-      Loc,
-      Located (..),
-      Comments (..),
-      RawBlockComment (..),
-      RawLineComment (..),
-      unLoc,
-      Txt,
-      EvalParams(..),
-    )
-where
-
-import           Control.DeepSeq    (NFData (rnf), deepseq)
-import           Data.Aeson         (FromJSON, ToJSON)
-import           Data.List          (partition)
-import           Data.List.NonEmpty (NonEmpty)
-import           Data.Map.Strict    (Map)
-import           Data.String        (IsString (..))
-import           Development.IDE    (Range)
-import           GHC.Generics       (Generic)
-import           Language.LSP.Types (TextDocumentIdentifier)
-import qualified Text.Megaparsec    as P
-
--- | A thing with a location attached.
-data Located l a = Located {location :: l, located :: a}
-    deriving (Eq, Show, Ord, Functor, Generic, FromJSON, ToJSON)
-
--- | Discard location information.
-unLoc :: Located l a -> a
-unLoc (Located _ a) = a
-
-instance (NFData l, NFData a) => NFData (Located l a) where
-    rnf (Located loc a) = loc `deepseq` a `deepseq` ()
-
-type Loc = Located Line
-
-type Line = Int
-
-locate :: Loc [a] -> [Loc a]
-locate (Located l tst) = zipWith Located [l ..] tst
-
-locate0 :: [a] -> [Loc a]
-locate0 = locate . Located 0
-
-type Txt = String
-
-data Sections = Sections
-    { nonSetupSections :: [Section]
-    , setupSections    :: [Section]
-    }
-    deriving (Show, Eq, Generic)
-
-data Section = Section
-    { sectionName     :: Txt
-    , sectionTests    :: [Test]
-    , sectionLanguage :: Language
-    , sectionFormat   :: Format
-    }
-    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)
-
-hasTests :: Section -> Bool
-hasTests = not . null . sectionTests
-
-hasPropertyTest :: Section -> Bool
-hasPropertyTest = any isProperty . sectionTests
-
--- |Split setup and normal sections
-splitSections :: [Section] -> ([Section], [Section])
-splitSections = partition ((== "setup") . sectionName)
-
-data Test
-    = Example {testLines :: NonEmpty Txt, testOutput :: [Txt], testRange :: Range}
-    | Property {testline :: Txt, testOutput :: [Txt], testRange :: Range}
-    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)
-
-data Comments = Comments
-    { lineComments  :: Map Range RawLineComment
-    , blockComments :: Map Range RawBlockComment
-    }
-    deriving (Show, Eq, Ord, Generic)
-
-newtype RawBlockComment = RawBlockComment {getRawBlockComment :: String}
-    deriving (Show, Eq, Ord)
-    deriving newtype
-        ( IsString
-        , P.Stream
-        , P.TraversableStream
-        , P.VisualStream
-        , Semigroup
-        , Monoid
-        )
-
-newtype RawLineComment = RawLineComment {getRawLineComment :: String}
-    deriving (Show, Eq, Ord)
-    deriving newtype
-        ( IsString
-        , P.Stream
-        , P.TraversableStream
-        , P.VisualStream
-        , Semigroup
-        , Monoid
-        )
-
-instance Semigroup Comments where
-    Comments ls bs <> Comments ls' bs' = Comments (ls <> ls') (bs <> bs')
-
-instance Monoid Comments where
-    mempty = Comments mempty mempty
-
-isProperty :: Test -> Bool
-isProperty Property {} = True
-isProperty _           = False
-
-data Format
-    = SingleLine
-    | -- | @Range@ is that of surrounding entire block comment, not section.
-      -- Used for detecting no-newline test commands.
-      MultiLine Range
-    deriving (Eq, Show, Ord, Generic, FromJSON, ToJSON, NFData)
-
-data Language = Plain | Haddock deriving (Eq, Show, Generic, Ord, FromJSON, ToJSON, NFData)
-
-data ExpectedLine = ExpectedLine [LineChunk] | WildCardLine
-    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)
-
-instance IsString ExpectedLine where
-    fromString = ExpectedLine . return . LineChunk
-
-data LineChunk = LineChunk String | WildCardChunk
-    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)
-
-instance IsString LineChunk where
-    fromString = LineChunk
-
-type EvalId = Int
-
--- | Specify the test section to execute
-data EvalParams = EvalParams
-    { sections :: [Section]
-    , module_  :: !TextDocumentIdentifier
-    , evalId   :: !EvalId -- ^ unique group id; for test uses
-    }
-    deriving (Eq, Show, Generic, FromJSON, ToJSON)
+{-# LANGUAGE DeriveAnyClass             #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE UndecidableInstances       #-}+{-# OPTIONS_GHC -Wwarn #-}++module Ide.Plugin.Eval.Types+    ( locate,+      locate0,+      Test (..),+      isProperty,+      Format (..),+      Language (..),+      Section (..),+      Sections (..),+      hasTests,+      hasPropertyTest,+      splitSections,+      Loc,+      Located (..),+      Comments (..),+      RawBlockComment (..),+      RawLineComment (..),+      unLoc,+      Txt,+      EvalParams(..),+    )+where++import           Control.DeepSeq    (NFData (rnf), deepseq)+import           Data.Aeson         (FromJSON, ToJSON)+import           Data.List          (partition)+import           Data.List.NonEmpty (NonEmpty)+import           Data.Map.Strict    (Map)+import           Data.String        (IsString (..))+import           Development.IDE    (Range)+import           GHC.Generics       (Generic)+import           Language.LSP.Types (TextDocumentIdentifier)+import qualified Text.Megaparsec    as P++-- | A thing with a location attached.+data Located l a = Located {location :: l, located :: a}+    deriving (Eq, Show, Ord, Functor, Generic, FromJSON, ToJSON)++-- | Discard location information.+unLoc :: Located l a -> a+unLoc (Located _ a) = a++instance (NFData l, NFData a) => NFData (Located l a) where+    rnf (Located loc a) = loc `deepseq` a `deepseq` ()++type Loc = Located Line++type Line = Int++locate :: Loc [a] -> [Loc a]+locate (Located l tst) = zipWith Located [l ..] tst++locate0 :: [a] -> [Loc a]+locate0 = locate . Located 0++type Txt = String++data Sections = Sections+    { nonSetupSections :: [Section]+    , setupSections    :: [Section]+    }+    deriving (Show, Eq, Generic)++data Section = Section+    { sectionName     :: Txt+    , sectionTests    :: [Test]+    , sectionLanguage :: Language+    , sectionFormat   :: Format+    }+    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)++hasTests :: Section -> Bool+hasTests = not . null . sectionTests++hasPropertyTest :: Section -> Bool+hasPropertyTest = any isProperty . sectionTests++-- |Split setup and normal sections+splitSections :: [Section] -> ([Section], [Section])+splitSections = partition ((== "setup") . sectionName)++data Test+    = Example {testLines :: NonEmpty Txt, testOutput :: [Txt], testRange :: Range}+    | Property {testline :: Txt, testOutput :: [Txt], testRange :: Range}+    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)++data Comments = Comments+    { lineComments  :: Map Range RawLineComment+    , blockComments :: Map Range RawBlockComment+    }+    deriving (Show, Eq, Ord, Generic)++newtype RawBlockComment = RawBlockComment {getRawBlockComment :: String}+    deriving (Show, Eq, Ord)+    deriving newtype+        ( IsString+        , P.Stream+        , P.TraversableStream+        , P.VisualStream+        , Semigroup+        , Monoid+        )++newtype RawLineComment = RawLineComment {getRawLineComment :: String}+    deriving (Show, Eq, Ord)+    deriving newtype+        ( IsString+        , P.Stream+        , P.TraversableStream+        , P.VisualStream+        , Semigroup+        , Monoid+        )++instance Semigroup Comments where+    Comments ls bs <> Comments ls' bs' = Comments (ls <> ls') (bs <> bs')++instance Monoid Comments where+    mempty = Comments mempty mempty++isProperty :: Test -> Bool+isProperty Property {} = True+isProperty _           = False++data Format+    = SingleLine+    | -- | @Range@ is that of surrounding entire block comment, not section.+      -- Used for detecting no-newline test commands.+      MultiLine Range+    deriving (Eq, Show, Ord, Generic, FromJSON, ToJSON, NFData)++data Language = Plain | Haddock deriving (Eq, Show, Generic, Ord, FromJSON, ToJSON, NFData)++data ExpectedLine = ExpectedLine [LineChunk] | WildCardLine+    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)++instance IsString ExpectedLine where+    fromString = ExpectedLine . return . LineChunk++data LineChunk = LineChunk String | WildCardChunk+    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)++instance IsString LineChunk where+    fromString = LineChunk++type EvalId = Int++-- | Specify the test section to execute+data EvalParams = EvalParams+    { sections :: [Section]+    , module_  :: !TextDocumentIdentifier+    , evalId   :: !EvalId -- ^ unique group id; for test uses+    }+    deriving (Eq, Show, Generic, FromJSON, ToJSON)
src/Ide/Plugin/Eval/Util.hs view
@@ -1,105 +1,106 @@-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE ScopedTypeVariables       #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- |Debug utilities
-module Ide.Plugin.Eval.Util (
-    asS,
-    timed,
-    isLiterate,
-    handleMaybe,
-    handleMaybeM,
-    response,
-    response',
-    gStrictTry,
-    logWith,
-) where
-
-import           Control.Monad.Extra        (maybeM)
-import           Control.Monad.IO.Class     (MonadIO (liftIO))
-import           Control.Monad.Trans.Class  (lift)
-import           Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE)
-import           Data.Aeson                 (Value (Null))
-import           Data.Bifunctor             (first)
-import           Data.String                (IsString (fromString))
-import qualified Data.Text                  as T
-import           Development.IDE            (IdeState, Priority (..), ideLogger,
-                                             logPriority)
-import           Exception                  (ExceptionMonad, SomeException (..),
-                                             evaluate, gcatch)
-import           GHC.Exts                   (toList)
-import           GHC.Stack                  (HasCallStack, callStack,
-                                             srcLocFile, srcLocStartCol,
-                                             srcLocStartLine)
-import           Language.LSP.Server
-import           Language.LSP.Types
-import           Outputable                 (Outputable (ppr), ppr,
-                                             showSDocUnsafe)
-import           System.FilePath            (takeExtension)
-import           System.Time.Extra          (duration, showDuration)
-import           UnliftIO.Exception         (catchAny)
-
-asS :: Outputable a => a -> String
-asS = showSDocUnsafe . ppr
-
-timed :: MonadIO m => (t -> String -> m a) -> t -> m b -> m b
-timed out name op = do
-    (secs, r) <- duration op
-    _ <- out name (showDuration secs)
-    return r
-
--- |Log using hie logger, reports source position of logging statement
-logWith :: (HasCallStack, MonadIO m, Show a1, Show a2) => IdeState -> a1 -> a2 -> m ()
-logWith state key val =
-    liftIO . logPriority (ideLogger state) logLevel $
-        T.unwords
-            [T.pack logWithPos, asT key, asT val]
-  where
-    logWithPos =
-        let stk = toList callStack
-            pr pos = concat [srcLocFile pos, ":", show . srcLocStartLine $ pos, ":", show . srcLocStartCol $ pos]
-         in if null stk then "" else pr . snd . head $ stk
-
-    asT :: Show a => a -> T.Text
-    asT = T.pack . show
-
--- | Set to Info to see extensive debug info in hie log, set to Debug in production
-logLevel :: Priority
-logLevel = Debug -- Info
-
-isLiterate :: FilePath -> Bool
-isLiterate x = takeExtension x `elem` [".lhs", ".lhs-boot"]
-
-handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
-handleMaybe msg = maybe (throwE msg) return
-
-handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
-handleMaybeM msg act = maybeM (throwE msg) return $ lift act
-
-response :: Functor f => ExceptT String f c -> f (Either ResponseError c)
-response =
-    fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing))
-        . runExceptT
-
-response' :: ExceptT String (LspM c) WorkspaceEdit -> LspM c (Either ResponseError Value)
-response' act = do
-    res <- runExceptT act
-             `catchAny` showErr
-    case res of
-      Left e ->
-          return $ Left (ResponseError InternalError (fromString e) Nothing)
-      Right a -> do
-        _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing a) (\_ -> pure ())
-        return $ Right Null
-
-gStrictTry :: ExceptionMonad m => m b -> m (Either String b)
-gStrictTry op =
-    gcatch
-        (op >>= fmap Right . gevaluate)
-        showErr
-
-gevaluate :: MonadIO m => a -> m a
-gevaluate = liftIO . evaluate
-
-showErr :: Monad m => SomeException -> m (Either String b)
-showErr = return . Left . show
+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |Debug utilities+module Ide.Plugin.Eval.Util (+    asS,+    timed,+    isLiterate,+    handleMaybe,+    handleMaybeM,+    response,+    response',+    gStrictTry,+    logWith,+) where++import           Control.Monad.Extra        (maybeM)+import           Control.Monad.IO.Class     (MonadIO (liftIO))+import           Control.Monad.Trans.Class  (lift)+import           Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE)+import           Data.Aeson                 (Value (Null))+import           Data.Bifunctor             (first)+import           Data.String                (IsString (fromString))+import qualified Data.Text                  as T+import           Development.IDE            (IdeState, Priority (..), ideLogger,+                                             logPriority)+import           Development.IDE.GHC.Compat (gcatch)+import           Exception                  (ExceptionMonad, SomeException (..),+                                             evaluate)+import           GHC.Exts                   (toList)+import           GHC.Stack                  (HasCallStack, callStack,+                                             srcLocFile, srcLocStartCol,+                                             srcLocStartLine)+import           Language.LSP.Server+import           Language.LSP.Types+import           Outputable                 (Outputable (ppr), ppr,+                                             showSDocUnsafe)+import           System.FilePath            (takeExtension)+import           System.Time.Extra          (duration, showDuration)+import           UnliftIO.Exception         (catchAny)++asS :: Outputable a => a -> String+asS = showSDocUnsafe . ppr++timed :: MonadIO m => (t -> String -> m a) -> t -> m b -> m b+timed out name op = do+    (secs, r) <- duration op+    _ <- out name (showDuration secs)+    return r++-- |Log using hie logger, reports source position of logging statement+logWith :: (HasCallStack, MonadIO m, Show a1, Show a2) => IdeState -> a1 -> a2 -> m ()+logWith state key val =+    liftIO . logPriority (ideLogger state) logLevel $+        T.unwords+            [T.pack logWithPos, asT key, asT val]+  where+    logWithPos =+        let stk = toList callStack+            pr pos = concat [srcLocFile pos, ":", show . srcLocStartLine $ pos, ":", show . srcLocStartCol $ pos]+         in if null stk then "" else pr . snd . head $ stk++    asT :: Show a => a -> T.Text+    asT = T.pack . show++-- | Set to Info to see extensive debug info in hie log, set to Debug in production+logLevel :: Priority+logLevel = Debug -- Info++isLiterate :: FilePath -> Bool+isLiterate x = takeExtension x `elem` [".lhs", ".lhs-boot"]++handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b+handleMaybe msg = maybe (throwE msg) return++handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b+handleMaybeM msg act = maybeM (throwE msg) return $ lift act++response :: Functor f => ExceptT String f c -> f (Either ResponseError c)+response =+    fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing))+        . runExceptT++response' :: ExceptT String (LspM c) WorkspaceEdit -> LspM c (Either ResponseError Value)+response' act = do+    res <- runExceptT act+             `catchAny` showErr+    case res of+      Left e ->+          return $ Left (ResponseError InternalError (fromString e) Nothing)+      Right a -> do+        _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing a) (\_ -> pure ())+        return $ Right Null++gStrictTry :: ExceptionMonad m => m b -> m (Either String b)+gStrictTry op =+    gcatch+        (op >>= fmap Right . gevaluate)+        showErr++gevaluate :: MonadIO m => a -> m a+gevaluate = liftIO . evaluate++showErr :: Monad m => SomeException -> m (Either String b)+showErr = return . Left . show
test/Main.hs view
@@ -1,218 +1,137 @@-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE ViewPatterns          #-}
-
-module Main (
-    main,
-) where
-
-import           Control.Lens            (_Just, preview, view)
-import           Control.Monad           (when)
-import           Data.Aeson              (fromJSON)
-import           Data.Aeson.Types        (Result (Success))
-import           Data.List.Extra         (nubOrdOn)
-import qualified Data.Text               as T
-import qualified Data.Text.IO            as T
-import qualified Ide.Plugin.Eval         as Eval
-import           Ide.Plugin.Eval.Types   (EvalParams (..))
-import           Language.LSP.Types.Lens (command, range, title)
-import           System.Directory        (doesFileExist)
-import           System.FilePath         ((<.>), (</>))
-import           Test.Hls
-
-main :: IO ()
-main = defaultTestRunner tests
-
-evalPlugin :: PluginDescriptor IdeState
-evalPlugin = Eval.descriptor "eval"
-
-tests :: TestTree
-tests =
-    testGroup
-        "eval"
-        [ testCase "Produces Evaluate code lenses" $
-            runSessionWithServer evalPlugin evalPath $ do
-                doc <- openDoc "T1.hs" "haskell"
-                lenses <- getEvalCodeLenses doc
-                liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Evaluate..."]
-        , testCase "Produces Refresh code lenses" $
-            runSessionWithServer evalPlugin evalPath $ do
-                doc <- openDoc "T2.hs" "haskell"
-                lenses <- getEvalCodeLenses doc
-                liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Refresh..."]
-        , testCase "Code lenses have ranges" $
-            runSessionWithServer evalPlugin evalPath $ do
-                doc <- openDoc "T1.hs" "haskell"
-                lenses <- getEvalCodeLenses doc
-                liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]
-        , testCase "Multi-line expressions have a multi-line range" $ do
-            runSessionWithServer evalPlugin evalPath $ do
-                doc <- openDoc "T3.hs" "haskell"
-                lenses <- getEvalCodeLenses doc
-                liftIO $ map (view range) lenses @?= [Range (Position 3 0) (Position 5 0)]
-        , testCase "Executed expressions range covers only the expression" $ do
-            runSessionWithServer evalPlugin evalPath $ do
-                doc <- openDoc "T2.hs" "haskell"
-                lenses <- getEvalCodeLenses doc
-                liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]
-        , testCase "Evaluation of expressions" $ goldenTest "T1.hs"
-        , testCase "Reevaluation of expressions" $ goldenTest "T2.hs"
-        , testCase "Evaluation of expressions w/ imports" $ goldenTest "T3.hs"
-        , testCase "Evaluation of expressions w/ lets" $ goldenTest "T4.hs"
-        , testCase "Refresh an evaluation" $ goldenTest "T5.hs"
-        , testCase "Refresh an evaluation w/ lets" $ goldenTest "T6.hs"
-        , testCase "Refresh a multiline evaluation" $ goldenTest "T7.hs"
-        , testCase "Semantic and Lexical errors are reported" $ goldenTest "T8.hs"
-        , testCase "Applies file LANGUAGE extensions" $ goldenTest "T9.hs"
-        , testCase "Evaluate a type with :kind!" $ goldenTest "T10.hs"
-        , testCase "Reports an error for an incorrect type with :kind!" $
-            goldenTest "T11.hs"
-        , testCase "Shows a kind with :kind" $ goldenTest "T12.hs"
-        , testCase "Reports an error for an incorrect type with :kind" $
-            goldenTest "T13.hs"
-        , testCase "Returns a fully-instantiated type for :type" $
-            goldenTest "T14.hs"
-        , testCase "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" $
-            goldenTest "T15.hs"
-        , testCase "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" $
-            goldenTest "T16.hs"
-        , testCase ":type reports an error when given with unknown +x option" $
-            goldenTest "T17.hs"
-        , testCase "Reports an error when given with unknown command" $
-            goldenTest "T18.hs"
-        , testCase "Returns defaulted type for :type +d reflecting the default declaration specified in the >>> prompt" $
-            goldenTest "T19.hs"
-        , expectFailBecause "known issue - see a note in P.R. #361" $
-            testCase ":type +d reflects the `default' declaration of the module" $
-                goldenTest "T20.hs"
-        , testCase ":type handles a multilined result properly" $
-            goldenTest "T21.hs"
-        , testCase ":t behaves exactly the same as :type" $
-            goldenTest "T22.hs"
-        , testCase ":type does \"dovetails\" for short identifiers" $
-            goldenTest "T23.hs"
-        , testCase ":kind! treats a multilined result properly" $
-            goldenTest "T24.hs"
-        , testCase ":kind treats a multilined result properly" $
-            goldenTest "T25.hs"
-        , testCase "local imports" $
-            goldenTest "T26.hs"
-        , testCase "Preserves one empty comment line after prompt" $
-            goldenTest "T27.hs"
-        , testCase
-            "Multi line comments"
-            $ goldenTest "TMulti.hs"
-        , testCase
-            "Multi line comments, with the last test line ends without newline"
-            $ goldenTest "TEndingMulti.hs"
-        , testCase
-            "Evaluate expressions in Plain comments in both single line and multi line format"
-            $ goldenTest "TPlainComment.hs"
-        , testCase
-            "Evaluate expressions in Haddock comments in both single line and multi line format"
-            $ goldenTest "THaddock.hs"
-        , testCase "Compare results (for Haddock tests only)" $
-            goldenTest "TCompare.hs"
-        , testCase "Local Modules imports are accessible in a test" $
-            goldenTest "TLocalImport.hs"
-        , -- , testCase "Local Modules can be imported in a test" $ goldenTest "TLocalImportInTest.hs"
-          expectFailBecause "Unexplained but minor issue" $
-            testCase "Setting language option TupleSections" $
-                goldenTest "TLanguageOptionsTupleSections.hs"
-        , testCase ":set accepts ghci flags" $
-            goldenTest "TFlags.hs"
-        , testCase "IO expressions are supported, stdout/stderr output is ignored" $
-            goldenTest "TIO.hs"
-        , testCase "Property checking" $ goldenTest "TProperty.hs"
-        , testCase
-            "Prelude has no special treatment, it is imported as stated in the module"
-            $ goldenTest "TPrelude.hs"
-        , testCase
-            "Don't panic on {-# UNPACK #-} pragma"
-            $ goldenTest "TUNPACK.hs"
-        , testCase
-            "Can handle eval inside nested comment properly"
-            $ goldenTest "TNested.hs"
-        , testCase "Test on last line insert results correctly" $ do
-                let mdl = "TLastLine.hs"
-                -- Write the test file, to make sure that it has no final line return
-                writeFile (evalPath </> mdl) "module TLastLine where\n\n-- >>> take 3 [1..]"
-                goldenTest mdl
-            , testGroup "with preprocessors"
-            [ knownBrokenInEnv [HostOS Windows, GhcVer GHC84, GhcVer GHC86]
-                "CPP eval on Windows and/or GHC <= 8.6 fails for some reasons" $
-              testCase "CPP support" $ goldenTest "TCPP.hs"
-            , knownBrokenForGhcVersions [GHC84, GHC86]
-                "Preprocessor known to fail on GHC <= 8.6"
-                $ testCase "Literate Haskell Bird Style" $ goldenTest "TLHS.lhs"
-            -- , testCase "Literate Haskell LaTeX Style" $ goldenTest "TLHSLateX.lhs"
-            ]
-        , testCase "Works with NoImplicitPrelude"
-            $ goldenTest "TNoImplicitPrelude.hs"
-        , testCase "Variable 'it' works"
-            $ goldenTest "TIt.hs"
-        ]
-
-goldenTest :: FilePath -> IO ()
-goldenTest = goldenTestBy isEvalTest
-
-{- |Execute all CodeLens accepted by 'filter'
- Compare results with the contents of corresponding '.expected' file (and creates it, if missing)
--}
-goldenTestBy :: (CodeLens -> Bool) -> FilePath -> IO ()
-goldenTestBy fltr input = runSessionWithServer evalPlugin evalPath $ do
-    doc <- openDoc input "haskell"
-
-    -- Execute lenses backwards, to avoid affecting their position in the source file
-    codeLenses <- reverse <$> getCodeLensesBy fltr doc
-    -- liftIO $ print codeLenses
-
-    -- Execute sequentially, nubbing elements to avoid
-    -- evaluating the same section with multiple tests
-    -- more than twice
-    mapM_ executeCmd
-        $ nubOrdOn actSectionId [c | CodeLens{_command = Just c} <- codeLenses]
-
-    edited <- replaceUnicodeQuotes <$> documentContents doc
-    -- liftIO $ T.putStrLn edited
-
-    let expectedFile = input <.> "expected"
-
-    liftIO $ do
-        -- Write expected file if missing
-        missingExpected <- not <$> doesFileExist expectedFile
-        when missingExpected $ T.writeFile expectedFile edited
-        expected <- T.readFile expectedFile
-        edited @?= expected
-
-actSectionId :: Command -> Int
-actSectionId Command{_arguments = Just (List [fromJSON -> Success EvalParams{..}])} = evalId
-actSectionId _ = error "Invalid CodeLens"
-
-getEvalCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
-getEvalCodeLenses = getCodeLensesBy isEvalTest
-
-getCodeLensesBy :: (CodeLens -> Bool) -> TextDocumentIdentifier -> Session [CodeLens]
-getCodeLensesBy f doc = filter f <$> getCodeLenses doc
-
--- Execute command and wait for result
-executeCmd :: Command -> Session ()
-executeCmd cmd = do
-    executeCommand cmd
-    _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit)
-    -- liftIO $ print _resp
-    return ()
-
--- Execute only Eval tests to avoid interference from other plugins (e.g ghcide:typesignature.add)
-isEvalTest :: CodeLens -> Bool
-isEvalTest (CodeLens _ (Just (Command _ cmd _)) _)
-    | ":eval:" `T.isInfixOf` cmd = True
-isEvalTest _ = False
-
-replaceUnicodeQuotes :: T.Text -> T.Text
-replaceUnicodeQuotes = T.replace "‘" "'" . T.replace "’" "'"
-
-evalPath :: FilePath
-evalPath = "test" </> "testdata"
+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE ViewPatterns      #-}++module Main+  ( main+  ) where++import           Control.Lens            (_Just, preview, view)+import           Control.Monad           (when)+import           Data.Aeson              (fromJSON)+import           Data.Aeson.Types        (Result (Success))+import           Data.List.Extra         (nubOrdOn)+import qualified Ide.Plugin.Eval         as Eval+import           Ide.Plugin.Eval.Types   (EvalParams (..))+import           Language.LSP.Types.Lens (command, range, title)+import           System.Directory        (doesFileExist)+import           System.FilePath         ((<.>), (</>))+import           Test.Hls++main :: IO ()+main = defaultTestRunner tests++evalPlugin :: PluginDescriptor IdeState+evalPlugin = Eval.descriptor "eval"++tests :: TestTree+tests =+  testGroup "eval"+  [ testCase "Produces Evaluate code lenses" $+      runSessionWithServer evalPlugin testDataDir $ do+        doc <- openDoc "T1.hs" "haskell"+        lenses <- getCodeLenses doc+        liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Evaluate..."]+  , testCase "Produces Refresh code lenses" $+      runSessionWithServer evalPlugin testDataDir $ do+        doc <- openDoc "T2.hs" "haskell"+        lenses <- getCodeLenses doc+        liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Refresh..."]+  , testCase "Code lenses have ranges" $+      runSessionWithServer evalPlugin testDataDir $ do+        doc <- openDoc "T1.hs" "haskell"+        lenses <- getCodeLenses doc+        liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]+  , testCase "Multi-line expressions have a multi-line range" $ do+      runSessionWithServer evalPlugin testDataDir $ do+        doc <- openDoc "T3.hs" "haskell"+        lenses <- getCodeLenses doc+        liftIO $ map (view range) lenses @?= [Range (Position 3 0) (Position 5 0)]+  , testCase "Executed expressions range covers only the expression" $ do+      runSessionWithServer evalPlugin testDataDir $ do+        doc <- openDoc "T2.hs" "haskell"+        lenses <- getCodeLenses doc+        liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]++  , goldenWithEval "Evaluation of expressions" "T1" "hs"+  , goldenWithEval "Reevaluation of expressions" "T2" "hs"+  , goldenWithEval "Evaluation of expressions w/ imports" "T3" "hs"+  , goldenWithEval "Evaluation of expressions w/ lets" "T4" "hs"+  , goldenWithEval "Refresh an evaluation" "T5" "hs"+  , goldenWithEval "Refresh an evaluation w/ lets" "T6" "hs"+  , goldenWithEval "Refresh a multiline evaluation" "T7" "hs"+  , goldenWithEval "Semantic and Lexical errors are reported" "T8" "hs"+  , goldenWithEval "Applies file LANGUAGE extensions" "T9" "hs"+  , goldenWithEval "Evaluate a type with :kind!" "T10" "hs"+  , goldenWithEval "Reports an error for an incorrect type with :kind!" "T11" "hs"+  , goldenWithEval "Shows a kind with :kind" "T12" "hs"+  , goldenWithEval "Reports an error for an incorrect type with :kind" "T13" "hs"+  , goldenWithEval "Returns a fully-instantiated type for :type" "T14" "hs"+  , goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs"+  , goldenWithEval "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" "T16" "hs"+  , goldenWithEval ":type reports an error when given with unknown +x option" "T17" "hs"+  , goldenWithEval "Reports an error when given with unknown command" "T18" "hs"+  , goldenWithEval "Returns defaulted type for :type +d reflecting the default declaration specified in the >>> prompt" "T19" "hs"+  , expectFailBecause "known issue - see a note in P.R. #361" $+      goldenWithEval ":type +d reflects the `default' declaration of the module" "T20" "hs"+  , goldenWithEval ":type handles a multilined result properly" "T21" "hs"+  , goldenWithEval ":t behaves exactly the same as :type" "T22" "hs"+  , goldenWithEval ":type does \"dovetails\" for short identifiers" "T23" "hs"+  , goldenWithEval ":kind! treats a multilined result properly" "T24" "hs"+  , goldenWithEval ":kind treats a multilined result properly" "T25" "hs"+  , goldenWithEval "local imports" "T26" "hs"+  , goldenWithEval "Preserves one empty comment line after prompt" "T27" "hs"+  , goldenWithEval "Multi line comments" "TMulti" "hs"+  , goldenWithEval "Multi line comments, with the last test line ends without newline" "TEndingMulti" "hs"+  , goldenWithEval "Evaluate expressions in Plain comments in both single line and multi line format" "TPlainComment" "hs"+  , goldenWithEval "Evaluate expressions in Haddock comments in both single line and multi line format" "THaddock" "hs"+  , goldenWithEval "Compare results (for Haddock tests only)" "TCompare" "hs"+  , goldenWithEval "Local Modules imports are accessible in a test" "TLocalImport" "hs"+  -- , goldenWithEval "Local Modules can be imported in a test" "TLocalImportInTest" "hs"+  , goldenWithEval "Setting language option TupleSections" "TLanguageOptionsTupleSections" "hs"+  , goldenWithEval ":set accepts ghci flags" "TFlags" "hs"+  , goldenWithEval "IO expressions are supported, stdout/stderr output is ignored" "TIO" "hs"+  , goldenWithEval "Property checking" "TProperty" "hs"+  , goldenWithEval "Prelude has no special treatment, it is imported as stated in the module" "TPrelude" "hs"+  , goldenWithEval "Don't panic on {-# UNPACK #-} pragma" "TUNPACK" "hs"+  , goldenWithEval "Can handle eval inside nested comment properly" "TNested" "hs"+  , goldenWithEval "Test on last line insert results correctly" "TLastLine" "hs"+  , testGroup "with preprocessors"+    [ knownBrokenInEnv [HostOS Windows, GhcVer GHC84, GhcVer GHC86]+        "CPP eval on Windows and/or GHC <= 8.6 fails for some reasons" $+          goldenWithEval "CPP support" "TCPP" "hs"+    , knownBrokenForGhcVersions [GHC84, GHC86]+        "Preprocessor known to fail on GHC <= 8.6" $+          goldenWithEval "Literate Haskell Bird Style" "TLHS" "lhs"+    -- , goldenWithEval "Literate Haskell LaTeX Style" "TLHSLateX" "lhs"+    ]+  , goldenWithEval "Works with NoImplicitPrelude" "TNoImplicitPrelude" "hs"+  , goldenWithEval "Variable 'it' works" "TIt" "hs"+  ]++goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree+goldenWithEval title path ext = goldenWithHaskellDoc evalPlugin title testDataDir path "expected" ext $ \doc -> do+  -- Execute lenses backwards, to avoid affecting their position in the source file+  codeLenses <- reverse <$> getCodeLenses doc+  -- liftIO $ print codeLenses++  -- Execute sequentially, nubbing elements to avoid+  -- evaluating the same section with multiple tests+  -- more than twice+  mapM_ executeCmd $+    nubOrdOn actSectionId [c | CodeLens{_command = Just c} <- codeLenses]++actSectionId :: Command -> Int+actSectionId Command{_arguments = Just (List [fromJSON -> Success EvalParams{..}])} = evalId+actSectionId _ = error "Invalid CodeLens"++-- Execute command and wait for result+executeCmd :: Command -> Session ()+executeCmd cmd = do+  executeCommand cmd+  _ <- skipManyTill anyMessage (message SWorkspaceApplyEdit)+  -- liftIO $ print _resp+  pure ()++testDataDir :: FilePath+testDataDir = "test" </> "testdata"
+ test/testdata/T1.expected.hs view
@@ -0,0 +1,8 @@+module T1 where++import Data.List (unwords)++-- >>> unwords example+-- "This is an example of evaluation"+example :: [String]+example = ["This","is","an","example","of","evaluation"]
test/testdata/T1.hs view
@@ -1,7 +1,7 @@-module T1 where
-
-import Data.List (unwords)
-
--- >>> unwords example
-example :: [String]
-example = ["This","is","an","example","of","evaluation"]
+module T1 where++import Data.List (unwords)++-- >>> unwords example+example :: [String]+example = ["This","is","an","example","of","evaluation"]
− test/testdata/T1.hs.expected 
@@ -1,8 +0,0 @@-module T1 where
-
-import Data.List (unwords)
-
--- >>> unwords example
--- "This is an example of evaluation"
-example :: [String]
-example = ["This","is","an","example","of","evaluation"]
+ test/testdata/T10.expected.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DataKinds, TypeOperators #-}+module T10 where+import GHC.TypeNats ( type (+) )++type Dummy = 1 + 1++-- >>> type N = 1+-- >>> type M = 40+-- >>> :kind! N + M + 1+-- N + M + 1 :: Nat+-- = 42
test/testdata/T10.hs view
@@ -1,9 +1,9 @@-{-# LANGUAGE DataKinds, TypeOperators #-}
-module T10 where
-import GHC.TypeNats ( type (+) )
-
-type Dummy = 1 + 1
-
--- >>> type N = 1
--- >>> type M = 40
--- >>> :kind! N + M + 1
+{-# LANGUAGE DataKinds, TypeOperators #-}+module T10 where+import GHC.TypeNats ( type (+) )++type Dummy = 1 + 1++-- >>> type N = 1+-- >>> type M = 40+-- >>> :kind! N + M + 1
− test/testdata/T10.hs.expected 
@@ -1,11 +0,0 @@-{-# LANGUAGE DataKinds, TypeOperators #-}
-module T10 where
-import GHC.TypeNats ( type (+) )
-
-type Dummy = 1 + 1
-
--- >>> type N = 1
--- >>> type M = 40
--- >>> :kind! N + M + 1
--- N + M + 1 :: Nat
--- = 42
+ test/testdata/T11.expected.hs view
@@ -0,0 +1,4 @@+module T11 where++-- >>> :kind! a+-- Not in scope: type variable ‘a’
test/testdata/T11.hs view
@@ -1,3 +1,3 @@-module T11 where
-
--- >>> :kind! a
+module T11 where++-- >>> :kind! a
− test/testdata/T11.hs.expected 
@@ -1,4 +0,0 @@-module T11 where
-
--- >>> :kind! a
--- Not in scope: type variable 'a'
+ test/testdata/T12.expected.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE DataKinds, TypeOperators #-}+module T12 where+import GHC.TypeNats ( type (+) )++type Dummy = 1 + 1++-- >>> type N = 1+-- >>> type M = 40+-- >>> :kind N + M + 1+-- N + M + 1 :: Nat
test/testdata/T12.hs view
@@ -1,9 +1,9 @@-{-# LANGUAGE DataKinds, TypeOperators #-}
-module T12 where
-import GHC.TypeNats ( type (+) )
-
-type Dummy = 1 + 1
-
--- >>> type N = 1
--- >>> type M = 40
--- >>> :kind N + M + 1
+{-# LANGUAGE DataKinds, TypeOperators #-}+module T12 where+import GHC.TypeNats ( type (+) )++type Dummy = 1 + 1++-- >>> type N = 1+-- >>> type M = 40+-- >>> :kind N + M + 1
− test/testdata/T12.hs.expected 
@@ -1,10 +0,0 @@-{-# LANGUAGE DataKinds, TypeOperators #-}
-module T12 where
-import GHC.TypeNats ( type (+) )
-
-type Dummy = 1 + 1
-
--- >>> type N = 1
--- >>> type M = 40
--- >>> :kind N + M + 1
--- N + M + 1 :: Nat
+ test/testdata/T13.expected.hs view
@@ -0,0 +1,4 @@+module T13 where++-- >>> :kind a+-- Not in scope: type variable ‘a’
test/testdata/T13.hs view
@@ -1,3 +1,3 @@-module T13 where
-
--- >>> :kind a
+module T13 where++-- >>> :kind a
− test/testdata/T13.hs.expected 
@@ -1,4 +0,0 @@-module T13 where
-
--- >>> :kind a
--- Not in scope: type variable 'a'
+ test/testdata/T14.expected.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TypeApplications #-}+module T14 where++foo :: Show a => a -> String+foo = show++-- >>> :type foo @Int+-- foo @Int :: Int -> String
test/testdata/T14.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE TypeApplications #-}
-module T14 where
-
-foo :: Show a => a -> String
-foo = show
-
--- >>> :type foo @Int
+{-# LANGUAGE TypeApplications #-}+module T14 where++foo :: Show a => a -> String+foo = show++-- >>> :type foo @Int
− test/testdata/T14.hs.expected 
@@ -1,8 +0,0 @@-{-# LANGUAGE TypeApplications #-}
-module T14 where
-
-foo :: Show a => a -> String
-foo = show
-
--- >>> :type foo @Int
--- foo @Int :: Int -> String
+ test/testdata/T15.expected.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TypeApplications #-}+module T15 where++foo :: Show a => a -> String+foo = show++-- >>> :type  +v  foo @Int+-- foo @Int :: Show Int => Int -> String
test/testdata/T15.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE TypeApplications #-}
-module T15 where
-
-foo :: Show a => a -> String
-foo = show
-
--- >>> :type  +v  foo @Int
+{-# LANGUAGE TypeApplications #-}+module T15 where++foo :: Show a => a -> String+foo = show++-- >>> :type  +v  foo @Int
− test/testdata/T15.hs.expected 
@@ -1,8 +0,0 @@-{-# LANGUAGE TypeApplications #-}
-module T15 where
-
-foo :: Show a => a -> String
-foo = show
-
--- >>> :type  +v  foo @Int
--- foo @Int :: Show Int => Int -> String
+ test/testdata/T16.expected.hs view
@@ -0,0 +1,4 @@+module T16 where++-- >>> :type  +d   40+ 2 +-- 40+ 2 :: Integer
test/testdata/T16.hs view
@@ -1,3 +1,3 @@-module T16 where
-
--- >>> :type  +d   40+ 2 
+module T16 where++-- >>> :type  +d   40+ 2
− test/testdata/T16.hs.expected 
@@ -1,4 +0,0 @@-module T16 where
-
--- >>> :type  +d   40+ 2 
--- 40+ 2 :: Integer
+ test/testdata/T17.expected.hs view
@@ -0,0 +1,4 @@+module T17 where++-- >>> :type  +no 42+-- parse error on input ‘+’
test/testdata/T17.hs view
@@ -1,3 +1,3 @@-module T17 where
-
--- >>> :type  +no 42
+module T17 where++-- >>> :type  +no 42
− test/testdata/T17.hs.expected 
@@ -1,4 +0,0 @@-module T17 where
-
--- >>> :type  +no 42
--- parse error on input '+'
+ test/testdata/T18.expected.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TypeApplications #-}+module T18 where++-- >>> :noooop foo bar+-- unknown command 'noooop'
test/testdata/T18.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeApplications #-}
-module T18 where
-
--- >>> :noooop foo bar
+{-# LANGUAGE TypeApplications #-}+module T18 where++-- >>> :noooop foo bar
− test/testdata/T18.hs.expected 
@@ -1,5 +0,0 @@-{-# LANGUAGE TypeApplications #-}
-module T18 where
-
--- >>> :noooop foo bar
--- unknown command 'noooop'
+ test/testdata/T19.expected.hs view
@@ -0,0 +1,7 @@+module T19 where+import Data.Word (Word)+type W = Word++-- >>> default (Word)+-- >>> :type  +d   40+ 2 +-- 40+ 2 :: Word
test/testdata/T19.hs view
@@ -1,6 +1,6 @@-module T19 where
-import Data.Word (Word)
-type W = Word
-
--- >>> default (Word)
--- >>> :type  +d   40+ 2 
+module T19 where+import Data.Word (Word)+type W = Word++-- >>> default (Word)+-- >>> :type  +d   40+ 2
− test/testdata/T19.hs.expected 
@@ -1,7 +0,0 @@-module T19 where
-import Data.Word (Word)
-type W = Word
-
--- >>> default (Word)
--- >>> :type  +d   40+ 2 
--- 40+ 2 :: Word
+ test/testdata/T2.expected.hs view
@@ -0,0 +1,8 @@+module T2 where++import Data.List (unwords)++-- >>> unwords example+-- "This is an example of evaluation"+example :: [String]+example = ["This","is","an","example","of","evaluation"]
test/testdata/T2.hs view
@@ -1,8 +1,8 @@-module T2 where
-
-import Data.List (unwords)
-
--- >>> unwords example
--- "Stale output"
-example :: [String]
-example = ["This","is","an","example","of","evaluation"]
+module T2 where++import Data.List (unwords)++-- >>> unwords example+-- "Stale output"+example :: [String]+example = ["This","is","an","example","of","evaluation"]
− test/testdata/T2.hs.expected 
@@ -1,8 +0,0 @@-module T2 where
-
-import Data.List (unwords)
-
--- >>> unwords example
--- "This is an example of evaluation"
-example :: [String]
-example = ["This","is","an","example","of","evaluation"]
+ test/testdata/T20.expected.hs view
@@ -0,0 +1,7 @@+module T20 where+import Data.Word (Word)++default (Word)++-- >>> :type  +d   40+ 2 +-- 40+ 2 :: Word
test/testdata/T20.hs view
@@ -1,6 +1,6 @@-module T20 where
-import Data.Word (Word)
-
-default (Word)
-
--- >>> :type  +d   40+ 2 
+module T20 where+import Data.Word (Word)++default (Word)++-- >>> :type  +d   40+ 2
− test/testdata/T20.hs.expected 
@@ -1,7 +0,0 @@-module T20 where
-import Data.Word (Word)
-
-default (Word)
-
--- >>> :type  +d   40+ 2 
--- 40+ 2 :: Word
+ test/testdata/T21.expected.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+module T21 where+import Data.Proxy (Proxy(..))+import GHC.TypeNats (KnownNat)+import Type.Reflection (Typeable)++fun :: forall k n a. (KnownNat k, KnownNat n, Typeable a)+    => Proxy k -> Proxy n -> Proxy a -> ()+fun _ _ _ = ()++-- >>> :type fun+-- fun+--   :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).+--      (KnownNat k2, KnownNat n, Typeable a) =>+--      Proxy k2 -> Proxy n -> Proxy a -> ()
test/testdata/T21.hs view
@@ -1,12 +1,12 @@-{-# LANGUAGE PolyKinds           #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module T21 where
-import Data.Proxy (Proxy(..))
-import GHC.TypeNats (KnownNat)
-import Type.Reflection (Typeable)
-
-fun :: forall k n a. (KnownNat k, KnownNat n, Typeable a)
-    => Proxy k -> Proxy n -> Proxy a -> ()
-fun _ _ _ = ()
-
--- >>> :type fun
+{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+module T21 where+import Data.Proxy (Proxy(..))+import GHC.TypeNats (KnownNat)+import Type.Reflection (Typeable)++fun :: forall k n a. (KnownNat k, KnownNat n, Typeable a)+    => Proxy k -> Proxy n -> Proxy a -> ()+fun _ _ _ = ()++-- >>> :type fun
− test/testdata/T21.hs.expected 
@@ -1,16 +0,0 @@-{-# LANGUAGE PolyKinds           #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module T21 where
-import Data.Proxy (Proxy(..))
-import GHC.TypeNats (KnownNat)
-import Type.Reflection (Typeable)
-
-fun :: forall k n a. (KnownNat k, KnownNat n, Typeable a)
-    => Proxy k -> Proxy n -> Proxy a -> ()
-fun _ _ _ = ()
-
--- >>> :type fun
--- fun
---   :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).
---      (KnownNat k2, KnownNat n, Typeable a) =>
---      Proxy k2 -> Proxy n -> Proxy a -> ()
+ test/testdata/T22.expected.hs view
@@ -0,0 +1,10 @@+module T22 where+import Data.Proxy      (Proxy (..))+import GHC.TypeNats    (KnownNat)+import Type.Reflection (Typeable)++f :: Integer+f = 32++-- >>> :t f+-- f :: Integer
test/testdata/T22.hs view
@@ -1,9 +1,9 @@-module T22 where
-import Data.Proxy      (Proxy (..))
-import GHC.TypeNats    (KnownNat)
-import Type.Reflection (Typeable)
-
-f :: Integer
-f = 32
-
--- >>> :t f
+module T22 where+import Data.Proxy      (Proxy (..))+import GHC.TypeNats    (KnownNat)+import Type.Reflection (Typeable)++f :: Integer+f = 32++-- >>> :t f
− test/testdata/T22.hs.expected 
@@ -1,10 +0,0 @@-module T22 where
-import Data.Proxy      (Proxy (..))
-import GHC.TypeNats    (KnownNat)
-import Type.Reflection (Typeable)
-
-f :: Integer
-f = 32
-
--- >>> :t f
--- f :: Integer
+ test/testdata/T23.expected.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+module T23 where+import Data.Proxy      (Proxy (..))+import GHC.TypeNats    (KnownNat)+import Type.Reflection (Typeable)++f :: forall k n a. (KnownNat k, KnownNat n, Typeable a)+  => Proxy k -> Proxy n -> Proxy a -> ()+f _ _ _ = ()++-- >>> :type f+-- f :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).+--      (KnownNat k2, KnownNat n, Typeable a) =>+--      Proxy k2 -> Proxy n -> Proxy a -> ()
test/testdata/T23.hs view
@@ -1,12 +1,12 @@-{-# LANGUAGE PolyKinds           #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module T23 where
-import Data.Proxy      (Proxy (..))
-import GHC.TypeNats    (KnownNat)
-import Type.Reflection (Typeable)
-
-f :: forall k n a. (KnownNat k, KnownNat n, Typeable a)
-  => Proxy k -> Proxy n -> Proxy a -> ()
-f _ _ _ = ()
-
--- >>> :type f
+{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE ScopedTypeVariables #-}+module T23 where+import Data.Proxy      (Proxy (..))+import GHC.TypeNats    (KnownNat)+import Type.Reflection (Typeable)++f :: forall k n a. (KnownNat k, KnownNat n, Typeable a)+  => Proxy k -> Proxy n -> Proxy a -> ()+f _ _ _ = ()++-- >>> :type f
− test/testdata/T23.hs.expected 
@@ -1,15 +0,0 @@-{-# LANGUAGE PolyKinds           #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module T23 where
-import Data.Proxy      (Proxy (..))
-import GHC.TypeNats    (KnownNat)
-import Type.Reflection (Typeable)
-
-f :: forall k n a. (KnownNat k, KnownNat n, Typeable a)
-  => Proxy k -> Proxy n -> Proxy a -> ()
-f _ _ _ = ()
-
--- >>> :type f
--- f :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).
---      (KnownNat k2, KnownNat n, Typeable a) =>
---      Proxy k2 -> Proxy n -> Proxy a -> ()
+ test/testdata/T24.expected.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE PolyKinds            #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}+module T24 where+import GHC.TypeNats (type (-))+data Proxy a = Stop | Next (Proxy a)++type family LongP n a where+  LongP 0 a = a+  LongP n a = Next (LongP (n - 1) a)++-- >>> :kind! ((LongP 10 Stop) :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double)))))))))))))+-- ((LongP 10 Stop) :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double))))))))))))) :: Proxy+--                                                                                                                                        (Proxy+--                                                                                                                                           (Proxy+--                                                                                                                                              (Proxy+--                                                                                                                                                 (Proxy+--                                                                                                                                                    (Proxy+--                                                                                                                                                       (Proxy+--                                                                                                                                                          (Proxy+--                                                                                                                                                             (Proxy+--                                                                                                                                                                (Proxy+--                                                                                                                                                                   (Proxy+--                                                                                                                                                                      (Proxy+--                                                                                                                                                                         (Proxy+--                                                                                                                                                                            Double))))))))))))+-- = 'Next+--     ('Next+--        ('Next+--           ('Next ('Next ('Next ('Next ('Next ('Next ('Next 'Stop)))))))))
test/testdata/T24.hs view
@@ -1,14 +1,14 @@-{-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE PolyKinds            #-}
-{-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE UndecidableInstances #-}
-module T24 where
-import GHC.TypeNats (type (-))
-data Proxy a = Stop | Next (Proxy a)
-
-type family LongP n a where
-  LongP 0 a = a
-  LongP n a = Next (LongP (n - 1) a)
-
--- >>> :kind! ((LongP 10 Stop) :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double)))))))))))))
+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE PolyKinds            #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}+module T24 where+import GHC.TypeNats (type (-))+data Proxy a = Stop | Next (Proxy a)++type family LongP n a where+  LongP 0 a = a+  LongP n a = Next (LongP (n - 1) a)++-- >>> :kind! ((LongP 10 Stop) :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double)))))))))))))
− test/testdata/T24.hs.expected 
@@ -1,32 +0,0 @@-{-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE PolyKinds            #-}
-{-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE UndecidableInstances #-}
-module T24 where
-import GHC.TypeNats (type (-))
-data Proxy a = Stop | Next (Proxy a)
-
-type family LongP n a where
-  LongP 0 a = a
-  LongP n a = Next (LongP (n - 1) a)
-
--- >>> :kind! ((LongP 10 Stop) :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double)))))))))))))
--- ((LongP 10 Stop) :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double))))))))))))) :: Proxy
---                                                                                                                                        (Proxy
---                                                                                                                                           (Proxy
---                                                                                                                                              (Proxy
---                                                                                                                                                 (Proxy
---                                                                                                                                                    (Proxy
---                                                                                                                                                       (Proxy
---                                                                                                                                                          (Proxy
---                                                                                                                                                             (Proxy
---                                                                                                                                                                (Proxy
---                                                                                                                                                                   (Proxy
---                                                                                                                                                                      (Proxy
---                                                                                                                                                                         (Proxy
---                                                                                                                                                                            Double))))))))))))
--- = 'Next
---     ('Next
---        ('Next
---           ('Next ('Next ('Next ('Next ('Next ('Next ('Next 'Stop)))))))))
+ test/testdata/T25.expected.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE PolyKinds            #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}+module T25 where+import GHC.TypeNats (type (-))+data Proxy a = Stop | Next (Proxy a)++type family LongP n a where+  LongP 0 a = a+  LongP n a = Next (LongP (n - 1) a)++-- >>> :kind (Stop :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double)))))))))))))+-- (Stop :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double))))))))))))) :: Proxy+--                                                                                                                             (Proxy+--                                                                                                                                (Proxy+--                                                                                                                                   (Proxy+--                                                                                                                                      (Proxy+--                                                                                                                                         (Proxy+--                                                                                                                                            (Proxy+--                                                                                                                                               (Proxy+--                                                                                                                                                  (Proxy+--                                                                                                                                                     (Proxy+--                                                                                                                                                        (Proxy+--                                                                                                                                                           (Proxy+--                                                                                                                                                              (Proxy+--                                                                                                                                                                 Double))))))))))))
test/testdata/T25.hs view
@@ -1,14 +1,14 @@-{-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE PolyKinds            #-}
-{-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE UndecidableInstances #-}
-module T25 where
-import GHC.TypeNats (type (-))
-data Proxy a = Stop | Next (Proxy a)
-
-type family LongP n a where
-  LongP 0 a = a
-  LongP n a = Next (LongP (n - 1) a)
-
--- >>> :kind (Stop :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double)))))))))))))
+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE PolyKinds            #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}+module T25 where+import GHC.TypeNats (type (-))+data Proxy a = Stop | Next (Proxy a)++type family LongP n a where+  LongP 0 a = a+  LongP n a = Next (LongP (n - 1) a)++-- >>> :kind (Stop :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double)))))))))))))
− test/testdata/T25.hs.expected 
@@ -1,28 +0,0 @@-{-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE PolyKinds            #-}
-{-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE UndecidableInstances #-}
-module T25 where
-import GHC.TypeNats (type (-))
-data Proxy a = Stop | Next (Proxy a)
-
-type family LongP n a where
-  LongP 0 a = a
-  LongP n a = Next (LongP (n - 1) a)
-
--- >>> :kind (Stop :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double)))))))))))))
--- (Stop :: Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy Double))))))))))))) :: Proxy
---                                                                                                                             (Proxy
---                                                                                                                                (Proxy
---                                                                                                                                   (Proxy
---                                                                                                                                      (Proxy
---                                                                                                                                         (Proxy
---                                                                                                                                            (Proxy
---                                                                                                                                               (Proxy
---                                                                                                                                                  (Proxy
---                                                                                                                                                     (Proxy
---                                                                                                                                                        (Proxy
---                                                                                                                                                           (Proxy
---                                                                                                                                                              (Proxy
---                                                                                                                                                                 Double))))))))))))
+ test/testdata/T26.expected.hs view
@@ -0,0 +1,5 @@+module T26 where+import Util ()++-- >>> "hello"+-- "hello"
test/testdata/T26.hs view
@@ -1,4 +1,4 @@-module T26 where
-import T25 ()
-
--- >>> "hello"
+module T26 where+import Util ()++-- >>> "hello"
− test/testdata/T26.hs.expected 
@@ -1,5 +0,0 @@-module T26 where
-import T25 ()
-
--- >>> "hello"
--- "hello"
+ test/testdata/T27.expected.hs view
@@ -0,0 +1,5 @@+module T27 where++-- >>> ()+-- ()+--
test/testdata/T27.hs view
@@ -1,4 +1,4 @@-module T27 where
-
--- >>> ()
---
+module T27 where++-- >>> ()+--
− test/testdata/T27.hs.expected 
@@ -1,5 +0,0 @@-module T27 where
-
--- >>> ()
--- ()
---
+ test/testdata/T3.expected.hs view
@@ -0,0 +1,8 @@+module T3 where+++-- >>> import Data.List (unwords)+-- >>> unwords example+-- "This is an example of evaluation"+example :: [String]+example = ["This","is","an","example","of","evaluation"]
test/testdata/T3.hs view
@@ -1,7 +1,7 @@-module T3 where
-
-
--- >>> import Data.List (unwords)
--- >>> unwords example
-example :: [String]
-example = ["This","is","an","example","of","evaluation"]
+module T3 where+++-- >>> import Data.List (unwords)+-- >>> unwords example+example :: [String]+example = ["This","is","an","example","of","evaluation"]
− test/testdata/T3.hs.expected 
@@ -1,8 +0,0 @@-module T3 where
-
-
--- >>> import Data.List (unwords)
--- >>> unwords example
--- "This is an example of evaluation"
-example :: [String]
-example = ["This","is","an","example","of","evaluation"]
+ test/testdata/T4.expected.hs view
@@ -0,0 +1,10 @@+module T4 where++import           Data.List (unwords)++-- >>> let evaluation = " evaluation"+-- >>> unwords example ++ evaluation+-- "This is an example of evaluation"+example :: [String]+example = ["This","is","an","example","of"]+
test/testdata/T4.hs view
@@ -1,9 +1,9 @@-module T4 where
-
-import           Data.List (unwords)
-
--- >>> let evaluation = " evaluation"
--- >>> unwords example ++ evaluation
-example :: [String]
-example = ["This","is","an","example","of"]
-
+module T4 where++import           Data.List (unwords)++-- >>> let evaluation = " evaluation"+-- >>> unwords example ++ evaluation+example :: [String]+example = ["This","is","an","example","of"]+
− test/testdata/T4.hs.expected 
@@ -1,10 +0,0 @@-module T4 where
-
-import           Data.List (unwords)
-
--- >>> let evaluation = " evaluation"
--- >>> unwords example ++ evaluation
--- "This is an example of evaluation"
-example :: [String]
-example = ["This","is","an","example","of"]
-
+ test/testdata/T5.expected.hs view
@@ -0,0 +1,6 @@+module T5 where++-- >>> unwords example+-- "This is an example of evaluation"+example :: [String]+example = ["This","is","an","example","of","evaluation"]
test/testdata/T5.hs view
@@ -1,6 +1,6 @@-module T5 where
-
--- >>> unwords example
--- "This is a stale example of evaluation"
-example :: [String]
-example = ["This","is","an","example","of","evaluation"]
+module T5 where++-- >>> unwords example+-- "This is a stale example of evaluation"+example :: [String]+example = ["This","is","an","example","of","evaluation"]
− test/testdata/T5.hs.expected 
@@ -1,6 +0,0 @@-module T5 where
-
--- >>> unwords example
--- "This is an example of evaluation"
-example :: [String]
-example = ["This","is","an","example","of","evaluation"]
+ test/testdata/T6.expected.hs view
@@ -0,0 +1,9 @@+module T6 where++import Data.List (unwords)++-- >>> let evaluation = " evaluation"+-- >>> unwords example ++ evaluation+-- "This is an example of evaluation"+example :: [String]+example = ["This","is","an","example","of"]
test/testdata/T6.hs view
@@ -1,9 +1,9 @@-module T6 where
-
-import Data.List (unwords)
-
--- >>> let evaluation = " evaluation"
--- >>> unwords example ++ evaluation
--- "This is a stale example of evaluation"
-example :: [String]
-example = ["This","is","an","example","of"]
+module T6 where++import Data.List (unwords)++-- >>> let evaluation = " evaluation"+-- >>> unwords example ++ evaluation+-- "This is a stale example of evaluation"+example :: [String]+example = ["This","is","an","example","of"]
− test/testdata/T6.hs.expected 
@@ -1,9 +0,0 @@-module T6 where
-
-import Data.List (unwords)
-
--- >>> let evaluation = " evaluation"
--- >>> unwords example ++ evaluation
--- "This is an example of evaluation"
-example :: [String]
-example = ["This","is","an","example","of"]
+ test/testdata/T7.expected.hs view
@@ -0,0 +1,10 @@+module T7 where++import Data.List (unwords)++-- >>> --+-- >>> --+-- >>> unwords example+-- "This is an example of"+example :: [String]+example = ["This","is","an","example","of"]
test/testdata/T7.hs view
@@ -1,10 +1,10 @@-module T7 where
-
-import Data.List (unwords)
-
--- >>> --
--- >>> --
--- >>> unwords example
--- "This is a stale example of"
-example :: [String]
-example = ["This","is","an","example","of"]
+module T7 where++import Data.List (unwords)++-- >>> --+-- >>> --+-- >>> unwords example+-- "This is a stale example of"+example :: [String]+example = ["This","is","an","example","of"]
− test/testdata/T7.hs.expected 
@@ -1,10 +0,0 @@-module T7 where
-
-import Data.List (unwords)
-
--- >>> --
--- >>> --
--- >>> unwords example
--- "This is an example of"
-example :: [String]
-example = ["This","is","an","example","of"]
+ test/testdata/T8.expected.hs view
@@ -0,0 +1,14 @@+-- Semantic and Lexical errors are reported+module T8 where++-- >>> noFunctionWithThisName+-- Variable not in scope: noFunctionWithThisName++-- >>> "a" + "bc"+-- No instance for (Num [Char]) arising from a use of ‘+’++-- >>> "+-- lexical error in string/character literal at end of input++-- >>> 3 `div` 0+-- divide by zero
test/testdata/T8.hs view
@@ -1,10 +1,10 @@--- Semantic and Lexical errors are reported
-module T8 where
-
--- >>> noFunctionWithThisName
-
--- >>> "a" + "bc"
-
--- >>> "
-
--- >>> 3 `div` 0
+-- Semantic and Lexical errors are reported+module T8 where++-- >>> noFunctionWithThisName++-- >>> "a" + "bc"++-- >>> "++-- >>> 3 `div` 0
− test/testdata/T8.hs.expected 
@@ -1,14 +0,0 @@--- Semantic and Lexical errors are reported
-module T8 where
-
--- >>> noFunctionWithThisName
--- Variable not in scope: noFunctionWithThisName
-
--- >>> "a" + "bc"
--- No instance for (Num [Char]) arising from a use of '+'
-
--- >>> "
--- lexical error in string/character literal at end of input
-
--- >>> 3 `div` 0
--- divide by zero
+ test/testdata/T9.expected.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE DataKinds #-}+module T9 where+import Data.Proxy (Proxy(..))++type P = Proxy++-- >>> Proxy :: Proxy 3+-- Proxy
test/testdata/T9.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DataKinds #-}
-module T9 where
-import Data.Proxy (Proxy(..))
-
-type P = Proxy
-
--- >>> Proxy :: Proxy 3
+{-# LANGUAGE DataKinds #-}+module T9 where+import Data.Proxy (Proxy(..))++type P = Proxy++-- >>> Proxy :: Proxy 3
− test/testdata/T9.hs.expected 
@@ -1,8 +0,0 @@-{-# LANGUAGE DataKinds #-}
-module T9 where
-import Data.Proxy (Proxy(..))
-
-type P = Proxy
-
--- >>> Proxy :: Proxy 3
--- Proxy
+ test/testdata/TCPP.expected.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module TCPP where++-- >>> y+-- 11+y :: Integer+y = 11++#define ALL++#ifdef ALL+-- >>> 3+y+-- 14+#else+-- >>> 5+y+#endif++-- >>> 2+y+-- 13
test/testdata/TCPP.hs view
@@ -1,19 +1,19 @@-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-
-module TCPP where
-
--- >>> y
-y :: Integer
-y = 11
-
-#define ALL
-
-#ifdef ALL
--- >>> 3+y
-#else
--- >>> 5+y
-#endif
-
--- >>> 2+y
+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module TCPP where++-- >>> y+y :: Integer+y = 11++#define ALL++#ifdef ALL+-- >>> 3+y+#else+-- >>> 5+y+#endif++-- >>> 2+y
− test/testdata/TCPP.hs.expected 
@@ -1,22 +0,0 @@-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-
-module TCPP where
-
--- >>> y
--- 11
-y :: Integer
-y = 11
-
-#define ALL
-
-#ifdef ALL
--- >>> 3+y
--- 14
-#else
--- >>> 5+y
-#endif
-
--- >>> 2+y
--- 13
+ test/testdata/TCompare.expected.hs view
@@ -0,0 +1,13 @@+module TCompare where++-- In plain comments, the previous result of an evaluation is simply replaced++-- >>> 2+2+-- 4++-- In Haddock comments, the previous result of an evaluation is compared with the new one+-- and difference are displayed++-- | >>> 2+2+-- WAS 5+-- NOW 4
test/testdata/TCompare.hs view
@@ -1,12 +1,12 @@-module TCompare where
-
--- In plain comments, the previous result of an evaluation is simply replaced
-
--- >>> 2+2
--- 5
-
--- In Haddock comments, the previous result of an evaluation is compared with the new one
--- and difference are displayed
-
--- | >>> 2+2
--- 5
+module TCompare where++-- In plain comments, the previous result of an evaluation is simply replaced++-- >>> 2+2+-- 5++-- In Haddock comments, the previous result of an evaluation is compared with the new one+-- and difference are displayed++-- | >>> 2+2+-- 5
− test/testdata/TCompare.hs.expected 
@@ -1,13 +0,0 @@-module TCompare where
-
--- In plain comments, the previous result of an evaluation is simply replaced
-
--- >>> 2+2
--- 4
-
--- In Haddock comments, the previous result of an evaluation is compared with the new one
--- and difference are displayed
-
--- | >>> 2+2
--- WAS 5
--- NOW 4
+ test/testdata/TEndingMulti.expected.hs view
@@ -0,0 +1,9 @@+module TEndingMulti where++-- Now trailing doctest is allowed:++{- >>> 42+>>> 54+42+54+-}
test/testdata/TEndingMulti.hs view
@@ -1,6 +1,6 @@-module TEndingMulti where
-
--- Now trailing doctest is allowed:
-
-{- >>> 42
->>> 54-}
+module TEndingMulti where++-- Now trailing doctest is allowed:++{- >>> 42+>>> 54-}
− test/testdata/TEndingMulti.hs.expected 
@@ -1,9 +0,0 @@-module TEndingMulti where
-
--- Now trailing doctest is allowed:
-
-{- >>> 42
->>> 54
-42
-54
--}
+ test/testdata/TFlags.expected.hs view
@@ -0,0 +1,76 @@+-- Support for language options++{-# LANGUAGE ScopedTypeVariables #-}+module TFlags where++-- Language options set in the module source (ScopedTypeVariables)+-- also apply to tests so this works fine+-- >>> f = (\(c::Char) -> [c])++{- Multiple options can be set with a single `:set`++>>> :set -XMultiParamTypeClasses -XFlexibleInstances+>>> class Z a b c+-}++{-++Options apply only in the section where they are defined (unless they are in the setup section), so this will fail:++>>> class L a b c+Too many parameters for class ‘L’+(Enable MultiParamTypeClasses to allow multi-parameter classes)+-}+++{-+Options apply to all tests in the same section after their declaration.++Not set yet:++>>> class D+No parameters for class ‘D’+(Enable MultiParamTypeClasses to allow no-parameter classes)++Now it works:++>>>:set -XMultiParamTypeClasses+>>> class C++It still works++>>> class F+-}++{- Now -package flag is handled correctly:++>>> :set -package ghc-prim+>>> import GHC.Prim++-}++{- -fprint-* families++>>> import Data.Proxy+>>> :set -XPolyKinds+>>> :t Proxy+Proxy :: forall k (t :: k). Proxy t++>>> :set -fprint-explicit-foralls+>>> :t Proxy+Proxy :: forall {k} {t :: k}. Proxy t+-}++{- Invalid option/flags are reported, but valid ones will be reflected++>>> :set -XRank2Types -XAbsent -XDatatypeContexts -XWrong -fprint-nothing-at-all+<interactive>: warning:+    -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.+Some flags have not been recognized: -XAbsent, -XWrong, -fprint-nothing-at-all++Still, Rank2Types is enabled, as in GHCi:++>>> f = const 42 :: (forall x. x) -> Int+>>> f undefined+42+-}
test/testdata/TFlags.hs view
@@ -1,68 +1,68 @@--- Support for language options
-
-{-# LANGUAGE ScopedTypeVariables #-}
-module TFlags where
-
--- Language options set in the module source (ScopedTypeVariables)
--- also apply to tests so this works fine
--- >>> f = (\(c::Char) -> [c])
-
-{- Multiple options can be set with a single `:set`
-
->>> :set -XMultiParamTypeClasses -XFlexibleInstances
->>> class Z a b c
--}
-
-{-
-
-Options apply only in the section where they are defined (unless they are in the setup section), so this will fail:
-
->>> class L a b c
--}
-
-
-{-
-Options apply to all tests in the same section after their declaration.
-
-Not set yet:
-
->>> class D
-
-Now it works:
-
->>>:set -XMultiParamTypeClasses
->>> class C
-
-It still works
-
->>> class F
--}
-
-{- Now -package flag is handled correctly:
-
->>> :set -package ghc-prim
->>> import GHC.Prim
-
--}
-
-{- -fprint-* families
-
->>> import Data.Proxy
->>> :set -XPolyKinds
->>> :t Proxy
-Proxy :: forall k (t :: k). Proxy t
-
->>> :set -fprint-explicit-foralls
->>> :t Proxy
-Proxy :: forall {k} {t :: k}. Proxy t
--}
-
-{- Invalid option/flags are reported, but valid ones will be reflected
-
->>> :set -XRank2Types -XAbsent -XDatatypeContexts -XWrong -fprint-nothing-at-all
-
-Still, Rank2Types is enabled, as in GHCi:
-
->>> f = const 42 :: (forall x. x) -> Int
->>> f undefined
--}
+-- Support for language options++{-# LANGUAGE ScopedTypeVariables #-}+module TFlags where++-- Language options set in the module source (ScopedTypeVariables)+-- also apply to tests so this works fine+-- >>> f = (\(c::Char) -> [c])++{- Multiple options can be set with a single `:set`++>>> :set -XMultiParamTypeClasses -XFlexibleInstances+>>> class Z a b c+-}++{-++Options apply only in the section where they are defined (unless they are in the setup section), so this will fail:++>>> class L a b c+-}+++{-+Options apply to all tests in the same section after their declaration.++Not set yet:++>>> class D++Now it works:++>>>:set -XMultiParamTypeClasses+>>> class C++It still works++>>> class F+-}++{- Now -package flag is handled correctly:++>>> :set -package ghc-prim+>>> import GHC.Prim++-}++{- -fprint-* families++>>> import Data.Proxy+>>> :set -XPolyKinds+>>> :t Proxy+Proxy :: forall k (t :: k). Proxy t++>>> :set -fprint-explicit-foralls+>>> :t Proxy+Proxy :: forall {k} {t :: k}. Proxy t+-}++{- Invalid option/flags are reported, but valid ones will be reflected++>>> :set -XRank2Types -XAbsent -XDatatypeContexts -XWrong -fprint-nothing-at-all++Still, Rank2Types is enabled, as in GHCi:++>>> f = const 42 :: (forall x. x) -> Int+>>> f undefined+-}
− test/testdata/TFlags.hs.expected 
@@ -1,76 +0,0 @@--- Support for language options
-
-{-# LANGUAGE ScopedTypeVariables #-}
-module TFlags where
-
--- Language options set in the module source (ScopedTypeVariables)
--- also apply to tests so this works fine
--- >>> f = (\(c::Char) -> [c])
-
-{- Multiple options can be set with a single `:set`
-
->>> :set -XMultiParamTypeClasses -XFlexibleInstances
->>> class Z a b c
--}
-
-{-
-
-Options apply only in the section where they are defined (unless they are in the setup section), so this will fail:
-
->>> class L a b c
-Too many parameters for class 'L'
-(Enable MultiParamTypeClasses to allow multi-parameter classes)
--}
-
-
-{-
-Options apply to all tests in the same section after their declaration.
-
-Not set yet:
-
->>> class D
-No parameters for class 'D'
-(Enable MultiParamTypeClasses to allow no-parameter classes)
-
-Now it works:
-
->>>:set -XMultiParamTypeClasses
->>> class C
-
-It still works
-
->>> class F
--}
-
-{- Now -package flag is handled correctly:
-
->>> :set -package ghc-prim
->>> import GHC.Prim
-
--}
-
-{- -fprint-* families
-
->>> import Data.Proxy
->>> :set -XPolyKinds
->>> :t Proxy
-Proxy :: forall k (t :: k). Proxy t
-
->>> :set -fprint-explicit-foralls
->>> :t Proxy
-Proxy :: forall {k} {t :: k}. Proxy t
--}
-
-{- Invalid option/flags are reported, but valid ones will be reflected
-
->>> :set -XRank2Types -XAbsent -XDatatypeContexts -XWrong -fprint-nothing-at-all
-<interactive>: warning:
-    -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
-Some flags have not been recognized: -XAbsent, -XWrong, -fprint-nothing-at-all
-
-Still, Rank2Types is enabled, as in GHCi:
-
->>> f = const 42 :: (forall x. x) -> Int
->>> f undefined
-42
--}
+ test/testdata/THaddock.expected.hs view
@@ -0,0 +1,42 @@+{- |+Tests in plain comments in both single line or multi line format, both forward and backward.+Tests are ignored if:+    * do not start on the first column (in Ordinary Haskell)+    * do not start on the first or second column (in Literate Haskell)+-}+module THaddock () where++{- ORMOLU_DISABLE -}++-- | Single line comment+-- >>> "a"++"b"+-- "ab"++{- | Multi line comment++>>> "b"++"c"+"bc"+-}++double :: Num a => a -> a+double a = a + a+-- ^ Single line backward comments+-- >>> double 11+-- 22++twice :: [a] -> [a]+twice a = a ++ a+{- ^ Multi-line backward comments+>>> twice "ABC"+"ABCABC"+-}++{- | >>> 2+five+7++   ^-- This works, as it starts at the first column after the header.++     >>> IGNORED as it does not start on the first column+-}+five :: Integer+five = 5
test/testdata/THaddock.hs view
@@ -1,35 +1,37 @@-{- |
-Tests in plain comments in both single line or multi line format, both forward and backward.
-Tests are ignored if:
-    * do not start on the first column (in Ordinary Haskell)
-    * do not start on the first or second column (in Literate Haskell)
--}
-module THaddock () where
-
-{- ORMOLU_DISABLE -}
-
--- | Single line comment
--- >>> "a"++"b"
-
-{- | Multi line comment
-
->>> "b"++"c"
--}
-
-double a = a + a
--- ^ Single line backward comments
--- >>> double 11
-
-twice :: [a] -> [a]
-twice a = a ++ a
-{- ^ Multi-line backward comments
->>> twice "ABC"
--}
-
-{- | >>> 2+five
-
-   ^-- This works, as it starts at the first column after the header.
-
-     >>> IGNORED as it does not start on the first column
--}
-five = 5
+{- |+Tests in plain comments in both single line or multi line format, both forward and backward.+Tests are ignored if:+    * do not start on the first column (in Ordinary Haskell)+    * do not start on the first or second column (in Literate Haskell)+-}+module THaddock () where++{- ORMOLU_DISABLE -}++-- | Single line comment+-- >>> "a"++"b"++{- | Multi line comment++>>> "b"++"c"+-}++double :: Num a => a -> a+double a = a + a+-- ^ Single line backward comments+-- >>> double 11++twice :: [a] -> [a]+twice a = a ++ a+{- ^ Multi-line backward comments+>>> twice "ABC"+-}++{- | >>> 2+five++   ^-- This works, as it starts at the first column after the header.++     >>> IGNORED as it does not start on the first column+-}+five :: Integer+five = 5
− test/testdata/THaddock.hs.expected 
@@ -1,40 +0,0 @@-{- |
-Tests in plain comments in both single line or multi line format, both forward and backward.
-Tests are ignored if:
-    * do not start on the first column (in Ordinary Haskell)
-    * do not start on the first or second column (in Literate Haskell)
--}
-module THaddock () where
-
-{- ORMOLU_DISABLE -}
-
--- | Single line comment
--- >>> "a"++"b"
--- "ab"
-
-{- | Multi line comment
-
->>> "b"++"c"
-"bc"
--}
-
-double a = a + a
--- ^ Single line backward comments
--- >>> double 11
--- 22
-
-twice :: [a] -> [a]
-twice a = a ++ a
-{- ^ Multi-line backward comments
->>> twice "ABC"
-"ABCABC"
--}
-
-{- | >>> 2+five
-7
-
-   ^-- This works, as it starts at the first column after the header.
-
-     >>> IGNORED as it does not start on the first column
--}
-five = 5
+ test/testdata/TIO.expected.hs view
@@ -0,0 +1,9 @@+-- IO expressions are supported, stdout/stderr output is ignored+module TIO where++{-+Does not capture stdout, returns value.++>>> print "ABC" >> return "XYZ"+"XYZ"+-}
test/testdata/TIO.hs view
@@ -1,9 +1,9 @@--- IO expressions are supported, stdout/stderr output is ignored
-module TIO where
-
-{-
-Does not capture stdout, returns value.
-
->>> print "ABC" >> return "XYZ"
-"XYZ"
--}
+-- IO expressions are supported, stdout/stderr output is ignored+module TIO where++{-+Does not capture stdout, returns value.++>>> print "ABC" >> return "XYZ"+"XYZ"+-}
− test/testdata/TIO.hs.expected 
@@ -1,9 +0,0 @@--- IO expressions are supported, stdout/stderr output is ignored
-module TIO where
-
-{-
-Does not capture stdout, returns value.
-
->>> print "ABC" >> return "XYZ"
-"XYZ"
--}
+ test/testdata/TIt.expected.hs view
@@ -0,0 +1,11 @@+module TIt where++-- >>> "test"+-- >>> it+-- "test"+-- "test"++-- >>> pure "test2"+-- >>> it+-- "test2"+-- "test2"
test/testdata/TIt.hs view
@@ -1,7 +1,7 @@-module TIt where
-
--- >>> "test"
--- >>> it
-
--- >>> pure "test2"
--- >>> it
+module TIt where++-- >>> "test"+-- >>> it++-- >>> pure "test2"+-- >>> it
− test/testdata/TIt.hs.expected 
@@ -1,11 +0,0 @@-module TIt where
-
--- >>> "test"
--- >>> it
--- "test"
--- "test"
-
--- >>> pure "test2"
--- >>> it
--- "test2"
--- "test2"
+ test/testdata/TLHS.expected.lhs view
@@ -0,0 +1,25 @@+An example LHS++> {-# LANGUAGE OverloadedStrings #-}++> module TLHS where++More comments, here.++> -- | >>> 2+2+> -- 4++> -- | >>> x+a+> -- 14++> {- |+> >>> 5+5+> WAS 11+> NOW 10+> -}+> x :: Integer+> x = 3++> a :: Integer+> a = 11+
test/testdata/TLHS.lhs view
@@ -1,22 +1,22 @@-An example LHS
-
-> {-# LANGUAGE OverloadedStrings #-}
-
-> module TLHS where
-
-More comments, here.
-
-> -- | >>> 2+2
-
-> -- | >>> x+a
-
-> {- |
-> >>> 5+5
-> 11
-> -}
-> x :: Integer
-> x = 3
-
-> a :: Integer
-> a = 11
-
+An example LHS++> {-# LANGUAGE OverloadedStrings #-}++> module TLHS where++More comments, here.++> -- | >>> 2+2++> -- | >>> x+a++> {- |+> >>> 5+5+> 11+> -}+> x :: Integer+> x = 3++> a :: Integer+> a = 11+
− test/testdata/TLHS.lhs.expected 
@@ -1,25 +0,0 @@-An example LHS
-
-> {-# LANGUAGE OverloadedStrings #-}
-
-> module TLHS where
-
-More comments, here.
-
-> -- | >>> 2+2
-> -- 4
-
-> -- | >>> x+a
-> -- 14
-
-> {- |
-> >>> 5+5
-> WAS 11
-> NOW 10
-> -}
-> x :: Integer
-> x = 3
-
-> a :: Integer
-> a = 11
-
+ test/testdata/TLHSLaTeX.expected.lhs view
@@ -0,0 +1,17 @@+\documentstyle{article}++\begin{document}++\section{Introduction}++This is a trivial program that prints the first 20 factorials.++\begin{code}+module TLHSLaTeX where++-- >>> prod+-- [(1,1),(2,2),(3,6)]+prod =  [ (n, product [1..n]) | n <- [1..3]]+\end{code}++\end{document}
test/testdata/TLHSLaTeX.lhs view
@@ -1,16 +1,16 @@-\documentstyle{article}
-
-\begin{document}
-
-\section{Introduction}
-
-This is a trivial program that prints the first 20 factorials.
-
-\begin{code}
-module TLHSLaTeX where
-
--- >>> prod
-prod =  [ (n, product [1..n]) | n <- [1..3]]
-\end{code}
-
-\end{document}
+\documentstyle{article}++\begin{document}++\section{Introduction}++This is a trivial program that prints the first 20 factorials.++\begin{code}+module TLHSLaTeX where++-- >>> prod+prod =  [ (n, product [1..n]) | n <- [1..3]]+\end{code}++\end{document}
− test/testdata/TLHSLateX.lhs.expected 
@@ -1,17 +0,0 @@-\documentstyle{article}
-
-\begin{document}
-
-\section{Introduction}
-
-This is a trivial program that prints the first 20 factorials.
-
-\begin{code}
-module TLHSLaTeX where
-
--- >>> prod
--- [(1,1),(2,2),(3,6)]
-prod =  [ (n, product [1..n]) | n <- [1..3]]
-\end{code}
-
-\end{document}
+ test/testdata/TLanguageOptionsTupleSections.expected.hs view
@@ -0,0 +1,9 @@+-- This works fine: {-# LANGUAGE TupleSections #-}+module TLanguageOptionsTupleSections where++-- Why oh why is this not working?+-- What is special about TupleSections?+-- >>> :set -XTupleSections+-- >>> ("a",) "b"+-- ("a","b")+
test/testdata/TLanguageOptionsTupleSections.hs view
@@ -1,9 +1,9 @@--- This works fine: {-# LANGUAGE TupleSections #-}
-module TLanguageOptionsTupleSection where
-
--- Why oh why is this not working?
--- What is special about TupleSections?
--- >>> :set -XTupleSections
--- >>> ("a",) "b"
--- ("a","b")
-
+-- This works fine: {-# LANGUAGE TupleSections #-}+module TLanguageOptionsTupleSections where++-- Why oh why is this not working?+-- What is special about TupleSections?+-- >>> :set -XTupleSections+-- >>> ("a",) "b"+-- ("a","b")+
− test/testdata/TLanguageOptionsTupleSections.hs.expected 
@@ -1,8 +0,0 @@--- This works fine: {-# LANGUAGE TupleSections #-}
-module TLanguageOptionsTupleSection where
-
--- Why oh why is this not working?
--- What is special about TupleSections?
--- >>> :set -XTupleSections
--- >>> ("a",) "b"
--- ("a","b")
+ test/testdata/TLastLine.expected.hs view
@@ -0,0 +1,4 @@+module TLastLine where++-- >>> take 3 [1..]+-- [1,2,3]
test/testdata/TLastLine.hs view
@@ -1,3 +1,3 @@-module TLastLine where
-
+module TLastLine where+ -- >>> take 3 [1..]
− test/testdata/TLastLine.hs.expected 
@@ -1,4 +0,0 @@-module TLastLine where
-
--- >>> take 3 [1..]
--- [1,2,3]
+ test/testdata/TLocalImport.expected.hs view
@@ -0,0 +1,6 @@+module TLocalImport where++import qualified Util++-- >>> Util.tst 11 11+-- True
test/testdata/TLocalImport.hs view
@@ -1,5 +1,5 @@-module TLocalImport where
-
-import qualified Util
-
--- >>> Util.tst 11 11
+module TLocalImport where++import qualified Util++-- >>> Util.tst 11 11
− test/testdata/TLocalImport.hs.expected 
@@ -1,6 +0,0 @@-module TLocalImport where
-
-import qualified Util
-
--- >>> Util.tst 11 11
--- True
+ test/testdata/TLocalImportInTest.expected.hs view
@@ -0,0 +1,5 @@+module TLocalImportInTest where++-- >>> import qualified Util+-- >>> Util.a+-- 'a'
test/testdata/TLocalImportInTest.hs view
@@ -1,4 +1,4 @@-module TLocalImportInTest where
-
--- >>> import qualified Util
--- >>> Util.a
+module TLocalImportInTest where++-- >>> import qualified Util+-- >>> Util.a
− test/testdata/TLocalImportInTest.hs.expected 
@@ -1,5 +0,0 @@-module TLocalImportInTest where
-
--- >>> import qualified Util
--- >>> Util.a
--- 'a'
+ test/testdata/TMulti.expected.hs view
@@ -0,0 +1,25 @@+{- | Multi line comments are parsed correctly.+-}+module TMulti () where++{- ORMOLU_DISABLE -}++-- this should work fine if previous multi comment is parsed correctly+-- >>> "a"++"b"+-- "ab"++  {- >>> 3+3+6+    -}++-- this should work fine if previous multi comment is parsed correctly+-- >>> "a"++"b"+-- "ab"++  {-| >>> "NOT IGNORED" +"NOT IGNORED"+-}++-- this should work fine if previous multi comment is parsed correctly+-- >>> "a"++"b"+-- "ab"
test/testdata/TMulti.hs view
@@ -1,19 +1,19 @@-{- | Multi line comments are parsed correctly.
--}
-module TMulti () where
-
-{- ORMOLU_DISABLE -}
-
--- this should work fine if previous multi comment is parsed correctly
--- >>> "a"++"b"
-
-  {- >>> 3+3
-    -}
-
--- this should work fine if previous multi comment is parsed correctly
--- >>> "a"++"b"
-
-  {-| >>> "NOT IGNORED" -}
-
--- this should work fine if previous multi comment is parsed correctly
--- >>> "a"++"b"
+{- | Multi line comments are parsed correctly.+-}+module TMulti () where++{- ORMOLU_DISABLE -}++-- this should work fine if previous multi comment is parsed correctly+-- >>> "a"++"b"++  {- >>> 3+3+    -}++-- this should work fine if previous multi comment is parsed correctly+-- >>> "a"++"b"++  {-| >>> "NOT IGNORED" -}++-- this should work fine if previous multi comment is parsed correctly+-- >>> "a"++"b"
− test/testdata/TMulti.hs.expected 
@@ -1,25 +0,0 @@-{- | Multi line comments are parsed correctly.
--}
-module TMulti () where
-
-{- ORMOLU_DISABLE -}
-
--- this should work fine if previous multi comment is parsed correctly
--- >>> "a"++"b"
--- "ab"
-
-  {- >>> 3+3
-6
-    -}
-
--- this should work fine if previous multi comment is parsed correctly
--- >>> "a"++"b"
--- "ab"
-
-  {-| >>> "NOT IGNORED" 
-"NOT IGNORED"
--}
-
--- this should work fine if previous multi comment is parsed correctly
--- >>> "a"++"b"
--- "ab"
+ test/testdata/TNested.expected.hs view
@@ -0,0 +1,15 @@+module TNested () where+{-+>>> 54+54+{-+Nested+-}+-}++{-+{-+>>> 42+42+-}+-}
test/testdata/TNested.hs view
@@ -1,13 +1,13 @@-module TNseted () where
-{-
->>> 54
-{-
-Nested
--}
--}
-
-{-
-{-
->>> 42
--}
--}
+module TNested () where+{-+>>> 54+{-+Nested+-}+-}++{-+{-+>>> 42+-}+-}
− test/testdata/TNested.hs.expected 
@@ -1,15 +0,0 @@-module TNseted () where
-{-
->>> 54
-54
-{-
-Nested
--}
--}
-
-{-
-{-
->>> 42
-42
--}
--}
+ test/testdata/TNoImplicitPrelude.expected.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE NoImplicitPrelude #-}++module TNoImplicitPrelude where++import Data.List (unwords)+import Data.String (String)++-- >>> unwords example+-- "This is an example of evaluation"+example :: [String]+example = ["This","is","an","example","of","evaluation"]
test/testdata/TNoImplicitPrelude.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE NoImplicitPrelude #-}
-
-module TNoImplicitPrelude where
-
-import Data.List (unwords)
-import Data.String (String)
-
--- >>> unwords example
-example :: [String]
-example = ["This","is","an","example","of","evaluation"]
+{-# LANGUAGE NoImplicitPrelude #-}++module TNoImplicitPrelude where++import Data.List (unwords)+import Data.String (String)++-- >>> unwords example+example :: [String]+example = ["This","is","an","example","of","evaluation"]
− test/testdata/TNoImplicitPrelude.hs.expected 
@@ -1,11 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}
-
-module TNoImplicitPrelude where
-
-import Data.List (unwords)
-import Data.String (String)
-
--- >>> unwords example
--- "This is an example of evaluation"
-example :: [String]
-example = ["This","is","an","example","of","evaluation"]
+ test/testdata/TPlainComment.expected.hs view
@@ -0,0 +1,29 @@+{- |+Tests in plain comments in both single line or multi line format.+Tests are ignored if:+    * do not start on the first column+    * are in multi line comments that open and close on the same line+-}+module TPlainComment where++{- ORMOLU_DISABLE -}++-- Single line comment+-- >>> "a"++"b"+-- "ab"++{- Multi line comment++>>> "b"++"c"+"bc"+-}++{- >>> 2+five+7++   ^-- This works, as it starts at the first column after the header.++     >>> IGNORED as it does not start on the first column+-}+five :: Integer+five = 5
test/testdata/TPlainComment.hs view
@@ -1,25 +1,26 @@-{- |
-Tests in plain comments in both single line or multi line format.
-Tests are ignored if:
-    * do not start on the first column
-    * are in multi line comments that open and close on the same line
--}
-module TPlain where
-
-{- ORMOLU_DISABLE -}
-
--- Single line comment
--- >>> "a"++"b"
-
-{- Multi line comment
-
->>> "b"++"c"
--}
-
-{- >>> 2+five
-
-   ^-- This works, as it starts at the first column after the header.
-
-     >>> IGNORED as it does not start on the first column
--}
-five = 5
+{- |+Tests in plain comments in both single line or multi line format.+Tests are ignored if:+    * do not start on the first column+    * are in multi line comments that open and close on the same line+-}+module TPlainComment where++{- ORMOLU_DISABLE -}++-- Single line comment+-- >>> "a"++"b"++{- Multi line comment++>>> "b"++"c"+-}++{- >>> 2+five++   ^-- This works, as it starts at the first column after the header.++     >>> IGNORED as it does not start on the first column+-}+five :: Integer+five = 5
− test/testdata/TPlainComment.hs.expected 
@@ -1,28 +0,0 @@-{- |
-Tests in plain comments in both single line or multi line format.
-Tests are ignored if:
-    * do not start on the first column
-    * are in multi line comments that open and close on the same line
--}
-module TPlain where
-
-{- ORMOLU_DISABLE -}
-
--- Single line comment
--- >>> "a"++"b"
--- "ab"
-
-{- Multi line comment
-
->>> "b"++"c"
-"bc"
--}
-
-{- >>> 2+five
-7
-
-   ^-- This works, as it starts at the first column after the header.
-
-     >>> IGNORED as it does not start on the first column
--}
-five = 5
+ test/testdata/TPrelude.expected.hs view
@@ -0,0 +1,11 @@+-- Prelude has no special treatment, it is imported as stated in the module.+module TPrelude where++import           Prelude hiding (foldr)++-- >>> foldr (+) 10 [2,3,5]+-- 20+foldr :: (a -> z -> z) -> z -> [a] -> z+foldr f z bs =+   (foldl (\g a -> g . f a) id bs) z+
test/testdata/TPrelude.hs view
@@ -1,10 +1,10 @@--- Prelude has no special treatment, it is imported as stated in the module.
-module TPrelude where
-
-import           Prelude hiding (foldr)
-
--- >>> foldr (+) 10 [2,3,5]
-foldr :: (a -> z -> z) -> z -> [a] -> z
-foldr f z bs =
-   (foldl (\g a -> g . f a) id bs) z
-
+-- Prelude has no special treatment, it is imported as stated in the module.+module TPrelude where++import           Prelude hiding (foldr)++-- >>> foldr (+) 10 [2,3,5]+foldr :: (a -> z -> z) -> z -> [a] -> z+foldr f z bs =+   (foldl (\g a -> g . f a) id bs) z+
− test/testdata/TPrelude.hs.expected 
@@ -1,11 +0,0 @@--- Prelude has no special treatment, it is imported as stated in the module.
-module TPrelude where
-
-import           Prelude hiding (foldr)
-
--- >>> foldr (+) 10 [2,3,5]
--- 20
-foldr :: (a -> z -> z) -> z -> [a] -> z
-foldr f z bs =
-   (foldl (\g a -> g . f a) id bs) z
-
+ test/testdata/TProperty.expected.hs view
@@ -0,0 +1,6 @@+-- Support for property checking+module TProperty where++-- prop> \(l::[Bool]) -> reverse (reverse l) == l+-- +++ OK, passed 100 tests.+
test/testdata/TProperty.hs view
@@ -1,5 +1,5 @@--- Support for property checking
-module TProperty where
-
--- prop> \(l::[Bool]) -> reverse (reverse l) == l
-
+-- Support for property checking+module TProperty where++-- prop> \(l::[Bool]) -> reverse (reverse l) == l+
− test/testdata/TProperty.hs.expected 
@@ -1,6 +0,0 @@--- Support for property checking
-module TProperty where
-
--- prop> \(l::[Bool]) -> reverse (reverse l) == l
--- +++ OK, passed 100 tests.
-
+ test/testdata/TSectionEval.expected.hs view
@@ -0,0 +1,17 @@+-- Tests in the same document section are executed together+module TSectionEval where++{-+>>> 1+1+2++>>> 2+2+4+-}++{-+>>> 3+3++>>> 4+4+-}+
test/testdata/TSectionEval.hs view
@@ -1,15 +1,15 @@--- Tests in the same document section are executed together
-module TSectionEval where
-
-{-
->>> 1+1
-
->>> 2+2
--}
-
-{-
->>> 3+3
-
->>> 4+4
--}
-
+-- Tests in the same document section are executed together+module TSectionEval where++{-+>>> 1+1++>>> 2+2+-}++{-+>>> 3+3++>>> 4+4+-}+
− test/testdata/TSectionEval.hs.expected 
@@ -1,17 +0,0 @@--- Tests in the same document section are executed together
-module TSectionEval where
-
-{-
->>> 1+1
-2
-
->>> 2+2
-4
--}
-
-{-
->>> 3+3
-
->>> 4+4
--}
-
+ test/testdata/TSetup.expected.hs view
@@ -0,0 +1,12 @@+-- The setup section is executed before any other test+module TSetup where++-- $setup+-- >>> x=11+-- >>> y=22++-- >>> x+y+-- 33++-- >>> x*y+-- 242
test/testdata/TSetup.hs view
@@ -1,10 +1,10 @@--- The setup section is executed before any other test
-module TSetup where
-
--- $setup
--- >>> x=11
--- >>> y=22
-
--- >>> x+y
-
--- >>> x*y
+-- The setup section is executed before any other test+module TSetup where++-- $setup+-- >>> x=11+-- >>> y=22++-- >>> x+y++-- >>> x*y
− test/testdata/TSetup.hs.expected 
@@ -1,12 +0,0 @@--- The setup section is executed before any other test
-module TSetup where
-
--- $setup
--- >>> x=11
--- >>> y=22
-
--- >>> x+y
--- 33
-
--- >>> x*y
--- 242
+ test/testdata/TUNPACK.expected.hs view
@@ -0,0 +1,14 @@+{- | Won't panic on UNPACKs -}+module TUNPACK (THStatus(..)) where++type ByteString = String+type BSEndo = ByteString -> ByteString+type BSEndoList = [ByteString] -> [ByteString]++data THStatus = THStatus+    {-# UNPACK #-} !Int -- running total byte count+    BSEndoList -- previously parsed lines+    BSEndo -- bytestrings to be prepended++-- >>> "Yay! UNPACK pragma didn't do bad things!"+-- "Yay! UNPACK pragma didn't do bad things!"
test/testdata/TUNPACK.hs view
@@ -1,13 +1,13 @@-{- | Won't panic on UNPACKs -}
-module TUNPACK (THStatus(..)) where
-
-type ByteString = String
-type BSEndo = ByteString -> ByteString
-type BSEndoList = [ByteString] -> [ByteString]
-
-data THStatus = THStatus
-    {-# UNPACK #-} !Int -- running total byte count
-    BSEndoList -- previously parsed lines
-    BSEndo -- bytestrings to be prepended
-
--- >>> "Yay! UNPACK pragma didn't do bad things!"
+{- | Won't panic on UNPACKs -}+module TUNPACK (THStatus(..)) where++type ByteString = String+type BSEndo = ByteString -> ByteString+type BSEndoList = [ByteString] -> [ByteString]++data THStatus = THStatus+    {-# UNPACK #-} !Int -- running total byte count+    BSEndoList -- previously parsed lines+    BSEndo -- bytestrings to be prepended++-- >>> "Yay! UNPACK pragma didn't do bad things!"
− test/testdata/TUNPACK.hs.expected 
@@ -1,14 +0,0 @@-{- | Won't panic on UNPACKs -}
-module TUNPACK (THStatus(..)) where
-
-type ByteString = String
-type BSEndo = ByteString -> ByteString
-type BSEndoList = [ByteString] -> [ByteString]
-
-data THStatus = THStatus
-    {-# UNPACK #-} !Int -- running total byte count
-    BSEndoList -- previously parsed lines
-    BSEndo -- bytestrings to be prepended
-
--- >>> "Yay! UNPACK pragma didn't do bad things!"
--- "Yay! UNPACK pragma didn't do bad things!"
test/testdata/Util.hs view
@@ -1,13 +1,13 @@--- Used for testing local imports
-module Util
-  ( tst
-  , a
-  , b
-  )
-where
-
-tst a b = a == b
-
-a = 'a'
-
-b = 'b'
+-- Used for testing local imports+module Util+  ( tst+  , a+  , b+  )+where++tst a b = a == b++a = 'a'++b = 'b'
+ test/testdata/cabal.project view
@@ -0,0 +1,1 @@+packages: ./
test/testdata/hie.yaml view
@@ -1,4 +1,4 @@-cradle:
-  cabal:
-    - path: "././"
-      component: "lib:test"
+cradle:+  cabal:+    - path: "./"+      component: "lib:test"
test/testdata/test.cabal view
@@ -1,63 +1,63 @@-name:                test
-version:             0.1.0.0
--- synopsis:
--- description:
-license:             BSD3
-author:              Author name here
-maintainer:          example@example.com
-copyright:           2017 Author name here
-category:            Web
-build-type:          Simple
-cabal-version:       >=1.10
-
-library
-  exposed-modules:
-      T1
-      T2
-      T3
-      T4
-      T5
-      T6
-      T7
-      T8
-      T9
-      T10
-      T11
-      T12
-      T13
-      T14
-      T15
-      T16
-      T17
-      T18
-      T19
-      T20
-      T21
-      T22
-      T23
-      T24
-      T25
-      T26
-      T27
-      TEndingMulti
-      TMulti
-      TPlainComment
-      THaddock
-      TCompare
-      TLocalImport
-      TLocalImportInTest
-      TFlags
-      TLanguageOptionsTupleSections
-      TIO
-      TProperty
-      TPrelude
-      TCPP
-      TLHS
-      TSetup
-      Util
-      TNested
-
-  build-depends:       base >= 4.7 && < 5, QuickCheck
-  default-language:    Haskell2010
-  ghc-options:         -Wall -fwarn-unused-imports
-
+name:                test+version:             0.1.0.0+-- synopsis:+-- description:+license:             BSD3+author:              Author name here+maintainer:          example@example.com+copyright:           2017 Author name here+category:            Web+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:+      T1+      T2+      T3+      T4+      T5+      T6+      T7+      T8+      T9+      T10+      T11+      T12+      T13+      T14+      T15+      T16+      T17+      T18+      T19+      T20+      T21+      T22+      T23+      T24+      T25+      T26+      T27+      TEndingMulti+      TMulti+      TPlainComment+      THaddock+      TCompare+      TLocalImport+      TLocalImportInTest+      TFlags+      TLanguageOptionsTupleSections+      TIO+      TProperty+      TPrelude+      TCPP+      TLHS+      TSetup+      Util+      TNested++  build-depends:       base >= 4.7 && < 5, QuickCheck+  default-language:    Haskell2010+  ghc-options:         -Wall -fwarn-unused-imports+