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

Avoid using showOutputable #900

Merged
merged 1 commit into from
May 18, 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
12 changes: 5 additions & 7 deletions src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ import HIndent.Pretty.NodeComments
import qualified Data.List.NonEmpty as NE
#endif
data GADTConstructor = GADTConstructor
{ names :: [WithComments String]
{ names :: [WithComments (GHC.IdP GHC.GhcPs)]
, forallNeeded :: Bool
, bindings :: WithComments (GHC.HsOuterSigTyVarBndrs GHC.GhcPs)
, context :: Maybe (WithComments Context)
Expand All @@ -32,7 +32,7 @@ instance CommentExtraction GADTConstructor where

instance Pretty GADTConstructor where
pretty' (GADTConstructor {..}) = do
hCommaSep $ fmap (`prettyWith` string) names
hCommaSep $ fmap (`prettyWith` pretty) names
hor <-|> ver
where
hor = string " :: " |=> body
Expand Down Expand Up @@ -71,12 +71,10 @@ mkGADTConstructor decl@GHC.ConDeclGADT {..} = Just $ GADTConstructor {..}
context = fmap (fmap mkContext . fromGenLocated) con_mb_cxt
mkGADTConstructor _ = Nothing

getNames :: GHC.ConDecl GHC.GhcPs -> Maybe [WithComments String]
getNames :: GHC.ConDecl GHC.GhcPs -> Maybe [WithComments (GHC.IdP GHC.GhcPs)]
#if MIN_VERSION_ghc_lib_parser(9, 6, 0)
getNames GHC.ConDeclGADT {..} =
Just $ NE.toList $ fmap (fmap showOutputable . fromGenLocated) con_names
getNames GHC.ConDeclGADT {..} = Just $ NE.toList $ fmap fromGenLocated con_names
#else
getNames GHC.ConDeclGADT {..} =
Just $ fmap (fmap showOutputable . fromGenLocated) con_names
getNames GHC.ConDeclGADT {..} = Just $ fmap fromGenLocated con_names
#endif
getNames _ = Nothing
6 changes: 3 additions & 3 deletions src/HIndent/Ast/Declaration/Family/Data.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ import HIndent.Pretty.NodeComments

data DataFamily = DataFamily
{ isTopLevel :: Bool
, name :: String
, name :: GHC.LIdP GHC.GhcPs
, typeVariables :: [WithComments TypeVariable]
, signature :: Maybe (WithComments Type)
}
Expand All @@ -32,7 +32,7 @@ instance Pretty DataFamily where
pretty' DataFamily {..} = do
string "data "
when isTopLevel $ string "family "
string name
pretty name
spacePrefixed $ fmap pretty typeVariables
whenJust signature $ \sig -> space >> pretty sig

Expand All @@ -46,7 +46,7 @@ mkDataFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..}
case fdTopLevel of
GHC.TopLevel -> True
GHC.NotTopLevel -> False
name = showOutputable fdLName
name = fdLName
typeVariables = fmap (fmap mkTypeVariable . fromGenLocated) hsq_explicit
signature =
case GHC.unLoc fdResultSig of
Expand Down
6 changes: 3 additions & 3 deletions src/HIndent/Ast/Declaration/Family/Type.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ import HIndent.Pretty.NodeComments

data TypeFamily = TypeFamily
{ isTopLevel :: Bool
, name :: String
, name :: GHC.LIdP GHC.GhcPs
, typeVariables :: [WithComments TypeVariable]
, signature :: WithComments ResultSignature
, injectivity :: Maybe (WithComments Injectivity)
Expand All @@ -34,7 +34,7 @@ instance Pretty TypeFamily where
pretty' TypeFamily {..} = do
string "type "
when isTopLevel $ string "family "
string name
pretty name
spacePrefixed $ fmap pretty typeVariables
pretty signature
whenJust injectivity $ \x -> string " | " >> pretty x
Expand All @@ -50,7 +50,7 @@ mkTypeFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..}
case fdTopLevel of
GHC.TopLevel -> True
GHC.NotTopLevel -> False
name = showOutputable fdLName
name = fdLName
typeVariables = fmap (fmap mkTypeVariable . fromGenLocated) hsq_explicit
signature = mkResultSignature <$> fromGenLocated fdResultSig
injectivity = fmap (fmap mkInjectivity . fromGenLocated) fdInjectivityAnn
Expand Down
27 changes: 12 additions & 15 deletions src/HIndent/Ast/Import.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ module HIndent.Ast.Import
import Control.Monad
import Data.Function
import Data.List
import qualified GHC.Types.SourceText as GHC
import qualified GHC.Unit as GHC
import HIndent.Applicative
import HIndent.Ast.Import.Entry.Collection
Expand All @@ -27,16 +28,16 @@ data QualificationPosition
deriving (Eq)

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

data Import = Import
{ moduleName :: String
{ moduleName :: GHC.XRec GHC.GhcPs GHC.ModuleName
, isSafe :: Bool
, isBoot :: Bool
, qualification :: Maybe Qualification
, packageName :: Maybe String
, packageName :: Maybe GHC.StringLiteral
, importEntries :: Maybe (WithComments ImportEntryCollection)
}

Expand All @@ -49,19 +50,19 @@ instance Pretty Import where
when isBoot $ string "{-# SOURCE #-} "
when isSafe $ string "safe "
when (fmap position qualification == Just Pre) $ string "qualified "
whenJust packageName $ \name -> string name >> space
string moduleName
whenJust packageName $ \name -> pretty name >> space
pretty moduleName
when (fmap position qualification == Just Post) $ string " qualified"
case qualification of
Just Qualification {qualifiedAs = Just name} ->
string " as " >> string name
string " as " >> pretty name
_ -> pure ()
whenJust importEntries pretty

mkImport :: GHC.ImportDecl GHC.GhcPs -> Import
mkImport decl@GHC.ImportDecl {..} = Import {..}
where
moduleName = showOutputable ideclName
moduleName = ideclName
isSafe = ideclSafe
isBoot = ideclSource == GHC.IsBoot
qualification =
Expand All @@ -72,22 +73,18 @@ mkImport decl@GHC.ImportDecl {..} = Import {..}
(_, Nothing, GHC.QualifiedPost) ->
Just Qualification {qualifiedAs = Nothing, position = Post}
(_, Just name, GHC.QualifiedPre) ->
Just
Qualification
{qualifiedAs = Just $ showOutputable name, position = Pre}
Just Qualification {qualifiedAs = Just name, position = Pre}
(_, Just name, GHC.QualifiedPost) ->
Just
Qualification
{qualifiedAs = Just $ showOutputable name, position = Post}
packageName = showOutputable <$> GHC.getPackageName decl
Just Qualification {qualifiedAs = Just name, position = Post}
packageName = GHC.getPackageName decl
importEntries = mkImportEntryCollection decl

sortByName :: [WithComments Import] -> [WithComments Import]
sortByName = fmap sortExplicitImportsInDecl . sortByModuleName

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

-- | This function sorts explicit imports in the given import declaration
-- by their names.
Expand Down
51 changes: 31 additions & 20 deletions src/HIndent/Ast/Import/Entry.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Import.Entry
Expand All @@ -15,32 +16,38 @@ import HIndent.Ast.WithComments
import HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
data ImportEntry
= SingleIdentifier String
= SingleIdentifier (GHC.LIEWrappedName GHC.GhcPs)
| WithSpecificConstructors
{ name :: String
, constructors :: [String]
{ name :: GHC.LIEWrappedName GHC.GhcPs
, constructors :: [GHC.LIEWrappedName GHC.GhcPs]
}
| WithAllConstructors String

| WithAllConstructors (GHC.LIEWrappedName GHC.GhcPs)
#else
data ImportEntry
= SingleIdentifier (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))
| WithSpecificConstructors
{ name :: GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)
, constructors :: [GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)]
}
| WithAllConstructors (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))
#endif
instance CommentExtraction ImportEntry where
nodeComments _ = NodeComments [] [] []

