diff --git a/src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs b/src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs index 37e5c4f58..1f5df9ff1 100644 --- a/src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs +++ b/src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs @@ -11,6 +11,7 @@ import qualified GHC.Types.SrcLoc as GHC import HIndent.Ast.Context import HIndent.Ast.Declaration.Data.GADT.Constructor.Signature import HIndent.Ast.NodeComments +import HIndent.Ast.Type.Variable import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import {-# SOURCE #-} HIndent.Pretty @@ -21,8 +22,7 @@ import qualified Data.List.NonEmpty as NE #endif data GADTConstructor = GADTConstructor { names :: [WithComments (GHC.IdP GHC.GhcPs)] - , forallNeeded :: Bool - , bindings :: WithComments (GHC.HsOuterSigTyVarBndrs GHC.GhcPs) + , bindings :: Maybe (WithComments [WithComments TypeVariable]) , context :: Maybe (WithComments Context) , signature :: ConstructorSignature } @@ -38,18 +38,22 @@ instance Pretty GADTConstructor where hor = string " :: " |=> body ver = newline >> indentedBlock (string ":: " |=> body) body = - case (forallNeeded, context) of - (True, Just ctx) -> withForallCtx ctx - (True, Nothing) -> withForallOnly - (False, Just ctx) -> withCtxOnly ctx - (False, Nothing) -> noForallCtx - withForallCtx ctx = do - pretty bindings + case (bindings, context) of + (Just bs, Just ctx) -> withForallCtx bs ctx + (Just bs, Nothing) -> withForallOnly bs + (Nothing, Just ctx) -> withCtxOnly ctx + (Nothing, Nothing) -> noForallCtx + withForallCtx bs ctx = do + string "forall" + prettyWith bs (spacePrefixed . fmap pretty) + dot (space >> pretty ctx) <-|> (newline >> pretty ctx) newline prefixed "=> " $ prettyVertically signature - withForallOnly = do - pretty bindings + withForallOnly bs = do + string "forall" + prettyWith bs (spacePrefixed . fmap pretty) + dot (space >> prettyHorizontally signature) <-|> (newline >> prettyVertically signature) withCtxOnly ctx = @@ -61,11 +65,15 @@ mkGADTConstructor :: GHC.ConDecl GHC.GhcPs -> Maybe GADTConstructor mkGADTConstructor decl@GHC.ConDeclGADT {..} = Just $ GADTConstructor {..} where names = fromMaybe (error "Couldn't get names.") $ getNames decl - bindings = fromGenLocated con_bndrs - forallNeeded = - case GHC.unLoc con_bndrs of - GHC.HsOuterImplicit {} -> False - GHC.HsOuterExplicit {} -> True + bindings = + case con_bndrs of + GHC.L _ GHC.HsOuterImplicit {} -> Nothing + GHC.L l GHC.HsOuterExplicit {..} -> + Just + $ fromGenLocated + $ fmap + (fmap (fmap mkTypeVariable . fromGenLocated)) + (GHC.L l hso_bndrs) signature = fromMaybe (error "Couldn't get signature.") $ mkConstructorSignature decl context = fmap (fmap mkContext . fromGenLocated) con_mb_cxt diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs index fa007a028..e0245a9b0 100644 --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -1685,14 +1685,6 @@ instance Pretty GHC.SrcStrictness where pretty' GHC.SrcLazy = string "~" pretty' GHC.SrcStrict = string "!" pretty' GHC.NoSrcStrict = pure () - -instance Pretty (GHC.HsOuterSigTyVarBndrs GHC.GhcPs) where - pretty' GHC.HsOuterImplicit {} = pure () - pretty' GHC.HsOuterExplicit {..} = do - string "forall" - spacePrefixed - $ fmap (pretty . fmap mkTypeVariable . fromGenLocated) hso_bndrs - dot #if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty GHC.FieldLabelString where pretty' = output diff --git a/src/HIndent/Pretty.hs-boot b/src/HIndent/Pretty.hs-boot index 1cc61795f..b1ed1a336 100644 --- a/src/HIndent/Pretty.hs-boot +++ b/src/HIndent/Pretty.hs-boot @@ -8,7 +8,6 @@ module HIndent.Pretty ) where import Data.Void -import qualified GHC.Core.Type as GHC import qualified GHC.Types.Basic as GHC import qualified GHC.Types.Name.Reader as GHC import qualified GHC.Types.SourceText as GHC @@ -44,8 +43,6 @@ instance Pretty instance Pretty GHC.RdrName -instance Pretty (GHC.HsOuterTyVarBndrs GHC.Specificity GHc.GhcPs) - instance Pretty SigBindFamily instance Pretty InfixOp