{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.Instance.Class
  ( ClassInstance
  , mkClassInstance
  ) where

import Control.Monad
import qualified GHC.Data.Bag as GHC
import HIndent.Applicative
import HIndent.Ast.Declaration.Instance.Class.OverlapMode
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
import HIndent.Pretty.SigBindFamily
import HIndent.Pretty.Types

data ClassInstance = ClassInstance
  { ClassInstance -> Maybe (WithComments OverlapMode)
overlapMode :: Maybe (WithComments OverlapMode)
  , ClassInstance -> [LSig GhcPs]
cid_sigs :: [GHC.LSig GHC.GhcPs]
  , ClassInstance -> LHsBinds GhcPs
cid_binds :: GHC.LHsBinds GHC.GhcPs
  , ClassInstance -> [LTyFamInstDecl GhcPs]
cid_tyfam_insts :: [GHC.LTyFamInstDecl GHC.GhcPs]
  , ClassInstance -> [LDataFamInstDecl GhcPs]
cid_datafam_insts :: [GHC.LDataFamInstDecl GHC.GhcPs]
  , ClassInstance -> LHsSigType GhcPs
cid_poly_ty :: GHC.LHsSigType GHC.GhcPs
  }

instance CommentExtraction ClassInstance where
  nodeComments :: ClassInstance -> NodeComments
nodeComments ClassInstance {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty ClassInstance where
  pretty' :: ClassInstance -> Printer ()
pretty' (ClassInstance {[LSig GhcPs]
[LDataFamInstDecl GhcPs]
[LTyFamInstDecl GhcPs]
Maybe (WithComments OverlapMode)
LHsSigType GhcPs
LHsBinds GhcPs
overlapMode :: ClassInstance -> Maybe (WithComments OverlapMode)
cid_sigs :: ClassInstance -> [LSig GhcPs]
cid_binds :: ClassInstance -> LHsBinds GhcPs
cid_tyfam_insts :: ClassInstance -> [LTyFamInstDecl GhcPs]
cid_datafam_insts :: ClassInstance -> [LDataFamInstDecl GhcPs]
cid_poly_ty :: ClassInstance -> LHsSigType GhcPs
overlapMode :: Maybe (WithComments OverlapMode)
cid_sigs :: [LSig GhcPs]
cid_binds :: LHsBinds GhcPs
cid_tyfam_insts :: [LTyFamInstDecl GhcPs]
cid_datafam_insts :: [LDataFamInstDecl GhcPs]
cid_poly_ty :: LHsSigType GhcPs
..}) = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"instance " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> do
      Maybe (WithComments OverlapMode)
-> (WithComments OverlapMode -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (WithComments OverlapMode)
overlapMode ((WithComments OverlapMode -> Printer ()) -> Printer ())
-> (WithComments OverlapMode -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \WithComments OverlapMode
x -> do
        WithComments OverlapMode -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments OverlapMode
x
        Printer ()
space
      GenLocated SrcSpanAnnA HsSigType' -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ((HsSigType GhcPs -> HsSigType')
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA HsSigType'
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsSigType GhcPs -> HsSigType'
HsSigTypeInsideInstDecl LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
cid_poly_ty)
        Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LSigBindFamily] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSigBindFamily]
sigsAndMethods) (HasCallStack => String -> Printer ()
String -> Printer ()
string String
" where")
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LSigBindFamily] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSigBindFamily]
sigsAndMethods) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
      Printer ()
newline
      Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LSigBindFamily -> Printer ()) -> [LSigBindFamily] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LSigBindFamily -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LSigBindFamily]
sigsAndMethods
    where
      sigsAndMethods :: [LSigBindFamily]
sigsAndMethods =
        [LSig GhcPs]
-> [LHsBindLR GhcPs GhcPs]
-> [LFamilyDecl GhcPs]
-> [LTyFamInstDecl GhcPs]
-> [LDataFamInstDecl GhcPs]
-> [LSigBindFamily]
mkSortedLSigBindFamilyList
          [LSig GhcPs]