instance Pretty ImportEntry where
pretty' (SingleIdentifier wrapped) = string wrapped
pretty' (WithAllConstructors wrapped) = string wrapped >> string "(..)"
pretty' (SingleIdentifier wrapped) = pretty wrapped
pretty' (WithAllConstructors wrapped) = pretty wrapped >> string "(..)"
pretty' WithSpecificConstructors {..} =
string name >> hFillingTuple (fmap string constructors)
pretty name >> hFillingTuple (fmap pretty constructors)

mkImportEntry :: GHC.IE GHC.GhcPs -> ImportEntry
mkImportEntry (GHC.IEVar _ name) = SingleIdentifier $ showOutputable name
mkImportEntry (GHC.IEThingAbs _ name) = SingleIdentifier $ showOutputable name
mkImportEntry (GHC.IEThingAll _ name) =
WithAllConstructors $ showOutputable name
mkImportEntry (GHC.IEThingWith _ name _ xs) =
WithSpecificConstructors
{name = showOutputable name, constructors = fmap showOutputable xs}
mkImportEntry (GHC.IEVar _ name) = SingleIdentifier name
mkImportEntry (GHC.IEThingAbs _ name) = SingleIdentifier name
mkImportEntry (GHC.IEThingAll _ name) = WithAllConstructors name
mkImportEntry (GHC.IEThingWith _ name _ constructors) =
WithSpecificConstructors {..}
mkImportEntry _ = undefined

