Implement StandAloneDeriving

hindent.cabal

@@ -67,6 +67,7 @@ library
       HIndent.Ast.Declaration.Signature.Fixity.Associativity
       HIndent.Ast.Declaration.Signature.Inline.Phase
       HIndent.Ast.Declaration.Signature.Inline.Spec
+      HIndent.Ast.Declaration.StandAloneDeriving
       HIndent.Ast.Declaration.TypeSynonym
       HIndent.Ast.Declaration.TypeSynonym.Lhs
       HIndent.Ast.FileHeaderPragma

src/HIndent/Ast/Declaration.hs

@@ -16,6 +16,7 @@ import qualified HIndent.Ast.Declaration.Instance.Class
 import qualified HIndent.Ast.Declaration.Instance.Family.Data
 import qualified HIndent.Ast.Declaration.Instance.Family.Type
 import HIndent.Ast.Declaration.Signature
+import qualified HIndent.Ast.Declaration.StandAloneDeriving
 import qualified HIndent.Ast.Declaration.TypeSynonym
 import HIndent.Ast.NodeComments
 import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
@@ -33,7 +34,8 @@ data Declaration
       HIndent.Ast.Declaration.Instance.Family.Data.DataFamilyInstance
   | TypeFamilyInstance
       HIndent.Ast.Declaration.Instance.Family.Type.TypeFamilyInstance
-  | DerivDecl (GHC.DerivDecl GHC.GhcPs)
+  | StandAloneDeriving
+      HIndent.Ast.Declaration.StandAloneDeriving.StandAloneDeriving
   | ValDecl (GHC.HsBind GHC.GhcPs)
   | Signature Signature
   | KindSigDecl (GHC.StandaloneKindSig GHC.GhcPs)
@@ -55,7 +57,7 @@ instance CommentExtraction Declaration where
   nodeComments ClassInstance {} = NodeComments [] [] []
   nodeComments DataFamilyInstance {} = NodeComments [] [] []
   nodeComments TypeFamilyInstance {} = NodeComments [] [] []
-  nodeComments DerivDecl {} = NodeComments [] [] []
+  nodeComments StandAloneDeriving {} = NodeComments [] [] []
   nodeComments ValDecl {} = NodeComments [] [] []
   nodeComments Signature {} = NodeComments [] [] []
   nodeComments KindSigDecl {} = NodeComments [] [] []
@@ -76,7 +78,7 @@ instance Pretty Declaration where
   pretty' (HIndent.Ast.Declaration.ClassInstance x) = pretty x
   pretty' (HIndent.Ast.Declaration.DataFamilyInstance x) = pretty x
   pretty' (HIndent.Ast.Declaration.TypeFamilyInstance x) = pretty x
-  pretty' (DerivDecl x) = pretty x
+  pretty' (HIndent.Ast.Declaration.StandAloneDeriving x) = pretty x
   pretty' (ValDecl x) = pretty x
   pretty' (HIndent.Ast.Declaration.Signature x) = pretty x
   pretty' (KindSigDecl x) = pretty x