cid_sigs
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
GHC.bagToList LHsBinds GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
cid_binds)
          []
          [LTyFamInstDecl GhcPs]
cid_tyfam_insts
          [LDataFamInstDecl GhcPs]
cid_datafam_insts

mkClassInstance :: GHC.InstDecl GHC.GhcPs -> Maybe ClassInstance
mkClassInstance :: InstDecl GhcPs -> Maybe ClassInstance
mkClassInstance GHC.ClsInstD {cid_inst :: forall pass. InstDecl pass -> ClsInstDecl pass
cid_inst = GHC.ClsInstDecl {[LSig GhcPs]
[LDataFamInstDecl GhcPs]
[LTyFamInstDecl GhcPs]
Maybe (XRec GhcPs OverlapMode)
XCClsInstDecl GhcPs
LHsSigType GhcPs
LHsBinds GhcPs
cid_ext :: XCClsInstDecl GhcPs
cid_poly_ty :: LHsSigType GhcPs
cid_binds :: LHsBinds GhcPs
cid_sigs :: [LSig GhcPs]
cid_tyfam_insts :: [LTyFamInstDecl GhcPs]
cid_datafam_insts :: [LDataFamInstDecl GhcPs]
cid_overlap_mode :: Maybe (XRec GhcPs OverlapMode)
cid_overlap_mode :: forall pass. ClsInstDecl pass -> Maybe (XRec pass OverlapMode)
cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_tyfam_insts :: forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_sigs :: forall pass. ClsInstDecl pass -> [LSig pass]
cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_ext :: forall pass. ClsInstDecl pass -> XCClsInstDecl pass
..}} =
  ClassInstance -> Maybe ClassInstance
forall a. a -> Maybe a
Just (ClassInstance -> Maybe ClassInstance)
-> ClassInstance -> Maybe ClassInstance
forall a b. (a -> b) -> a -> b
$ ClassInstance {[LSig GhcPs]
[LDataFamInstDecl GhcPs]
[LTyFamInstDecl GhcPs]
Maybe (WithComments OverlapMode)
LHsSigType GhcPs
LHsBinds GhcPs
overlapMode :: Maybe (WithComments OverlapMode)
cid_sigs :: [LSig GhcPs]
cid_binds :: LHsBinds GhcPs
cid_tyfam_insts :: [LTyFamInstDecl GhcPs]
cid_datafam_insts :: [LDataFamInstDecl GhcPs]
cid_poly_ty :: LHsSigType GhcPs
cid_poly_ty :: LHsSigType GhcPs
cid_binds :: LHsBinds GhcPs
cid_sigs :: [LSig GhcPs]
cid_tyfam_insts :: [LTyFamInstDecl GhcPs]
cid_datafam_insts :: [LDataFamInstDecl GhcPs]
overlapMode :: Maybe (WithComments OverlapMode)
..}
  where
    overlapMode :: Maybe (WithComments OverlapMode)
overlapMode = (GenLocated SrcSpanAnnP OverlapMode -> WithComments OverlapMode)
-> Maybe (GenLocated SrcSpanAnnP OverlapMode)
-> Maybe (WithComments OverlapMode)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((OverlapMode -> OverlapMode)
-> WithComments OverlapMode -> WithComments OverlapMode
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OverlapMode -> OverlapMode
mkOverlapMode (WithComments OverlapMode -> WithComments OverlapMode)
-> (GenLocated SrcSpanAnnP OverlapMode -> WithComments OverlapMode)
-> GenLocated SrcSpanAnnP OverlapMode
-> WithComments OverlapMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnP OverlapMode -> WithComments OverlapMode
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) Maybe (XRec GhcPs OverlapMode)
Maybe (GenLocated SrcSpanAnnP OverlapMode)
cid_overlap_mode
mkClassInstance InstDecl GhcPs
_ = Maybe ClassInstance
forall a. Maybe a
Nothing