Skip to content

Commit

Permalink
Remove the Pretty instance for RdrName
Browse files Browse the repository at this point in the history
  • Loading branch information
toku-sa-n committed Jul 5, 2024
1 parent 067f2fb commit 0efa332
Show file tree
Hide file tree
Showing 25 changed files with 230 additions and 153 deletions.
12 changes: 8 additions & 4 deletions src/HIndent/Ast/Declaration/Annotation/Provenance.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,15 +3,17 @@ module HIndent.Ast.Declaration.Annotation.Provenance
, mkProvenance
) where

import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data Provenance
= Value (GHC.LIdP GHC.GhcPs)
| Type (GHC.LIdP GHC.GhcPs)
= Value (WithComments PrefixName)
| Type (WithComments PrefixName)
| Module

instance CommentExtraction Provenance where
Expand All @@ -25,6 +27,8 @@ instance Pretty Provenance where
pretty' Module = string "module"

mkProvenance :: GHC.AnnProvenance GHC.GhcPs -> Provenance
mkProvenance (GHC.ValueAnnProvenance x) = Value x
mkProvenance (GHC.TypeAnnProvenance x) = Type x
mkProvenance (GHC.ValueAnnProvenance x) =
Value $ fromGenLocated $ fmap mkPrefixName x
mkProvenance (GHC.TypeAnnProvenance x) =
Type $ fromGenLocated $ fmap mkPrefixName x
mkProvenance GHC.ModuleAnnProvenance = Module
6 changes: 4 additions & 2 deletions src/HIndent/Ast/Declaration/Annotation/Role.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@ module HIndent.Ast.Declaration.Annotation.Role
, mkRoleAnnotation
) where

import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.Role
import HIndent.Ast.WithComments
Expand All @@ -14,7 +15,7 @@ import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data RoleAnnotation = RoleAnnotation
{ name :: GHC.LIdP GHC.GhcPs
{ name :: WithComments PrefixName
, roles :: [WithComments (Maybe Role)]
}

Expand All @@ -28,6 +29,7 @@ instance Pretty RoleAnnotation where
++ fmap (`prettyWith` maybe (string "_") pretty) roles

mkRoleAnnotation :: GHC.RoleAnnotDecl GHC.GhcPs -> RoleAnnotation
mkRoleAnnotation (GHC.RoleAnnotDecl _ name rs) = RoleAnnotation {..}
mkRoleAnnotation (GHC.RoleAnnotDecl _ nm rs) = RoleAnnotation {..}
where
name = fromGenLocated $ fmap mkPrefixName nm
roles = fmap (fmap (fmap mkRole) . fromGenLocated) rs
11 changes: 8 additions & 3 deletions src/HIndent/Ast/Declaration/Bind.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ module HIndent.Ast.Declaration.Bind
) where

import HIndent.Ast.Name.Infix
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
Expand Down Expand Up @@ -46,9 +47,13 @@ instance Pretty Bind where
string "pattern "
case parameters of
GHC.InfixCon l r ->
spaced [pretty l, pretty $ fmap mkInfixName name, pretty r]
GHC.PrefixCon _ [] -> pretty name
_ -> spaced [pretty name, pretty parameters]
spaced
[ pretty $ fmap mkPrefixName l
, pretty $ fmap mkInfixName name
, pretty $ fmap mkPrefixName r
]
GHC.PrefixCon _ [] -> pretty $ fmap mkPrefixName name
_ -> spaced [pretty $ fmap mkPrefixName name, pretty parameters]
spacePrefixed [pretty direction, pretty $ fmap PatInsidePatDecl definition]
case direction of
GHC.ExplicitBidirectional matches -> do
Expand Down
11 changes: 8 additions & 3 deletions src/HIndent/Ast/Declaration/Class/FunctionalDependency.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,15 +5,17 @@ module HIndent.Ast.Declaration.Class.FunctionalDependency
, mkFunctionalDependency
) where

