hls-eval-plugin 1.0.0.0 → 1.1.0.0

raw patch · 113 files changed

+4050/−2632 lines, 113 filesdep +hls-eval-plugindep +hls-test-utilsdep +lsp-testdep ~Diffdep ~basedep ~ghcidenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: hls-eval-plugin, hls-test-utils, lsp-test

Dependency ranges changed: Diff, base, ghcide, hls-plugin-api, megaparsec

API changes (from Hackage documentation)

Files

• LICENSE +201/−201
• README.md +332/−332
• hls-eval-plugin.cabal +112/−78
• src/Ide/Plugin/Eval.hs +28/−28
• src/Ide/Plugin/Eval/Code.hs +131/−127
• src/Ide/Plugin/Eval/CodeLens.hs +711/−767
• src/Ide/Plugin/Eval/GHC.hs +174/−206
• src/Ide/Plugin/Eval/Parse/Comments.hs +571/−575
• src/Ide/Plugin/Eval/Parse/Option.hs +40/−40
• src/Ide/Plugin/Eval/Types.hs +162/−162
• src/Ide/Plugin/Eval/Util.hs +105/−116
• test/Main.hs +218/−0
• test/testdata/T1.hs +7/−0
• test/testdata/T1.hs.expected +8/−0
• test/testdata/T10.hs +9/−0
• test/testdata/T10.hs.expected +11/−0
• test/testdata/T11.hs +3/−0
• test/testdata/T11.hs.expected +4/−0
• test/testdata/T12.hs +9/−0
• test/testdata/T12.hs.expected +10/−0
• test/testdata/T13.hs +3/−0
• test/testdata/T13.hs.expected +4/−0
• test/testdata/T14.hs +7/−0
• test/testdata/T14.hs.expected +8/−0
• test/testdata/T15.hs +7/−0
• test/testdata/T15.hs.expected +8/−0
• test/testdata/T16.hs +3/−0
• test/testdata/T16.hs.expected +4/−0
• test/testdata/T17.hs +3/−0
• test/testdata/T17.hs.expected +4/−0
• test/testdata/T18.hs +4/−0
• test/testdata/T18.hs.expected +5/−0
• test/testdata/T19.hs +6/−0
• test/testdata/T19.hs.expected +7/−0
• test/testdata/T2.hs +8/−0
• test/testdata/T2.hs.expected +8/−0
• test/testdata/T20.hs +6/−0
• test/testdata/T20.hs.expected +7/−0
• test/testdata/T21.hs +12/−0
• test/testdata/T21.hs.expected +16/−0
• test/testdata/T22.hs +9/−0
• test/testdata/T22.hs.expected +10/−0
• test/testdata/T23.hs +12/−0
• test/testdata/T23.hs.expected +15/−0
• test/testdata/T24.hs +14/−0
• test/testdata/T24.hs.expected +32/−0
• test/testdata/T25.hs +14/−0
• test/testdata/T25.hs.expected +28/−0
• test/testdata/T26.hs +4/−0
• test/testdata/T26.hs.expected +5/−0
• test/testdata/T27.hs +4/−0
• test/testdata/T27.hs.expected +5/−0
• test/testdata/T3.hs +7/−0
• test/testdata/T3.hs.expected +8/−0
• test/testdata/T4.hs +9/−0
• test/testdata/T4.hs.expected +10/−0
• test/testdata/T5.hs +6/−0
• test/testdata/T5.hs.expected +6/−0
• test/testdata/T6.hs +9/−0
• test/testdata/T6.hs.expected +9/−0
• test/testdata/T7.hs +10/−0
• test/testdata/T7.hs.expected +10/−0
• test/testdata/T8.hs +10/−0
• test/testdata/T8.hs.expected +14/−0
• test/testdata/T9.hs +7/−0
• test/testdata/T9.hs.expected +8/−0
• test/testdata/TCPP.hs +19/−0
• test/testdata/TCPP.hs.expected +22/−0
• test/testdata/TCompare.hs +12/−0
• test/testdata/TCompare.hs.expected +13/−0
• test/testdata/TEndingMulti.hs +6/−0
• test/testdata/TEndingMulti.hs.expected +9/−0
• test/testdata/TFlags.hs +68/−0
• test/testdata/TFlags.hs.expected +76/−0
• test/testdata/THaddock.hs +35/−0
• test/testdata/THaddock.hs.expected +40/−0
• test/testdata/TIO.hs +9/−0
• test/testdata/TIO.hs.expected +9/−0
• test/testdata/TIt.hs +7/−0
• test/testdata/TIt.hs.expected +11/−0
• test/testdata/TLHS.lhs +22/−0
• test/testdata/TLHS.lhs.expected +25/−0
• test/testdata/TLHSLaTeX.lhs +16/−0
• test/testdata/TLHSLateX.lhs.expected +17/−0
• test/testdata/TLanguageOptionsTupleSections.hs +9/−0
• test/testdata/TLanguageOptionsTupleSections.hs.expected +8/−0
• test/testdata/TLastLine.hs +3/−0
• test/testdata/TLastLine.hs.expected +4/−0
• test/testdata/TLocalImport.hs +5/−0
• test/testdata/TLocalImport.hs.expected +6/−0
• test/testdata/TLocalImportInTest.hs +4/−0
• test/testdata/TLocalImportInTest.hs.expected +5/−0
• test/testdata/TMulti.hs +19/−0
• test/testdata/TMulti.hs.expected +25/−0
• test/testdata/TNested.hs +13/−0
• test/testdata/TNested.hs.expected +15/−0
• test/testdata/TNoImplicitPrelude.hs +10/−0
• test/testdata/TNoImplicitPrelude.hs.expected +11/−0
• test/testdata/TPlainComment.hs +25/−0
• test/testdata/TPlainComment.hs.expected +28/−0
• test/testdata/TPrelude.hs +10/−0
• test/testdata/TPrelude.hs.expected +11/−0
• test/testdata/TProperty.hs +5/−0
• test/testdata/TProperty.hs.expected +6/−0
• test/testdata/TSectionEval.hs +15/−0
• test/testdata/TSectionEval.hs.expected +17/−0
• test/testdata/TSetup.hs +10/−0
• test/testdata/TSetup.hs.expected +12/−0
• test/testdata/TUNPACK.hs +13/−0
• test/testdata/TUNPACK.hs.expected +14/−0
• test/testdata/Util.hs +13/−0
• test/testdata/hie.yaml +4/−0
• test/testdata/test.cabal +63/−0