@@ -116,7 +118,9 @@ mkDeclaration (GHC.InstD _ GHC.DataFamInstD {GHC.dfid_inst = GHC.DataFamInstDecl
 mkDeclaration (GHC.InstD _ x@GHC.TyFamInstD {}) =
   maybe (error "Unreachable.") TypeFamilyInstance
     $ HIndent.Ast.Declaration.Instance.Family.Type.mkTypeFamilyInstance x
-mkDeclaration (GHC.DerivD _ x) = DerivDecl x
+mkDeclaration (GHC.DerivD _ x) =
+  StandAloneDeriving
+    $ HIndent.Ast.Declaration.StandAloneDeriving.mkStandAloneDeriving x
 mkDeclaration (GHC.ValD _ x) = ValDecl x
 mkDeclaration (GHC.SigD _ x) =
   Signature $ HIndent.Ast.Declaration.Signature.mkSignature x

src/HIndent/Ast/Declaration/StandAloneDeriving.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module HIndent.Ast.Declaration.StandAloneDeriving
+  ( StandAloneDeriving
+  , mkStandAloneDeriving
+  ) where
+
+import HIndent.Applicative
+import HIndent.Ast.Declaration.Data.Deriving.Strategy
+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 StandAloneDeriving = StandAloneDeriving
+  { strategy :: Maybe (WithComments DerivingStrategy)
+  , className :: GHC.LHsSigType GHC.GhcPs
+  }
+
+instance CommentExtraction StandAloneDeriving where
+  nodeComments StandAloneDeriving {} = NodeComments [] [] []
+
+instance Pretty StandAloneDeriving where
+  pretty' StandAloneDeriving {strategy = Just strategy, ..}
+    | isViaStrategy (getNode strategy) =
+      spaced
+        [ string "deriving"
+        , pretty strategy
+        , string "instance"
+        , pretty className
+        ]
+  pretty' StandAloneDeriving {..} = do
+    string "deriving "
+    whenJust strategy $ \x -> pretty x >> space
+    string "instance "
+    pretty className
+
+mkStandAloneDeriving :: GHC.DerivDecl GHC.GhcPs -> StandAloneDeriving
+mkStandAloneDeriving GHC.DerivDecl {deriv_type = GHC.HsWC {..}, ..} =
+  StandAloneDeriving {..}
+  where
+    strategy = fmap (fmap mkDerivingStrategy . fromGenLocated) deriv_strategy
+    className = hswc_body

src/HIndent/Pretty.hs

@@ -41,7 +41,6 @@ import qualified GHC.Unit.Module.Warnings as GHC
 import HIndent.Applicative
 import HIndent.Ast.Declaration
 import HIndent.Ast.Declaration.Data.Body
-import HIndent.Ast.Declaration.Data.Deriving.Strategy
 import HIndent.Ast.Declaration.Signature
 import HIndent.Ast.NodeComments
 import HIndent.Ast.WithComments
@@ -1581,31 +1580,6 @@ instance Pretty (GHC.RuleDecl GHC.GhcPs) where
 instance Pretty GHC.OccName where
   pretty' = output
 
-instance Pretty (GHC.DerivDecl GHC.GhcPs) where
-  pretty' GHC.DerivDecl { deriv_strategy = (Just deriv_strategy@(GHC.L _ GHC.ViaStrategy {}))
-                        , ..
-                        } =
-    spaced
-      [ string "deriving"
-      , pretty $ mkDerivingStrategy <$> fromGenLocated deriv_strategy
-      , string "instance"
-      , pretty deriv_type
-      ]
-  pretty' GHC.DerivDecl {..} = do
-    string "deriving "
-    whenJust deriv_strategy $ \x -> do
-      pretty $ mkDerivingStrategy <$> fromGenLocated x
-      space
-    string "instance "
-    pretty deriv_type
-
--- | 'Pretty' for 'LHsSigWcType GhcPs'.
-instance Pretty
-           (GHC.HsWildCardBndrs
-              GHC.GhcPs
-              (GHC.GenLocated GHC.SrcSpanAnnA (GHC.HsSigType GHC.GhcPs))) where
-  pretty' GHC.HsWC {..} = pretty hswc_body
-
 -- | 'Pretty' for 'LHsWcType'
 instance Pretty
            (GHC.HsWildCardBndrs

src/HIndent/Pretty.hs-boot

@@ -58,8 +58,6 @@ instance Pretty GHC.OverlapMode
 
 instance Pretty HsSigType'
 
-instance Pretty (GHC.DerivDecl GHC.GhcPs)
-
 instance Pretty (GHC.HsBind GHC.GhcPs)
 
 instance Pretty (GHC.StandaloneKindSig GHC.GhcPs)