Implement DefaultDeclaration

hindent.cabal

@@ -55,6 +55,7 @@ library
       HIndent.Ast.Declaration.Data.Haskell98.Constructor.Body
       HIndent.Ast.Declaration.Data.Header
       HIndent.Ast.Declaration.Data.NewOrData
+      HIndent.Ast.Declaration.Default
       HIndent.Ast.Declaration.Family.Data
       HIndent.Ast.Declaration.Family.Type
       HIndent.Ast.Declaration.Family.Type.Injectivity

src/HIndent/Ast/Declaration.hs

@@ -11,6 +11,7 @@ import Data.Maybe
 import HIndent.Ast.Declaration.Bind
 import HIndent.Ast.Declaration.Class
 import HIndent.Ast.Declaration.Data
+import HIndent.Ast.Declaration.Default
 import HIndent.Ast.Declaration.Family.Data
 import HIndent.Ast.Declaration.Family.Type
 import HIndent.Ast.Declaration.Instance.Class
@@ -38,7 +39,7 @@ data Declaration
   | Bind Bind
   | Signature Signature
   | StandaloneKindSignature StandaloneKind
-  | DefDecl (GHC.DefaultDecl GHC.GhcPs)
+  | Default DefaultDeclaration
   | ForDecl (GHC.ForeignDecl GHC.GhcPs)
   | WarningDecl (GHC.WarnDecls GHC.GhcPs)
   | AnnDecl (GHC.AnnDecl GHC.GhcPs)
@@ -59,7 +60,7 @@ instance CommentExtraction Declaration where
   nodeComments Bind {} = NodeComments [] [] []
   nodeComments Signature {} = NodeComments [] [] []
   nodeComments StandaloneKindSignature {} = NodeComments [] [] []
-  nodeComments DefDecl {} = NodeComments [] [] []
+  nodeComments Default {} = NodeComments [] [] []
   nodeComments ForDecl {} = NodeComments [] [] []
   nodeComments WarningDecl {} = NodeComments [] [] []
   nodeComments AnnDecl {} = NodeComments [] [] []
@@ -80,7 +81,7 @@ instance Pretty Declaration where
   pretty' (Bind x) = pretty x
   pretty' (Signature x) = pretty x
   pretty' (StandaloneKindSignature x) = pretty x
-  pretty' (DefDecl x) = pretty x
+  pretty' (Default x) = pretty x
   pretty' (ForDecl x) = pretty x
   pretty' (WarningDecl x) = pretty x
   pretty' (AnnDecl x) = pretty x
@@ -107,7 +108,7 @@ mkDeclaration (GHC.DerivD _ x) = StandAloneDeriving $ mkStandAloneDeriving x
 mkDeclaration (GHC.ValD _ x) = Bind $ mkBind x
 mkDeclaration (GHC.SigD _ x) = Signature $ mkSignature x
 mkDeclaration (GHC.KindSigD _ x) = StandaloneKindSignature $ mkStandaloneKind x
-mkDeclaration (GHC.DefD _ x) = DefDecl x
+mkDeclaration (GHC.DefD _ x) = Default $ mkDefaultDeclaration x
 mkDeclaration (GHC.ForD _ x) = ForDecl x
 mkDeclaration (GHC.WarningD _ x) = WarningDecl x
 mkDeclaration (GHC.AnnD _ x) = AnnDecl x

src/HIndent/Ast/Declaration/Default.hs

