diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/hls-splice-plugin.cabal b/hls-splice-plugin.cabal --- a/hls-splice-plugin.cabal +++ b/hls-splice-plugin.cabal @@ -1,73 +1,73 @@ -cabal-version: 2.4 -name: hls-splice-plugin -version: 1.0.0.1 -synopsis: - HLS Plugin to expand TemplateHaskell Splices and QuasiQuotes - -description: - HLS Plugin to expand TemplateHaskell Splices and QuasiQuotes. - -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 - -category: Development -build-type: Simple -extra-source-files: - LICENSE - test/testdata/*.error - test/testdata/*.expected - test/testdata/*.hs - test/testdata/*.yaml - -library - exposed-modules: - Ide.Plugin.Splice - Ide.Plugin.Splice.Types - - ghc-options: -Wall -Wno-unticked-promoted-constructors - hs-source-dirs: src - build-depends: - , aeson - , base >=4.12 && <5 - , containers - , dlist - , extra - , foldl - , ghc - , ghc-exactprint - , ghcide ^>=1.2 - , hls-plugin-api ^>=1.1 - , lens - , lsp - , retrie - , shake - , syb - , text - , transformers - , unliftio-core - , unordered-containers - - 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: - , base - , directory - , extra - , filepath - , hls-splice-plugin - , hls-test-utils ^>= 1.0 - , text +cabal-version: 2.4 +name: hls-splice-plugin +version: 1.0.0.2 +synopsis: + HLS Plugin to expand TemplateHaskell Splices and QuasiQuotes + +description: + HLS Plugin to expand TemplateHaskell Splices and QuasiQuotes. + +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 + +category: Development +build-type: Simple +extra-source-files: + LICENSE + test/testdata/*.error + test/testdata/*.expected + test/testdata/*.hs + test/testdata/*.yaml + +library + exposed-modules: + Ide.Plugin.Splice + Ide.Plugin.Splice.Types + + ghc-options: -Wall -Wno-unticked-promoted-constructors + hs-source-dirs: src + build-depends: + , aeson + , base >=4.12 && <5 + , containers + , dlist + , extra + , foldl + , ghc + , ghc-exactprint + , ghcide ^>=1.2 + , hls-plugin-api ^>=1.1 + , lens + , lsp + , retrie + , shake + , syb + , text + , transformers + , unliftio-core + , unordered-containers + + 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: + , base + , directory + , extra + , filepath + , hls-splice-plugin + , hls-test-utils ^>= 1.0 + , text diff --git a/src/Ide/Plugin/Splice.hs b/src/Ide/Plugin/Splice.hs --- a/src/Ide/Plugin/Splice.hs +++ b/src/Ide/Plugin/Splice.hs @@ -1,472 +1,472 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE NamedFieldPuns #-} - -module Ide.Plugin.Splice - ( descriptor, - ) -where - -import Control.Applicative (Alternative ((<|>))) -import Control.Arrow -import qualified Control.Foldl as L -import Control.Lens (ix, view, (%~), (<&>), (^.), Identity(..)) -import Control.Monad -import Control.Monad.Extra (eitherM) -import qualified Control.Monad.Fail as Fail -import Control.Monad.IO.Unlift -import Control.Monad.Trans.Class -import Control.Monad.Trans.Except -import Control.Monad.Trans.Maybe -import Data.Aeson -import Data.Foldable (Foldable (foldl')) -import Data.Function -import Data.Generics -import qualified Data.Kind as Kinds -import Data.List (sortOn) -import Data.Maybe (fromMaybe, listToMaybe, - mapMaybe) -import qualified Data.Text as T -import Development.IDE -import Development.IDE.GHC.Compat hiding (getLoc) -import Development.IDE.GHC.ExactPrint -import Exception -import GHC.Exts -import GhcMonad -import GhcPlugins hiding (Var, getLoc, (<>)) -import Ide.Plugin.Splice.Types -import Ide.Types -import Language.Haskell.GHC.ExactPrint (setPrecedingLines, - uniqueSrcSpanT) -import Language.LSP.Server -import Language.LSP.Types -import Language.LSP.Types.Capabilities -import qualified Language.LSP.Types.Lens as J -import RnSplice -import TcRnMonad - -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = - (defaultPluginDescriptor plId) - { pluginCommands = commands - , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction - } - -commands :: [PluginCommand IdeState] -commands = - [ PluginCommand expandInplaceId inplaceCmdName $ expandTHSplice Inplace - -- , PluginCommand expandCommentedId commentedCmdName $ expandTHSplice Commented - ] - -newtype SubSpan = SubSpan {runSubSpan :: SrcSpan} - -instance Eq SubSpan where - (==) = (==) `on` runSubSpan - -instance Ord SubSpan where - (<=) = coerce isSubspanOf - -expandTHSplice :: - -- | Inplace? - ExpandStyle -> - CommandFunction IdeState ExpandSpliceParams -expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do - clientCapabilities <- getClientCapabilities - rio <- askRunInIO - let reportEditor :: ReportEditor - reportEditor msgTy msgs = liftIO $ rio $ sendNotification SWindowShowMessage (ShowMessageParams msgTy (T.unlines msgs)) - expandManually fp = do - mresl <- - liftIO $ runAction "expandTHSplice.fallback.TypeCheck (stale)" ideState $ useWithStale TypeCheck fp - (TcModuleResult {..}, _) <- - maybe - (throwE "Splice expansion: Type-checking information not found in cache.\nYou can once delete or replace the macro with placeholder, convince the type checker and then revert to original (errornous) macro and expand splice again." - ) - pure mresl - reportEditor - MtWarning - [ "Expansion in type-chcking phase failed;" - , "trying to expand manually, but note taht it is less rigorous." - ] - pm <- - liftIO $ - runAction "expandTHSplice.fallback.GetParsedModule" ideState $ - use_ GetParsedModule fp - (ps, hscEnv, _dflags) <- setupHscEnv ideState fp pm - - manualCalcEdit - clientCapabilities - reportEditor - range - ps - hscEnv - tmrTypechecked - spliceSpan - _eStyle - params - - withTypeChecked fp TcModuleResult {..} = do - (ps, _hscEnv, dflags) <- setupHscEnv ideState fp tmrParsed - let Splices {..} = tmrTopLevelSplices - let exprSuperSpans = - listToMaybe $ findSubSpansDesc srcSpan exprSplices - _patSuperSpans = -#if __GLASGOW_HASKELL__ == 808 - fmap (second dL) $ -#endif - listToMaybe $ findSubSpansDesc srcSpan patSplices - typeSuperSpans = - listToMaybe $ findSubSpansDesc srcSpan typeSplices - declSuperSpans = - listToMaybe $ findSubSpansDesc srcSpan declSplices - - graftSpliceWith :: - forall ast. - HasSplice ast => - Maybe (SrcSpan, Located (ast GhcPs)) -> - Maybe (Either String WorkspaceEdit) - graftSpliceWith expandeds = - expandeds <&> \(_, expanded) -> - transform - dflags - clientCapabilities - uri - (graft (RealSrcSpan spliceSpan) expanded) - ps - maybe (throwE "No splice information found") (either throwE pure) $ - case spliceContext of - Expr -> graftSpliceWith exprSuperSpans - Pat -> - - graftSpliceWith _patSuperSpans - - HsType -> graftSpliceWith typeSuperSpans - HsDecl -> - declSuperSpans <&> \(_, expanded) -> - transform - dflags - clientCapabilities - uri - (graftDecls (RealSrcSpan spliceSpan) expanded) - ps - <&> - -- FIXME: Why ghc-exactprint sweeps preceeding comments? - adjustToRange uri range - - res <- liftIO $ runMaybeT $ do - - fp <- MaybeT $ pure $ uriToNormalizedFilePath $ toNormalizedUri uri - eedits <- - ( lift . runExceptT . withTypeChecked fp - =<< MaybeT - (runAction "expandTHSplice.TypeCheck" ideState $ use TypeCheck fp) - ) - <|> lift (runExceptT $ expandManually fp) - - case eedits of - Left err -> do - reportEditor - MtError - ["Error during expanding splice: " <> T.pack err] - pure (Left $ responseError $ T.pack err) - Right edits -> - pure (Right edits) - case res of - Nothing -> pure $ Right Null - Just (Left err) -> pure $ Left err - Just (Right edit) -> do - _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) - pure $ Right Null - - where - range = realSrcSpanToRange spliceSpan - srcSpan = RealSrcSpan spliceSpan - - -setupHscEnv - :: IdeState - -> NormalizedFilePath - -> ParsedModule - -> ExceptT String IO (Annotated ParsedSource, HscEnv, DynFlags) -setupHscEnv ideState fp pm = do - hscEnvEq <- - liftIO $ - runAction "expandTHSplice.fallback.ghcSessionDeps" ideState $ - use_ GhcSessionDeps fp - let ps = annotateParsedSource pm - hscEnv0 = hscEnvWithImportPaths hscEnvEq - modSum = pm_mod_summary pm - df' <- liftIO $ setupDynFlagsForGHCiLike hscEnv0 $ ms_hspp_opts modSum - let hscEnv = hscEnv0 { hsc_dflags = df' } - pure (ps, hscEnv, df') - -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 - -adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit -adjustToRange uri ran (WorkspaceEdit mhult mlt x) = - WorkspaceEdit (adjustWS <$> mhult) (fmap adjustDoc <$> mlt) x - where - adjustTextEdits :: Traversable f => f TextEdit -> f TextEdit - adjustTextEdits eds = - let Just minStart = - L.fold - (L.premap (view J.range) L.minimum) - eds - in adjustLine minStart <$> eds - - adjustATextEdits :: Traversable f => f (TextEdit |? AnnotatedTextEdit) -> f (TextEdit |? AnnotatedTextEdit) - adjustATextEdits = fmap $ \case - InL t -> InL $ runIdentity $ adjustTextEdits (Identity t) - InR AnnotatedTextEdit{_range, _newText, _annotationId} -> - let oldTE = TextEdit{_range,_newText} - in let TextEdit{_range,_newText} = runIdentity $ adjustTextEdits (Identity oldTE) - in InR $ AnnotatedTextEdit{_range,_newText,_annotationId} - - adjustWS = ix uri %~ adjustTextEdits - adjustDoc :: DocumentChange -> DocumentChange - adjustDoc (InR es) = InR es - adjustDoc (InL es) - | es ^. J.textDocument . J.uri == uri = - InL $ es & J.edits %~ adjustATextEdits - | otherwise = InL es - - adjustLine :: Range -> TextEdit -> TextEdit - adjustLine bad = - J.range %~ \r -> - if r == bad then ran else bad - -findSubSpansDesc :: SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)] -findSubSpansDesc srcSpan = - sortOn (Down . SubSpan . fst) - . mapMaybe - ( \(L spn _, e) -> do - guard (spn `isSubspanOf` srcSpan) - pure (spn, e) - ) - -data SpliceClass where - OneToOneAST :: HasSplice ast => Proxy# ast -> SpliceClass - IsHsDecl :: SpliceClass - -class (Outputable (ast GhcRn), ASTElement (ast GhcPs)) => HasSplice ast where - type SpliceOf ast :: Kinds.Type -> Kinds.Type - type SpliceOf ast = HsSplice - matchSplice :: Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs) - expandSplice :: Proxy# ast -> SpliceOf ast GhcPs -> RnM (Either (ast GhcPs) (ast GhcRn), FreeVars) - -instance HasSplice HsExpr where - matchSplice _ (HsSpliceE _ spl) = Just spl - matchSplice _ _ = Nothing - expandSplice _ = fmap (first Right) . rnSpliceExpr - -instance HasSplice Pat where - matchSplice _ (SplicePat _ spl) = Just spl - matchSplice _ _ = Nothing - expandSplice _ = rnSplicePat - - -instance HasSplice HsType where - matchSplice _ (HsSpliceTy _ spl) = Just spl - matchSplice _ _ = Nothing - expandSplice _ = fmap (first Right) . rnSpliceType - -classifyAST :: SpliceContext -> SpliceClass -classifyAST = \case - Expr -> OneToOneAST @HsExpr proxy# - HsDecl -> IsHsDecl - Pat -> OneToOneAST @Pat proxy# - HsType -> OneToOneAST @HsType proxy# - -type ReportEditor = forall m. MonadIO m => MessageType -> [T.Text] -> m () - -manualCalcEdit :: - ClientCapabilities -> - ReportEditor -> - Range -> - Annotated ParsedSource -> - HscEnv -> - TcGblEnv -> - RealSrcSpan -> - ExpandStyle -> - ExpandSpliceParams -> - ExceptT String IO WorkspaceEdit -manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _eStyle ExpandSpliceParams {..} = do - (warns, resl) <- - ExceptT $ do - ((warns, errs), eresl) <- - initTcWithGbl hscEnv typechkd srcSpan $ - case classifyAST spliceContext of - IsHsDecl -> fmap (fmap $ adjustToRange uri ran) $ - flip (transformM dflags clientCapabilities uri) ps $ - graftDeclsWithM (RealSrcSpan srcSpan) $ \case - (L _spn (SpliceD _ (SpliceDecl _ (L _ spl) _))) -> do - eExpr <- - eitherM (fail . show) pure - $ lift - ( lift $ - gtry @_ @SomeException $ - (fst <$> rnTopSpliceDecls spl) - ) - pure $ Just eExpr - _ -> pure Nothing - OneToOneAST astP -> - flip (transformM dflags clientCapabilities uri) ps $ - graftWithM (RealSrcSpan srcSpan) $ \case - (L _spn (matchSplice astP -> Just spl)) -> do - eExpr <- - eitherM (fail . show) pure - $ lift - ( lift $ - gtry @_ @SomeException $ - (fst <$> expandSplice astP spl) - ) - Just <$> either (pure . L _spn) (unRenamedE dflags) eExpr - _ -> pure Nothing - pure $ (warns,) <$> fromMaybe (Left $ show errs) eresl - - unless - (null warns) - $ reportEditor - MtWarning - [ "Warning during expanding: " - , "" - , T.pack (show warns) - ] - pure resl - where - dflags = hsc_dflags hscEnv - --- | FIXME: Is thereAny "clever" way to do this exploiting TTG? -unRenamedE :: - forall ast m. - (Fail.MonadFail m, HasSplice ast) => - DynFlags -> - ast GhcRn -> - TransformT m (Located (ast GhcPs)) -unRenamedE dflags expr = do - uniq <- show <$> uniqueSrcSpanT - (anns, expr') <- - either (fail . show) pure $ - parseAST @(ast GhcPs) dflags uniq $ - showSDoc dflags $ ppr expr - let _anns' = setPrecedingLines expr' 0 1 anns - pure expr' - -data SearchResult r = - Continue | Stop | Here r - deriving (Read, Show, Eq, Ord, Data, Typeable) - -fromSearchResult :: SearchResult a -> Maybe a -fromSearchResult (Here r) = Just r -fromSearchResult _ = Nothing - --- TODO: workaround when HieAst unavailable (e.g. when the module itself errors) --- TODO: Declaration Splices won't appear in HieAst; perhaps we must just use Parsed/Renamed ASTs? -codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction -codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $ - fmap (maybe (Right $ List []) Right) $ - runMaybeT $ do - fp <- MaybeT $ pure $ uriToNormalizedFilePath $ toNormalizedUri theUri - ParsedModule {..} <- - MaybeT . runAction "splice.codeAction.GitHieAst" state $ - use GetParsedModule fp - let spn = rangeToRealSrcSpan fp ran - mouterSplice = something' (detectSplice spn) pm_parsed_source - mcmds <- forM mouterSplice $ - \(spliceSpan, spliceContext) -> - forM expandStyles $ \(_, (title, cmdId)) -> do - let params = ExpandSpliceParams {uri = theUri, ..} - act = mkLspCommand plId cmdId title (Just [toJSON params]) - pure $ - InR $ - CodeAction title (Just CodeActionRefactorRewrite) Nothing Nothing Nothing Nothing (Just act) Nothing - - pure $ maybe mempty List mcmds - where - theUri = docId ^. J.uri - detectSplice :: - RealSrcSpan -> - GenericQ (SearchResult (RealSrcSpan, SpliceContext)) - detectSplice spn = - mkQ - Continue - ( \case - (L l@(RealSrcSpan spLoc) expr :: LHsExpr GhcPs) - | RealSrcSpan spn `isSubspanOf` l -> - case expr of - HsSpliceE {} -> Here (spLoc, Expr) - _ -> Continue - _ -> Stop - ) - `extQ` \case -#if __GLASGOW_HASKELL__ == 808 - (dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc) pat :: Located (Pat GhcPs)) -#else - (L l@(RealSrcSpan spLoc) pat :: LPat GhcPs) -#endif - | RealSrcSpan spn `isSubspanOf` l -> - case pat of - SplicePat{} -> Here (spLoc, Pat) - _ -> Continue - _ -> Stop - `extQ` \case - (L l@(RealSrcSpan spLoc) ty :: LHsType GhcPs) - | RealSrcSpan spn `isSubspanOf` l -> - case ty of - HsSpliceTy {} -> Here (spLoc, HsType) - _ -> Continue - _ -> Stop - `extQ` \case - (L l@(RealSrcSpan spLoc) decl :: LHsDecl GhcPs) - | RealSrcSpan spn `isSubspanOf` l -> - case decl of - SpliceD {} -> Here (spLoc, HsDecl) - _ -> Continue - _ -> Stop - --- | Like 'something', but performs top-down searching, cutoffs when 'Stop' received, --- and picks inenrmost result. -something' :: forall a. GenericQ (SearchResult a) -> GenericQ (Maybe a) -something' f = go - where - go :: GenericQ (Maybe a) - go x = - case f x of - Stop -> Nothing - resl -> foldl' (flip (<|>)) (fromSearchResult resl) (gmapQ go x) +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE NamedFieldPuns #-} + +module Ide.Plugin.Splice + ( descriptor, + ) +where + +import Control.Applicative (Alternative ((<|>))) +import Control.Arrow +import qualified Control.Foldl as L +import Control.Lens (ix, view, (%~), (<&>), (^.), Identity(..)) +import Control.Monad +import Control.Monad.Extra (eitherM) +import qualified Control.Monad.Fail as Fail +import Control.Monad.IO.Unlift +import Control.Monad.Trans.Class +import Control.Monad.Trans.Except +import Control.Monad.Trans.Maybe +import Data.Aeson +import Data.Foldable (Foldable (foldl')) +import Data.Function +import Data.Generics +import qualified Data.Kind as Kinds +import Data.List (sortOn) +import Data.Maybe (fromMaybe, listToMaybe, + mapMaybe) +import qualified Data.Text as T +import Development.IDE +import Development.IDE.GHC.Compat hiding (getLoc) +import Development.IDE.GHC.ExactPrint +import Exception +import GHC.Exts +import GhcMonad +import GhcPlugins hiding (Var, getLoc, (<>)) +import Ide.Plugin.Splice.Types +import Ide.Types +import Language.Haskell.GHC.ExactPrint (setPrecedingLines, + uniqueSrcSpanT) +import Language.LSP.Server +import Language.LSP.Types +import Language.LSP.Types.Capabilities +import qualified Language.LSP.Types.Lens as J +import RnSplice +import TcRnMonad + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = + (defaultPluginDescriptor plId) + { pluginCommands = commands + , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction + } + +commands :: [PluginCommand IdeState] +commands = + [ PluginCommand expandInplaceId inplaceCmdName $ expandTHSplice Inplace + -- , PluginCommand expandCommentedId commentedCmdName $ expandTHSplice Commented + ] + +newtype SubSpan = SubSpan {runSubSpan :: SrcSpan} + +instance Eq SubSpan where + (==) = (==) `on` runSubSpan + +instance Ord SubSpan where + (<=) = coerce isSubspanOf + +expandTHSplice :: + -- | Inplace? + ExpandStyle -> + CommandFunction IdeState ExpandSpliceParams +expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do + clientCapabilities <- getClientCapabilities + rio <- askRunInIO + let reportEditor :: ReportEditor + reportEditor msgTy msgs = liftIO $ rio $ sendNotification SWindowShowMessage (ShowMessageParams msgTy (T.unlines msgs)) + expandManually fp = do + mresl <- + liftIO $ runAction "expandTHSplice.fallback.TypeCheck (stale)" ideState $ useWithStale TypeCheck fp + (TcModuleResult {..}, _) <- + maybe + (throwE "Splice expansion: Type-checking information not found in cache.\nYou can once delete or replace the macro with placeholder, convince the type checker and then revert to original (errornous) macro and expand splice again." + ) + pure mresl + reportEditor + MtWarning + [ "Expansion in type-chcking phase failed;" + , "trying to expand manually, but note taht it is less rigorous." + ] + pm <- + liftIO $ + runAction "expandTHSplice.fallback.GetParsedModule" ideState $ + use_ GetParsedModule fp + (ps, hscEnv, _dflags) <- setupHscEnv ideState fp pm + + manualCalcEdit + clientCapabilities + reportEditor + range + ps + hscEnv + tmrTypechecked + spliceSpan + _eStyle + params + + withTypeChecked fp TcModuleResult {..} = do + (ps, _hscEnv, dflags) <- setupHscEnv ideState fp tmrParsed + let Splices {..} = tmrTopLevelSplices + let exprSuperSpans = + listToMaybe $ findSubSpansDesc srcSpan exprSplices + _patSuperSpans = +#if __GLASGOW_HASKELL__ == 808 + fmap (second dL) $ +#endif + listToMaybe $ findSubSpansDesc srcSpan patSplices + typeSuperSpans = + listToMaybe $ findSubSpansDesc srcSpan typeSplices + declSuperSpans = + listToMaybe $ findSubSpansDesc srcSpan declSplices + + graftSpliceWith :: + forall ast. + HasSplice ast => + Maybe (SrcSpan, Located (ast GhcPs)) -> + Maybe (Either String WorkspaceEdit) + graftSpliceWith expandeds = + expandeds <&> \(_, expanded) -> + transform + dflags + clientCapabilities + uri + (graft (RealSrcSpan spliceSpan) expanded) + ps + maybe (throwE "No splice information found") (either throwE pure) $ + case spliceContext of + Expr -> graftSpliceWith exprSuperSpans + Pat -> + + graftSpliceWith _patSuperSpans + + HsType -> graftSpliceWith typeSuperSpans + HsDecl -> + declSuperSpans <&> \(_, expanded) -> + transform + dflags + clientCapabilities + uri + (graftDecls (RealSrcSpan spliceSpan) expanded) + ps + <&> + -- FIXME: Why ghc-exactprint sweeps preceeding comments? + adjustToRange uri range + + res <- liftIO $ runMaybeT $ do + + fp <- MaybeT $ pure $ uriToNormalizedFilePath $ toNormalizedUri uri + eedits <- + ( lift . runExceptT . withTypeChecked fp + =<< MaybeT + (runAction "expandTHSplice.TypeCheck" ideState $ use TypeCheck fp) + ) + <|> lift (runExceptT $ expandManually fp) + + case eedits of + Left err -> do + reportEditor + MtError + ["Error during expanding splice: " <> T.pack err] + pure (Left $ responseError $ T.pack err) + Right edits -> + pure (Right edits) + case res of + Nothing -> pure $ Right Null + Just (Left err) -> pure $ Left err + Just (Right edit) -> do + _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) + pure $ Right Null + + where + range = realSrcSpanToRange spliceSpan + srcSpan = RealSrcSpan spliceSpan + + +setupHscEnv + :: IdeState + -> NormalizedFilePath + -> ParsedModule + -> ExceptT String IO (Annotated ParsedSource, HscEnv, DynFlags) +setupHscEnv ideState fp pm = do + hscEnvEq <- + liftIO $ + runAction "expandTHSplice.fallback.ghcSessionDeps" ideState $ + use_ GhcSessionDeps fp + let ps = annotateParsedSource pm + hscEnv0 = hscEnvWithImportPaths hscEnvEq + modSum = pm_mod_summary pm + df' <- liftIO $ setupDynFlagsForGHCiLike hscEnv0 $ ms_hspp_opts modSum + let hscEnv = hscEnv0 { hsc_dflags = df' } + pure (ps, hscEnv, df') + +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 + +adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit +adjustToRange uri ran (WorkspaceEdit mhult mlt x) = + WorkspaceEdit (adjustWS <$> mhult) (fmap adjustDoc <$> mlt) x + where + adjustTextEdits :: Traversable f => f TextEdit -> f TextEdit + adjustTextEdits eds = + let Just minStart = + L.fold + (L.premap (view J.range) L.minimum) + eds + in adjustLine minStart <$> eds + + adjustATextEdits :: Traversable f => f (TextEdit |? AnnotatedTextEdit) -> f (TextEdit |? AnnotatedTextEdit) + adjustATextEdits = fmap $ \case + InL t -> InL $ runIdentity $ adjustTextEdits (Identity t) + InR AnnotatedTextEdit{_range, _newText, _annotationId} -> + let oldTE = TextEdit{_range,_newText} + in let TextEdit{_range,_newText} = runIdentity $ adjustTextEdits (Identity oldTE) + in InR $ AnnotatedTextEdit{_range,_newText,_annotationId} + + adjustWS = ix uri %~ adjustTextEdits + adjustDoc :: DocumentChange -> DocumentChange + adjustDoc (InR es) = InR es + adjustDoc (InL es) + | es ^. J.textDocument . J.uri == uri = + InL $ es & J.edits %~ adjustATextEdits + | otherwise = InL es + + adjustLine :: Range -> TextEdit -> TextEdit + adjustLine bad = + J.range %~ \r -> + if r == bad then ran else bad + +findSubSpansDesc :: SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)] +findSubSpansDesc srcSpan = + sortOn (Down . SubSpan . fst) + . mapMaybe + ( \(L spn _, e) -> do + guard (spn `isSubspanOf` srcSpan) + pure (spn, e) + ) + +data SpliceClass where + OneToOneAST :: HasSplice ast => Proxy# ast -> SpliceClass + IsHsDecl :: SpliceClass + +class (Outputable (ast GhcRn), ASTElement (ast GhcPs)) => HasSplice ast where + type SpliceOf ast :: Kinds.Type -> Kinds.Type + type SpliceOf ast = HsSplice + matchSplice :: Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs) + expandSplice :: Proxy# ast -> SpliceOf ast GhcPs -> RnM (Either (ast GhcPs) (ast GhcRn), FreeVars) + +instance HasSplice HsExpr where + matchSplice _ (HsSpliceE _ spl) = Just spl + matchSplice _ _ = Nothing + expandSplice _ = fmap (first Right) . rnSpliceExpr + +instance HasSplice Pat where + matchSplice _ (SplicePat _ spl) = Just spl + matchSplice _ _ = Nothing + expandSplice _ = rnSplicePat + + +instance HasSplice HsType where + matchSplice _ (HsSpliceTy _ spl) = Just spl + matchSplice _ _ = Nothing + expandSplice _ = fmap (first Right) . rnSpliceType + +classifyAST :: SpliceContext -> SpliceClass +classifyAST = \case + Expr -> OneToOneAST @HsExpr proxy# + HsDecl -> IsHsDecl + Pat -> OneToOneAST @Pat proxy# + HsType -> OneToOneAST @HsType proxy# + +type ReportEditor = forall m. MonadIO m => MessageType -> [T.Text] -> m () + +manualCalcEdit :: + ClientCapabilities -> + ReportEditor -> + Range -> + Annotated ParsedSource -> + HscEnv -> + TcGblEnv -> + RealSrcSpan -> + ExpandStyle -> + ExpandSpliceParams -> + ExceptT String IO WorkspaceEdit +manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _eStyle ExpandSpliceParams {..} = do + (warns, resl) <- + ExceptT $ do + ((warns, errs), eresl) <- + initTcWithGbl hscEnv typechkd srcSpan $ + case classifyAST spliceContext of + IsHsDecl -> fmap (fmap $ adjustToRange uri ran) $ + flip (transformM dflags clientCapabilities uri) ps $ + graftDeclsWithM (RealSrcSpan srcSpan) $ \case + (L _spn (SpliceD _ (SpliceDecl _ (L _ spl) _))) -> do + eExpr <- + eitherM (fail . show) pure + $ lift + ( lift $ + gtry @_ @SomeException $ + (fst <$> rnTopSpliceDecls spl) + ) + pure $ Just eExpr + _ -> pure Nothing + OneToOneAST astP -> + flip (transformM dflags clientCapabilities uri) ps $ + graftWithM (RealSrcSpan srcSpan) $ \case + (L _spn (matchSplice astP -> Just spl)) -> do + eExpr <- + eitherM (fail . show) pure + $ lift + ( lift $ + gtry @_ @SomeException $ + (fst <$> expandSplice astP spl) + ) + Just <$> either (pure . L _spn) (unRenamedE dflags) eExpr + _ -> pure Nothing + pure $ (warns,) <$> fromMaybe (Left $ show errs) eresl + + unless + (null warns) + $ reportEditor + MtWarning + [ "Warning during expanding: " + , "" + , T.pack (show warns) + ] + pure resl + where + dflags = hsc_dflags hscEnv + +-- | FIXME: Is thereAny "clever" way to do this exploiting TTG? +unRenamedE :: + forall ast m. + (Fail.MonadFail m, HasSplice ast) => + DynFlags -> + ast GhcRn -> + TransformT m (Located (ast GhcPs)) +unRenamedE dflags expr = do + uniq <- show <$> uniqueSrcSpanT + (anns, expr') <- + either (fail . show) pure $ + parseAST @(ast GhcPs) dflags uniq $ + showSDoc dflags $ ppr expr + let _anns' = setPrecedingLines expr' 0 1 anns + pure expr' + +data SearchResult r = + Continue | Stop | Here r + deriving (Read, Show, Eq, Ord, Data, Typeable) + +fromSearchResult :: SearchResult a -> Maybe a +fromSearchResult (Here r) = Just r +fromSearchResult _ = Nothing + +-- TODO: workaround when HieAst unavailable (e.g. when the module itself errors) +-- TODO: Declaration Splices won't appear in HieAst; perhaps we must just use Parsed/Renamed ASTs? +codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction +codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $ + fmap (maybe (Right $ List []) Right) $ + runMaybeT $ do + fp <- MaybeT $ pure $ uriToNormalizedFilePath $ toNormalizedUri theUri + ParsedModule {..} <- + MaybeT . runAction "splice.codeAction.GitHieAst" state $ + use GetParsedModule fp + let spn = rangeToRealSrcSpan fp ran + mouterSplice = something' (detectSplice spn) pm_parsed_source + mcmds <- forM mouterSplice $ + \(spliceSpan, spliceContext) -> + forM expandStyles $ \(_, (title, cmdId)) -> do + let params = ExpandSpliceParams {uri = theUri, ..} + act = mkLspCommand plId cmdId title (Just [toJSON params]) + pure $ + InR $ + CodeAction title (Just CodeActionRefactorRewrite) Nothing Nothing Nothing Nothing (Just act) Nothing + + pure $ maybe mempty List mcmds + where + theUri = docId ^. J.uri + detectSplice :: + RealSrcSpan -> + GenericQ (SearchResult (RealSrcSpan, SpliceContext)) + detectSplice spn = + mkQ + Continue + ( \case + (L l@(RealSrcSpan spLoc) expr :: LHsExpr GhcPs) + | RealSrcSpan spn `isSubspanOf` l -> + case expr of + HsSpliceE {} -> Here (spLoc, Expr) + _ -> Continue + _ -> Stop + ) + `extQ` \case +#if __GLASGOW_HASKELL__ == 808 + (dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc) pat :: Located (Pat GhcPs)) +#else + (L l@(RealSrcSpan spLoc) pat :: LPat GhcPs) +#endif + | RealSrcSpan spn `isSubspanOf` l -> + case pat of + SplicePat{} -> Here (spLoc, Pat) + _ -> Continue + _ -> Stop + `extQ` \case + (L l@(RealSrcSpan spLoc) ty :: LHsType GhcPs) + | RealSrcSpan spn `isSubspanOf` l -> + case ty of + HsSpliceTy {} -> Here (spLoc, HsType) + _ -> Continue + _ -> Stop + `extQ` \case + (L l@(RealSrcSpan spLoc) decl :: LHsDecl GhcPs) + | RealSrcSpan spn `isSubspanOf` l -> + case decl of + SpliceD {} -> Here (spLoc, HsDecl) + _ -> Continue + _ -> Stop + +-- | Like 'something', but performs top-down searching, cutoffs when 'Stop' received, +-- and picks inenrmost result. +something' :: forall a. GenericQ (SearchResult a) -> GenericQ (Maybe a) +something' f = go + where + go :: GenericQ (Maybe a) + go x = + case f x of + Stop -> Nothing + resl -> foldl' (flip (<|>)) (fromSearchResult resl) (gmapQ go x) diff --git a/src/Ide/Plugin/Splice/Types.hs b/src/Ide/Plugin/Splice/Types.hs --- a/src/Ide/Plugin/Splice/Types.hs +++ b/src/Ide/Plugin/Splice/Types.hs @@ -1,54 +1,54 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE OverloadedStrings #-} - -module Ide.Plugin.Splice.Types where - -import Data.Aeson (FromJSON, ToJSON) -import qualified Data.Text as T -import Development.IDE (Uri) -import Development.IDE.GHC.Compat (RealSrcSpan) -import GHC.Generics (Generic) -import Ide.Types (CommandId) - --- | Parameter for the addMethods PluginCommand. -data ExpandSpliceParams = ExpandSpliceParams - { uri :: Uri - , spliceSpan :: RealSrcSpan - , spliceContext :: SpliceContext - } - deriving (Show, Eq, Generic) - deriving anyclass (ToJSON, FromJSON) - --- FIXME: HsDecl needs different treatment of splicing. -data SpliceContext = Expr | HsDecl | Pat | HsType - deriving (Read, Show, Eq, Ord, Generic) - deriving anyclass (ToJSON, FromJSON) - -data ExpandStyle = Inplace | Commented - deriving (Read, Show, Eq, Ord, Generic) - -expandStyles :: [(ExpandStyle, (T.Text, CommandId))] -expandStyles = - [ (Inplace, (inplaceCmdName, expandInplaceId)) - -- , (Commented, commentedCmdName, expandCommentedId) - ] - -toExpandCmdTitle :: ExpandStyle -> T.Text -toExpandCmdTitle Inplace = inplaceCmdName -toExpandCmdTitle Commented = commentedCmdName - -toCommandId :: ExpandStyle -> CommandId -toCommandId Inplace = expandInplaceId -toCommandId Commented = expandCommentedId - -expandInplaceId, expandCommentedId :: CommandId -expandInplaceId = "expandTHSpliceInplace" -expandCommentedId = "expandTHSpliceCommented" - -inplaceCmdName :: T.Text -inplaceCmdName = "expand TemplateHaskell Splice (in-place)" - -commentedCmdName :: T.Text -commentedCmdName = "expand TemplateHaskell Splice (comented-out)" +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE OverloadedStrings #-} + +module Ide.Plugin.Splice.Types where + +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Text as T +import Development.IDE (Uri) +import Development.IDE.GHC.Compat (RealSrcSpan) +import GHC.Generics (Generic) +import Ide.Types (CommandId) + +-- | Parameter for the addMethods PluginCommand. +data ExpandSpliceParams = ExpandSpliceParams + { uri :: Uri + , spliceSpan :: RealSrcSpan + , spliceContext :: SpliceContext + } + deriving (Show, Eq, Generic) + deriving anyclass (ToJSON, FromJSON) + +-- FIXME: HsDecl needs different treatment of splicing. +data SpliceContext = Expr | HsDecl | Pat | HsType + deriving (Read, Show, Eq, Ord, Generic) + deriving anyclass (ToJSON, FromJSON) + +data ExpandStyle = Inplace | Commented + deriving (Read, Show, Eq, Ord, Generic) + +expandStyles :: [(ExpandStyle, (T.Text, CommandId))] +expandStyles = + [ (Inplace, (inplaceCmdName, expandInplaceId)) + -- , (Commented, commentedCmdName, expandCommentedId) + ] + +toExpandCmdTitle :: ExpandStyle -> T.Text +toExpandCmdTitle Inplace = inplaceCmdName +toExpandCmdTitle Commented = commentedCmdName + +toCommandId :: ExpandStyle -> CommandId +toCommandId Inplace = expandInplaceId +toCommandId Commented = expandCommentedId + +expandInplaceId, expandCommentedId :: CommandId +expandInplaceId = "expandTHSpliceInplace" +expandCommentedId = "expandTHSpliceCommented" + +inplaceCmdName :: T.Text +inplaceCmdName = "expand TemplateHaskell Splice (in-place)" + +commentedCmdName :: T.Text +commentedCmdName = "expand TemplateHaskell Splice (comented-out)" diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,135 +1,135 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ViewPatterns #-} - -module Main (main) where - -import Control.Monad -import Data.List (find) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import qualified Ide.Plugin.Splice as Splice -import Ide.Plugin.Splice.Types -import System.Directory -import System.FilePath -import System.Time.Extra (sleep) -import Test.Hls - -main :: IO () -main = defaultTestRunner tests - -plugin :: PluginDescriptor IdeState -plugin = Splice.descriptor "splice" - -tests :: TestTree -tests = - testGroup - "splice" - [ goldenTest "TSimpleExp.hs" Inplace 6 15 - , goldenTest "TSimpleExp.hs" Inplace 6 24 - , goldenTest "TTypeAppExp.hs" Inplace 7 5 - , goldenTest "TErrorExp.hs" Inplace 6 15 - , goldenTest "TErrorExp.hs" Inplace 6 51 - , goldenTest "TQQExp.hs" Inplace 6 17 - , goldenTest "TQQExp.hs" Inplace 6 25 - , goldenTest "TQQExpError.hs" Inplace 6 13 - , goldenTest "TQQExpError.hs" Inplace 6 22 - , testGroup "Pattern Splices" - [ goldenTest "TSimplePat.hs" Inplace 6 3 - , goldenTest "TSimplePat.hs" Inplace 6 22 - , goldenTest "TSimplePat.hs" Inplace 6 3 - , goldenTest "TSimplePat.hs" Inplace 6 22 - , goldenTest "TErrorPat.hs" Inplace 6 3 - , goldenTest "TErrorPat.hs" Inplace 6 18 - , goldenTest "TQQPat.hs" Inplace 6 3 - , goldenTest "TQQPat.hs" Inplace 6 11 - , goldenTest "TQQPatError.hs" Inplace 6 3 - , goldenTest "TQQPatError.hs" Inplace 6 11 - ] - , goldenTest "TSimpleType.hs" Inplace 5 12 - , goldenTest "TSimpleType.hs" Inplace 5 22 - , goldenTest "TTypeTypeError.hs" Inplace 7 12 - , goldenTest "TTypeTypeError.hs" Inplace 7 52 - , goldenTest "TQQType.hs" Inplace 8 19 - , goldenTest "TQQType.hs" Inplace 8 28 - , goldenTest "TQQTypeTypeError.hs" Inplace 8 19 - , goldenTest "TQQTypeTypeError.hs" Inplace 8 28 - , goldenTest "TSimpleDecl.hs" Inplace 8 1 - , goldenTest "TQQDecl.hs" Inplace 5 1 - , goldenTestWithEdit "TTypeKindError.hs" Inplace 7 9 - , goldenTestWithEdit "TDeclKindError.hs" Inplace 8 1 - ] - -goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree -goldenTest input tc line col = - testCase (input <> " (golden)") $ do - runSessionWithServer plugin spliceTestPath $ do - doc <- openDoc input "haskell" - _ <- waitForDiagnostics - actions <- getCodeActions doc $ pointRange line col - case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of - Just (InR CodeAction {_command = Just c}) -> do - executeCommand c - _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) - edited <- documentContents doc - let expected_name = input <.> "expected" - -- Write golden tests if they don't already exist - liftIO $ - (doesFileExist expected_name >>=) $ - flip unless $ do - T.writeFile expected_name edited - expected <- liftIO $ T.readFile expected_name - liftIO $ edited @?= expected - _ -> liftIO $ assertFailure "No CodeAction detected" - -goldenTestWithEdit :: FilePath -> ExpandStyle -> Int -> Int -> TestTree -goldenTestWithEdit input tc line col = - testCase (input <> " (golden)") $ do - runSessionWithServer plugin spliceTestPath $ do - doc <- openDoc input "haskell" - orig <- documentContents doc - let lns = T.lines orig - theRange = - Range - { _start = Position 0 0 - , _end = Position (length lns + 1) 1 - } - liftIO $ sleep 3 - alt <- liftIO $ T.readFile (input <.> "error") - void $ applyEdit doc $ TextEdit theRange alt - changeDoc doc [TextDocumentContentChangeEvent (Just theRange) Nothing alt] - void waitForDiagnostics - actions <- getCodeActions doc $ pointRange line col - case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of - Just (InR CodeAction {_command = Just c}) -> do - executeCommand c - _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) - edited <- documentContents doc - let expected_name = input <.> "expected" - -- Write golden tests if they don't already exist - liftIO $ - (doesFileExist expected_name >>=) $ - flip unless $ do - T.writeFile expected_name edited - expected <- liftIO $ T.readFile expected_name - liftIO $ edited @?= expected - _ -> liftIO $ assertFailure "No CodeAction detected" - -spliceTestPath :: FilePath -spliceTestPath = "test" "testdata" - -pointRange :: Int -> Int -> Range -pointRange - (subtract 1 -> line) - (subtract 1 -> col) = - Range (Position line col) (Position line $ col + 1) - --- | Get the title of a code action. -codeActionTitle :: (Command |? CodeAction) -> Maybe Text -codeActionTitle InL{} = Nothing -codeActionTitle (InR(CodeAction title _ _ _ _ _ _ _)) = Just title +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} + +module Main (main) where + +import Control.Monad +import Data.List (find) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified Ide.Plugin.Splice as Splice +import Ide.Plugin.Splice.Types +import System.Directory +import System.FilePath +import System.Time.Extra (sleep) +import Test.Hls + +main :: IO () +main = defaultTestRunner tests + +plugin :: PluginDescriptor IdeState +plugin = Splice.descriptor "splice" + +tests :: TestTree +tests = + testGroup + "splice" + [ goldenTest "TSimpleExp.hs" Inplace 6 15 + , goldenTest "TSimpleExp.hs" Inplace 6 24 + , goldenTest "TTypeAppExp.hs" Inplace 7 5 + , goldenTest "TErrorExp.hs" Inplace 6 15 + , goldenTest "TErrorExp.hs" Inplace 6 51 + , goldenTest "TQQExp.hs" Inplace 6 17 + , goldenTest "TQQExp.hs" Inplace 6 25 + , goldenTest "TQQExpError.hs" Inplace 6 13 + , goldenTest "TQQExpError.hs" Inplace 6 22 + , testGroup "Pattern Splices" + [ goldenTest "TSimplePat.hs" Inplace 6 3 + , goldenTest "TSimplePat.hs" Inplace 6 22 + , goldenTest "TSimplePat.hs" Inplace 6 3 + , goldenTest "TSimplePat.hs" Inplace 6 22 + , goldenTest "TErrorPat.hs" Inplace 6 3 + , goldenTest "TErrorPat.hs" Inplace 6 18 + , goldenTest "TQQPat.hs" Inplace 6 3 + , goldenTest "TQQPat.hs" Inplace 6 11 + , goldenTest "TQQPatError.hs" Inplace 6 3 + , goldenTest "TQQPatError.hs" Inplace 6 11 + ] + , goldenTest "TSimpleType.hs" Inplace 5 12 + , goldenTest "TSimpleType.hs" Inplace 5 22 + , goldenTest "TTypeTypeError.hs" Inplace 7 12 + , goldenTest "TTypeTypeError.hs" Inplace 7 52 + , goldenTest "TQQType.hs" Inplace 8 19 + , goldenTest "TQQType.hs" Inplace 8 28 + , goldenTest "TQQTypeTypeError.hs" Inplace 8 19 + , goldenTest "TQQTypeTypeError.hs" Inplace 8 28 + , goldenTest "TSimpleDecl.hs" Inplace 8 1 + , goldenTest "TQQDecl.hs" Inplace 5 1 + , goldenTestWithEdit "TTypeKindError.hs" Inplace 7 9 + , goldenTestWithEdit "TDeclKindError.hs" Inplace 8 1 + ] + +goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree +goldenTest input tc line col = + testCase (input <> " (golden)") $ do + runSessionWithServer plugin spliceTestPath $ do + doc <- openDoc input "haskell" + _ <- waitForDiagnostics + actions <- getCodeActions doc $ pointRange line col + case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of + Just (InR CodeAction {_command = Just c}) -> do + executeCommand c + _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) + edited <- documentContents doc + let expected_name = input <.> "expected" + -- Write golden tests if they don't already exist + liftIO $ + (doesFileExist expected_name >>=) $ + flip unless $ do + T.writeFile expected_name edited + expected <- liftIO $ T.readFile expected_name + liftIO $ edited @?= expected + _ -> liftIO $ assertFailure "No CodeAction detected" + +goldenTestWithEdit :: FilePath -> ExpandStyle -> Int -> Int -> TestTree +goldenTestWithEdit input tc line col = + testCase (input <> " (golden)") $ do + runSessionWithServer plugin spliceTestPath $ do + doc <- openDoc input "haskell" + orig <- documentContents doc + let lns = T.lines orig + theRange = + Range + { _start = Position 0 0 + , _end = Position (length lns + 1) 1 + } + liftIO $ sleep 3 + alt <- liftIO $ T.readFile (input <.> "error") + void $ applyEdit doc $ TextEdit theRange alt + changeDoc doc [TextDocumentContentChangeEvent (Just theRange) Nothing alt] + void waitForDiagnostics + actions <- getCodeActions doc $ pointRange line col + case find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions of + Just (InR CodeAction {_command = Just c}) -> do + executeCommand c + _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) + edited <- documentContents doc + let expected_name = input <.> "expected" + -- Write golden tests if they don't already exist + liftIO $ + (doesFileExist expected_name >>=) $ + flip unless $ do + T.writeFile expected_name edited + expected <- liftIO $ T.readFile expected_name + liftIO $ edited @?= expected + _ -> liftIO $ assertFailure "No CodeAction detected" + +spliceTestPath :: FilePath +spliceTestPath = "test" "testdata" + +pointRange :: Int -> Int -> Range +pointRange + (subtract 1 -> line) + (subtract 1 -> col) = + Range (Position line col) (Position line $ col + 1) + +-- | Get the title of a code action. +codeActionTitle :: (Command |? CodeAction) -> Maybe Text +codeActionTitle InL{} = Nothing +codeActionTitle (InR(CodeAction title _ _ _ _ _ _ _)) = Just title diff --git a/test/testdata/QQ.hs b/test/testdata/QQ.hs --- a/test/testdata/QQ.hs +++ b/test/testdata/QQ.hs @@ -1,28 +1,28 @@ -{-# LANGUAGE TemplateHaskell #-} -module QQ (str) where - -import Language.Haskell.TH - ( mkName, - stringL, - litP, - clause, - litE, - normalB, - funD, - sigD, - litT, - strTyLit ) -import Language.Haskell.TH.Quote (QuasiQuoter (..)) - -str :: QuasiQuoter -str = - QuasiQuoter - { quoteExp = litE . stringL - , quotePat = litP . stringL - , quoteType = litT . strTyLit - , quoteDec = \name -> - sequence - [ sigD (mkName name) [t|String|] - , funD (mkName name) [clause [] (normalB $ litE $ stringL name) []] - ] - } +{-# LANGUAGE TemplateHaskell #-} +module QQ (str) where + +import Language.Haskell.TH + ( mkName, + stringL, + litP, + clause, + litE, + normalB, + funD, + sigD, + litT, + strTyLit ) +import Language.Haskell.TH.Quote (QuasiQuoter (..)) + +str :: QuasiQuoter +str = + QuasiQuoter + { quoteExp = litE . stringL + , quotePat = litP . stringL + , quoteType = litT . strTyLit + , quoteDec = \name -> + sequence + [ sigD (mkName name) [t|String|] + , funD (mkName name) [clause [] (normalB $ litE $ stringL name) []] + ] + } diff --git a/test/testdata/TDeclKindError.hs b/test/testdata/TDeclKindError.hs --- a/test/testdata/TDeclKindError.hs +++ b/test/testdata/TDeclKindError.hs @@ -1,15 +1,15 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE QuasiQuotes #-} -module TSimpleDecl where -import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD ) - --- Foo --- Bar -$(sequence - [sigD (mkName "foo") [t|Int|] - ,funD (mkName "foo") [clause [] (normalB [|42|]) []] - ] - ) --- Bar --- ee --- dddd +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +module TSimpleDecl where +import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD ) + +-- Foo +-- Bar +$(sequence + [sigD (mkName "foo") [t|Int|] + ,funD (mkName "foo") [clause [] (normalB [|42|]) []] + ] + ) +-- Bar +-- ee +-- dddd diff --git a/test/testdata/TDeclKindError.hs.error b/test/testdata/TDeclKindError.hs.error --- a/test/testdata/TDeclKindError.hs.error +++ b/test/testdata/TDeclKindError.hs.error @@ -1,16 +1,16 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE QuasiQuotes #-} -module TSimpleDecl where -import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD ) - --- Foo --- Bar -$(sequence - [sigD (mkName "foo") [t|Int|] - ,funD (mkName "foo") [clause [] (normalB [|42|]) []] - ,sigD (mkName "bar") [t|Int|] - ] - ) --- Bar --- ee --- dddd +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +module TSimpleDecl where +import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD ) + +-- Foo +-- Bar +$(sequence + [sigD (mkName "foo") [t|Int|] + ,funD (mkName "foo") [clause [] (normalB [|42|]) []] + ,sigD (mkName "bar") [t|Int|] + ] + ) +-- Bar +-- ee +-- dddd diff --git a/test/testdata/TDeclKindError.hs.expected b/test/testdata/TDeclKindError.hs.expected --- a/test/testdata/TDeclKindError.hs.expected +++ b/test/testdata/TDeclKindError.hs.expected @@ -1,13 +1,13 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE QuasiQuotes #-} -module TSimpleDecl where -import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD ) - --- Foo --- Bar -foo :: Int -foo = 42 -bar :: Int --- Bar --- ee --- dddd +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +module TSimpleDecl where +import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD ) + +-- Foo +-- Bar +foo :: Int +foo = 42 +bar :: Int +-- Bar +-- ee +-- dddd diff --git a/test/testdata/TErrorExp.hs b/test/testdata/TErrorExp.hs --- a/test/testdata/TErrorExp.hs +++ b/test/testdata/TErrorExp.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} -module TErrorExp where -import Language.Haskell.TH ( tupE, litE, integerL ) - -main :: IO () -main = return $(tupE [litE $ integerL 42, tupE []]) +{-# LANGUAGE TemplateHaskell #-} +module TErrorExp where +import Language.Haskell.TH ( tupE, litE, integerL ) + +main :: IO () +main = return $(tupE [litE $ integerL 42, tupE []]) diff --git a/test/testdata/TErrorExp.hs.expected b/test/testdata/TErrorExp.hs.expected --- a/test/testdata/TErrorExp.hs.expected +++ b/test/testdata/TErrorExp.hs.expected @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} -module TErrorExp where -import Language.Haskell.TH ( tupE, litE, integerL ) - -main :: IO () -main = return (42, ()) +{-# LANGUAGE TemplateHaskell #-} +module TErrorExp where +import Language.Haskell.TH ( tupE, litE, integerL ) + +main :: IO () +main = return (42, ()) diff --git a/test/testdata/TErrorPat.hs b/test/testdata/TErrorPat.hs --- a/test/testdata/TErrorPat.hs +++ b/test/testdata/TErrorPat.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} -module TErrorPat where -import Language.Haskell.TH ( conP ) - -f :: () -> () -f $(conP 'True []) = x +{-# LANGUAGE TemplateHaskell #-} +module TErrorPat where +import Language.Haskell.TH ( conP ) + +f :: () -> () +f $(conP 'True []) = x diff --git a/test/testdata/TErrorPat.hs.expected b/test/testdata/TErrorPat.hs.expected --- a/test/testdata/TErrorPat.hs.expected +++ b/test/testdata/TErrorPat.hs.expected @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} -module TErrorPat where -import Language.Haskell.TH ( conP ) - -f :: () -> () -f True = x +{-# LANGUAGE TemplateHaskell #-} +module TErrorPat where +import Language.Haskell.TH ( conP ) + +f :: () -> () +f True = x diff --git a/test/testdata/TQQDecl.hs b/test/testdata/TQQDecl.hs --- a/test/testdata/TQQDecl.hs +++ b/test/testdata/TQQDecl.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE QuasiQuotes #-} -module TQQDecl where -import QQ (str) - -[str|foo|] +{-# LANGUAGE QuasiQuotes #-} +module TQQDecl where +import QQ (str) + +[str|foo|] diff --git a/test/testdata/TQQDecl.hs.expected b/test/testdata/TQQDecl.hs.expected --- a/test/testdata/TQQDecl.hs.expected +++ b/test/testdata/TQQDecl.hs.expected @@ -1,6 +1,6 @@ -{-# LANGUAGE QuasiQuotes #-} -module TQQDecl where -import QQ (str) - -foo :: String -foo = "foo" +{-# LANGUAGE QuasiQuotes #-} +module TQQDecl where +import QQ (str) + +foo :: String +foo = "foo" diff --git a/test/testdata/TQQExp.hs b/test/testdata/TQQExp.hs --- a/test/testdata/TQQExp.hs +++ b/test/testdata/TQQExp.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE QuasiQuotes #-} -module TQQExp where -import QQ - -main :: IO () -main = putStrLn [str|str|] +{-# LANGUAGE QuasiQuotes #-} +module TQQExp where +import QQ + +main :: IO () +main = putStrLn [str|str|] diff --git a/test/testdata/TQQExp.hs.expected b/test/testdata/TQQExp.hs.expected --- a/test/testdata/TQQExp.hs.expected +++ b/test/testdata/TQQExp.hs.expected @@ -1,6 +1,6 @@ -{-# LANGUAGE QuasiQuotes #-} -module TQQExp where -import QQ - -main :: IO () -main = putStrLn "str" +{-# LANGUAGE QuasiQuotes #-} +module TQQExp where +import QQ + +main :: IO () +main = putStrLn "str" diff --git a/test/testdata/TQQExpError.hs b/test/testdata/TQQExpError.hs --- a/test/testdata/TQQExpError.hs +++ b/test/testdata/TQQExpError.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE QuasiQuotes #-} -module TQQExpError where -import QQ - -main :: IO () -main = pure [str|str|] +{-# LANGUAGE QuasiQuotes #-} +module TQQExpError where +import QQ + +main :: IO () +main = pure [str|str|] diff --git a/test/testdata/TQQExpError.hs.expected b/test/testdata/TQQExpError.hs.expected --- a/test/testdata/TQQExpError.hs.expected +++ b/test/testdata/TQQExpError.hs.expected @@ -1,6 +1,6 @@ -{-# LANGUAGE QuasiQuotes #-} -module TQQExpError where -import QQ - -main :: IO () -main = pure "str" +{-# LANGUAGE QuasiQuotes #-} +module TQQExpError where +import QQ + +main :: IO () +main = pure "str" diff --git a/test/testdata/TQQPat.hs b/test/testdata/TQQPat.hs --- a/test/testdata/TQQPat.hs +++ b/test/testdata/TQQPat.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE QuasiQuotes #-} -module TQQPat where -import QQ - -f :: String -> IO () -f [str|str|] = putStrLn "is str" -f _ = putStrLn " not str" +{-# LANGUAGE QuasiQuotes #-} +module TQQPat where +import QQ + +f :: String -> IO () +f [str|str|] = putStrLn "is str" +f _ = putStrLn " not str" diff --git a/test/testdata/TQQPat.hs.expected b/test/testdata/TQQPat.hs.expected --- a/test/testdata/TQQPat.hs.expected +++ b/test/testdata/TQQPat.hs.expected @@ -1,7 +1,7 @@ -{-# LANGUAGE QuasiQuotes #-} -module TQQPat where -import QQ - -f :: String -> IO () -f "str" = putStrLn "is str" -f _ = putStrLn " not str" +{-# LANGUAGE QuasiQuotes #-} +module TQQPat where +import QQ + +f :: String -> IO () +f "str" = putStrLn "is str" +f _ = putStrLn " not str" diff --git a/test/testdata/TQQPatError.hs b/test/testdata/TQQPatError.hs --- a/test/testdata/TQQPatError.hs +++ b/test/testdata/TQQPatError.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE QuasiQuotes #-} -module TQQPatError where -import QQ - -f :: () -> IO () -f [str|str|] = putStrLn "is str" -f _ = putStrLn " not str" +{-# LANGUAGE QuasiQuotes #-} +module TQQPatError where +import QQ + +f :: () -> IO () +f [str|str|] = putStrLn "is str" +f _ = putStrLn " not str" diff --git a/test/testdata/TQQPatError.hs.expected b/test/testdata/TQQPatError.hs.expected --- a/test/testdata/TQQPatError.hs.expected +++ b/test/testdata/TQQPatError.hs.expected @@ -1,7 +1,7 @@ -{-# LANGUAGE QuasiQuotes #-} -module TQQPatError where -import QQ - -f :: () -> IO () -f "str" = putStrLn "is str" -f _ = putStrLn " not str" +{-# LANGUAGE QuasiQuotes #-} +module TQQPatError where +import QQ + +f :: () -> IO () +f "str" = putStrLn "is str" +f _ = putStrLn " not str" diff --git a/test/testdata/TQQType.hs b/test/testdata/TQQType.hs --- a/test/testdata/TQQType.hs +++ b/test/testdata/TQQType.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE QuasiQuotes #-} -module TQQType where -import Language.Haskell.TH ( appT, numTyLit, litT, conT ) -import Data.Proxy ( Proxy(..) ) -import QQ - -main :: IO (Proxy [str|str|]) -main = return Proxy +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE QuasiQuotes #-} +module TQQType where +import Language.Haskell.TH ( appT, numTyLit, litT, conT ) +import Data.Proxy ( Proxy(..) ) +import QQ + +main :: IO (Proxy [str|str|]) +main = return Proxy diff --git a/test/testdata/TQQType.hs.expected b/test/testdata/TQQType.hs.expected --- a/test/testdata/TQQType.hs.expected +++ b/test/testdata/TQQType.hs.expected @@ -1,9 +1,9 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE QuasiQuotes #-} -module TQQType where -import Language.Haskell.TH ( appT, numTyLit, litT, conT ) -import Data.Proxy ( Proxy(..) ) -import QQ - -main :: IO (Proxy "str") -main = return Proxy +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE QuasiQuotes #-} +module TQQType where +import Language.Haskell.TH ( appT, numTyLit, litT, conT ) +import Data.Proxy ( Proxy(..) ) +import QQ + +main :: IO (Proxy "str") +main = return Proxy diff --git a/test/testdata/TQQTypeTypeError.hs b/test/testdata/TQQTypeTypeError.hs --- a/test/testdata/TQQTypeTypeError.hs +++ b/test/testdata/TQQTypeTypeError.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE QuasiQuotes #-} -module TQQTypeTypeError where -import Language.Haskell.TH ( appT, numTyLit, litT, conT ) -import Data.Proxy ( Proxy(..) ) -import QQ - -main :: IO (Proxy [str|str|]) -main = return () +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE QuasiQuotes #-} +module TQQTypeTypeError where +import Language.Haskell.TH ( appT, numTyLit, litT, conT ) +import Data.Proxy ( Proxy(..) ) +import QQ + +main :: IO (Proxy [str|str|]) +main = return () diff --git a/test/testdata/TQQTypeTypeError.hs.expected b/test/testdata/TQQTypeTypeError.hs.expected --- a/test/testdata/TQQTypeTypeError.hs.expected +++ b/test/testdata/TQQTypeTypeError.hs.expected @@ -1,9 +1,9 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE QuasiQuotes #-} -module TQQTypeTypeError where -import Language.Haskell.TH ( appT, numTyLit, litT, conT ) -import Data.Proxy ( Proxy(..) ) -import QQ - -main :: IO (Proxy "str") -main = return () +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE QuasiQuotes #-} +module TQQTypeTypeError where +import Language.Haskell.TH ( appT, numTyLit, litT, conT ) +import Data.Proxy ( Proxy(..) ) +import QQ + +main :: IO (Proxy "str") +main = return () diff --git a/test/testdata/TSimpleDecl.hs b/test/testdata/TSimpleDecl.hs --- a/test/testdata/TSimpleDecl.hs +++ b/test/testdata/TSimpleDecl.hs @@ -1,15 +1,15 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE QuasiQuotes #-} -module TSimpleDecl where -import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD ) - --- Foo --- Bar -$(sequence - [sigD (mkName "foo") [t|Int|] - ,funD (mkName "foo") [clause [] (normalB [|42|]) []] - ] - ) --- Bar --- ee --- dddd +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +module TSimpleDecl where +import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD ) + +-- Foo +-- Bar +$(sequence + [sigD (mkName "foo") [t|Int|] + ,funD (mkName "foo") [clause [] (normalB [|42|]) []] + ] + ) +-- Bar +-- ee +-- dddd diff --git a/test/testdata/TSimpleDecl.hs.expected b/test/testdata/TSimpleDecl.hs.expected --- a/test/testdata/TSimpleDecl.hs.expected +++ b/test/testdata/TSimpleDecl.hs.expected @@ -1,12 +1,12 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE QuasiQuotes #-} -module TSimpleDecl where -import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD ) - --- Foo --- Bar -foo :: Int -foo = 42 --- Bar --- ee --- dddd +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +module TSimpleDecl where +import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD ) + +-- Foo +-- Bar +foo :: Int +foo = 42 +-- Bar +-- ee +-- dddd diff --git a/test/testdata/TSimpleExp.hs b/test/testdata/TSimpleExp.hs --- a/test/testdata/TSimpleExp.hs +++ b/test/testdata/TSimpleExp.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} -module TSimpleExp where -import Language.Haskell.TH ( tupE, litE, integerL ) - -main :: IO () -main = return $(tupE []) +{-# LANGUAGE TemplateHaskell #-} +module TSimpleExp where +import Language.Haskell.TH ( tupE, litE, integerL ) + +main :: IO () +main = return $(tupE []) diff --git a/test/testdata/TSimpleExp.hs.expected b/test/testdata/TSimpleExp.hs.expected --- a/test/testdata/TSimpleExp.hs.expected +++ b/test/testdata/TSimpleExp.hs.expected @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} -module TSimpleExp where -import Language.Haskell.TH ( tupE, litE, integerL ) - -main :: IO () -main = return () +{-# LANGUAGE TemplateHaskell #-} +module TSimpleExp where +import Language.Haskell.TH ( tupE, litE, integerL ) + +main :: IO () +main = return () diff --git a/test/testdata/TSimplePat.hs b/test/testdata/TSimplePat.hs --- a/test/testdata/TSimplePat.hs +++ b/test/testdata/TSimplePat.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} -module TSimplePat where -import Language.Haskell.TH ( varP, mkName ) - -f :: x -> x -f $(varP $ mkName "x") = x +{-# LANGUAGE TemplateHaskell #-} +module TSimplePat where +import Language.Haskell.TH ( varP, mkName ) + +f :: x -> x +f $(varP $ mkName "x") = x diff --git a/test/testdata/TSimplePat.hs.expected b/test/testdata/TSimplePat.hs.expected --- a/test/testdata/TSimplePat.hs.expected +++ b/test/testdata/TSimplePat.hs.expected @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} -module TSimplePat where -import Language.Haskell.TH ( varP, mkName ) - -f :: x -> x -f x = x +{-# LANGUAGE TemplateHaskell #-} +module TSimplePat where +import Language.Haskell.TH ( varP, mkName ) + +f :: x -> x +f x = x diff --git a/test/testdata/TSimpleType.hs b/test/testdata/TSimpleType.hs --- a/test/testdata/TSimpleType.hs +++ b/test/testdata/TSimpleType.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} -module TSimpleType where -import Language.Haskell.TH ( tupleT ) - -main :: IO $(tupleT 0) -main = return () +{-# LANGUAGE TemplateHaskell #-} +module TSimpleType where +import Language.Haskell.TH ( tupleT ) + +main :: IO $(tupleT 0) +main = return () diff --git a/test/testdata/TSimpleType.hs.expected b/test/testdata/TSimpleType.hs.expected --- a/test/testdata/TSimpleType.hs.expected +++ b/test/testdata/TSimpleType.hs.expected @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} -module TSimpleType where -import Language.Haskell.TH ( tupleT ) - -main :: IO () -main = return () +{-# LANGUAGE TemplateHaskell #-} +module TSimpleType where +import Language.Haskell.TH ( tupleT ) + +main :: IO () +main = return () diff --git a/test/testdata/TTypeAppExp.hs b/test/testdata/TTypeAppExp.hs --- a/test/testdata/TTypeAppExp.hs +++ b/test/testdata/TTypeAppExp.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -module TTypeAppExp where -import Data.Proxy - -f :: Proxy Int -f = $([|Proxy @Int|]) +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +module TTypeAppExp where +import Data.Proxy + +f :: Proxy Int +f = $([|Proxy @Int|]) diff --git a/test/testdata/TTypeAppExp.hs.expected b/test/testdata/TTypeAppExp.hs.expected --- a/test/testdata/TTypeAppExp.hs.expected +++ b/test/testdata/TTypeAppExp.hs.expected @@ -1,7 +1,7 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -module TTypeAppExp where -import Data.Proxy - -f :: Proxy Int -f = (Proxy @Int) +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +module TTypeAppExp where +import Data.Proxy + +f :: Proxy Int +f = (Proxy @Int) diff --git a/test/testdata/TTypeKindError.hs b/test/testdata/TTypeKindError.hs --- a/test/testdata/TTypeKindError.hs +++ b/test/testdata/TTypeKindError.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -module TTypeKindError where -import Language.Haskell.TH ( numTyLit, litT ) -import Data.Proxy ( Proxy ) - -main :: IO () -main = return () +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module TTypeKindError where +import Language.Haskell.TH ( numTyLit, litT ) +import Data.Proxy ( Proxy ) + +main :: IO () +main = return () diff --git a/test/testdata/TTypeKindError.hs.error b/test/testdata/TTypeKindError.hs.error --- a/test/testdata/TTypeKindError.hs.error +++ b/test/testdata/TTypeKindError.hs.error @@ -1,8 +1,8 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -module TTypeKindError where -import Language.Haskell.TH ( numTyLit, litT ) -import Data.Proxy ( Proxy ) - -main :: $(litT (numTyLit 42)) -main = return () +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module TTypeKindError where +import Language.Haskell.TH ( numTyLit, litT ) +import Data.Proxy ( Proxy ) + +main :: $(litT (numTyLit 42)) +main = return () diff --git a/test/testdata/TTypeKindError.hs.expected b/test/testdata/TTypeKindError.hs.expected --- a/test/testdata/TTypeKindError.hs.expected +++ b/test/testdata/TTypeKindError.hs.expected @@ -1,8 +1,8 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -module TTypeKindError where -import Language.Haskell.TH ( numTyLit, litT ) -import Data.Proxy ( Proxy ) - -main :: (42) -main = return () +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module TTypeKindError where +import Language.Haskell.TH ( numTyLit, litT ) +import Data.Proxy ( Proxy ) + +main :: (42) +main = return () diff --git a/test/testdata/TTypeTypeError.hs b/test/testdata/TTypeTypeError.hs --- a/test/testdata/TTypeTypeError.hs +++ b/test/testdata/TTypeTypeError.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -module TTypeTypeError where -import Language.Haskell.TH ( appT, numTyLit, litT, conT ) -import Data.Proxy ( Proxy ) - -main :: IO $(conT ''Proxy `appT` litT (numTyLit 42)) -main = return () +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module TTypeTypeError where +import Language.Haskell.TH ( appT, numTyLit, litT, conT ) +import Data.Proxy ( Proxy ) + +main :: IO $(conT ''Proxy `appT` litT (numTyLit 42)) +main = return () diff --git a/test/testdata/TTypeTypeError.hs.expected b/test/testdata/TTypeTypeError.hs.expected --- a/test/testdata/TTypeTypeError.hs.expected +++ b/test/testdata/TTypeTypeError.hs.expected @@ -1,8 +1,8 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -module TTypeTypeError where -import Language.Haskell.TH ( appT, numTyLit, litT, conT ) -import Data.Proxy ( Proxy ) - -main :: IO (Proxy 42) -main = return () +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module TTypeTypeError where +import Language.Haskell.TH ( appT, numTyLit, litT, conT ) +import Data.Proxy ( Proxy ) + +main :: IO (Proxy 42) +main = return () diff --git a/test/testdata/hie.yaml b/test/testdata/hie.yaml --- a/test/testdata/hie.yaml +++ b/test/testdata/hie.yaml @@ -1,21 +1,21 @@ -cradle: - direct: - arguments: - - QQ.hs - - TQQExpError.hs - - TSimpleExp.hs - - TTypeAppExp.hs - - TDeclKindError.hs - - TQQPat.hs - - TSimplePat.hs - - TErrorExp.hs - - TQQPatError.hs - - TSimpleType.hs - - TErrorPat.hs - - TQQType.hs - - TTypeKindError.hs - - TQQDecl.hs - - TQQTypeTypeError.hs - - TTypeTypeError.hs - - TQQExp.hs - - TSimpleDecl.hs +cradle: + direct: + arguments: + - QQ.hs + - TQQExpError.hs + - TSimpleExp.hs + - TTypeAppExp.hs + - TDeclKindError.hs + - TQQPat.hs + - TSimplePat.hs + - TErrorExp.hs + - TQQPatError.hs + - TSimpleType.hs + - TErrorPat.hs + - TQQType.hs + - TTypeKindError.hs + - TQQDecl.hs + - TQQTypeTypeError.hs + - TTypeTypeError.hs + - TQQExp.hs + - TSimpleDecl.hs