@@ -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.

@@ -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)
+

@@ -1,78 +1,112 @@-cabal-version:      2.2-name:               hls-eval-plugin-version:            1.0.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--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-  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.Types-    Ide.Plugin.Eval.Util--  build-depends:-    , aeson-    , base                  >=4.12    && <5-    , containers-    , deepseq-    , Diff-    , directory-    , dlist-    , extra-    , filepath-    , ghc-    , ghc-boot-th-    , ghc-paths-    , ghcide                ^>= 1.0.0.0-    , hashable-    , lsp-    , lsp-types-    , hls-plugin-api        ^>= 1.0.0.0-    , lens-    , megaparsec            >=0.9-    , mtl-    , parser-combinators-    , pretty-simple-    , QuickCheck-    , safe-exceptions-    , shake-    , temporary-    , text-    , time-    , transformers-    , unordered-containers-    , unliftio--  ghc-options:      -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors--  if flag(pedantic)-    ghc-options: -Werror--  default-language: Haskell2010-  default-extensions: DataKinds, TypeOperators+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

@@ -1,28 +1,28 @@-{-# 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]
+        }

@@ -1,127 +1,131 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -Wwarn -fno-warn-orphans #-}---- | Expression execution-module Ide.Plugin.Eval.Code (Statement, testRanges, resultRange, evalExtensions, evalSetup, evalExpr, propSetup, testCheck, asStatements) where--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 (compileExpr)-import GHC.LanguageExtensions.Type (Extension (..))-import GhcMonad (Ghc, GhcMonad, liftIO)-import Ide.Plugin.Eval.Types (-    Language (Plain),-    Loc,-    Section (sectionLanguage),-    Test (..),-    Txt,-    locate,-    locate0, Located(..)- )-import InteractiveEval (runDecls)-import Unsafe.Coerce (unsafeCoerce)-import Control.Lens ((^.))-import Language.LSP.Types.Lens (start, line)---- | 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)"]---- |Evaluate an expression (either a pure expression or an IO a)-evalExpr :: GhcMonad m => [Char] -> m String-evalExpr e = do-    res <- compileExpr $ "asPrint (" ++ e ++ ")"-    liftIO (unsafeCoerce res :: 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 =-    mapM_-        runDecls-        [ "class Print f where asPrint :: f -> IO String"-        , "instance Show a => Print (IO a) where asPrint io = io >>= return . show"-        , "instance Show a => Print a where asPrint a = return (show a)"-        ]--{- |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
+        ]