sortVariantsAndExplicitImports ::
Expand All @@ -53,7 +60,8 @@ sortVariants :: WithComments ImportEntry -> WithComments ImportEntry
sortVariants = fmap f
where
f WithSpecificConstructors {..} =
WithSpecificConstructors {constructors = sort constructors, ..}
WithSpecificConstructors
{constructors = sortBy (compare `on` showOutputable) constructors, ..}
f x = x

-- | This function sorts the given explicit imports by their names.
Expand All @@ -62,11 +70,14 @@ sortExplicitImports = sortBy (compareImportEntities `on` getNode)

-- | This function compares two import declarations by their module names.
compareImportEntities :: ImportEntry -> ImportEntry -> Ordering
compareImportEntities = compareIdentifier `on` getModuleName

compareImportEntities = compareIdentifier `on` showOutputable . getModuleName
-- | This function returns a 'Just' value with the module name extracted
-- from the import declaration. Otherwise, it returns a 'Nothing'.
getModuleName :: ImportEntry -> String
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
getModuleName :: ImportEntry -> GHC.LIEWrappedName GHC.GhcPs
#else
getModuleName :: ImportEntry -> GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)
#endif
getModuleName (SingleIdentifier wrapped) = wrapped
getModuleName (WithAllConstructors wrapped) = wrapped
getModuleName (WithSpecificConstructors wrapped _) = wrapped
Expand Down
47 changes: 29 additions & 18 deletions src/HIndent/Ast/Module/Export/Entry.hs
Original file line number Diff line number Diff line change
@@ -1,43 +1,54 @@
{-# LANGUAGE CPP #-}

module HIndent.Ast.Module.Export.Entry
( ExportEntry
, mkExportEntry
) where

import GHC.Stack
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Unit 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

#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
data ExportEntry
= SingleIdentifier String
| WithSpecificConstructors String [String]
| WithAllConstructors String
| ByModule String

= SingleIdentifier (GHC.LIEWrappedName GHC.GhcPs)
| WithSpecificConstructors
(GHC.LIEWrappedName GHC.GhcPs)
[GHC.LIEWrappedName GHC.GhcPs]
| WithAllConstructors (GHC.LIEWrappedName GHC.GhcPs)
| ByModule (GHC.GenLocated GHC.SrcSpanAnnA GHC.ModuleName)
#else
data ExportEntry
= SingleIdentifier (GHC.LIEWrappedName (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)
#endif
instance CommentExtraction ExportEntry where
nodeComments SingleIdentifier {} = NodeComments [] [] []
nodeComments WithSpecificConstructors {} = NodeComments [] [] []
nodeComments WithAllConstructors {} = NodeComments [] [] []
nodeComments ByModule {} = NodeComments [] [] []

instance Pretty ExportEntry where
pretty' (SingleIdentifier s) = string s
pretty' (WithSpecificConstructors s xs) = string s >> hTuple (fmap string xs)
pretty' (WithAllConstructors s) = string s >> string "(..)"
pretty' (ByModule s) = string "module " >> string s
pretty' (SingleIdentifier s) = pretty s
pretty' (WithSpecificConstructors s xs) = pretty s >> hTuple (fmap pretty xs)
pretty' (WithAllConstructors s) = pretty s >> string "(..)"
pretty' (ByModule s) = string "module " >> pretty s

mkExportEntry :: GHC.IE GHC.GhcPs -> ExportEntry
mkExportEntry (GHC.IEVar _ name) = SingleIdentifier $ showOutputable name
mkExportEntry (GHC.IEThingAbs _ name) = SingleIdentifier $ showOutputable name
mkExportEntry (GHC.IEThingAll _ name) =
WithAllConstructors $ showOutputable name
mkExportEntry (GHC.IEVar _ name) = SingleIdentifier name
mkExportEntry (GHC.IEThingAbs _ name) = SingleIdentifier name
mkExportEntry (GHC.IEThingAll _ name) = WithAllConstructors name
mkExportEntry (GHC.IEThingWith _ name _ constructors) =
WithSpecificConstructors
(showOutputable name)
(fmap showOutputable constructors)
mkExportEntry (GHC.IEModuleContents _ name) = ByModule $ showOutputable name
WithSpecificConstructors name constructors
mkExportEntry (GHC.IEModuleContents _ name) = ByModule name
mkExportEntry GHC.IEGroup {} = neverAppears
mkExportEntry GHC.IEDoc {} = neverAppears
mkExportEntry GHC.IEDocNamed {} = neverAppears
Expand Down
2 changes: 1 addition & 1 deletion src/HIndent/Ast/Module/Name.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,4 +19,4 @@ instance Pretty ModuleName where
pretty' (ModuleName x) = string "module " >> string x

mkModuleName :: GHC.ModuleName -> ModuleName
mkModuleName = ModuleName . showOutputable
mkModuleName = ModuleName . GHC.moduleNameString
Loading
Loading