From fe3a27ca1befe6403397442f2adb12dbbc0a9bd0 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 08:48:05 +0900 Subject: [PATCH 01/44] Add `HIndent.Ast` --- hindent.cabal | 1 + src/HIndent/Ast.hs | 16 ++++++++++++++++ 2 files changed, 17 insertions(+) create mode 100644 src/HIndent/Ast.hs diff --git a/hindent.cabal b/hindent.cabal index b4ba3157e..44aace64b 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -36,6 +36,7 @@ library HIndent other-modules: HIndent.Applicative + HIndent.Ast HIndent.ByteString HIndent.CabalFile HIndent.CodeBlock diff --git a/src/HIndent/Ast.hs b/src/HIndent/Ast.hs new file mode 100644 index 000000000..c9c4f87be --- /dev/null +++ b/src/HIndent/Ast.hs @@ -0,0 +1,16 @@ +-- | This module defines the AST for Haskell code. +-- +-- GHC provides its AST for Haskell code, but the structure it offers may change +-- with version updates. In other words, when directly using GHC's AST as the +-- AST for pretty-printing, updates in GHC require direct modifications to the +-- pretty-printing functions. On the other hand, when there is a need to change +-- the pretty-printing style, corresponding modifications to the functions are +-- also necessary. The presence of these two reasons for modification leads to a +-- suboptimal design state. +-- +-- Therefore, this module defines a custom AST for HIndent, allowing flexibility +-- to adapt to changes in GHC's AST across different versions. +-- +module HIndent.AST + ( + ) where From 660ce5caea46848839950d631ee36da53ca9eda7 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 09:03:29 +0900 Subject: [PATCH 02/44] Define `Module` --- hindent.cabal | 1 + src/HIndent.hs | 3 ++- src/HIndent/Ast.hs | 6 ++++-- src/HIndent/Ast/Module.hs | 23 +++++++++++++++++++++++ src/HIndent/Pretty.hs | 7 ++++--- 5 files changed, 34 insertions(+), 6 deletions(-) create mode 100644 src/HIndent/Ast/Module.hs diff --git a/hindent.cabal b/hindent.cabal index 44aace64b..d37393f1c 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -37,6 +37,7 @@ library other-modules: HIndent.Applicative HIndent.Ast + HIndent.Ast.Module HIndent.ByteString HIndent.CabalFile HIndent.CodeBlock diff --git a/src/HIndent.hs b/src/HIndent.hs index 8b56f6d9f..557adbf37 100644 --- a/src/HIndent.hs +++ b/src/HIndent.hs @@ -39,6 +39,7 @@ import Foreign.C import GHC.IO.Exception import GHC.Parser.Lexer hiding (buffer, options) import GHC.Types.SrcLoc +import HIndent.Ast import HIndent.ByteString import HIndent.CabalFile import HIndent.CodeBlock @@ -182,4 +183,4 @@ testAst x = -- | Print the module. prettyPrint :: Config -> HsModule' -> Builder prettyPrint config m = - runPrinterStyle config (pretty $ modifyASTForPrettyPrinting m) + runPrinterStyle config (pretty $ mkModule $ modifyASTForPrettyPrinting m) diff --git a/src/HIndent/Ast.hs b/src/HIndent/Ast.hs index c9c4f87be..35a22a55b 100644 --- a/src/HIndent/Ast.hs +++ b/src/HIndent/Ast.hs @@ -11,6 +11,8 @@ -- Therefore, this module defines a custom AST for HIndent, allowing flexibility -- to adapt to changes in GHC's AST across different versions. -- -module HIndent.AST - ( +module HIndent.Ast + ( mkModule ) where + +import HIndent.Ast.Module diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs new file mode 100644 index 000000000..d1d555140 --- /dev/null +++ b/src/HIndent/Ast/Module.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE CPP #-} + +module HIndent.Ast.Module + ( Module + , mkModule + ) where + +import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC +import HIndent.Pretty +import HIndent.Pretty.NodeComments +import HIndent.Pretty.Types + +newtype Module = + Module GHC.HsModule' + +instance CommentExtraction Module where + nodeComments Module {} = NodeComments [] [] [] + +instance Pretty Module where + pretty' (Module x) = pretty x + +mkModule :: GHC.HsModule' -> Module +mkModule = Module diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs index 94b07ed8f..0fc13f989 100644 --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -16,7 +16,8 @@ -- using an AST: parsing, renaming, and type checking, and GHC uses these -- constructors only in remaining and type checking. module HIndent.Pretty - ( pretty + ( Pretty(..) + , pretty ) where import Control.Monad @@ -2266,9 +2267,9 @@ instance Pretty (ForeignImport GhcPs) where pretty' (CImport _ conv safety _ _) = spaced [pretty conv, pretty safety] #elif MIN_VERSION_ghc_lib_parser(9,6,0) instance Pretty (ForeignImport GhcPs) where - pretty' (CImport (L _ (SourceText s)) conv safety _ _ ) = + pretty' (CImport (L _ (SourceText s)) conv safety _ _) = spaced [pretty conv, pretty safety, string s] - pretty' (CImport _ conv safety _ _) = spaced [pretty conv, pretty safety] + pretty' (CImport _ conv safety _ _) = spaced [pretty conv, pretty safety] #else instance Pretty ForeignImport where pretty' (CImport conv safety _ _ (L _ (SourceText s))) = From 879210ab12100cdc62fc628d1a4fc8fb481c68c3 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 09:12:35 +0900 Subject: [PATCH 03/44] Define `WithComments` --- hindent.cabal | 1 + src/HIndent/Ast/Module.hs | 11 ++++++----- src/HIndent/Ast/WithComments.hs | 22 ++++++++++++++++++++++ 3 files changed, 29 insertions(+), 5 deletions(-) create mode 100644 src/HIndent/Ast/WithComments.hs diff --git a/hindent.cabal b/hindent.cabal index d37393f1c..1cade2c03 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -38,6 +38,7 @@ library HIndent.Applicative HIndent.Ast HIndent.Ast.Module + HIndent.Ast.WithComments HIndent.ByteString HIndent.CabalFile HIndent.CodeBlock diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index d1d555140..adfaf2a11 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -5,10 +5,11 @@ module HIndent.Ast.Module , mkModule ) where +import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC -import HIndent.Pretty -import HIndent.Pretty.NodeComments -import HIndent.Pretty.Types +import HIndent.Pretty +import HIndent.Pretty.NodeComments +import HIndent.Pretty.Types newtype Module = Module GHC.HsModule' @@ -19,5 +20,5 @@ instance CommentExtraction Module where instance Pretty Module where pretty' (Module x) = pretty x -mkModule :: GHC.HsModule' -> Module -mkModule = Module +mkModule :: GHC.HsModule' -> WithComments Module +mkModule = mkWithComments . Module diff --git a/src/HIndent/Ast/WithComments.hs b/src/HIndent/Ast/WithComments.hs new file mode 100644 index 000000000..748fa30e0 --- /dev/null +++ b/src/HIndent/Ast/WithComments.hs @@ -0,0 +1,22 @@ +module HIndent.Ast.WithComments + ( WithComments + , mkWithComments + ) where + +import HIndent.Pretty +import HIndent.Pretty.NodeComments +import HIndent.Pretty.Types + +data WithComments a = WithComments + { comments :: NodeComments + , _node :: a + } + +instance CommentExtraction (WithComments a) where + nodeComments = comments + +instance (Pretty a) => Pretty (WithComments a) where + pretty' (WithComments _ x) = pretty' x + +mkWithComments :: a -> WithComments a +mkWithComments = WithComments (NodeComments [] [] []) From 1c14459d4de9e3c01f5a91fcc396b8c5a18d10f2 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 09:14:58 +0900 Subject: [PATCH 04/44] Format --- src/HIndent/Ast/Module.hs | 8 ++++---- src/HIndent/Ast/WithComments.hs | 12 +++++++----- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index adfaf2a11..bc1d7cadf 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -5,11 +5,11 @@ module HIndent.Ast.Module , mkModule ) where -import HIndent.Ast.WithComments +import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC -import HIndent.Pretty -import HIndent.Pretty.NodeComments -import HIndent.Pretty.Types +import HIndent.Pretty +import HIndent.Pretty.NodeComments +import HIndent.Pretty.Types newtype Module = Module GHC.HsModule' diff --git a/src/HIndent/Ast/WithComments.hs b/src/HIndent/Ast/WithComments.hs index 748fa30e0..8bd5a8ddd 100644 --- a/src/HIndent/Ast/WithComments.hs +++ b/src/HIndent/Ast/WithComments.hs @@ -1,22 +1,24 @@ +{-# LANGUAGE RecordWildCards #-} + module HIndent.Ast.WithComments ( WithComments , mkWithComments ) where -import HIndent.Pretty -import HIndent.Pretty.NodeComments -import HIndent.Pretty.Types +import HIndent.Pretty +import HIndent.Pretty.NodeComments +import HIndent.Pretty.Types data WithComments a = WithComments { comments :: NodeComments - , _node :: a + , node :: a } instance CommentExtraction (WithComments a) where nodeComments = comments instance (Pretty a) => Pretty (WithComments a) where - pretty' (WithComments _ x) = pretty' x + pretty' WithComments {..} = pretty' node mkWithComments :: a -> WithComments a mkWithComments = WithComments (NodeComments [] [] []) From c26665c8bb97a97ca0c1d2a0f35584427a0ff505 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 10:01:14 +0900 Subject: [PATCH 05/44] Wrap with a `WithComments` --- src/HIndent/Ast/Module.hs | 5 ++- src/HIndent/Ast/WithComments.hs | 47 +++++++++++++++++++++-- src/HIndent/GhcLibParserWrapper/GHC/Hs.hs | 10 ++++- 3 files changed, 55 insertions(+), 7 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index bc1d7cadf..898d0ebd5 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} module HIndent.Ast.Module ( Module @@ -18,7 +19,7 @@ instance CommentExtraction Module where nodeComments Module {} = NodeComments [] [] [] instance Pretty Module where - pretty' (Module x) = pretty x + pretty' (Module x) = pretty' x mkModule :: GHC.HsModule' -> WithComments Module -mkModule = mkWithComments . Module +mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module m diff --git a/src/HIndent/Ast/WithComments.hs b/src/HIndent/Ast/WithComments.hs index 8bd5a8ddd..946959f39 100644 --- a/src/HIndent/Ast/WithComments.hs +++ b/src/HIndent/Ast/WithComments.hs @@ -2,11 +2,14 @@ module HIndent.Ast.WithComments ( WithComments - , mkWithComments + , fromEpAnn ) where +import qualified GHC.Hs as GHC +import qualified GHC.Types.SrcLoc as GHC import HIndent.Pretty import HIndent.Pretty.NodeComments +import HIndent.Pretty.Pragma import HIndent.Pretty.Types data WithComments a = WithComments @@ -15,10 +18,46 @@ data WithComments a = WithComments } instance CommentExtraction (WithComments a) where - nodeComments = comments + nodeComments WithComments {..} = comments instance (Pretty a) => Pretty (WithComments a) where pretty' WithComments {..} = pretty' node -mkWithComments :: a -> WithComments a -mkWithComments = WithComments (NodeComments [] [] []) +fromEpAnn :: GHC.EpAnn a -> b -> WithComments b +fromEpAnn ann = WithComments (epaComments $ filterOutEofAndPragmasFromAnn ann) + +epaComments :: GHC.EpAnn a -> NodeComments +epaComments GHC.EpAnn {..} = NodeComments {..} + where + commentsBefore = GHC.priorComments comments + commentsOnSameLine = + filter isCommentOnSameLine $ GHC.getFollowingComments comments + commentsAfter = + filter (not . isCommentOnSameLine) $ GHC.getFollowingComments comments + isCommentOnSameLine (GHC.L comAnn _) = + GHC.srcSpanEndLine (GHC.anchor entry) + == GHC.srcSpanStartLine (GHC.anchor comAnn) +epaComments GHC.EpAnnNotUsed = NodeComments [] [] [] + +filterOutEofAndPragmasFromAnn :: GHC.EpAnn ann -> GHC.EpAnn ann +filterOutEofAndPragmasFromAnn GHC.EpAnn {..} = + GHC.EpAnn {comments = filterOutEofAndPragmasFromComments comments, ..} +filterOutEofAndPragmasFromAnn GHC.EpAnnNotUsed = GHC.EpAnnNotUsed + +filterOutEofAndPragmasFromComments :: GHC.EpAnnComments -> GHC.EpAnnComments +filterOutEofAndPragmasFromComments comments = + GHC.EpaCommentsBalanced + { priorComments = filterOutEofAndPragmas $ GHC.priorComments comments + , followingComments = + filterOutEofAndPragmas $ GHC.getFollowingComments comments + } + +filterOutEofAndPragmas :: + [GHC.GenLocated l GHC.EpaComment] -> [GHC.GenLocated l GHC.EpaComment] +filterOutEofAndPragmas = filter isNeitherEofNorPragmaComment + +isNeitherEofNorPragmaComment :: GHC.GenLocated l GHC.EpaComment -> Bool +isNeitherEofNorPragmaComment (GHC.L _ (GHC.EpaComment GHC.EpaEofComment _)) = + False +isNeitherEofNorPragmaComment (GHC.L _ (GHC.EpaComment tok _)) = + not $ isPragma tok diff --git a/src/HIndent/GhcLibParserWrapper/GHC/Hs.hs b/src/HIndent/GhcLibParserWrapper/GHC/Hs.hs index fee12f76a..70e04db6a 100644 --- a/src/HIndent/GhcLibParserWrapper/GHC/Hs.hs +++ b/src/HIndent/GhcLibParserWrapper/GHC/Hs.hs @@ -1,15 +1,23 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} -- | Wrapper for 'GHC.Hs' module HIndent.GhcLibParserWrapper.GHC.Hs ( module GHC.Hs , HsModule' + , getModuleAnn ) where import GHC.Hs -- | The wrapper for `HsModule` -#if MIN_VERSION_ghc_lib_parser(9,6,1) +#if MIN_VERSION_ghc_lib_parser(9, 6, 1) type HsModule' = HsModule GhcPs #else type HsModule' = HsModule #endif +getModuleAnn :: HsModule' -> EpAnn AnnsModule +#if MIN_VERSION_ghc_lib_parser(9, 6, 1) +getModuleAnn HsModule {hsmodExt = XModulePs {..}} = hsmodAnn +#else +getModuleAnn HsModule {..} = hsmodAnn +#endif From 8fec0da9cb30b0ba0b3c6155f14691a1772ae37a Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 10:06:05 +0900 Subject: [PATCH 06/44] Create the `NodeComments` module --- hindent.cabal | 1 + src/HIndent/Ast/Module.hs | 2 +- src/HIndent/Ast/NodeComments.hs | 20 ++++++++++++++++++++ src/HIndent/Ast/WithComments.hs | 2 +- src/HIndent/Pretty.hs | 1 + src/HIndent/Pretty/NodeComments.hs | 1 + src/HIndent/Pretty/Types.hs | 16 ---------------- 7 files changed, 25 insertions(+), 18 deletions(-) create mode 100644 src/HIndent/Ast/NodeComments.hs diff --git a/hindent.cabal b/hindent.cabal index 1cade2c03..af2055ea4 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -38,6 +38,7 @@ library HIndent.Applicative HIndent.Ast HIndent.Ast.Module + HIndent.Ast.NodeComments HIndent.Ast.WithComments HIndent.ByteString HIndent.CabalFile diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 898d0ebd5..ee1247d4c 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -6,11 +6,11 @@ module HIndent.Ast.Module , mkModule ) where +import HIndent.Ast.NodeComments import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import HIndent.Pretty import HIndent.Pretty.NodeComments -import HIndent.Pretty.Types newtype Module = Module GHC.HsModule' diff --git a/src/HIndent/Ast/NodeComments.hs b/src/HIndent/Ast/NodeComments.hs new file mode 100644 index 000000000..b8917cae1 --- /dev/null +++ b/src/HIndent/Ast/NodeComments.hs @@ -0,0 +1,20 @@ +module HIndent.Ast.NodeComments + ( NodeComments(..) + ) where + +import qualified GHC.Hs as GHC + +-- | Comments belonging to an AST node. +data NodeComments = NodeComments + { commentsBefore :: [GHC.LEpaComment] + , commentsOnSameLine :: [GHC.LEpaComment] + , commentsAfter :: [GHC.LEpaComment] + } + +instance Semigroup NodeComments where + x <> y = + NodeComments + { commentsBefore = commentsBefore x <> commentsBefore y + , commentsOnSameLine = commentsOnSameLine x <> commentsOnSameLine y + , commentsAfter = commentsAfter x <> commentsAfter y + } diff --git a/src/HIndent/Ast/WithComments.hs b/src/HIndent/Ast/WithComments.hs index 946959f39..374ff5d9d 100644 --- a/src/HIndent/Ast/WithComments.hs +++ b/src/HIndent/Ast/WithComments.hs @@ -7,10 +7,10 @@ module HIndent.Ast.WithComments import qualified GHC.Hs as GHC import qualified GHC.Types.SrcLoc as GHC +import HIndent.Ast.NodeComments import HIndent.Pretty import HIndent.Pretty.NodeComments import HIndent.Pretty.Pragma -import HIndent.Pretty.Types data WithComments a = WithComments { comments :: NodeComments diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs index 0fc13f989..194c39bb1 100644 --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -40,6 +40,7 @@ import GHC.Types.SourceText import GHC.Types.SrcLoc import GHC.Unit.Module.Warnings import HIndent.Applicative +import HIndent.Ast.NodeComments import HIndent.Config import HIndent.Fixity import HIndent.Pretty.Combinators diff --git a/src/HIndent/Pretty/NodeComments.hs b/src/HIndent/Pretty/NodeComments.hs index cca18f150..39dab9e71 100644 --- a/src/HIndent/Pretty/NodeComments.hs +++ b/src/HIndent/Pretty/NodeComments.hs @@ -20,6 +20,7 @@ import GHC.Types.Name import GHC.Types.Name.Reader import GHC.Types.SourceText import GHC.Types.SrcLoc +import HIndent.Ast.NodeComments import HIndent.Pretty.Pragma import HIndent.Pretty.SigBindFamily import HIndent.Pretty.Types diff --git a/src/HIndent/Pretty/Types.hs b/src/HIndent/Pretty/Types.hs index 552705523..da6ca7c2b 100644 --- a/src/HIndent/Pretty/Types.hs +++ b/src/HIndent/Pretty/Types.hs @@ -46,7 +46,6 @@ module HIndent.Pretty.Types , DoOrMdo(..) , QualifiedDo(..) , LetIn(..) - , NodeComments(..) , GRHSExprType(..) , GRHSProcType(..) , HsTypeFor(..) @@ -282,21 +281,6 @@ data LetIn = LetIn , inExpr :: LHsExpr GhcPs } --- | Comments belonging to an AST node. -data NodeComments = NodeComments - { commentsBefore :: [LEpaComment] - , commentsOnSameLine :: [LEpaComment] - , commentsAfter :: [LEpaComment] - } - -instance Semigroup NodeComments where - x <> y = - NodeComments - { commentsBefore = commentsBefore x <> commentsBefore y - , commentsOnSameLine = commentsOnSameLine x <> commentsOnSameLine y - , commentsAfter = commentsAfter x <> commentsAfter y - } - -- | Values indicating whether `do` or `mdo` is used. data DoOrMdo = Do From 3609021a10632a6e37addae8b32942f9400ba2c4 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 10:17:57 +0900 Subject: [PATCH 07/44] Move functions of `NodeComments` --- src/HIndent/Ast/Module.hs | 2 +- src/HIndent/Ast/NodeComments.hs | 44 +++++++++++++++++++++++++++++++++ src/HIndent/Ast/WithComments.hs | 43 +++----------------------------- 3 files changed, 48 insertions(+), 41 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index ee1247d4c..148d00cbb 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -6,7 +6,7 @@ module HIndent.Ast.Module , mkModule ) where -import HIndent.Ast.NodeComments +import HIndent.Ast.NodeComments (NodeComments(..)) import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import HIndent.Pretty diff --git a/src/HIndent/Ast/NodeComments.hs b/src/HIndent/Ast/NodeComments.hs index b8917cae1..fb5651612 100644 --- a/src/HIndent/Ast/NodeComments.hs +++ b/src/HIndent/Ast/NodeComments.hs @@ -1,8 +1,13 @@ +{-# LANGUAGE RecordWildCards #-} + module HIndent.Ast.NodeComments ( NodeComments(..) + , fromEpAnn ) where import qualified GHC.Hs as GHC +import qualified GHC.Types.SrcLoc as GHC +import HIndent.Pretty.Pragma -- | Comments belonging to an AST node. data NodeComments = NodeComments @@ -18,3 +23,42 @@ instance Semigroup NodeComments where , commentsOnSameLine = commentsOnSameLine x <> commentsOnSameLine y , commentsAfter = commentsAfter x <> commentsAfter y } + +fromEpAnn :: GHC.EpAnn a -> NodeComments +fromEpAnn = fromEpAnn' . filterOutEofAndPragmasFromAnn + +fromEpAnn' :: GHC.EpAnn a -> NodeComments +fromEpAnn' GHC.EpAnn {..} = NodeComments {..} + where + commentsBefore = GHC.priorComments comments + commentsOnSameLine = + filter isCommentOnSameLine $ GHC.getFollowingComments comments + commentsAfter = + filter (not . isCommentOnSameLine) $ GHC.getFollowingComments comments + isCommentOnSameLine (GHC.L comAnn _) = + GHC.srcSpanEndLine (GHC.anchor entry) + == GHC.srcSpanStartLine (GHC.anchor comAnn) +fromEpAnn' GHC.EpAnnNotUsed = NodeComments [] [] [] + +filterOutEofAndPragmasFromAnn :: GHC.EpAnn ann -> GHC.EpAnn ann +filterOutEofAndPragmasFromAnn GHC.EpAnn {..} = + GHC.EpAnn {comments = filterOutEofAndPragmasFromComments comments, ..} +filterOutEofAndPragmasFromAnn GHC.EpAnnNotUsed = GHC.EpAnnNotUsed + +filterOutEofAndPragmasFromComments :: GHC.EpAnnComments -> GHC.EpAnnComments +filterOutEofAndPragmasFromComments comments = + GHC.EpaCommentsBalanced + { priorComments = filterOutEofAndPragmas $ GHC.priorComments comments + , followingComments = + filterOutEofAndPragmas $ GHC.getFollowingComments comments + } + +filterOutEofAndPragmas :: + [GHC.GenLocated l GHC.EpaComment] -> [GHC.GenLocated l GHC.EpaComment] +filterOutEofAndPragmas = filter isNeitherEofNorPragmaComment + +isNeitherEofNorPragmaComment :: GHC.GenLocated l GHC.EpaComment -> Bool +isNeitherEofNorPragmaComment (GHC.L _ (GHC.EpaComment GHC.EpaEofComment _)) = + False +isNeitherEofNorPragmaComment (GHC.L _ (GHC.EpaComment tok _)) = + not $ isPragma tok diff --git a/src/HIndent/Ast/WithComments.hs b/src/HIndent/Ast/WithComments.hs index 374ff5d9d..501028433 100644 --- a/src/HIndent/Ast/WithComments.hs +++ b/src/HIndent/Ast/WithComments.hs @@ -6,11 +6,10 @@ module HIndent.Ast.WithComments ) where import qualified GHC.Hs as GHC -import qualified GHC.Types.SrcLoc as GHC -import HIndent.Ast.NodeComments +import HIndent.Ast.NodeComments (NodeComments(..)) +import qualified HIndent.Ast.NodeComments as NodeComments import HIndent.Pretty import HIndent.Pretty.NodeComments -import HIndent.Pretty.Pragma data WithComments a = WithComments { comments :: NodeComments @@ -24,40 +23,4 @@ instance (Pretty a) => Pretty (WithComments a) where pretty' WithComments {..} = pretty' node fromEpAnn :: GHC.EpAnn a -> b -> WithComments b -fromEpAnn ann = WithComments (epaComments $ filterOutEofAndPragmasFromAnn ann) - -epaComments :: GHC.EpAnn a -> NodeComments -epaComments GHC.EpAnn {..} = NodeComments {..} - where - commentsBefore = GHC.priorComments comments - commentsOnSameLine = - filter isCommentOnSameLine $ GHC.getFollowingComments comments - commentsAfter = - filter (not . isCommentOnSameLine) $ GHC.getFollowingComments comments - isCommentOnSameLine (GHC.L comAnn _) = - GHC.srcSpanEndLine (GHC.anchor entry) - == GHC.srcSpanStartLine (GHC.anchor comAnn) -epaComments GHC.EpAnnNotUsed = NodeComments [] [] [] - -filterOutEofAndPragmasFromAnn :: GHC.EpAnn ann -> GHC.EpAnn ann -filterOutEofAndPragmasFromAnn GHC.EpAnn {..} = - GHC.EpAnn {comments = filterOutEofAndPragmasFromComments comments, ..} -filterOutEofAndPragmasFromAnn GHC.EpAnnNotUsed = GHC.EpAnnNotUsed - -filterOutEofAndPragmasFromComments :: GHC.EpAnnComments -> GHC.EpAnnComments -filterOutEofAndPragmasFromComments comments = - GHC.EpaCommentsBalanced - { priorComments = filterOutEofAndPragmas $ GHC.priorComments comments - , followingComments = - filterOutEofAndPragmas $ GHC.getFollowingComments comments - } - -filterOutEofAndPragmas :: - [GHC.GenLocated l GHC.EpaComment] -> [GHC.GenLocated l GHC.EpaComment] -filterOutEofAndPragmas = filter isNeitherEofNorPragmaComment - -isNeitherEofNorPragmaComment :: GHC.GenLocated l GHC.EpaComment -> Bool -isNeitherEofNorPragmaComment (GHC.L _ (GHC.EpaComment GHC.EpaEofComment _)) = - False -isNeitherEofNorPragmaComment (GHC.L _ (GHC.EpaComment tok _)) = - not $ isPragma tok +fromEpAnn ann = WithComments (NodeComments.fromEpAnn ann) From b8a7115f2dab626504737f0fa7cf8ee757a649ff Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 10:18:44 +0900 Subject: [PATCH 08/44] Add a label --- src/HIndent/Ast/Module.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 148d00cbb..91b992b42 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -12,14 +12,15 @@ import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import HIndent.Pretty import HIndent.Pretty.NodeComments -newtype Module = - Module GHC.HsModule' +newtype Module = Module + { module' :: GHC.HsModule' + } instance CommentExtraction Module where nodeComments Module {} = NodeComments [] [] [] instance Pretty Module where - pretty' (Module x) = pretty' x + pretty' Module {..} = pretty' module' mkModule :: GHC.HsModule' -> WithComments Module mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module m From 9994431e098041d229920b0c1b9f2de154009258 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 10:21:42 +0900 Subject: [PATCH 09/44] Add `ModuleDeclaration` --- hindent.cabal | 1 + src/HIndent/Ast/Module.hs | 11 ++++++++--- src/HIndent/Ast/Module/Declaration.hs | 10 ++++++++++ 3 files changed, 19 insertions(+), 3 deletions(-) create mode 100644 src/HIndent/Ast/Module/Declaration.hs diff --git a/hindent.cabal b/hindent.cabal index af2055ea4..0473fff07 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -38,6 +38,7 @@ library HIndent.Applicative HIndent.Ast HIndent.Ast.Module + HIndent.Ast.Module.Declaration HIndent.Ast.NodeComments HIndent.Ast.WithComments HIndent.ByteString diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 91b992b42..2f8cabf78 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -6,14 +6,16 @@ module HIndent.Ast.Module , mkModule ) where +import HIndent.Ast.Module.Declaration import HIndent.Ast.NodeComments (NodeComments(..)) import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import HIndent.Pretty import HIndent.Pretty.NodeComments -newtype Module = Module - { module' :: GHC.HsModule' +data Module = Module + { moduleDeclaration :: ModuleDeclaration + , module' :: GHC.HsModule' } instance CommentExtraction Module where @@ -23,4 +25,7 @@ instance Pretty Module where pretty' Module {..} = pretty' module' mkModule :: GHC.HsModule' -> WithComments Module -mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module m +mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module {..} + where + moduleDeclaration = mkModuleDeclaration m + module' = m diff --git a/src/HIndent/Ast/Module/Declaration.hs b/src/HIndent/Ast/Module/Declaration.hs new file mode 100644 index 000000000..8f47b5184 --- /dev/null +++ b/src/HIndent/Ast/Module/Declaration.hs @@ -0,0 +1,10 @@ +module HIndent.Ast.Module.Declaration + ( ModuleDeclaration + , mkModuleDeclaration + ) where + +data ModuleDeclaration = + ModuleDeclaration + +mkModuleDeclaration :: a -> ModuleDeclaration +mkModuleDeclaration _ = ModuleDeclaration From 08e7e03bae66909246cd2eac6dda58f7838eaf9a Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 10:36:36 +0900 Subject: [PATCH 10/44] Remove `Pretty HsModule` --- src/HIndent/Ast/Module.hs | 135 +++++++++++++++++++++++++++++++++++++- src/HIndent/Pretty.hs | 120 +-------------------------------- 2 files changed, 134 insertions(+), 121 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 2f8cabf78..b2b4e11be 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} module HIndent.Ast.Module @@ -6,12 +7,22 @@ module HIndent.Ast.Module , mkModule ) where +import Control.Monad.RWS +import Data.Maybe +import qualified GHC.Types.SrcLoc as GHC +import HIndent.Applicative import HIndent.Ast.Module.Declaration import HIndent.Ast.NodeComments (NodeComments(..)) import HIndent.Ast.WithComments +import HIndent.Config import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import HIndent.Pretty +import HIndent.Pretty.Combinators +import HIndent.Pretty.Import import HIndent.Pretty.NodeComments +import HIndent.Pretty.Pragma +import HIndent.Pretty.Types +import HIndent.Printer data Module = Module { moduleDeclaration :: ModuleDeclaration @@ -20,10 +31,128 @@ data Module = Module instance CommentExtraction Module where nodeComments Module {} = NodeComments [] [] [] - +#if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty Module where - pretty' Module {..} = pretty' module' - + pretty' Module {module' = m@GHC.HsModule { hsmodName = Nothing + , hsmodImports = [] + , hsmodDecls = [] + }} + | not (pragmaExists m) = pure () + pretty' Module {module' = m} = blanklined printers >> newline + where + printers = snd <$> filter fst pairs + pairs = + [ (pragmaExists m, prettyPragmas m) + , (moduleDeclExists m, prettyModuleDecl m) + , (importsExist m, prettyImports) + , (declsExist m, prettyDecls) + ] + prettyModuleDecl :: GHC.HsModule GHC.GhcPs -> Printer () + prettyModuleDecl GHC.HsModule {hsmodName = Nothing} = + error "The module declaration does not exist." + prettyModuleDecl GHC.HsModule { hsmodName = Just name + , hsmodExports = Nothing + , hsmodExt = GHC.XModulePs {..} + } = do + pretty $ fmap ModuleNameWithPrefix name + whenJust hsmodDeprecMessage $ \x -> do + space + pretty $ fmap ModuleDeprecatedPragma x + string " where" + prettyModuleDecl GHC.HsModule { hsmodName = Just name + , hsmodExports = Just exports + , hsmodExt = GHC.XModulePs {..} + } = do + pretty $ fmap ModuleNameWithPrefix name + whenJust hsmodDeprecMessage $ \x -> do + space + pretty $ fmap ModuleDeprecatedPragma x + newline + indentedBlock $ do + printCommentsAnd exports (vTuple . fmap pretty) + string " where" + moduleDeclExists GHC.HsModule {hsmodName = Nothing} = False + moduleDeclExists _ = True + prettyDecls = + mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp) + $ addDeclSeparator + $ GHC.hsmodDecls m + addDeclSeparator [] = [] + addDeclSeparator [x] = [(x, Nothing)] + addDeclSeparator (x:xs) = + (x, Just $ declSeparator $ GHC.unLoc x) : addDeclSeparator xs + declSeparator (GHC.SigD _ GHC.TypeSig {}) = newline + declSeparator (GHC.SigD _ GHC.InlineSig {}) = newline + declSeparator (GHC.SigD _ GHC.PatSynSig {}) = newline + declSeparator _ = blankline + declsExist = not . null . GHC.hsmodDecls + prettyImports = importDecls >>= blanklined . fmap outputImportGroup + outputImportGroup = lined . fmap pretty + importDecls = + gets (configSortImports . psConfig) >>= \case + True -> pure $ extractImportsSorted m + False -> pure $ extractImports m +#else +instance Pretty Module where + pretty' Module {module' = m@GHC.HsModule { hsmodName = Nothing + , hsmodImports = [] + , hsmodDecls = [] + }} + | not (pragmaExists m) = pure () + pretty' Module {module' = m} = blanklined printers >> newline + where + printers = snd <$> filter fst pairs + pairs = + [ (pragmaExists m, prettyPragmas m) + , (moduleDeclExists m, prettyModuleDecl m) + , (importsExist m, prettyImports) + , (declsExist m, prettyDecls) + ] + prettyModuleDecl GHC.HsModule {hsmodName = Nothing} = + error "The module declaration does not exist." + prettyModuleDecl GHC.HsModule { hsmodName = Just name + , hsmodExports = Nothing + , .. + } = do + pretty $ fmap ModuleNameWithPrefix name + whenJust hsmodDeprecMessage $ \x -> do + space + pretty $ fmap ModuleDeprecatedPragma x + string " where" + prettyModuleDecl GHC.HsModule { hsmodName = Just name + , hsmodExports = Just exports + , .. + } = do + pretty $ fmap ModuleNameWithPrefix name + whenJust hsmodDeprecMessage $ \x -> do + space + pretty $ fmap ModuleDeprecatedPragma x + newline + indentedBlock $ do + printCommentsAnd exports (vTuple . fmap pretty) + string " where" + moduleDeclExists GHC.HsModule {hsmodName = Nothing} = False + moduleDeclExists _ = True + prettyDecls = + mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp) + $ addDeclSeparator + $ GHC.hsmodDecls m + addDeclSeparator [] = [] + addDeclSeparator [x] = [(x, Nothing)] + addDeclSeparator (x:xs) = + (x, Just $ declSeparator $ GHC.unLoc x) : addDeclSeparator xs + declSeparator (GHC.SigD _ GHC.TypeSig {}) = newline + declSeparator (GHC.SigD _ GHC.InlineSig {}) = newline + declSeparator (GHC.SigD _ GHC.PatSynSig {}) = newline + declSeparator _ = blankline + declsExist = not . null . GHC.hsmodDecls + prettyImports = importDecls >>= blanklined . fmap outputImportGroup + outputImportGroup = lined . fmap pretty + importDecls = + gets (configSortImports . psConfig) >>= \case + True -> pure $ extractImportsSorted m + False -> pure $ extractImports m +#endif mkModule :: GHC.HsModule' -> WithComments Module mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module {..} where diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs index 194c39bb1..9811df31d 100644 --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -18,6 +18,7 @@ module HIndent.Pretty ( Pretty(..) , pretty + , printCommentsAnd ) where import Control.Monad @@ -44,9 +45,7 @@ import HIndent.Ast.NodeComments import HIndent.Config import HIndent.Fixity import HIndent.Pretty.Combinators -import HIndent.Pretty.Import import HIndent.Pretty.NodeComments -import HIndent.Pretty.Pragma import HIndent.Pretty.SigBindFamily import HIndent.Pretty.Types import HIndent.Printer @@ -124,126 +123,11 @@ class CommentExtraction a => Pretty a where pretty' :: a -> Printer () + -- Do nothing if there are no pragmas, module headers, imports, or -- declarations. Otherwise, extra blank lines will be inserted if only -- comments are present in the source code. See -- https://github.com/mihaimaruseac/hindent/issues/586#issuecomment-1374992624. -#if MIN_VERSION_ghc_lib_parser(9,6,1) -instance Pretty (HsModule GhcPs) where - pretty' m@HsModule {hsmodName = Nothing, hsmodImports = [], hsmodDecls = []} - | not (pragmaExists m) = pure () - pretty' m = blanklined printers >> newline - where - printers = snd <$> filter fst pairs - pairs = - [ (pragmaExists m, prettyPragmas m) - , (moduleDeclExists m, prettyModuleDecl m) - , (importsExist m, prettyImports) - , (declsExist m, prettyDecls) - ] - prettyModuleDecl :: HsModule GhcPs -> Printer () - prettyModuleDecl HsModule {hsmodName = Nothing} = - error "The module declaration does not exist." - prettyModuleDecl HsModule { hsmodName = Just name - , hsmodExports = Nothing - , hsmodExt = XModulePs {..} - } = do - pretty $ fmap ModuleNameWithPrefix name - whenJust hsmodDeprecMessage $ \x -> do - space - pretty $ fmap ModuleDeprecatedPragma x - string " where" - prettyModuleDecl HsModule { hsmodName = Just name - , hsmodExports = Just exports - , hsmodExt = XModulePs {..} - } = do - pretty $ fmap ModuleNameWithPrefix name - whenJust hsmodDeprecMessage $ \x -> do - space - pretty $ fmap ModuleDeprecatedPragma x - newline - indentedBlock $ do - printCommentsAnd exports (vTuple . fmap pretty) - string " where" - moduleDeclExists HsModule {hsmodName = Nothing} = False - moduleDeclExists _ = True - prettyDecls = - mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp) - $ addDeclSeparator - $ hsmodDecls m - addDeclSeparator [] = [] - addDeclSeparator [x] = [(x, Nothing)] - addDeclSeparator (x:xs) = - (x, Just $ declSeparator $ unLoc x) : addDeclSeparator xs - declSeparator (SigD _ TypeSig {}) = newline - declSeparator (SigD _ InlineSig {}) = newline - declSeparator (SigD _ PatSynSig {}) = newline - declSeparator _ = blankline - declsExist = not . null . hsmodDecls - prettyImports = importDecls >>= blanklined . fmap outputImportGroup - outputImportGroup = lined . fmap pretty - importDecls = - gets (configSortImports . psConfig) >>= \case - True -> pure $ extractImportsSorted m - False -> pure $ extractImports m -#else -instance Pretty HsModule where - pretty' m@HsModule {hsmodName = Nothing, hsmodImports = [], hsmodDecls = []} - | not (pragmaExists m) = pure () - pretty' m = blanklined printers >> newline - where - printers = snd <$> filter fst pairs - pairs = - [ (pragmaExists m, prettyPragmas m) - , (moduleDeclExists m, prettyModuleDecl m) - , (importsExist m, prettyImports) - , (declsExist m, prettyDecls) - ] - prettyModuleDecl HsModule {hsmodName = Nothing} = - error "The module declaration does not exist." - prettyModuleDecl HsModule { hsmodName = Just name - , hsmodExports = Nothing - , .. - } = do - pretty $ fmap ModuleNameWithPrefix name - whenJust hsmodDeprecMessage $ \x -> do - space - pretty $ fmap ModuleDeprecatedPragma x - string " where" - prettyModuleDecl HsModule { hsmodName = Just name - , hsmodExports = Just exports - , .. - } = do - pretty $ fmap ModuleNameWithPrefix name - whenJust hsmodDeprecMessage $ \x -> do - space - pretty $ fmap ModuleDeprecatedPragma x - newline - indentedBlock $ do - printCommentsAnd exports (vTuple . fmap pretty) - string " where" - moduleDeclExists HsModule {hsmodName = Nothing} = False - moduleDeclExists _ = True - prettyDecls = - mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp) - $ addDeclSeparator - $ hsmodDecls m - addDeclSeparator [] = [] - addDeclSeparator [x] = [(x, Nothing)] - addDeclSeparator (x:xs) = - (x, Just $ declSeparator $ unLoc x) : addDeclSeparator xs - declSeparator (SigD _ TypeSig {}) = newline - declSeparator (SigD _ InlineSig {}) = newline - declSeparator (SigD _ PatSynSig {}) = newline - declSeparator _ = blankline - declsExist = not . null . hsmodDecls - prettyImports = importDecls >>= blanklined . fmap outputImportGroup - outputImportGroup = lined . fmap pretty - importDecls = - gets (configSortImports . psConfig) >>= \case - True -> pure $ extractImportsSorted m - False -> pure $ extractImports m -#endif instance (CommentExtraction l, Pretty e) => Pretty (GenLocated l e) where pretty' (L _ e) = pretty e From e225921e133cb2e85d4383ac183f5a6e963aab84 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 10:39:24 +0900 Subject: [PATCH 11/44] Change the type --- src/HIndent/Ast/Module/Declaration.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/HIndent/Ast/Module/Declaration.hs b/src/HIndent/Ast/Module/Declaration.hs index 8f47b5184..a7c5889d8 100644 --- a/src/HIndent/Ast/Module/Declaration.hs +++ b/src/HIndent/Ast/Module/Declaration.hs @@ -3,8 +3,10 @@ module HIndent.Ast.Module.Declaration , mkModuleDeclaration ) where +import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC + data ModuleDeclaration = ModuleDeclaration -mkModuleDeclaration :: a -> ModuleDeclaration +mkModuleDeclaration :: GHC.HsModule' -> ModuleDeclaration mkModuleDeclaration _ = ModuleDeclaration From ecdbd7773e81c239933afd5d03cc7640edbe1e8c Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 10:45:44 +0900 Subject: [PATCH 12/44] Define `FileHeaderPragmaCollection` --- hindent.cabal | 1 + src/HIndent/Ast/FileHeaderPragma/Collection.hs | 10 ++++++++++ src/HIndent/Ast/Module.hs | 5 ++++- 3 files changed, 15 insertions(+), 1 deletion(-) create mode 100644 src/HIndent/Ast/FileHeaderPragma/Collection.hs diff --git a/hindent.cabal b/hindent.cabal index 0473fff07..2a1e714f0 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -37,6 +37,7 @@ library other-modules: HIndent.Applicative HIndent.Ast + HIndent.Ast.FileHeaderPragma.Collection HIndent.Ast.Module HIndent.Ast.Module.Declaration HIndent.Ast.NodeComments diff --git a/src/HIndent/Ast/FileHeaderPragma/Collection.hs b/src/HIndent/Ast/FileHeaderPragma/Collection.hs new file mode 100644 index 000000000..1e90a6b67 --- /dev/null +++ b/src/HIndent/Ast/FileHeaderPragma/Collection.hs @@ -0,0 +1,10 @@ +module HIndent.Ast.FileHeaderPragma.Collection + ( FileHeaderPragmaCollection + , mkFileHeaderPragmaCollection + ) where + +data FileHeaderPragmaCollection = + FileHeaderPragmaCollection + +mkFileHeaderPragmaCollection :: a -> FileHeaderPragmaCollection +mkFileHeaderPragmaCollection _ = FileHeaderPragmaCollection diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index b2b4e11be..93ee2dacf 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -11,6 +11,7 @@ import Control.Monad.RWS import Data.Maybe import qualified GHC.Types.SrcLoc as GHC import HIndent.Applicative +import HIndent.Ast.FileHeaderPragma.Collection import HIndent.Ast.Module.Declaration import HIndent.Ast.NodeComments (NodeComments(..)) import HIndent.Ast.WithComments @@ -25,7 +26,8 @@ import HIndent.Pretty.Types import HIndent.Printer data Module = Module - { moduleDeclaration :: ModuleDeclaration + { pragmas :: FileHeaderPragmaCollection + , moduleDeclaration :: ModuleDeclaration , module' :: GHC.HsModule' } @@ -156,5 +158,6 @@ instance Pretty Module where mkModule :: GHC.HsModule' -> WithComments Module mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module {..} where + pragmas = mkFileHeaderPragmaCollection m moduleDeclaration = mkModuleDeclaration m module' = m From 08b8ac074ab6afbb11f8cb0b4bea2a201878396c Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 10:49:57 +0900 Subject: [PATCH 13/44] Define `FileHeaderPragma` --- hindent.cabal | 1 + src/HIndent/Ast/FileHeaderPragma.hs | 5 +++++ src/HIndent/Ast/FileHeaderPragma/Collection.hs | 8 +++++--- 3 files changed, 11 insertions(+), 3 deletions(-) create mode 100644 src/HIndent/Ast/FileHeaderPragma.hs diff --git a/hindent.cabal b/hindent.cabal index 2a1e714f0..951637eca 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -37,6 +37,7 @@ library other-modules: HIndent.Applicative HIndent.Ast + HIndent.Ast.FileHeaderPragma HIndent.Ast.FileHeaderPragma.Collection HIndent.Ast.Module HIndent.Ast.Module.Declaration diff --git a/src/HIndent/Ast/FileHeaderPragma.hs b/src/HIndent/Ast/FileHeaderPragma.hs new file mode 100644 index 000000000..a2ca2c1e5 --- /dev/null +++ b/src/HIndent/Ast/FileHeaderPragma.hs @@ -0,0 +1,5 @@ +module HIndent.Ast.FileHeaderPragma + ( FileHeaderPragma + ) where + +data FileHeaderPragma diff --git a/src/HIndent/Ast/FileHeaderPragma/Collection.hs b/src/HIndent/Ast/FileHeaderPragma/Collection.hs index 1e90a6b67..9b13d3eb9 100644 --- a/src/HIndent/Ast/FileHeaderPragma/Collection.hs +++ b/src/HIndent/Ast/FileHeaderPragma/Collection.hs @@ -3,8 +3,10 @@ module HIndent.Ast.FileHeaderPragma.Collection , mkFileHeaderPragmaCollection ) where -data FileHeaderPragmaCollection = - FileHeaderPragmaCollection +import HIndent.Ast.FileHeaderPragma + +newtype FileHeaderPragmaCollection = + FileHeaderPragmaCollection [FileHeaderPragma] mkFileHeaderPragmaCollection :: a -> FileHeaderPragmaCollection -mkFileHeaderPragmaCollection _ = FileHeaderPragmaCollection +mkFileHeaderPragmaCollection _ = FileHeaderPragmaCollection [] From ca4516874c5da49b180fe4398da2ad0f6a902fc0 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 10:59:57 +0900 Subject: [PATCH 14/44] Imprement `Pretty FileHeaderPragmaCollection` --- src/HIndent/Ast/FileHeaderPragma.hs | 18 +++++- .../Ast/FileHeaderPragma/Collection.hs | 57 ++++++++++++++++++- 2 files changed, 72 insertions(+), 3 deletions(-) diff --git a/src/HIndent/Ast/FileHeaderPragma.hs b/src/HIndent/Ast/FileHeaderPragma.hs index a2ca2c1e5..b83b0a2dd 100644 --- a/src/HIndent/Ast/FileHeaderPragma.hs +++ b/src/HIndent/Ast/FileHeaderPragma.hs @@ -1,5 +1,21 @@ module HIndent.Ast.FileHeaderPragma ( FileHeaderPragma + , mkFileHeaderPragma ) where -data FileHeaderPragma +import HIndent.Ast.NodeComments +import HIndent.Pretty +import HIndent.Pretty.Combinators +import HIndent.Pretty.NodeComments + +newtype FileHeaderPragma = + FileHeaderPragma String + +instance CommentExtraction FileHeaderPragma where + nodeComments _ = NodeComments [] [] [] + +instance Pretty FileHeaderPragma where + pretty' (FileHeaderPragma x) = string x + +mkFileHeaderPragma :: String -> FileHeaderPragma +mkFileHeaderPragma = FileHeaderPragma diff --git a/src/HIndent/Ast/FileHeaderPragma/Collection.hs b/src/HIndent/Ast/FileHeaderPragma/Collection.hs index 9b13d3eb9..031f48f46 100644 --- a/src/HIndent/Ast/FileHeaderPragma/Collection.hs +++ b/src/HIndent/Ast/FileHeaderPragma/Collection.hs @@ -1,12 +1,65 @@ +{-# LANGUAGE CPP #-} + module HIndent.Ast.FileHeaderPragma.Collection ( FileHeaderPragmaCollection , mkFileHeaderPragmaCollection ) where +import Data.Bifunctor +import Data.Char +import Data.List +import Data.List.Split +import Data.Maybe +import Generics.SYB import HIndent.Ast.FileHeaderPragma +import HIndent.Ast.NodeComments +import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC +import HIndent.Pragma +import HIndent.Pretty +import HIndent.Pretty.Combinators +import HIndent.Pretty.NodeComments newtype FileHeaderPragmaCollection = FileHeaderPragmaCollection [FileHeaderPragma] -mkFileHeaderPragmaCollection :: a -> FileHeaderPragmaCollection -mkFileHeaderPragmaCollection _ = FileHeaderPragmaCollection [] +instance CommentExtraction FileHeaderPragmaCollection where + nodeComments _ = NodeComments [] [] [] + +instance Pretty FileHeaderPragmaCollection where + pretty' (FileHeaderPragmaCollection xs) = lined $ fmap pretty xs + +mkFileHeaderPragmaCollection :: GHC.HsModule' -> FileHeaderPragmaCollection +mkFileHeaderPragmaCollection = + FileHeaderPragmaCollection . fmap mkFileHeaderPragma . collectPragmas + +-- | This function collects pragma comments from the +-- given module and modifies them into 'String's. +-- +-- A pragma's name is converted to the @SHOUT_CASE@ (e.g., @lAnGuAgE@ -> +-- @LANGUAGE@). +collectPragmas :: GHC.HsModule' -> [String] +collectPragmas = + fmap (uncurry constructPragma) + . mapMaybe extractPragma + . listify isBlockComment + . GHC.getModuleAnn + +-- | This function returns a 'Just' value with the pragma +-- extracted from the passed 'EpaCommentTok' if it has one. Otherwise, it +-- returns a 'Nothing'. +extractPragma :: GHC.EpaCommentTok -> Maybe (String, [String]) +extractPragma (GHC.EpaBlockComment c) = + second (fmap strip . splitOn ",") <$> extractPragmaNameAndElement c + where + strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace +extractPragma _ = Nothing + +-- | Construct a pragma. +constructPragma :: String -> [String] -> String +constructPragma optionOrPragma xs = + "{-# " ++ fmap toUpper optionOrPragma ++ " " ++ intercalate ", " xs ++ " #-}" + +-- | Checks if the given comment is a block one. +isBlockComment :: GHC.EpaCommentTok -> Bool +isBlockComment GHC.EpaBlockComment {} = True +isBlockComment _ = False From ea2a0b829d3b371422ec1bb27df0dea89f35c360 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 11:06:21 +0900 Subject: [PATCH 15/44] `hasPragmas` --- src/HIndent/Ast/FileHeaderPragma/Collection.hs | 4 ++++ src/HIndent/Ast/Module.hs | 8 ++++---- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/src/HIndent/Ast/FileHeaderPragma/Collection.hs b/src/HIndent/Ast/FileHeaderPragma/Collection.hs index 031f48f46..50531741d 100644 --- a/src/HIndent/Ast/FileHeaderPragma/Collection.hs +++ b/src/HIndent/Ast/FileHeaderPragma/Collection.hs @@ -3,6 +3,7 @@ module HIndent.Ast.FileHeaderPragma.Collection ( FileHeaderPragmaCollection , mkFileHeaderPragmaCollection + , hasPragmas ) where import Data.Bifunctor @@ -32,6 +33,9 @@ mkFileHeaderPragmaCollection :: GHC.HsModule' -> FileHeaderPragmaCollection mkFileHeaderPragmaCollection = FileHeaderPragmaCollection . fmap mkFileHeaderPragma . collectPragmas +hasPragmas :: FileHeaderPragmaCollection -> Bool +hasPragmas (FileHeaderPragmaCollection xs) = not $ null xs + -- | This function collects pragma comments from the -- given module and modifies them into 'String's. -- diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 93ee2dacf..0b3f2e83d 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -40,11 +40,11 @@ instance Pretty Module where , hsmodDecls = [] }} | not (pragmaExists m) = pure () - pretty' Module {module' = m} = blanklined printers >> newline + pretty' Module {module' = m, ..} = blanklined printers >> newline where printers = snd <$> filter fst pairs pairs = - [ (pragmaExists m, prettyPragmas m) + [ (hasPragmas pragmas, prettyPragmas m) , (moduleDeclExists m, prettyModuleDecl m) , (importsExist m, prettyImports) , (declsExist m, prettyDecls) @@ -101,11 +101,11 @@ instance Pretty Module where , hsmodDecls = [] }} | not (pragmaExists m) = pure () - pretty' Module {module' = m} = blanklined printers >> newline + pretty' Module {module' = m, ..} = blanklined printers >> newline where printers = snd <$> filter fst pairs pairs = - [ (pragmaExists m, prettyPragmas m) + [ (hasPragmas pragmas, prettyPragmas m) , (moduleDeclExists m, prettyModuleDecl m) , (importsExist m, prettyImports) , (declsExist m, prettyDecls) From b6646a8a078f4bd122d7d2ee928da9e9b7d75adb Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 11:07:13 +0900 Subject: [PATCH 16/44] Use `pretty` --- src/HIndent/Ast/Module.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 0b3f2e83d..846fa8fe7 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -105,7 +105,7 @@ instance Pretty Module where where printers = snd <$> filter fst pairs pairs = - [ (hasPragmas pragmas, prettyPragmas m) + [ (hasPragmas pragmas, pretty pragmas) , (moduleDeclExists m, prettyModuleDecl m) , (importsExist m, prettyImports) , (declsExist m, prettyDecls) From 67b1dd3faf103bc9a9e2caf78946bea59645c8cc Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 11:18:58 +0900 Subject: [PATCH 17/44] Move a function --- src/HIndent/Pragma.hs | 9 ++++++++- src/HIndent/Pretty/Pragma.hs | 7 ------- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/HIndent/Pragma.hs b/src/HIndent/Pragma.hs index 3cf914b2a..4f3a157f7 100644 --- a/src/HIndent/Pragma.hs +++ b/src/HIndent/Pragma.hs @@ -4,10 +4,11 @@ module HIndent.Pragma ( extractPragmasFromCode , extractPragmaNameAndElement - , pragmaRegex + , isPragma ) where import Data.Maybe +import GHC.Hs import GHC.Parser.Lexer import HIndent.Parse import Text.Regex.TDFA hiding (empty) @@ -37,6 +38,12 @@ extractPragmaNameAndElement l Just (name, element) extractPragmaNameAndElement _ = Nothing +-- | This function returns a 'True' if the passed 'EpaCommentTok' is +-- a pragma. Otherwise, it returns a 'False'. +isPragma :: EpaCommentTok -> Bool +isPragma (EpaBlockComment c) = match pragmaRegex c +isPragma _ = False + -- | A regex to match against a pragma. pragmaRegex :: Regex pragmaRegex = diff --git a/src/HIndent/Pretty/Pragma.hs b/src/HIndent/Pretty/Pragma.hs index 1ed4e9bbe..b228da0b3 100644 --- a/src/HIndent/Pretty/Pragma.hs +++ b/src/HIndent/Pretty/Pragma.hs @@ -18,7 +18,6 @@ import HIndent.Pragma import HIndent.Pretty.Combinators.Lineup import HIndent.Pretty.Combinators.String import HIndent.Printer -import Text.Regex.TDFA -- | This function pretty-prints the module's pragmas prettyPragmas :: HsModule' -> Printer () @@ -59,12 +58,6 @@ extractPragma (EpaBlockComment c) = strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace extractPragma _ = Nothing --- | This function returns a 'True' if the passed 'EpaCommentTok' is --- a pragma. Otherwise, it returns a 'False'. -isPragma :: EpaCommentTok -> Bool -isPragma (EpaBlockComment c) = match pragmaRegex c -isPragma _ = False - -- | Construct a pragma. constructPragma :: String -> [String] -> String constructPragma optionOrPragma xs = From f9aeecd03780ae9d68370967145551b25dfe1ce9 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 11:24:15 +0900 Subject: [PATCH 18/44] Remove a function --- src/HIndent/Ast/Module.hs | 2 +- src/HIndent/Pretty/Pragma.hs | 10 +--------- 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 846fa8fe7..d2169d373 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -44,7 +44,7 @@ instance Pretty Module where where printers = snd <$> filter fst pairs pairs = - [ (hasPragmas pragmas, prettyPragmas m) + [ (hasPragmas pragmas, pretty pragmas) , (moduleDeclExists m, prettyModuleDecl m) , (importsExist m, prettyImports) , (declsExist m, prettyDecls) diff --git a/src/HIndent/Pretty/Pragma.hs b/src/HIndent/Pretty/Pragma.hs index b228da0b3..d9132c993 100644 --- a/src/HIndent/Pretty/Pragma.hs +++ b/src/HIndent/Pretty/Pragma.hs @@ -2,8 +2,7 @@ -- | Pretty-printing pragmas module HIndent.Pretty.Pragma - ( prettyPragmas - , pragmaExists + ( pragmaExists , isPragma ) where @@ -15,13 +14,6 @@ import Data.List.Split import Data.Maybe import HIndent.GhcLibParserWrapper.GHC.Hs import HIndent.Pragma -import HIndent.Pretty.Combinators.Lineup -import HIndent.Pretty.Combinators.String -import HIndent.Printer - --- | This function pretty-prints the module's pragmas -prettyPragmas :: HsModule' -> Printer () -prettyPragmas = lined . fmap string . collectPragmas -- | This function returns a 'True' if the module has pragmas. -- Otherwise, it returns a 'False'. From 5ad77156eb573fb33e3eb226242fa653e3bdd5ad Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 11:29:25 +0900 Subject: [PATCH 19/44] Remove a module --- hindent.cabal | 1 - src/HIndent/Ast/Module.hs | 2 +- src/HIndent/Ast/NodeComments.hs | 2 +- .../ModulePreprocessing/CommentRelocation.hs | 7 ++- src/HIndent/Pragma.hs | 52 ++++++++++++++++ src/HIndent/Pretty/NodeComments.hs | 2 +- src/HIndent/Pretty/Pragma.hs | 61 ------------------- 7 files changed, 59 insertions(+), 68 deletions(-) delete mode 100644 src/HIndent/Pretty/Pragma.hs diff --git a/hindent.cabal b/hindent.cabal index 951637eca..17ccaf93d 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -75,7 +75,6 @@ library HIndent.Pretty.Import HIndent.Pretty.Import.Sort HIndent.Pretty.NodeComments - HIndent.Pretty.Pragma HIndent.Pretty.SigBindFamily HIndent.Pretty.Types HIndent.Printer diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index d2169d373..81a501984 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -17,11 +17,11 @@ import HIndent.Ast.NodeComments (NodeComments(..)) import HIndent.Ast.WithComments import HIndent.Config import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC +import HIndent.Pragma import HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.Import import HIndent.Pretty.NodeComments -import HIndent.Pretty.Pragma import HIndent.Pretty.Types import HIndent.Printer diff --git a/src/HIndent/Ast/NodeComments.hs b/src/HIndent/Ast/NodeComments.hs index fb5651612..8f978c748 100644 --- a/src/HIndent/Ast/NodeComments.hs +++ b/src/HIndent/Ast/NodeComments.hs @@ -7,7 +7,7 @@ module HIndent.Ast.NodeComments import qualified GHC.Hs as GHC import qualified GHC.Types.SrcLoc as GHC -import HIndent.Pretty.Pragma +import HIndent.Pragma -- | Comments belonging to an AST node. data NodeComments = NodeComments diff --git a/src/HIndent/ModulePreprocessing/CommentRelocation.hs b/src/HIndent/ModulePreprocessing/CommentRelocation.hs index a87b1d16e..39d0af618 100644 --- a/src/HIndent/ModulePreprocessing/CommentRelocation.hs +++ b/src/HIndent/ModulePreprocessing/CommentRelocation.hs @@ -1,5 +1,6 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs, CPP #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -47,7 +48,7 @@ import GHC.Data.Bag import GHC.Types.SrcLoc import Generics.SYB hiding (GT, typeOf, typeRep) import HIndent.GhcLibParserWrapper.GHC.Hs -import HIndent.Pretty.Pragma +import HIndent.Pragma import HIndent.Pretty.SigBindFamily import Type.Reflection #if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0) @@ -106,7 +107,7 @@ relocateCommentsBeforePragmas m@HsModule {hsmodExt = xmod@XModulePs {hsmodAnn = | otherwise = pure m where startPosOfPragmas = anchor $ getLoc $ head $ priorComments $ comments ann -#else +#else relocateCommentsBeforePragmas :: HsModule -> WithComments HsModule relocateCommentsBeforePragmas m@HsModule {hsmodAnn = ann} | pragmaExists m = do diff --git a/src/HIndent/Pragma.hs b/src/HIndent/Pragma.hs index 4f3a157f7..d644fc9e9 100644 --- a/src/HIndent/Pragma.hs +++ b/src/HIndent/Pragma.hs @@ -4,12 +4,19 @@ module HIndent.Pragma ( extractPragmasFromCode , extractPragmaNameAndElement + , pragmaExists , isPragma ) where +import Data.Bifunctor +import Data.Char +import Data.Generics +import Data.List +import Data.List.Split import Data.Maybe import GHC.Hs import GHC.Parser.Lexer +import HIndent.GhcLibParserWrapper.GHC.Hs import HIndent.Parse import Text.Regex.TDFA hiding (empty) @@ -69,3 +76,48 @@ compOption = , newSyntax = True , lastStarGreedy = True } + +-- | This function returns a 'True' if the module has pragmas. +-- Otherwise, it returns a 'False'. +pragmaExists :: HsModule' -> Bool +pragmaExists = not . null . collectPragmas +-- | This function collects pragma comments from the +-- given module and modifies them into 'String's. +-- +-- A pragma's name is converted to the @SHOUT_CASE@ (e.g., @lAnGuAgE@ -> +-- @LANGUAGE@). +#if MIN_VERSION_ghc_lib_parser(9,6,1) +collectPragmas :: HsModule GhcPs -> [String] +collectPragmas = + fmap (uncurry constructPragma) + . mapMaybe extractPragma + . listify isBlockComment + . hsmodAnn + . hsmodExt +#else +collectPragmas :: HsModule -> [String] +collectPragmas = + fmap (uncurry constructPragma) + . mapMaybe extractPragma + . listify isBlockComment + . hsmodAnn +#endif +-- | This function returns a 'Just' value with the pragma +-- extracted from the passed 'EpaCommentTok' if it has one. Otherwise, it +-- returns a 'Nothing'. +extractPragma :: EpaCommentTok -> Maybe (String, [String]) +extractPragma (EpaBlockComment c) = + second (fmap strip . splitOn ",") <$> extractPragmaNameAndElement c + where + strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace +extractPragma _ = Nothing + +-- | Construct a pragma. +constructPragma :: String -> [String] -> String +constructPragma optionOrPragma xs = + "{-# " ++ fmap toUpper optionOrPragma ++ " " ++ intercalate ", " xs ++ " #-}" + +-- | Checks if the given comment is a block one. +isBlockComment :: EpaCommentTok -> Bool +isBlockComment EpaBlockComment {} = True +isBlockComment _ = False diff --git a/src/HIndent/Pretty/NodeComments.hs b/src/HIndent/Pretty/NodeComments.hs index 39dab9e71..240555d49 100644 --- a/src/HIndent/Pretty/NodeComments.hs +++ b/src/HIndent/Pretty/NodeComments.hs @@ -21,7 +21,7 @@ import GHC.Types.Name.Reader import GHC.Types.SourceText import GHC.Types.SrcLoc import HIndent.Ast.NodeComments -import HIndent.Pretty.Pragma +import HIndent.Pragma import HIndent.Pretty.SigBindFamily import HIndent.Pretty.Types #if MIN_VERSION_ghc_lib_parser(9,6,1) diff --git a/src/HIndent/Pretty/Pragma.hs b/src/HIndent/Pretty/Pragma.hs deleted file mode 100644 index d9132c993..000000000 --- a/src/HIndent/Pretty/Pragma.hs +++ /dev/null @@ -1,61 +0,0 @@ -{-# LANGUAGE CPP #-} - --- | Pretty-printing pragmas -module HIndent.Pretty.Pragma - ( pragmaExists - , isPragma - ) where - -import Data.Bifunctor -import Data.Char -import Data.Generics.Schemes -import Data.List -import Data.List.Split -import Data.Maybe -import HIndent.GhcLibParserWrapper.GHC.Hs -import HIndent.Pragma - --- | This function returns a 'True' if the module has pragmas. --- Otherwise, it returns a 'False'. -pragmaExists :: HsModule' -> Bool -pragmaExists = not . null . collectPragmas --- | This function collects pragma comments from the --- given module and modifies them into 'String's. --- --- A pragma's name is converted to the @SHOUT_CASE@ (e.g., @lAnGuAgE@ -> --- @LANGUAGE@). -#if MIN_VERSION_ghc_lib_parser(9,6,1) -collectPragmas :: HsModule GhcPs -> [String] -collectPragmas = - fmap (uncurry constructPragma) - . mapMaybe extractPragma - . listify isBlockComment - . hsmodAnn - . hsmodExt -#else -collectPragmas :: HsModule -> [String] -collectPragmas = - fmap (uncurry constructPragma) - . mapMaybe extractPragma - . listify isBlockComment - . hsmodAnn -#endif --- | This function returns a 'Just' value with the pragma --- extracted from the passed 'EpaCommentTok' if it has one. Otherwise, it --- returns a 'Nothing'. -extractPragma :: EpaCommentTok -> Maybe (String, [String]) -extractPragma (EpaBlockComment c) = - second (fmap strip . splitOn ",") <$> extractPragmaNameAndElement c - where - strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace -extractPragma _ = Nothing - --- | Construct a pragma. -constructPragma :: String -> [String] -> String -constructPragma optionOrPragma xs = - "{-# " ++ fmap toUpper optionOrPragma ++ " " ++ intercalate ", " xs ++ " #-}" - --- | Checks if the given comment is a block one. -isBlockComment :: EpaCommentTok -> Bool -isBlockComment EpaBlockComment {} = True -isBlockComment _ = False From 22f3f85dce2365e937fc78a7da10f3608db00aa8 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 11:40:06 +0900 Subject: [PATCH 20/44] `ModuleName` --- hindent.cabal | 1 + src/HIndent/Ast/Module.hs | 2 +- src/HIndent/Ast/Module/Declaration.hs | 17 +++++++++++++---- src/HIndent/Ast/Module/Name.hs | 13 +++++++++++++ src/HIndent/Ast/WithComments.hs | 8 ++++++++ 5 files changed, 36 insertions(+), 5 deletions(-) create mode 100644 src/HIndent/Ast/Module/Name.hs diff --git a/hindent.cabal b/hindent.cabal index 17ccaf93d..b47bd5499 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -41,6 +41,7 @@ library HIndent.Ast.FileHeaderPragma.Collection HIndent.Ast.Module HIndent.Ast.Module.Declaration + HIndent.Ast.Module.Name HIndent.Ast.NodeComments HIndent.Ast.WithComments HIndent.ByteString diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 81a501984..394f1d45e 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -27,7 +27,7 @@ import HIndent.Printer data Module = Module { pragmas :: FileHeaderPragmaCollection - , moduleDeclaration :: ModuleDeclaration + , moduleDeclaration :: Maybe ModuleDeclaration , module' :: GHC.HsModule' } diff --git a/src/HIndent/Ast/Module/Declaration.hs b/src/HIndent/Ast/Module/Declaration.hs index a7c5889d8..8c787271f 100644 --- a/src/HIndent/Ast/Module/Declaration.hs +++ b/src/HIndent/Ast/Module/Declaration.hs @@ -1,12 +1,21 @@ +{-# LANGUAGE RecordWildCards #-} + module HIndent.Ast.Module.Declaration ( ModuleDeclaration , mkModuleDeclaration ) where +import HIndent.Ast.Module.Name +import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC -data ModuleDeclaration = - ModuleDeclaration +newtype ModuleDeclaration = ModuleDeclaration + { name :: WithComments ModuleName + } -mkModuleDeclaration :: GHC.HsModule' -> ModuleDeclaration -mkModuleDeclaration _ = ModuleDeclaration +mkModuleDeclaration :: GHC.HsModule' -> Maybe ModuleDeclaration +mkModuleDeclaration GHC.HsModule {..} = + case hsmodName of + Nothing -> Nothing + Just name' -> Just ModuleDeclaration {..} + where name = mkModuleName <$> fromGenLocated name' diff --git a/src/HIndent/Ast/Module/Name.hs b/src/HIndent/Ast/Module/Name.hs new file mode 100644 index 000000000..e891a49fb --- /dev/null +++ b/src/HIndent/Ast/Module/Name.hs @@ -0,0 +1,13 @@ +module HIndent.Ast.Module.Name + ( ModuleName + , mkModuleName + ) where + +import qualified GHC.Unit as GHC +import HIndent.Pretty.Combinators + +newtype ModuleName = + ModuleName String + +mkModuleName :: GHC.ModuleName -> ModuleName +mkModuleName = ModuleName . showOutputable diff --git a/src/HIndent/Ast/WithComments.hs b/src/HIndent/Ast/WithComments.hs index 501028433..5f18a2f69 100644 --- a/src/HIndent/Ast/WithComments.hs +++ b/src/HIndent/Ast/WithComments.hs @@ -2,10 +2,12 @@ module HIndent.Ast.WithComments ( WithComments + , fromGenLocated , fromEpAnn ) where import qualified GHC.Hs as GHC +import qualified GHC.Types.SrcLoc as GHC import HIndent.Ast.NodeComments (NodeComments(..)) import qualified HIndent.Ast.NodeComments as NodeComments import HIndent.Pretty @@ -16,11 +18,17 @@ data WithComments a = WithComments , node :: a } +instance Functor WithComments where + fmap f WithComments {..} = WithComments comments (f node) + instance CommentExtraction (WithComments a) where nodeComments WithComments {..} = comments instance (Pretty a) => Pretty (WithComments a) where pretty' WithComments {..} = pretty' node +fromGenLocated :: (CommentExtraction l) => GHC.GenLocated l a -> WithComments a +fromGenLocated (GHC.L l a) = WithComments (nodeComments l) a + fromEpAnn :: GHC.EpAnn a -> b -> WithComments b fromEpAnn ann = WithComments (NodeComments.fromEpAnn ann) From 510c5f64cbc598f9620c0c17cf1bfa74091ad3ad Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 11:41:40 +0900 Subject: [PATCH 21/44] Exports --- src/HIndent/Ast/Module/Declaration.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/HIndent/Ast/Module/Declaration.hs b/src/HIndent/Ast/Module/Declaration.hs index 8c787271f..f7deefe8a 100644 --- a/src/HIndent/Ast/Module/Declaration.hs +++ b/src/HIndent/Ast/Module/Declaration.hs @@ -9,8 +9,9 @@ import HIndent.Ast.Module.Name import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC -newtype ModuleDeclaration = ModuleDeclaration +data ModuleDeclaration = ModuleDeclaration { name :: WithComments ModuleName + , exports :: Maybe (GHC.LocatedL [GHC.LIE GHC.GhcPs]) } mkModuleDeclaration :: GHC.HsModule' -> Maybe ModuleDeclaration @@ -19,3 +20,4 @@ mkModuleDeclaration GHC.HsModule {..} = Nothing -> Nothing Just name' -> Just ModuleDeclaration {..} where name = mkModuleName <$> fromGenLocated name' + exports = hsmodExports From 64b0be992ba12eebccaa330f62983d1affe820fe Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 11:43:40 +0900 Subject: [PATCH 22/44] `CommentExtraction` --- src/HIndent/Ast/Module/Declaration.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/HIndent/Ast/Module/Declaration.hs b/src/HIndent/Ast/Module/Declaration.hs index f7deefe8a..c78ef9b8d 100644 --- a/src/HIndent/Ast/Module/Declaration.hs +++ b/src/HIndent/Ast/Module/Declaration.hs @@ -6,14 +6,19 @@ module HIndent.Ast.Module.Declaration ) where import HIndent.Ast.Module.Name +import HIndent.Ast.NodeComments import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC +import HIndent.Pretty.NodeComments data ModuleDeclaration = ModuleDeclaration { name :: WithComments ModuleName , exports :: Maybe (GHC.LocatedL [GHC.LIE GHC.GhcPs]) } +instance CommentExtraction ModuleDeclaration where + nodeComments ModuleDeclaration {} = NodeComments [] [] [] + mkModuleDeclaration :: GHC.HsModule' -> Maybe ModuleDeclaration mkModuleDeclaration GHC.HsModule {..} = case hsmodName of From 4857e4f612e9515d2bf0e8af290dc2e1574f11b5 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 11:54:17 +0900 Subject: [PATCH 23/44] `DeprecMessage` --- hindent.cabal | 1 + src/HIndent/Ast/Module/Declaration.hs | 9 ++++++--- src/HIndent/GhcLibParserWrapper/GHC/Hs.hs | 8 ++++++++ .../GHC/Unit/Module/Warnings.hs | 15 +++++++++++++++ 4 files changed, 30 insertions(+), 3 deletions(-) create mode 100644 src/HIndent/GhcLibParserWrapper/GHC/Unit/Module/Warnings.hs diff --git a/hindent.cabal b/hindent.cabal index b47bd5499..19a14cb1a 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -52,6 +52,7 @@ library HIndent.Error HIndent.Fixity HIndent.GhcLibParserWrapper.GHC.Hs + HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings HIndent.Language HIndent.LanguageExtension HIndent.LanguageExtension.Conversion diff --git a/src/HIndent/Ast/Module/Declaration.hs b/src/HIndent/Ast/Module/Declaration.hs index c78ef9b8d..4c205b8e2 100644 --- a/src/HIndent/Ast/Module/Declaration.hs +++ b/src/HIndent/Ast/Module/Declaration.hs @@ -9,10 +9,12 @@ import HIndent.Ast.Module.Name import HIndent.Ast.NodeComments import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC +import qualified HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings as GHC import HIndent.Pretty.NodeComments data ModuleDeclaration = ModuleDeclaration { name :: WithComments ModuleName + , warning :: Maybe (GHC.LocatedP GHC.WarningTxt') , exports :: Maybe (GHC.LocatedL [GHC.LIE GHC.GhcPs]) } @@ -20,9 +22,10 @@ instance CommentExtraction ModuleDeclaration where nodeComments ModuleDeclaration {} = NodeComments [] [] [] mkModuleDeclaration :: GHC.HsModule' -> Maybe ModuleDeclaration -mkModuleDeclaration GHC.HsModule {..} = - case hsmodName of +mkModuleDeclaration m = + case GHC.hsmodName m of Nothing -> Nothing Just name' -> Just ModuleDeclaration {..} where name = mkModuleName <$> fromGenLocated name' - exports = hsmodExports + warning = GHC.getDeprecMessage m + exports = GHC.hsmodExports m diff --git a/src/HIndent/GhcLibParserWrapper/GHC/Hs.hs b/src/HIndent/GhcLibParserWrapper/GHC/Hs.hs index 70e04db6a..15cab13c9 100644 --- a/src/HIndent/GhcLibParserWrapper/GHC/Hs.hs +++ b/src/HIndent/GhcLibParserWrapper/GHC/Hs.hs @@ -6,9 +6,11 @@ module HIndent.GhcLibParserWrapper.GHC.Hs ( module GHC.Hs , HsModule' , getModuleAnn + , getDeprecMessage ) where import GHC.Hs +import HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings -- | The wrapper for `HsModule` #if MIN_VERSION_ghc_lib_parser(9, 6, 1) type HsModule' = HsModule GhcPs @@ -21,3 +23,9 @@ getModuleAnn HsModule {hsmodExt = XModulePs {..}} = hsmodAnn #else getModuleAnn HsModule {..} = hsmodAnn #endif +getDeprecMessage :: HsModule' -> Maybe (LocatedP WarningTxt') +#if MIN_VERSION_ghc_lib_parser(9, 6, 1) +getDeprecMessage HsModule {hsmodExt = XModulePs {..}} = hsmodDeprecMessage +#else +getDeprecMessage HsModule {..} = hsmodDeprecMessage +#endif diff --git a/src/HIndent/GhcLibParserWrapper/GHC/Unit/Module/Warnings.hs b/src/HIndent/GhcLibParserWrapper/GHC/Unit/Module/Warnings.hs new file mode 100644 index 000000000..1807db5d2 --- /dev/null +++ b/src/HIndent/GhcLibParserWrapper/GHC/Unit/Module/Warnings.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings + ( module GHC.Unit.Module.Warnings + , WarningTxt' + ) where + +import GHC.Unit.Module.Warnings +#if MIN_VERSION_ghc_lib_parser(9, 6, 1) +import GHC.Hs + +type WarningTxt' = WarningTxt GhcPs +#else +type WarningTxt' = WarningTxt +#endif From 9c4ae68af3191425c247b9378349f8cfb9914a69 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 11:57:47 +0900 Subject: [PATCH 24/44] Implement `Pretty` --- src/HIndent/Ast/Module/Declaration.hs | 16 ++++++++++++++++ src/HIndent/Ast/Module/Name.hs | 9 +++++++++ 2 files changed, 25 insertions(+) diff --git a/src/HIndent/Ast/Module/Declaration.hs b/src/HIndent/Ast/Module/Declaration.hs index 4c205b8e2..22a37a6a9 100644 --- a/src/HIndent/Ast/Module/Declaration.hs +++ b/src/HIndent/Ast/Module/Declaration.hs @@ -5,12 +5,16 @@ module HIndent.Ast.Module.Declaration , mkModuleDeclaration ) where +import HIndent.Applicative import HIndent.Ast.Module.Name import HIndent.Ast.NodeComments import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import qualified HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings as GHC +import HIndent.Pretty +import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments +import HIndent.Pretty.Types data ModuleDeclaration = ModuleDeclaration { name :: WithComments ModuleName @@ -21,6 +25,18 @@ data ModuleDeclaration = ModuleDeclaration instance CommentExtraction ModuleDeclaration where nodeComments ModuleDeclaration {} = NodeComments [] [] [] +instance Pretty ModuleDeclaration where + pretty' ModuleDeclaration {..} = do + pretty name + whenJust warning $ \x -> do + space + pretty $ fmap ModuleDeprecatedPragma x + whenJust exports $ \xs -> do + newline + indentedBlock $ do + printCommentsAnd xs (vTuple . fmap pretty) + string " where" + mkModuleDeclaration :: GHC.HsModule' -> Maybe ModuleDeclaration mkModuleDeclaration m = case GHC.hsmodName m of diff --git a/src/HIndent/Ast/Module/Name.hs b/src/HIndent/Ast/Module/Name.hs index e891a49fb..9166c9fd5 100644 --- a/src/HIndent/Ast/Module/Name.hs +++ b/src/HIndent/Ast/Module/Name.hs @@ -4,10 +4,19 @@ module HIndent.Ast.Module.Name ) where import qualified GHC.Unit as GHC +import HIndent.Ast.NodeComments +import HIndent.Pretty import HIndent.Pretty.Combinators +import HIndent.Pretty.NodeComments newtype ModuleName = ModuleName String +instance CommentExtraction ModuleName where + nodeComments _ = NodeComments [] [] [] + +instance Pretty ModuleName where + pretty' (ModuleName x) = string "module " >> string x + mkModuleName :: GHC.ModuleName -> ModuleName mkModuleName = ModuleName . showOutputable From 3a29b016924f8f15b961de5b51b048278a05436a Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 11:59:03 +0900 Subject: [PATCH 25/44] Remove a function --- src/HIndent/Ast/Module.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 394f1d45e..f9e44ba5e 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -106,7 +106,7 @@ instance Pretty Module where printers = snd <$> filter fst pairs pairs = [ (hasPragmas pragmas, pretty pragmas) - , (moduleDeclExists m, prettyModuleDecl m) + , (isJust moduleDeclaration, prettyModuleDecl m) , (importsExist m, prettyImports) , (declsExist m, prettyDecls) ] @@ -133,8 +133,6 @@ instance Pretty Module where indentedBlock $ do printCommentsAnd exports (vTuple . fmap pretty) string " where" - moduleDeclExists GHC.HsModule {hsmodName = Nothing} = False - moduleDeclExists _ = True prettyDecls = mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp) $ addDeclSeparator From d6810e605fcca09ad52ced7bd171ec5ed44678be Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:01:14 +0900 Subject: [PATCH 26/44] Use `pretty` --- src/HIndent/Ast/Module.hs | 59 ++++----------------------------------- 1 file changed, 6 insertions(+), 53 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index f9e44ba5e..f5a7e2ff6 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -10,7 +10,6 @@ module HIndent.Ast.Module import Control.Monad.RWS import Data.Maybe import qualified GHC.Types.SrcLoc as GHC -import HIndent.Applicative import HIndent.Ast.FileHeaderPragma.Collection import HIndent.Ast.Module.Declaration import HIndent.Ast.NodeComments (NodeComments(..)) @@ -22,7 +21,6 @@ import HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.Import import HIndent.Pretty.NodeComments -import HIndent.Pretty.Types import HIndent.Printer data Module = Module @@ -45,36 +43,12 @@ instance Pretty Module where printers = snd <$> filter fst pairs pairs = [ (hasPragmas pragmas, pretty pragmas) - , (moduleDeclExists m, prettyModuleDecl m) + , (isJust moduleDeclaration, prettyModuleDecl moduleDeclaration) , (importsExist m, prettyImports) , (declsExist m, prettyDecls) ] - prettyModuleDecl :: GHC.HsModule GHC.GhcPs -> Printer () - prettyModuleDecl GHC.HsModule {hsmodName = Nothing} = - error "The module declaration does not exist." - prettyModuleDecl GHC.HsModule { hsmodName = Just name - , hsmodExports = Nothing - , hsmodExt = GHC.XModulePs {..} - } = do - pretty $ fmap ModuleNameWithPrefix name - whenJust hsmodDeprecMessage $ \x -> do - space - pretty $ fmap ModuleDeprecatedPragma x - string " where" - prettyModuleDecl GHC.HsModule { hsmodName = Just name - , hsmodExports = Just exports - , hsmodExt = GHC.XModulePs {..} - } = do - pretty $ fmap ModuleNameWithPrefix name - whenJust hsmodDeprecMessage $ \x -> do - space - pretty $ fmap ModuleDeprecatedPragma x - newline - indentedBlock $ do - printCommentsAnd exports (vTuple . fmap pretty) - string " where" - moduleDeclExists GHC.HsModule {hsmodName = Nothing} = False - moduleDeclExists _ = True + prettyModuleDecl Nothing = error "The module declaration does not exist." + prettyModuleDecl (Just decl) = pretty decl prettyDecls = mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp) $ addDeclSeparator @@ -106,33 +80,12 @@ instance Pretty Module where printers = snd <$> filter fst pairs pairs = [ (hasPragmas pragmas, pretty pragmas) - , (isJust moduleDeclaration, prettyModuleDecl m) + , (isJust moduleDeclaration, prettyModuleDecl moduleDeclaration) , (importsExist m, prettyImports) , (declsExist m, prettyDecls) ] - prettyModuleDecl GHC.HsModule {hsmodName = Nothing} = - error "The module declaration does not exist." - prettyModuleDecl GHC.HsModule { hsmodName = Just name - , hsmodExports = Nothing - , .. - } = do - pretty $ fmap ModuleNameWithPrefix name - whenJust hsmodDeprecMessage $ \x -> do - space - pretty $ fmap ModuleDeprecatedPragma x - string " where" - prettyModuleDecl GHC.HsModule { hsmodName = Just name - , hsmodExports = Just exports - , .. - } = do - pretty $ fmap ModuleNameWithPrefix name - whenJust hsmodDeprecMessage $ \x -> do - space - pretty $ fmap ModuleDeprecatedPragma x - newline - indentedBlock $ do - printCommentsAnd exports (vTuple . fmap pretty) - string " where" + prettyModuleDecl Nothing = error "The module declaration does not exist." + prettyModuleDecl (Just decl) = pretty decl prettyDecls = mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp) $ addDeclSeparator From 685c27450ca91563e55259842a95bc0994d51468 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:01:58 +0900 Subject: [PATCH 27/44] Remove an unnecessary CPP block --- src/HIndent/Ast/Module.hs | 41 ++------------------------------------- 1 file changed, 2 insertions(+), 39 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index f5a7e2ff6..d02825f19 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -31,44 +31,7 @@ data Module = Module instance CommentExtraction Module where nodeComments Module {} = NodeComments [] [] [] -#if MIN_VERSION_ghc_lib_parser(9,6,1) -instance Pretty Module where - pretty' Module {module' = m@GHC.HsModule { hsmodName = Nothing - , hsmodImports = [] - , hsmodDecls = [] - }} - | not (pragmaExists m) = pure () - pretty' Module {module' = m, ..} = blanklined printers >> newline - where - printers = snd <$> filter fst pairs - pairs = - [ (hasPragmas pragmas, pretty pragmas) - , (isJust moduleDeclaration, prettyModuleDecl moduleDeclaration) - , (importsExist m, prettyImports) - , (declsExist m, prettyDecls) - ] - prettyModuleDecl Nothing = error "The module declaration does not exist." - prettyModuleDecl (Just decl) = pretty decl - prettyDecls = - mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp) - $ addDeclSeparator - $ GHC.hsmodDecls m - addDeclSeparator [] = [] - addDeclSeparator [x] = [(x, Nothing)] - addDeclSeparator (x:xs) = - (x, Just $ declSeparator $ GHC.unLoc x) : addDeclSeparator xs - declSeparator (GHC.SigD _ GHC.TypeSig {}) = newline - declSeparator (GHC.SigD _ GHC.InlineSig {}) = newline - declSeparator (GHC.SigD _ GHC.PatSynSig {}) = newline - declSeparator _ = blankline - declsExist = not . null . GHC.hsmodDecls - prettyImports = importDecls >>= blanklined . fmap outputImportGroup - outputImportGroup = lined . fmap pretty - importDecls = - gets (configSortImports . psConfig) >>= \case - True -> pure $ extractImportsSorted m - False -> pure $ extractImports m -#else + instance Pretty Module where pretty' Module {module' = m@GHC.HsModule { hsmodName = Nothing , hsmodImports = [] @@ -105,7 +68,7 @@ instance Pretty Module where gets (configSortImports . psConfig) >>= \case True -> pure $ extractImportsSorted m False -> pure $ extractImports m -#endif + mkModule :: GHC.HsModule' -> WithComments Module mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module {..} where From f1b4476032c42ab24c18c61b35c86adc746d2a1d Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:04:33 +0900 Subject: [PATCH 28/44] `ImportCollection` --- hindent.cabal | 1 + src/HIndent/Ast/Import/Collection.hs | 10 ++++++++++ src/HIndent/Ast/Module.hs | 3 +++ 3 files changed, 14 insertions(+) create mode 100644 src/HIndent/Ast/Import/Collection.hs diff --git a/hindent.cabal b/hindent.cabal index 19a14cb1a..fec340032 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -39,6 +39,7 @@ library HIndent.Ast HIndent.Ast.FileHeaderPragma HIndent.Ast.FileHeaderPragma.Collection + HIndent.Ast.Import.Collection HIndent.Ast.Module HIndent.Ast.Module.Declaration HIndent.Ast.Module.Name diff --git a/src/HIndent/Ast/Import/Collection.hs b/src/HIndent/Ast/Import/Collection.hs new file mode 100644 index 000000000..4e65b6eb8 --- /dev/null +++ b/src/HIndent/Ast/Import/Collection.hs @@ -0,0 +1,10 @@ +module HIndent.Ast.Import.Collection + ( ImportCollection + , mkImportCollection + ) where + +data ImportCollection = + ImportCollection + +mkImportCollection :: a -> ImportCollection +mkImportCollection _ = ImportCollection diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index d02825f19..e4ba3abec 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -11,6 +11,7 @@ import Control.Monad.RWS import Data.Maybe import qualified GHC.Types.SrcLoc as GHC import HIndent.Ast.FileHeaderPragma.Collection +import HIndent.Ast.Import.Collection import HIndent.Ast.Module.Declaration import HIndent.Ast.NodeComments (NodeComments(..)) import HIndent.Ast.WithComments @@ -26,6 +27,7 @@ import HIndent.Printer data Module = Module { pragmas :: FileHeaderPragmaCollection , moduleDeclaration :: Maybe ModuleDeclaration + , imports :: ImportCollection , module' :: GHC.HsModule' } @@ -74,4 +76,5 @@ mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module {..} where pragmas = mkFileHeaderPragmaCollection m moduleDeclaration = mkModuleDeclaration m + imports = mkImportCollection m module' = m From 08ab09fb80fa6d75d7a89de08f92118a72b9f9ae Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:05:31 +0900 Subject: [PATCH 29/44] `newtype` --- src/HIndent/Ast/Import/Collection.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/HIndent/Ast/Import/Collection.hs b/src/HIndent/Ast/Import/Collection.hs index 4e65b6eb8..81ba0dd82 100644 --- a/src/HIndent/Ast/Import/Collection.hs +++ b/src/HIndent/Ast/Import/Collection.hs @@ -1,10 +1,15 @@ +{-# LANGUAGE RecordWildCards #-} + module HIndent.Ast.Import.Collection ( ImportCollection , mkImportCollection ) where -data ImportCollection = - ImportCollection +import qualified GHC.Hs as GHC +import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC + +newtype ImportCollection = + ImportCollection [GHC.LImportDecl GHC.GhcPs] -mkImportCollection :: a -> ImportCollection -mkImportCollection _ = ImportCollection +mkImportCollection :: GHC.HsModule' -> ImportCollection +mkImportCollection GHC.HsModule {..} = ImportCollection hsmodImports From a47797be090947f024609ae426e61756e2e7867c Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:09:23 +0900 Subject: [PATCH 30/44] `Pretty` --- src/HIndent/Ast/Import/Collection.hs | 22 ++++++++++++++++++++++ src/HIndent/Pretty/Import.hs | 12 ++++++++++++ 2 files changed, 34 insertions(+) diff --git a/src/HIndent/Ast/Import/Collection.hs b/src/HIndent/Ast/Import/Collection.hs index 81ba0dd82..82af8b372 100644 --- a/src/HIndent/Ast/Import/Collection.hs +++ b/src/HIndent/Ast/Import/Collection.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} module HIndent.Ast.Import.Collection @@ -5,11 +6,32 @@ module HIndent.Ast.Import.Collection , mkImportCollection ) where +import Control.Monad.RWS import qualified GHC.Hs as GHC +import HIndent.Ast.NodeComments +import HIndent.Config import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC +import HIndent.Pretty +import HIndent.Pretty.Combinators +import HIndent.Pretty.Import +import HIndent.Pretty.NodeComments +import HIndent.Printer newtype ImportCollection = ImportCollection [GHC.LImportDecl GHC.GhcPs] +instance CommentExtraction ImportCollection where + nodeComments ImportCollection {} = NodeComments [] [] [] + +instance Pretty ImportCollection where + pretty' (ImportCollection xs) = + importDecls >>= blanklined . fmap outputImportGroup + where + outputImportGroup = lined . fmap pretty + importDecls = + gets (configSortImports . psConfig) >>= \case + True -> pure $ extractImportsSorted' xs + False -> pure $ extractImports' xs + mkImportCollection :: GHC.HsModule' -> ImportCollection mkImportCollection GHC.HsModule {..} = ImportCollection hsmodImports diff --git a/src/HIndent/Pretty/Import.hs b/src/HIndent/Pretty/Import.hs index f9cfe6c98..930706ab7 100644 --- a/src/HIndent/Pretty/Import.hs +++ b/src/HIndent/Pretty/Import.hs @@ -5,6 +5,8 @@ module HIndent.Pretty.Import ( importsExist , extractImports , extractImportsSorted + , extractImports' + , extractImportsSorted' , groupImports ) where @@ -21,11 +23,21 @@ importsExist = not . null . hsmodImports extractImports :: HsModule' -> [[LImportDecl GhcPs]] extractImports = groupImports . sortImportsByLocation . hsmodImports +-- | Extracts import declarations from the given module. Adjacent import +-- declarations are grouped as a single list. +extractImports' :: [LImportDecl GhcPs] -> [[LImportDecl GhcPs]] +extractImports' = groupImports . sortImportsByLocation + -- | Extracts import declarations from the given module and sorts them by -- their names. Adjacent import declarations are grouped as a single list. extractImportsSorted :: HsModule' -> [[LImportDecl GhcPs]] extractImportsSorted = fmap sortImportsByName . extractImports +-- | Extracts import declarations from the given module and sorts them by +-- their names. Adjacent import declarations are grouped as a single list. +extractImportsSorted' :: [LImportDecl GhcPs] -> [[LImportDecl GhcPs]] +extractImportsSorted' = fmap sortImportsByName . extractImports' + -- | Combines adjacent import declarations into a single list. groupImports :: [LImportDecl GhcPs] -> [[LImportDecl GhcPs]] groupImports = groupImports' [] From c918e97d6908d30fe67fe776e91262c1c49946d9 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:10:14 +0900 Subject: [PATCH 31/44] Use `pretty` --- src/HIndent/Ast/Module.hs | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index e4ba3abec..4c0f05a12 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -7,7 +7,6 @@ module HIndent.Ast.Module , mkModule ) where -import Control.Monad.RWS import Data.Maybe import qualified GHC.Types.SrcLoc as GHC import HIndent.Ast.FileHeaderPragma.Collection @@ -15,14 +14,12 @@ import HIndent.Ast.Import.Collection import HIndent.Ast.Module.Declaration import HIndent.Ast.NodeComments (NodeComments(..)) import HIndent.Ast.WithComments -import HIndent.Config import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import HIndent.Pragma import HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.Import import HIndent.Pretty.NodeComments -import HIndent.Printer data Module = Module { pragmas :: FileHeaderPragmaCollection @@ -46,7 +43,7 @@ instance Pretty Module where pairs = [ (hasPragmas pragmas, pretty pragmas) , (isJust moduleDeclaration, prettyModuleDecl moduleDeclaration) - , (importsExist m, prettyImports) + , (importsExist m, pretty imports) , (declsExist m, prettyDecls) ] prettyModuleDecl Nothing = error "The module declaration does not exist." @@ -64,12 +61,6 @@ instance Pretty Module where declSeparator (GHC.SigD _ GHC.PatSynSig {}) = newline declSeparator _ = blankline declsExist = not . null . GHC.hsmodDecls - prettyImports = importDecls >>= blanklined . fmap outputImportGroup - outputImportGroup = lined . fmap pretty - importDecls = - gets (configSortImports . psConfig) >>= \case - True -> pure $ extractImportsSorted m - False -> pure $ extractImports m mkModule :: GHC.HsModule' -> WithComments Module mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module {..} From 139c2b3cf571e4e090c2678a03027ee4fc249fd0 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:11:02 +0900 Subject: [PATCH 32/44] `hasImports` --- src/HIndent/Ast/Import/Collection.hs | 4 ++++ src/HIndent/Ast/Module.hs | 3 +-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/HIndent/Ast/Import/Collection.hs b/src/HIndent/Ast/Import/Collection.hs index 82af8b372..dc2a6d3c8 100644 --- a/src/HIndent/Ast/Import/Collection.hs +++ b/src/HIndent/Ast/Import/Collection.hs @@ -4,6 +4,7 @@ module HIndent.Ast.Import.Collection ( ImportCollection , mkImportCollection + , hasImports ) where import Control.Monad.RWS @@ -35,3 +36,6 @@ instance Pretty ImportCollection where mkImportCollection :: GHC.HsModule' -> ImportCollection mkImportCollection GHC.HsModule {..} = ImportCollection hsmodImports + +hasImports :: ImportCollection -> Bool +hasImports (ImportCollection xs) = not $ null xs diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 4c0f05a12..77405f957 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -18,7 +18,6 @@ import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import HIndent.Pragma import HIndent.Pretty import HIndent.Pretty.Combinators -import HIndent.Pretty.Import import HIndent.Pretty.NodeComments data Module = Module @@ -43,7 +42,7 @@ instance Pretty Module where pairs = [ (hasPragmas pragmas, pretty pragmas) , (isJust moduleDeclaration, prettyModuleDecl moduleDeclaration) - , (importsExist m, pretty imports) + , (hasImports imports, pretty imports) , (declsExist m, prettyDecls) ] prettyModuleDecl Nothing = error "The module declaration does not exist." From ec744b6b5bda94abb41071a5cebd70fceb02b4fa Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:15:27 +0900 Subject: [PATCH 33/44] `DeclarationCollection` --- hindent.cabal | 1 + src/HIndent/Ast/Declaration/Collection.hs | 10 ++++++++++ src/HIndent/Ast/Module.hs | 5 ++++- 3 files changed, 15 insertions(+), 1 deletion(-) create mode 100644 src/HIndent/Ast/Declaration/Collection.hs diff --git a/hindent.cabal b/hindent.cabal index fec340032..d984dcc8d 100644 --- a/hindent.cabal +++ b/hindent.cabal @@ -37,6 +37,7 @@ library other-modules: HIndent.Applicative HIndent.Ast + HIndent.Ast.Declaration.Collection HIndent.Ast.FileHeaderPragma HIndent.Ast.FileHeaderPragma.Collection HIndent.Ast.Import.Collection diff --git a/src/HIndent/Ast/Declaration/Collection.hs b/src/HIndent/Ast/Declaration/Collection.hs new file mode 100644 index 000000000..694bab10b --- /dev/null +++ b/src/HIndent/Ast/Declaration/Collection.hs @@ -0,0 +1,10 @@ +module HIndent.Ast.Declaration.Collection + ( DeclarationCollection + , mkDeclarationCollection + ) where + +data DeclarationCollection = + DeclarationCollection + +mkDeclarationCollection :: a -> DeclarationCollection +mkDeclarationCollection _ = DeclarationCollection diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 77405f957..efd872888 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -9,10 +9,11 @@ module HIndent.Ast.Module import Data.Maybe import qualified GHC.Types.SrcLoc as GHC +import HIndent.Ast.Declaration.Collection import HIndent.Ast.FileHeaderPragma.Collection import HIndent.Ast.Import.Collection import HIndent.Ast.Module.Declaration -import HIndent.Ast.NodeComments (NodeComments(..)) +import HIndent.Ast.NodeComments hiding (fromEpAnn) import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import HIndent.Pragma @@ -24,6 +25,7 @@ data Module = Module { pragmas :: FileHeaderPragmaCollection , moduleDeclaration :: Maybe ModuleDeclaration , imports :: ImportCollection + , declarations :: DeclarationCollection , module' :: GHC.HsModule' } @@ -67,4 +69,5 @@ mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module {..} pragmas = mkFileHeaderPragmaCollection m moduleDeclaration = mkModuleDeclaration m imports = mkImportCollection m + declarations = mkDeclarationCollection m module' = m From b860c039544ed3145b3893a2a89d321ad783e0f2 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:16:32 +0900 Subject: [PATCH 34/44] `newtype` --- src/HIndent/Ast/Declaration/Collection.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/HIndent/Ast/Declaration/Collection.hs b/src/HIndent/Ast/Declaration/Collection.hs index 694bab10b..68951beef 100644 --- a/src/HIndent/Ast/Declaration/Collection.hs +++ b/src/HIndent/Ast/Declaration/Collection.hs @@ -1,10 +1,15 @@ +{-# LANGUAGE RecordWildCards #-} + module HIndent.Ast.Declaration.Collection ( DeclarationCollection , mkDeclarationCollection ) where -data DeclarationCollection = - DeclarationCollection +import qualified GHC.Hs as GHC +import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC + +newtype DeclarationCollection = + DeclarationCollection [GHC.LHsDecl GHC.GhcPs] -mkDeclarationCollection :: a -> DeclarationCollection -mkDeclarationCollection _ = DeclarationCollection +mkDeclarationCollection :: GHC.HsModule' -> DeclarationCollection +mkDeclarationCollection GHC.HsModule {..} = DeclarationCollection hsmodDecls From 55a5bc9ab65c22bb355bd5d74aa0f37e8be8026b Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:18:53 +0900 Subject: [PATCH 35/44] Implement `Pretty` --- src/HIndent/Ast/Declaration/Collection.hs | 23 +++++++++++++++++++++++ src/HIndent/Ast/Module.hs | 15 +-------------- 2 files changed, 24 insertions(+), 14 deletions(-) diff --git a/src/HIndent/Ast/Declaration/Collection.hs b/src/HIndent/Ast/Declaration/Collection.hs index 68951beef..98775c397 100644 --- a/src/HIndent/Ast/Declaration/Collection.hs +++ b/src/HIndent/Ast/Declaration/Collection.hs @@ -5,11 +5,34 @@ module HIndent.Ast.Declaration.Collection , mkDeclarationCollection ) where +import Data.Maybe import qualified GHC.Hs as GHC +import qualified GHC.Types.SrcLoc as GHC +import HIndent.Ast.NodeComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC +import HIndent.Pretty +import HIndent.Pretty.Combinators +import HIndent.Pretty.NodeComments newtype DeclarationCollection = DeclarationCollection [GHC.LHsDecl GHC.GhcPs] +instance CommentExtraction DeclarationCollection where + nodeComments DeclarationCollection {} = NodeComments [] [] [] + +instance Pretty DeclarationCollection where + pretty' (DeclarationCollection decls) = + mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp) + $ addDeclSeparator decls + where + addDeclSeparator [] = [] + addDeclSeparator [x] = [(x, Nothing)] + addDeclSeparator (x:xs) = + (x, Just $ declSeparator $ GHC.unLoc x) : addDeclSeparator xs + declSeparator (GHC.SigD _ GHC.TypeSig {}) = newline + declSeparator (GHC.SigD _ GHC.InlineSig {}) = newline + declSeparator (GHC.SigD _ GHC.PatSynSig {}) = newline + declSeparator _ = blankline + mkDeclarationCollection :: GHC.HsModule' -> DeclarationCollection mkDeclarationCollection GHC.HsModule {..} = DeclarationCollection hsmodDecls diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index efd872888..88e68e6ac 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -8,7 +8,6 @@ module HIndent.Ast.Module ) where import Data.Maybe -import qualified GHC.Types.SrcLoc as GHC import HIndent.Ast.Declaration.Collection import HIndent.Ast.FileHeaderPragma.Collection import HIndent.Ast.Import.Collection @@ -45,22 +44,10 @@ instance Pretty Module where [ (hasPragmas pragmas, pretty pragmas) , (isJust moduleDeclaration, prettyModuleDecl moduleDeclaration) , (hasImports imports, pretty imports) - , (declsExist m, prettyDecls) + , (declsExist m, pretty declarations) ] prettyModuleDecl Nothing = error "The module declaration does not exist." prettyModuleDecl (Just decl) = pretty decl - prettyDecls = - mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp) - $ addDeclSeparator - $ GHC.hsmodDecls m - addDeclSeparator [] = [] - addDeclSeparator [x] = [(x, Nothing)] - addDeclSeparator (x:xs) = - (x, Just $ declSeparator $ GHC.unLoc x) : addDeclSeparator xs - declSeparator (GHC.SigD _ GHC.TypeSig {}) = newline - declSeparator (GHC.SigD _ GHC.InlineSig {}) = newline - declSeparator (GHC.SigD _ GHC.PatSynSig {}) = newline - declSeparator _ = blankline declsExist = not . null . GHC.hsmodDecls mkModule :: GHC.HsModule' -> WithComments Module From 6ab0db3dcfc7b8d7bbf59587c4139542fee10956 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:19:54 +0900 Subject: [PATCH 36/44] `hasDeclarations` --- src/HIndent/Ast/Declaration/Collection.hs | 4 ++++ src/HIndent/Ast/Module.hs | 5 ++--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/HIndent/Ast/Declaration/Collection.hs b/src/HIndent/Ast/Declaration/Collection.hs index 98775c397..eadb42626 100644 --- a/src/HIndent/Ast/Declaration/Collection.hs +++ b/src/HIndent/Ast/Declaration/Collection.hs @@ -3,6 +3,7 @@ module HIndent.Ast.Declaration.Collection ( DeclarationCollection , mkDeclarationCollection + , hasDeclarations ) where import Data.Maybe @@ -36,3 +37,6 @@ instance Pretty DeclarationCollection where mkDeclarationCollection :: GHC.HsModule' -> DeclarationCollection mkDeclarationCollection GHC.HsModule {..} = DeclarationCollection hsmodDecls + +hasDeclarations :: DeclarationCollection -> Bool +hasDeclarations (DeclarationCollection xs) = not $ null xs diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 88e68e6ac..110212803 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -37,18 +37,17 @@ instance Pretty Module where , hsmodDecls = [] }} | not (pragmaExists m) = pure () - pretty' Module {module' = m, ..} = blanklined printers >> newline + pretty' Module {..} = blanklined printers >> newline where printers = snd <$> filter fst pairs pairs = [ (hasPragmas pragmas, pretty pragmas) , (isJust moduleDeclaration, prettyModuleDecl moduleDeclaration) , (hasImports imports, pretty imports) - , (declsExist m, pretty declarations) + , (hasDeclarations declarations, pretty declarations) ] prettyModuleDecl Nothing = error "The module declaration does not exist." prettyModuleDecl (Just decl) = pretty decl - declsExist = not . null . GHC.hsmodDecls mkModule :: GHC.HsModule' -> WithComments Module mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module {..} From 7bc2686cb2562cc6f0b81d92e7fadfb616dc30ea Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:22:58 +0900 Subject: [PATCH 37/44] Merge two branches --- src/HIndent/Ast/Module.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 110212803..c6fdc474f 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -15,7 +15,6 @@ import HIndent.Ast.Module.Declaration import HIndent.Ast.NodeComments hiding (fromEpAnn) import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC -import HIndent.Pragma import HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments @@ -32,13 +31,15 @@ instance CommentExtraction Module where nodeComments Module {} = NodeComments [] [] [] instance Pretty Module where - pretty' Module {module' = m@GHC.HsModule { hsmodName = Nothing - , hsmodImports = [] - , hsmodDecls = [] - }} - | not (pragmaExists m) = pure () - pretty' Module {..} = blanklined printers >> newline + pretty' Module {..} + | isEmpty = pure () + | otherwise = blanklined printers >> newline where + isEmpty = + not (hasPragmas pragmas) + && isNothing moduleDeclaration + && not (hasImports imports) + && not (hasDeclarations declarations) printers = snd <$> filter fst pairs pairs = [ (hasPragmas pragmas, pretty pragmas) From c5119cc567f41e5e190e1e8243c5043128575af3 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:23:20 +0900 Subject: [PATCH 38/44] Remove an unused member --- src/HIndent/Ast/Module.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index c6fdc474f..8004b58e7 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -24,7 +24,6 @@ data Module = Module , moduleDeclaration :: Maybe ModuleDeclaration , imports :: ImportCollection , declarations :: DeclarationCollection - , module' :: GHC.HsModule' } instance CommentExtraction Module where @@ -57,4 +56,3 @@ mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module {..} moduleDeclaration = mkModuleDeclaration m imports = mkImportCollection m declarations = mkDeclarationCollection m - module' = m From 47170139825144b4cac5ebd28ed482b8c65b093e Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:27:28 +0900 Subject: [PATCH 39/44] No `error` --- src/HIndent/Ast/Module.hs | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 8004b58e7..34371706c 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -39,15 +39,17 @@ instance Pretty Module where && isNothing moduleDeclaration && not (hasImports imports) && not (hasDeclarations declarations) - printers = snd <$> filter fst pairs - pairs = - [ (hasPragmas pragmas, pretty pragmas) - , (isJust moduleDeclaration, prettyModuleDecl moduleDeclaration) - , (hasImports imports, pretty imports) - , (hasDeclarations declarations, pretty declarations) - ] - prettyModuleDecl Nothing = error "The module declaration does not exist." - prettyModuleDecl (Just decl) = pretty decl + printers = + catMaybes + [ toMaybe (hasPragmas pragmas) (pretty pragmas) + , fmap pretty moduleDeclaration + , toMaybe (hasImports imports) (pretty imports) + , toMaybe (hasDeclarations declarations) (pretty declarations) + ] + toMaybe cond x = + if cond + then Just x + else Nothing mkModule :: GHC.HsModule' -> WithComments Module mkModule m = fromEpAnn (GHC.getModuleAnn m) $ Module {..} From b8451fcf476c39e8827f79e80102c1892320870d Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:30:36 +0900 Subject: [PATCH 40/44] Pointfree --- src/HIndent.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/HIndent.hs b/src/HIndent.hs index 557adbf37..c320b4049 100644 --- a/src/HIndent.hs +++ b/src/HIndent.hs @@ -182,5 +182,5 @@ testAst x = -- | Print the module. prettyPrint :: Config -> HsModule' -> Builder -prettyPrint config m = - runPrinterStyle config (pretty $ mkModule $ modifyASTForPrettyPrinting m) +prettyPrint config = + runPrinterStyle config . pretty . mkModule . modifyASTForPrettyPrinting From 93fd481c0e60057b74612bf54d4ab4dba4e8511b Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:31:53 +0900 Subject: [PATCH 41/44] Remove an unnecessary line --- src/HIndent/Ast.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/HIndent/Ast.hs b/src/HIndent/Ast.hs index 35a22a55b..3e6897b5d 100644 --- a/src/HIndent/Ast.hs +++ b/src/HIndent/Ast.hs @@ -10,7 +10,6 @@ -- -- Therefore, this module defines a custom AST for HIndent, allowing flexibility -- to adapt to changes in GHC's AST across different versions. --- module HIndent.Ast ( mkModule ) where From 56cc65cff9a0cd6b952c0cec71bdae5374edcf3b Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 12:33:52 +0900 Subject: [PATCH 42/44] Remove an unnecessary CPP block --- src/HIndent/Pragma.hs | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/src/HIndent/Pragma.hs b/src/HIndent/Pragma.hs index d644fc9e9..20f93e42c 100644 --- a/src/HIndent/Pragma.hs +++ b/src/HIndent/Pragma.hs @@ -81,27 +81,19 @@ compOption = -- Otherwise, it returns a 'False'. pragmaExists :: HsModule' -> Bool pragmaExists = not . null . collectPragmas + -- | This function collects pragma comments from the -- given module and modifies them into 'String's. -- -- A pragma's name is converted to the @SHOUT_CASE@ (e.g., @lAnGuAgE@ -> -- @LANGUAGE@). -#if MIN_VERSION_ghc_lib_parser(9,6,1) -collectPragmas :: HsModule GhcPs -> [String] -collectPragmas = - fmap (uncurry constructPragma) - . mapMaybe extractPragma - . listify isBlockComment - . hsmodAnn - . hsmodExt -#else -collectPragmas :: HsModule -> [String] +collectPragmas :: HsModule' -> [String] collectPragmas = fmap (uncurry constructPragma) . mapMaybe extractPragma . listify isBlockComment - . hsmodAnn -#endif + . getModuleAnn + -- | This function returns a 'Just' value with the pragma -- extracted from the passed 'EpaCommentTok' if it has one. Otherwise, it -- returns a 'Nothing'. From 2eeb0a6d32cb4337f0c2c3197f6362585f180edd Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 13:00:41 +0900 Subject: [PATCH 43/44] Make hlint happy --- src/HIndent/Ast/Module.hs | 1 - src/HIndent/Pretty.hs | 1 - 2 files changed, 2 deletions(-) diff --git a/src/HIndent/Ast/Module.hs b/src/HIndent/Ast/Module.hs index 34371706c..f5e89c868 100644 --- a/src/HIndent/Ast/Module.hs +++ b/src/HIndent/Ast/Module.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} module HIndent.Ast.Module diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs index a58ad2b95..9811df31d 100644 --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} From 638190640ab6756f01bff98608873d1d17f9a8d4 Mon Sep 17 00:00:00 2001 From: Hiroki Tokunaga Date: Tue, 27 Feb 2024 14:10:43 +0900 Subject: [PATCH 44/44] Fix a compile error --- src/HIndent/GhcLibParserWrapper/GHC/Unit/Module/Warnings.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/HIndent/GhcLibParserWrapper/GHC/Unit/Module/Warnings.hs b/src/HIndent/GhcLibParserWrapper/GHC/Unit/Module/Warnings.hs index 1807db5d2..72e4f73f1 100644 --- a/src/HIndent/GhcLibParserWrapper/GHC/Unit/Module/Warnings.hs +++ b/src/HIndent/GhcLibParserWrapper/GHC/Unit/Module/Warnings.hs @@ -6,7 +6,7 @@ module HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings ) where import GHC.Unit.Module.Warnings -#if MIN_VERSION_ghc_lib_parser(9, 6, 1) +#if MIN_VERSION_ghc_lib_parser(9, 4, 1) import GHC.Hs type WarningTxt' = WarningTxt GhcPs