@@ -1,767 +1,711 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# 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 Control.Applicative (Alternative ((<|>)))-import Control.Arrow (second, (>>>))-import qualified Control.Exception as E-import Control.Monad-    ( void,-      when, guard,-      join-    )-import Control.Monad.IO.Class (MonadIO (liftIO))-import Control.Monad.Trans.Except-    ( ExceptT (..),-    )-import Data.Aeson (toJSON)-import Data.Char (isSpace)-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,-      realSrcSpanToRange,  GetModSummary (..),-      GetParsedModuleWithComments (..),-      HscEnvEq,-      IdeState,-      evalGhcEnv,-      hscEnvWithImportPaths,-      runAction,-      textToStringBuffer,-      toNormalizedFilePath',-      uriToFilePath',-      useWithStale_,-      prettyPrint,-      use_, useNoFile_, uses_,-      GhcSessionIO(..), GetDependencies(..), GetModIface(..),-      HiFileResult (hirHomeMod, hirModSummary)-    )-import Development.IDE.Core.Rules (TransitiveDependencies(transitiveModuleDeps))-import Development.IDE.Core.Compile (setupFinderCache, loadModulesHome)-import Development.IDE.GHC.Compat (AnnotationComment(AnnBlockComment, AnnLineComment), GenLocated (L), HscEnv, ParsedModule (..), SrcSpan (RealSrcSpan, UnhelpfulSpan), srcSpanFile, GhcException, setInteractiveDynFlags)-import Development.IDE.Types.Options-import DynamicLoading (initializePlugins)-import FastString (unpackFS)-import GHC-    (ExecOptions-        ( execLineNumber,-          execSourceFile-        ),-      ExecResult (..),-      GeneralFlag (..),-      Ghc,-      GhcLink (LinkInMemory),-      GhcMode (CompManager),-      GhcMonad (getSession),-      HscTarget (HscInterpreted),-      LoadHowMuch (LoadAllTargets),-      ModSummary (ms_hspp_opts),-      Module (moduleName),-      SuccessFlag (Failed, Succeeded),-      TcRnExprMode (..),-      execOptions,-      execStmt,-      exprType,-      getInteractiveDynFlags,-      getSessionDynFlags,-      isImport,-      isStmt,-      load,-      runDecls,-      setContext,-      setLogAction,-      setSessionDynFlags,-      setTargets,-      typeKind,-    )-import GhcPlugins-    ( DynFlags (..),-      hsc_dflags,-      defaultLogActionHPutStrDoc,-      gopt_set,-      gopt_unset,-      interpWays,-      targetPlatform,-      updateWays,-      wayGeneralFlags,-      wayUnsetGeneralFlags,-      xopt_set, parseDynamicFlagsCmdLine-    )-import HscTypes-    ( InteractiveImport (IIModule),-      ModSummary (ms_mod),-      Target (Target),-      TargetId (TargetFile),-    )-import Ide.Plugin.Eval.Code-    ( Statement,-      asStatements,-      evalExpr,-      evalExtensions,-      evalSetup,-      propSetup,-      resultRange,-      testCheck,-      testRanges,-    )-import Ide.Plugin.Eval.GHC-    ( addImport,-      addPackages,-      hasPackage,-      isExpr,-      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.VFS (virtualFileText)-import Outputable-    ( nest,-      ppr,-      showSDoc,-      text,-      ($$),-      (<+>),-    )-import System.FilePath (takeFileName)-import System.IO (hClose)-import UnliftIO.Temporary (withSystemTempFile)-import Util (OverridingBool (Never))-import Development.IDE.Core.PositionMapping (toCurrentRange)-import qualified Data.DList as DL-import Control.Lens ((^.), _1, (%~), (<&>), _3)-import Language.LSP.Types.Lens (line, end)-import CmdLineParser-import qualified Development.IDE.GHC.Compat as SrcLoc-import Control.Exception (try)--{- | 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, _) <--                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--            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-        | -- An expression-          isExpr df stmt =-            do-                dbg "{EXPR" stmt-                eres <- gStrictTry $ evalExpr stmt-                dbg "RES ->" eres-                let res = case eres of-                        Left err -> errorLines err-                        Right rs -> [T.pack rs]-                dbg "EXPR} ->" res-                return . Just $ res-        | -- A statement-          isStmt df stmt =-            do-                dbg "{STMT " stmt-                res <- exec stmt l-                r <- case res of-                    ExecComplete (Left err) _ -> return . Just . errorLines . show $ err-                    ExecComplete (Right _) _ -> return Nothing-                    ExecBreak{} ->-                        return . Just . singleLine $ "breakpoints are not supported"-                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 execStmt 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 =-    map (\e -> fromMaybe e (T.stripSuffix "arising from a use of ‘asPrint’" e))-        . 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 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