import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data FunctionalDependency = FunctionalDependency
{ from :: [GHC.LIdP GHC.GhcPs]
, to :: [GHC.LIdP GHC.GhcPs]
{ from :: [WithComments PrefixName]
, to :: [WithComments PrefixName]
}

instance CommentExtraction FunctionalDependency where
Expand All @@ -24,4 +26,7 @@ instance Pretty FunctionalDependency where
spaced $ fmap pretty from ++ [string "->"] ++ fmap pretty to

mkFunctionalDependency :: GHC.FunDep GHC.GhcPs -> FunctionalDependency
mkFunctionalDependency (GHC.FunDep _ from to) = FunctionalDependency {..}
mkFunctionalDependency (GHC.FunDep _ f t) = FunctionalDependency {..}
where
from = fmap (fromGenLocated . fmap mkPrefixName) f
to = fmap (fromGenLocated . fmap mkPrefixName) t
13 changes: 7 additions & 6 deletions src/HIndent/Ast/Declaration/Class/NameAndTypeVariables.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ module HIndent.Ast.Declaration.Class.NameAndTypeVariables

import qualified GHC.Types.Fixity as GHC
import HIndent.Ast.Name.Infix
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.Type.Variable
import HIndent.Ast.WithComments
Expand All @@ -17,12 +18,12 @@ import HIndent.Pretty.NodeComments

data NameAndTypeVariables
= Prefix
{ name :: GHC.LIdP GHC.GhcPs
{ pName :: WithComments PrefixName -- Using `name` in both `Prefix` and `Infix` causes a type conflict.
, typeVariables :: [WithComments TypeVariable]
}
| Infix
{ left :: WithComments TypeVariable
, name :: GHC.LIdP GHC.GhcPs
, iName :: WithComments InfixName
, right :: WithComments TypeVariable
, remains :: [WithComments TypeVariable]
}
Expand All @@ -32,16 +33,16 @@ instance CommentExtraction NameAndTypeVariables where
nodeComments Infix {} = NodeComments [] [] []

instance Pretty NameAndTypeVariables where
pretty' Prefix {..} = spaced $ pretty name : fmap pretty typeVariables
pretty' Prefix {..} = spaced $ pretty pName : fmap pretty typeVariables
pretty' Infix {..} = do
parens $ spaced [pretty left, pretty $ fmap mkInfixName name, pretty right]
parens $ spaced [pretty left, pretty iName, pretty right]
spacePrefixed $ fmap pretty remains

mkNameAndTypeVariables :: GHC.TyClDecl GHC.GhcPs -> Maybe NameAndTypeVariables
mkNameAndTypeVariables GHC.ClassDecl {tcdFixity = GHC.Prefix, ..} =
Just Prefix {..}
where
name = tcdLName
pName = fromGenLocated $ fmap mkPrefixName tcdLName
typeVariables =
fmap mkTypeVariable . fromGenLocated <$> GHC.hsq_explicit tcdTyVars
mkNameAndTypeVariables GHC.ClassDecl { tcdFixity = GHC.Infix
Expand All @@ -50,7 +51,7 @@ mkNameAndTypeVariables GHC.ClassDecl { tcdFixity = GHC.Infix
} = Just Infix {..}
where
left = mkTypeVariable <$> fromGenLocated h
name = tcdLName
iName = fromGenLocated $ fmap mkInfixName tcdLName
right = mkTypeVariable <$> fromGenLocated t
remains = fmap (fmap mkTypeVariable . fromGenLocated) xs
mkNameAndTypeVariables _ = Nothing
11 changes: 7 additions & 4 deletions src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,9 +19,10 @@ import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
#if MIN_VERSION_ghc_lib_parser(9, 6, 0)
import qualified Data.List.NonEmpty as NE
import HIndent.Ast.Name.Prefix
#endif
data GADTConstructor = GADTConstructor
{ names :: [WithComments (GHC.IdP GHC.GhcPs)]
{ names :: [WithComments PrefixName]
, bindings :: Maybe (WithComments [WithComments TypeVariable])
, context :: Maybe (WithComments Context)
, signature :: ConstructorSignature
Expand Down Expand Up @@ -79,10 +80,12 @@ mkGADTConstructor decl@GHC.ConDeclGADT {..} = Just $ GADTConstructor {..}
context = fmap (fmap mkContext . fromGenLocated) con_mb_cxt
mkGADTConstructor _ = Nothing

getNames :: GHC.ConDecl GHC.GhcPs -> Maybe [WithComments (GHC.IdP GHC.GhcPs)]
getNames :: GHC.ConDecl GHC.GhcPs -> Maybe [WithComments PrefixName]
#if MIN_VERSION_ghc_lib_parser(9, 6, 0)
getNames GHC.ConDeclGADT {..} = Just $ NE.toList $ fmap fromGenLocated con_names
getNames GHC.ConDeclGADT {..} =
Just $ NE.toList $ fmap (fromGenLocated . fmap mkPrefixName) con_names
#else
getNames GHC.ConDeclGADT {..} = Just $ fmap fromGenLocated con_names
getNames GHC.ConDeclGADT {..} =
Just $ fmap (fromGenLocated . fmap mkPrefixName) con_names
#endif
getNames _ = Nothing
22 changes: 12 additions & 10 deletions src/HIndent/Ast/Declaration/Data/Haskell98/Constructor/Body.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ module HIndent.Ast.Declaration.Data.Haskell98.Constructor.Body

import HIndent.Ast.Declaration.Data.Record.Field
import HIndent.Ast.Name.Infix
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
Expand All @@ -17,16 +18,16 @@ import HIndent.Pretty.NodeComments

data Haskell98ConstructorBody
= Infix
{ name :: GHC.LIdP GHC.GhcPs
{ iName :: WithComments InfixName -- Using `name` in all constructors causes a type clash
, left :: GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)
, right :: GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)
}
| Prefix
{ name :: GHC.LIdP GHC.GhcPs
{ pName :: WithComments PrefixName
, types :: [GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)]
}
| Record
{ name :: GHC.LIdP GHC.GhcPs
{ rName :: WithComments PrefixName
, records :: WithComments [WithComments RecordField]
}

Expand All @@ -36,30 +37,31 @@ instance CommentExtraction Haskell98ConstructorBody where
nodeComments Record {} = NodeComments [] [] []

instance Pretty Haskell98ConstructorBody where
pretty' Infix {..} =
spaced [pretty left, pretty $ fmap mkInfixName name, pretty right]
pretty' Prefix {..} = pretty name >> hor <-|> ver
pretty' Infix {..} = spaced [pretty left, pretty iName, pretty right]
pretty' Prefix {..} = pretty pName >> hor <-|> ver
where
hor = spacePrefixed $ fmap pretty types
ver = indentedBlock $ newlinePrefixed $ fmap pretty types
pretty' Record {..} = do
pretty name
pretty rName
prettyWith records $ \r ->
newline >> indentedBlock (vFields $ fmap pretty r)

mkHaskell98ConstructorBody ::
GHC.ConDecl GHC.GhcPs -> Maybe Haskell98ConstructorBody
mkHaskell98ConstructorBody GHC.ConDeclH98 { con_args = GHC.InfixCon left right
, ..
} = Just Infix {name = con_name, ..}
} = Just Infix {..}
where
iName = fromGenLocated $ fmap mkInfixName con_name
mkHaskell98ConstructorBody GHC.ConDeclH98 {con_args = GHC.PrefixCon _ types, ..} =
Just Prefix {..}
where
name = con_name
pName = fromGenLocated $ fmap mkPrefixName con_name
mkHaskell98ConstructorBody GHC.ConDeclH98 {con_args = GHC.RecCon rs, ..} =
Just Record {..}
where
name = con_name
rName = fromGenLocated $ fmap mkPrefixName con_name
records =
fromGenLocated $ fmap (fmap (fmap mkRecordField . fromGenLocated)) rs
mkHaskell98ConstructorBody GHC.ConDeclGADT {} = Nothing
Expand Down
5 changes: 3 additions & 2 deletions src/HIndent/Ast/Declaration/Data/Header.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ module HIndent.Ast.Declaration.Data.Header
import HIndent.Applicative
import HIndent.Ast.Context
import HIndent.Ast.Declaration.Data.NewOrData
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.Type.Variable
import HIndent.Ast.WithComments
Expand All @@ -18,7 +19,7 @@ import HIndent.Pretty.NodeComments

data Header = Header
{ newOrData :: NewOrData
, name :: WithComments (GHC.IdP GHC.GhcPs)
, name :: WithComments PrefixName
, context :: Maybe (WithComments Context)
, typeVariables :: [WithComments TypeVariable]
}
Expand All @@ -39,7 +40,7 @@ mkHeader GHC.DataDecl {tcdDataDefn = defn@GHC.HsDataDefn {..}, ..} =
where
newOrData = mkNewOrData defn
context = fmap (fmap mkContext . fromGenLocated) dd_ctxt
name = fromGenLocated tcdLName
name = fromGenLocated $ fmap mkPrefixName tcdLName
typeVariables =
fmap mkTypeVariable . fromGenLocated <$> GHC.hsq_explicit tcdTyVars
mkHeader _ = Nothing
5 changes: 3 additions & 2 deletions src/HIndent/Ast/Declaration/Family/Data.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ import Control.Monad
import qualified GHC.Types.Basic as GHC
import qualified GHC.Types.SrcLoc as GHC
import HIndent.Applicative
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments hiding (fromEpAnn)
import HIndent.Ast.Type
import HIndent.Ast.Type.Variable
Expand All @@ -20,7 +21,7 @@ import HIndent.Pretty.NodeComments

data DataFamily = DataFamily
{ isTopLevel :: Bool
, name :: GHC.LIdP GHC.GhcPs
, name :: WithComments PrefixName
, typeVariables :: [WithComments TypeVariable]
, signature :: Maybe (WithComments Type)
}
Expand All @@ -46,7 +47,7 @@ mkDataFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..}
case fdTopLevel of
GHC.TopLevel -> True
GHC.NotTopLevel -> False
name = fdLName
name = fromGenLocated $ fmap mkPrefixName fdLName
typeVariables = fmap (fmap mkTypeVariable . fromGenLocated) hsq_explicit
signature =
case GHC.unLoc fdResultSig of
Expand Down
5 changes: 3 additions & 2 deletions src/HIndent/Ast/Declaration/Family/Type.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ import qualified GHC.Types.Basic as GHC
import HIndent.Applicative
import HIndent.Ast.Declaration.Family.Type.Injectivity
import HIndent.Ast.Declaration.Family.Type.ResultSignature
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments hiding (fromEpAnn)
import HIndent.Ast.Type.Variable
import HIndent.Ast.WithComments
Expand All @@ -20,7 +21,7 @@ import HIndent.Pretty.NodeComments

data TypeFamily = TypeFamily
{ isTopLevel :: Bool
, name :: GHC.LIdP GHC.GhcPs
, name :: WithComments PrefixName
, typeVariables :: [WithComments TypeVariable]
, signature :: WithComments ResultSignature
, injectivity :: Maybe (WithComments Injectivity)
Expand Down Expand Up @@ -50,7 +51,7 @@ mkTypeFamily GHC.FamilyDecl {fdTyVars = GHC.HsQTvs {..}, ..}
case fdTopLevel of
GHC.TopLevel -> True
GHC.NotTopLevel -> False
name = fdLName
name = fromGenLocated $ fmap mkPrefixName fdLName
typeVariables = fmap (fmap mkTypeVariable . fromGenLocated) hsq_explicit
signature = mkResultSignature <$> fromGenLocated fdResultSig
injectivity = fmap (fmap mkInjectivity . fromGenLocated) fdInjectivityAnn
Expand Down
11 changes: 8 additions & 3 deletions src/HIndent/Ast/Declaration/Family/Type/Injectivity.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,15 +5,17 @@ module HIndent.Ast.Declaration.Family.Type.Injectivity
, mkInjectivity
) where

import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data Injectivity = Injectivity
{ from :: GHC.LIdP GHC.GhcPs
, to :: [GHC.LIdP GHC.GhcPs]
{ from :: WithComments PrefixName
, to :: [WithComments PrefixName]
}

instance CommentExtraction Injectivity where
Expand All @@ -23,4 +25,7 @@ instance Pretty Injectivity where
pretty' Injectivity {..} = spaced $ pretty from : string "->" : fmap pretty to

mkInjectivity :: GHC.InjectivityAnn GHC.GhcPs -> Injectivity
mkInjectivity (GHC.InjectivityAnn _ from to) = Injectivity {..}
mkInjectivity (GHC.InjectivityAnn _ f t) = Injectivity {..}
where
from = fromGenLocated $ fmap mkPrefixName f
to = fmap (fromGenLocated . fmap mkPrefixName) t
Loading

0 comments on commit 0efa332

Please sign in to comment.