Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use WithComments instead of GHC's types #959

Merged
merged 1 commit into from
Sep 15, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions src/HIndent/Ast/Declaration/Family/Type.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ data TypeFamily = TypeFamily
, typeVariables :: [WithComments TypeVariable]
, signature :: WithComments ResultSignature
, injectivity :: Maybe (WithComments Injectivity)
, equations :: Maybe [GHC.LTyFamInstEqn GHC.GhcPs]
, equations :: Maybe [WithComments (GHC.TyFamInstEqn GHC.GhcPs)]
}

instance CommentExtraction TypeFamily where
Expand Down Expand Up @@ -60,4 +60,4 @@ mkTypeFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..}
GHC.DataFamily -> error "Not a TypeFamily"
GHC.OpenTypeFamily -> Nothing
GHC.ClosedTypeFamily Nothing -> Just []
GHC.ClosedTypeFamily (Just xs) -> Just xs
GHC.ClosedTypeFamily (Just xs) -> Just $ fmap fromGenLocated xs
17 changes: 11 additions & 6 deletions src/HIndent/Ast/Import.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,12 +28,12 @@ data QualificationPosition
deriving (Eq)

data Qualification = Qualification
{ qualifiedAs :: Maybe (GHC.XRec GHC.GhcPs GHC.ModuleName)
{ qualifiedAs :: Maybe (WithComments GHC.ModuleName)
, position :: QualificationPosition
} deriving (Eq)

data Import = Import
{ moduleName :: GHC.XRec GHC.GhcPs GHC.ModuleName
{ moduleName :: WithComments GHC.ModuleName
, isSafe :: Bool
, isBoot :: Bool
, qualification :: Maybe Qualification
Expand Down Expand Up @@ -62,7 +62,7 @@ instance Pretty Import where
mkImport :: GHC.ImportDecl GHC.GhcPs -> Import
mkImport decl@GHC.ImportDecl {..} = Import {..}
where
moduleName = ideclName
moduleName = fromGenLocated ideclName
isSafe = ideclSafe
isBoot = ideclSource == GHC.IsBoot
qualification =
Expand All @@ -73,9 +73,13 @@ mkImport decl@GHC.ImportDecl {..} = Import {..}
(_, Nothing, GHC.QualifiedPost) ->
Just Qualification {qualifiedAs = Nothing, position = Post}
(_, Just name, GHC.QualifiedPre) ->
Just Qualification {qualifiedAs = Just name, position = Pre}
Just
Qualification
{qualifiedAs = Just $ fromGenLocated name, position = Pre}
(_, Just name, GHC.QualifiedPost) ->
Just Qualification {qualifiedAs = Just name, position = Post}
Just
Qualification
{qualifiedAs = Just $ fromGenLocated name, position = Post}
packageName = GHC.getPackageName decl
importEntries = mkImportEntryCollection decl

Expand All @@ -84,7 +88,8 @@ sortByName = fmap sortExplicitImportsInDecl . sortByModuleName

-- | This function sorts import declarations by their module names.
sortByModuleName :: [WithComments Import] -> [WithComments Import]
sortByModuleName = sortBy (compare `on` showOutputable . moduleName . getNode)
sortByModuleName =
sortBy (compare `on` showOutputable . getNode . moduleName . getNode)

-- | This function sorts explicit imports in the given import declaration
-- by their names.
Expand Down
46 changes: 26 additions & 20 deletions src/HIndent/Ast/Module/Export/Entry.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,29 +6,29 @@ module HIndent.Ast.Module.Export.Entry
) where

import GHC.Stack
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Unit as GHC
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
data ExportEntry
= SingleIdentifier (GHC.LIEWrappedName GHC.GhcPs)
= SingleIdentifier (WithComments (GHC.IEWrappedName GHC.GhcPs))
| WithSpecificConstructors
(GHC.LIEWrappedName GHC.GhcPs)
[GHC.LIEWrappedName GHC.GhcPs]
| WithAllConstructors (GHC.LIEWrappedName GHC.GhcPs)
| ByModule (GHC.GenLocated GHC.SrcSpanAnnA GHC.ModuleName)
(WithComments (GHC.IEWrappedName GHC.GhcPs))
[WithComments (GHC.IEWrappedName GHC.GhcPs)]
| WithAllConstructors (WithComments (GHC.IEWrappedName GHC.GhcPs))
| ByModule (WithComments GHC.ModuleName)
#else
data ExportEntry
= SingleIdentifier (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))
= SingleIdentifier (WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs)))
| WithSpecificConstructors
(GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))
[GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)]
| WithAllConstructors (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))
| ByModule (GHC.GenLocated GHC.SrcSpanAnnA GHC.ModuleName)
(WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs)))
[WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs))]
| WithAllConstructors (WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs)))
| ByModule (WithComments GHC.ModuleName)
#endif
instance CommentExtraction ExportEntry where
nodeComments SingleIdentifier {} = NodeComments [] [] []
Expand All @@ -44,19 +44,25 @@ instance Pretty ExportEntry where