@@ -1,206 +1,174 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-unused-imports -Wno-orphans #-}---- |GHC API utilities-module Ide.Plugin.Eval.GHC (-    isExpr,-    addExtension,-    addImport,-    hasPackage,-    addPackages,-    modifyFlags,-    showDynFlags,-) where--import Data.List (isPrefixOf)-import Data.Maybe (mapMaybe)-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)-import Data.String (fromString)--{- $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"--}--{- | Returns true if string is an expression-->>> isExprTst e df = return (isExpr df e)->>> run $ isExprTst "3"-True-->>> run $ isExprTst "(x+y)"-True-->>> run $ isExprTst "import Data.Maybe"-False-->>> run $ isExprTst "three=3"-False--}-isExpr :: DynFlags -> String -> Bool-isExpr df stmt = case parseThing Parser.parseExpression df stmt of-    Lexer.POk _ _ -> True-    Lexer.PFailed{} -> False--parseThing :: Lexer.P thing -> DynFlags -> String -> Lexer.ParseResult thing-parseThing parser dflags stmt = do-    let buf = stringToStringBuffer stmt-        loc = mkRealSrcLoc (fsLit "<interactive>") 1 1--    Lexer.unP parser (Lexer.mkPState dflags buf loc)--{- | 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                  (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

@@ -1,575 +1,571 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# 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.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 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,-    )-import Data.Functor ((<&>))-import qualified Data.Text as T--{--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

@@ -1,40 +1,40 @@-{-# OPTIONS_GHC -Wwarn #-}---- | GHC language options parser-module Ide.Plugin.Eval.Parse.Option (-    langOptions,-    parseSetFlags,-) where--import Text.Megaparsec.Char-import Text.Megaparsec-import Data.Void (Void)-import Control.Arrow (left)--{- |->>> 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)

@@ -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 qualified Text.Megaparsec as P-import Language.LSP.Types (TextDocumentIdentifier)---- | 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)

@@ -1,116 +1,105 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# 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           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

