Skip to content

Commit

Permalink
Remove the Pretty instance for HsOuterSigTyVarBndrs
Browse files Browse the repository at this point in the history
  • Loading branch information
toku-sa-n committed Jun 5, 2024
1 parent 1e4e4c0 commit 86bb2e7
Show file tree
Hide file tree
Showing 3 changed files with 24 additions and 27 deletions.
40 changes: 24 additions & 16 deletions src/HIndent/Ast/Declaration/Data/GADT/Constructor.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
}
Expand All @@ -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 =
Expand All @@ -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
Expand Down
8 changes: 0 additions & 8 deletions src/HIndent/Pretty.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1693,14 +1693,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
Expand Down
3 changes: 0 additions & 3 deletions src/HIndent/Pretty.hs-boot
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -46,8 +45,6 @@ instance Pretty GHC.RdrName

instance Pretty (GHC.ConDeclField GHC.GhcPs)

instance Pretty (GHC.HsOuterTyVarBndrs GHC.Specificity GHc.GhcPs)

instance Pretty SigBindFamily

instance Pretty InfixOp
Expand Down

0 comments on commit 86bb2e7

Please sign in to comment.