Define ClassInstance (#836)

* Add `ClassInstance`

* Create `ClassInstance`

* Return a `Maybe` value

* Use `mkClassInstance`

* Use `ClsInstDecl`

* Inline the `Pretty` instance

* Format

hindent.cabal

@@ -43,6 +43,7 @@ library
       HIndent.Ast.Declaration.Family.Type
       HIndent.Ast.Declaration.Family.Type.Injectivity
       HIndent.Ast.Declaration.Family.Type.ResultSignature
+      HIndent.Ast.Declaration.Instance.Class
       HIndent.Ast.Declaration.TypeSynonym
       HIndent.Ast.Declaration.TypeSynonym.Lhs
       HIndent.Ast.FileHeaderPragma

src/HIndent/Ast/Declaration.hs

@@ -6,6 +6,7 @@ module HIndent.Ast.Declaration
 
 import HIndent.Ast.Declaration.Family.Data
 import HIndent.Ast.Declaration.Family.Type
+import HIndent.Ast.Declaration.Instance.Class
 import HIndent.Ast.Declaration.TypeSynonym
 import HIndent.Ast.NodeComments
 import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
@@ -17,6 +18,7 @@ data Declaration
   | TypeFamily TypeFamily
   | TypeSynonym TypeSynonym
   | TyClDecl (GHC.TyClDecl GHC.GhcPs)
+  | ClassInstance ClassInstance
   | InstDecl (GHC.InstDecl GHC.GhcPs)
   | DerivDecl (GHC.DerivDecl GHC.GhcPs)
   | ValDecl (GHC.HsBind GHC.GhcPs)
@@ -35,6 +37,7 @@ instance CommentExtraction Declaration where
   nodeComments TypeFamily {} = NodeComments [] [] []
   nodeComments TypeSynonym {} = NodeComments [] [] []
   nodeComments TyClDecl {} = NodeComments [] [] []
+  nodeComments ClassInstance {} = NodeComments [] [] []
   nodeComments InstDecl {} = NodeComments [] [] []
   nodeComments DerivDecl {} = NodeComments [] [] []
   nodeComments ValDecl {} = NodeComments [] [] []
@@ -53,6 +56,7 @@ instance Pretty Declaration where
   pretty' (TypeFamily x) = pretty x
   pretty' (TypeSynonym x) = pretty x
   pretty' (TyClDecl x) = pretty x
+  pretty' (ClassInstance x) = pretty x
   pretty' (InstDecl x) = pretty x
   pretty' (DerivDecl x) = pretty x
   pretty' (ValDecl x) = pretty x
@@ -72,7 +76,9 @@ mkDeclaration (GHC.TyClD _ (GHC.FamDecl _ x))
   | otherwise = TypeFamily $ mkTypeFamily x
 mkDeclaration (GHC.TyClD _ x@GHC.SynDecl {}) = TypeSynonym $ mkTypeSynonym x
 mkDeclaration (GHC.TyClD _ x) = TyClDecl x
-mkDeclaration (GHC.InstD _ x) = InstDecl x
+mkDeclaration (GHC.InstD _ x)
+  | Just inst <- mkClassInstance x = ClassInstance inst
+  | otherwise = InstDecl x
 mkDeclaration (GHC.DerivD _ x) = DerivDecl x
 mkDeclaration (GHC.ValD _ x) = ValDecl x
 mkDeclaration (GHC.SigD _ x) = SigDecl x

src/HIndent/Ast/Declaration/Instance/Class.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module HIndent.Ast.Declaration.Instance.Class
+  ( ClassInstance
+  , mkClassInstance
+  ) where
+
+import Control.Monad
+import GHC.Data.Bag
+import HIndent.Applicative
+import HIndent.Ast.NodeComments
+import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
+import HIndent.Pretty
+import HIndent.Pretty.Combinators
+import HIndent.Pretty.NodeComments
+import HIndent.Pretty.SigBindFamily
+import HIndent.Pretty.Types
+
+newtype ClassInstance =
+  ClassInstance (GHC.ClsInstDecl GHC.GhcPs)
+
+instance CommentExtraction ClassInstance where
+  nodeComments ClassInstance {} = NodeComments [] [] []
+
+instance Pretty ClassInstance where
+  pretty' (ClassInstance GHC.ClsInstDecl {..}) = do
+    string "instance " |=> do
+      whenJust cid_overlap_mode $ \x -> do
+        pretty x
+        space
+      pretty (fmap HsSigTypeInsideInstDecl cid_poly_ty)
+        |=> unless (null sigsAndMethods) (string " where")
+    unless (null sigsAndMethods) $ do
+      newline
+      indentedBlock $ lined $ fmap pretty sigsAndMethods
+    where
+      sigsAndMethods =
+        mkSortedLSigBindFamilyList
+          cid_sigs
+          (bagToList cid_binds)
+          []
+          cid_tyfam_insts
+          cid_datafam_insts
+
+mkClassInstance :: GHC.InstDecl GHC.GhcPs -> Maybe ClassInstance
+mkClassInstance GHC.ClsInstD {..} = Just $ ClassInstance cid_inst
+mkClassInstance _ = Nothing