@@ -0,0 +1,218 @@+{-# 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"

@@ -0,0 +1,7 @@+module T1 where
+
+import Data.List (unwords)
+
+-- >>> unwords example
+example :: [String]
+example = ["This","is","an","example","of","evaluation"]

@@ -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"]

@@ -0,0 +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

@@ -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

@@ -0,0 +1,3 @@+module T11 where
+
+-- >>> :kind! a

@@ -0,0 +1,4 @@+module T11 where
+
+-- >>> :kind! a
+-- Not in scope: type variable 'a'

@@ -0,0 +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

@@ -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

@@ -0,0 +1,3 @@+module T13 where
+
+-- >>> :kind a

@@ -0,0 +1,4 @@+module T13 where
+
+-- >>> :kind a
+-- Not in scope: type variable 'a'

@@ -0,0 +1,7 @@+{-# LANGUAGE TypeApplications #-}
+module T14 where
+
+foo :: Show a => a -> String
+foo = show
+
+-- >>> :type foo @Int

@@ -0,0 +1,8 @@+{-# LANGUAGE TypeApplications #-}
+module T14 where
+
+foo :: Show a => a -> String
+foo = show
+
+-- >>> :type foo @Int
+-- foo @Int :: Int -> String

@@ -0,0 +1,7 @@+{-# LANGUAGE TypeApplications #-}
+module T15 where
+
+foo :: Show a => a -> String
+foo = show
+
+-- >>> :type  +v  foo @Int

@@ -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

@@ -0,0 +1,3 @@+module T16 where
+
+-- >>> :type  +d   40+ 2 

@@ -0,0 +1,4 @@+module T16 where
+
+-- >>> :type  +d   40+ 2 
+-- 40+ 2 :: Integer

@@ -0,0 +1,3 @@+module T17 where
+
+-- >>> :type  +no 42

@@ -0,0 +1,4 @@+module T17 where
+
+-- >>> :type  +no 42
+-- parse error on input '+'

@@ -0,0 +1,4 @@+{-# LANGUAGE TypeApplications #-}
+module T18 where
+
+-- >>> :noooop foo bar

@@ -0,0 +1,5 @@+{-# LANGUAGE TypeApplications #-}
+module T18 where
+
+-- >>> :noooop foo bar
+-- unknown command 'noooop'

@@ -0,0 +1,6 @@+module T19 where
+import Data.Word (Word)
+type W = Word
+
+-- >>> default (Word)
+-- >>> :type  +d   40+ 2 

@@ -0,0 +1,7 @@+module T19 where
+import Data.Word (Word)
+type W = Word
+
+-- >>> default (Word)
+-- >>> :type  +d   40+ 2 
+-- 40+ 2 :: Word

@@ -0,0 +1,8 @@+module T2 where
+
+import Data.List (unwords)
+
+-- >>> unwords example
+-- "Stale output"
+example :: [String]
+example = ["This","is","an","example","of","evaluation"]

@@ -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"]

@@ -0,0 +1,6 @@+module T20 where
+import Data.Word (Word)
+
+default (Word)
+
+-- >>> :type  +d   40+ 2 

@@ -0,0 +1,7 @@+module T20 where
+import Data.Word (Word)
+
+default (Word)
+
+-- >>> :type  +d   40+ 2 
+-- 40+ 2 :: Word

@@ -0,0 +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

@@ -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 -> ()

@@ -0,0 +1,9 @@+module T22 where
+import Data.Proxy      (Proxy (..))
+import GHC.TypeNats    (KnownNat)
+import Type.Reflection (Typeable)
+
+f :: Integer
+f = 32
+
+-- >>> :t f

@@ -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

@@ -0,0 +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

@@ -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 -> ()

@@ -0,0 +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)))))))))))))

@@ -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)))))))))

@@ -0,0 +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)))))))))))))

@@ -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))))))))))))

@@ -0,0 +1,4 @@+module T26 where
+import T25 ()
+
+-- >>> "hello"

@@ -0,0 +1,5 @@+module T26 where
+import T25 ()
+
+-- >>> "hello"
+-- "hello"

@@ -0,0 +1,4 @@+module T27 where
+
+-- >>> ()
+--

@@ -0,0 +1,5 @@+module T27 where
+
+-- >>> ()
+-- ()
+--

@@ -0,0 +1,7 @@+module T3 where
+
+
+-- >>> import Data.List (unwords)
+-- >>> unwords example
+example :: [String]
+example = ["This","is","an","example","of","evaluation"]

@@ -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"]

@@ -0,0 +1,9 @@+module T4 where
+
+import           Data.List (unwords)
+
+-- >>> let evaluation = " evaluation"
+-- >>> unwords example ++ evaluation
+example :: [String]
+example = ["This","is","an","example","of"]
+

@@ -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"]
+

@@ -0,0 +1,6 @@+module T5 where
+
+-- >>> unwords example
+-- "This is a stale example of evaluation"
+example :: [String]
+example = ["This","is","an","example","of","evaluation"]

@@ -0,0 +1,6 @@+module T5 where
+
+-- >>> unwords example
+-- "This is an example of evaluation"
+example :: [String]
+example = ["This","is","an","example","of","evaluation"]

@@ -0,0 +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"]

@@ -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"]

@@ -0,0 +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"]

@@ -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"]

@@ -0,0 +1,10 @@+-- Semantic and Lexical errors are reported
+module T8 where
+
+-- >>> noFunctionWithThisName
+
+-- >>> "a" + "bc"
+
+-- >>> "
+
+-- >>> 3 `div` 0

@@ -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