@@ -0,0 +1,23 @@
+module HIndent.Ast.Declaration.Default
+  ( DefaultDeclaration
+  , mkDefaultDeclaration
+  ) where
+
+import qualified GHC.Hs as GHC
+import HIndent.Ast.NodeComments
+import {-# SOURCE #-} HIndent.Pretty
+import HIndent.Pretty.Combinators
+import HIndent.Pretty.NodeComments
+
+newtype DefaultDeclaration =
+  DefaultDeclaration [GHC.LHsType GHC.GhcPs]
+
+instance CommentExtraction DefaultDeclaration where
+  nodeComments DefaultDeclaration {} = NodeComments [] [] []
+
+instance Pretty DefaultDeclaration where
+  pretty' (DefaultDeclaration xs) =
+    spaced [string "default", hTuple $ fmap pretty xs]
+
+mkDefaultDeclaration :: GHC.DefaultDecl GHC.GhcPs -> DefaultDeclaration
+mkDefaultDeclaration (GHC.DefaultDecl _ xs) = DefaultDeclaration xs

src/HIndent/Pretty.hs

@@ -58,7 +58,7 @@
 import qualified Language.Haskell.GhclibParserEx.GHC.Hs.Expr as GHC
 import Text.Show.Unicode
 #if MIN_VERSION_ghc_lib_parser(9,6,1)
 import qualified Data.Foldable as NonEmpty
 import qualified GHC.Core.DataCon as GHC
 #endif
 #if !MIN_VERSION_ghc_lib_parser(9,6,1)
@@ -548,7 +548,7 @@
 prettyMatchExpr GHC.Match {m_ctxt = GHC.LambdaExpr, ..} = do
   string "\\"
   unless (null m_pats)
     $ case GHC.unLoc $ head m_pats of
         GHC.LazyPat {} -> space
         GHC.BangPat {} -> space
         _ -> return ()
@@ -587,7 +587,7 @@
 prettyMatchProc GHC.Match {m_ctxt = GHC.LambdaExpr, ..} = do
   string "\\"
   unless (null m_pats)
     $ case GHC.unLoc $ head m_pats of
         GHC.LazyPat {} -> space
         GHC.BangPat {} -> space
         _ -> return ()
@@ -1231,7 +1231,7 @@
   pretty' (GHC.DctMulti _ ts) = hvTuple $ fmap pretty ts
 
 instance Pretty GHC.OverlapMode where
   pretty' GHC.NoOverlap {} = notUsedInParsedStage
   pretty' GHC.Overlappable {} = string "{-# OVERLAPPABLE #-}"
   pretty' GHC.Overlapping {} = string "{-# OVERLAPPING #-}"
   pretty' GHC.Overlaps {} = string "{-# OVERLAPS #-}"
@@ -1348,8 +1348,8 @@
       [] -> pure ()
       [x'] -> string x'
       xs -> do
         string $ head xs
         indentedWithFixedLevel 0 $ newlinePrefixed $ string <$> tail xs
   pretty' (GHC.IEModuleContents _ name) =
     pretty $ fmap ModuleNameWithPrefix name
   pretty' GHC.IEGroup {} = docNode
@@ -1545,10 +1545,6 @@
               (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsType GHC.GhcPs))) where
   pretty' GHC.HsWC {..} = pretty hswc_body
 
-instance Pretty (GHC.DefaultDecl GHC.GhcPs) where
-  pretty' (GHC.DefaultDecl _ xs) =
-    spaced [string "default", hTuple $ fmap pretty xs]
-
 instance Pretty (GHC.ForeignDecl GHC.GhcPs) where
   pretty' GHC.ForeignImport {..} =
     spaced
@@ -1697,7 +1693,7 @@
   pretty' (GHC.HsFloatPrim _ x) = pretty x >> string "#"
   pretty' GHC.HsDoublePrim {} = notUsedInParsedStage
   pretty' x =
     case x of
       GHC.HsString {} -> prettyString
       GHC.HsStringPrim {} -> prettyString
     where
@@ -1829,7 +1825,7 @@
           string p |=> pretty (fmap StmtLRInsideVerticalList x)
           newline
         string "]"
       stmtsAndPrefixes l = ("| ", head l) : fmap (", ", ) (tail l)
 
 instance Pretty DoExpression where
   pretty' DoExpression {..} = do

src/HIndent/Pretty.hs-boot

@@ -77,8 +77,6 @@ instance Pretty (GHC.HsPatSynDir GHC.GhcPs)
 
 instance Pretty PatInsidePatDecl
 
-instance Pretty (GHC.DefaultDecl GHc.GhcPs)
-
 instance Pretty (GHC.ForeignDecl GHC.GhcPs)
 
 instance Pretty (GHC.WarnDecls GHC.GhcPs)