mkExportEntry :: GHC.IE GHC.GhcPs -> ExportEntry
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
mkExportEntry (GHC.IEVar _ name _) = SingleIdentifier name
mkExportEntry (GHC.IEThingAbs _ name _) = SingleIdentifier name
mkExportEntry (GHC.IEThingAll _ name _) = WithAllConstructors name
mkExportEntry (GHC.IEVar _ name _) = SingleIdentifier $ fromGenLocated name
mkExportEntry (GHC.IEThingAbs _ name _) = SingleIdentifier $ fromGenLocated name
mkExportEntry (GHC.IEThingAll _ name _) =
WithAllConstructors $ fromGenLocated name
mkExportEntry (GHC.IEThingWith _ name _ constructors _) =
WithSpecificConstructors name constructors
WithSpecificConstructors
(fromGenLocated name)
(fmap fromGenLocated constructors)
#else
mkExportEntry (GHC.IEVar _ name) = SingleIdentifier name
mkExportEntry (GHC.IEThingAbs _ name) = SingleIdentifier name
mkExportEntry (GHC.IEThingAll _ name) = WithAllConstructors name
mkExportEntry (GHC.IEVar _ name) = SingleIdentifier $ fromGenLocated name
mkExportEntry (GHC.IEThingAbs _ name) = SingleIdentifier $ fromGenLocated name
mkExportEntry (GHC.IEThingAll _ name) =
WithAllConstructors $ fromGenLocated name
mkExportEntry (GHC.IEThingWith _ name _ constructors) =
WithSpecificConstructors name constructors
WithSpecificConstructors
(fromGenLocated name)
(fmap fromGenLocated constructors)
#endif
mkExportEntry (GHC.IEModuleContents _ name) = ByModule name
mkExportEntry (GHC.IEModuleContents _ name) = ByModule $ fromGenLocated name
mkExportEntry GHC.IEGroup {} = neverAppears
mkExportEntry GHC.IEDoc {} = neverAppears
mkExportEntry GHC.IEDocNamed {} = neverAppears
Expand Down
2 changes: 1 addition & 1 deletion src/HIndent/Ast/NodeComments.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ data NodeComments = NodeComments
{ commentsBefore :: [GHC.LEpaComment]
, commentsOnSameLine :: [GHC.LEpaComment]
, commentsAfter :: [GHC.LEpaComment]
}
} deriving (Eq)

instance Semigroup NodeComments where
x <> y =
Expand Down
2 changes: 1 addition & 1 deletion src/HIndent/Ast/WithComments.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ import HIndent.Printer
data WithComments a = WithComments
{ comments :: NodeComments
, node :: a
} deriving (Foldable, Traversable)
} deriving (Foldable, Traversable, Eq)

instance Functor WithComments where
fmap f WithComments {..} = WithComments comments (f node)
Expand Down
Loading