@@ -0,0 +1,7 @@+{-# LANGUAGE DataKinds #-}
+module T9 where
+import Data.Proxy (Proxy(..))
+
+type P = Proxy
+
+-- >>> Proxy :: Proxy 3

@@ -0,0 +1,8 @@+{-# LANGUAGE DataKinds #-}
+module T9 where
+import Data.Proxy (Proxy(..))
+
+type P = Proxy
+
+-- >>> Proxy :: Proxy 3
+-- Proxy

@@ -0,0 +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

@@ -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

@@ -0,0 +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

@@ -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

@@ -0,0 +1,6 @@+module TEndingMulti where
+
+-- Now trailing doctest is allowed:
+
+{- >>> 42
+>>> 54-}

@@ -0,0 +1,9 @@+module TEndingMulti where
+
+-- Now trailing doctest is allowed:
+
+{- >>> 42
+>>> 54
+42
+54
+-}

@@ -0,0 +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
+-}

@@ -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
+-}

@@ -0,0 +1,35 @@+{- |
+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

@@ -0,0 +1,40 @@+{- |
+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

@@ -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"
+-}

@@ -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"
+-}

@@ -0,0 +1,7 @@+module TIt where
+
+-- >>> "test"
+-- >>> it
+
+-- >>> pure "test2"
+-- >>> it

@@ -0,0 +1,11 @@+module TIt where
+
+-- >>> "test"
+-- >>> it
+-- "test"
+-- "test"
+
+-- >>> pure "test2"
+-- >>> it
+-- "test2"
+-- "test2"

@@ -0,0 +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
+

@@ -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
+

@@ -0,0 +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}

@@ -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}

@@ -0,0 +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")
+

@@ -0,0 +1,8 @@+-- 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")

@@ -0,0 +1,3 @@+module TLastLine where
+
+-- >>> take 3 [1..]

@@ -0,0 +1,4 @@+module TLastLine where
+
+-- >>> take 3 [1..]
+-- [1,2,3]

@@ -0,0 +1,5 @@+module TLocalImport where
+
+import qualified Util
+
+-- >>> Util.tst 11 11

@@ -0,0 +1,6 @@+module TLocalImport where
+
+import qualified Util
+
+-- >>> Util.tst 11 11
+-- True

@@ -0,0 +1,4 @@+module TLocalImportInTest where
+
+-- >>> import qualified Util
+-- >>> Util.a

@@ -0,0 +1,5 @@+module TLocalImportInTest where
+
+-- >>> import qualified Util
+-- >>> Util.a
+-- 'a'

@@ -0,0 +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"

@@ -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"

@@ -0,0 +1,13 @@+module TNseted () where
+{-
+>>> 54
+{-
+Nested
+-}
+-}
+
+{-
+{-
+>>> 42
+-}
+-}

@@ -0,0 +1,15 @@+module TNseted () where
+{-
+>>> 54
+54
+{-
+Nested
+-}
+-}
+
+{-
+{-
+>>> 42
+42
+-}
+-}

@@ -0,0 +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"]

@@ -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"]

@@ -0,0 +1,25 @@+{- |
+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

@@ -0,0 +1,28 @@+{- |
+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

@@ -0,0 +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
+

@@ -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
+

@@ -0,0 +1,5 @@+-- Support for property checking
+module TProperty where
+
+-- prop> \(l::[Bool]) -> reverse (reverse l) == l
+

@@ -0,0 +1,6 @@+-- Support for property checking
+module TProperty where
+
+-- prop> \(l::[Bool]) -> reverse (reverse l) == l
+-- +++ OK, passed 100 tests.
+

@@ -0,0 +1,15 @@+-- Tests in the same document section are executed together
+module TSectionEval where
+
+{-
+>>> 1+1
+
+>>> 2+2
+-}
+
+{-
+>>> 3+3
+
+>>> 4+4
+-}
+

@@ -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
+-}
+

@@ -0,0 +1,10 @@+-- The setup section is executed before any other test
+module TSetup where
+
+-- $setup
+-- >>> x=11
+-- >>> y=22
+
+-- >>> x+y
+
+-- >>> x*y

@@ -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

@@ -0,0 +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!"

@@ -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!"

@@ -0,0 +1,13 @@+-- Used for testing local imports
+module Util
+  ( tst
+  , a
+  , b
+  )
+where
+
+tst a b = a == b
+
+a = 'a'
+
+b = 'b'

@@ -0,0 +1,4 @@+cradle:
+  cabal:
+    - path: "././"
+      component: "lib:test"

@@ -0,0 +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
+