module HIndent.Ast.Declaration.Family.Type.ResultSignature ( ResultSignature(..) , mkResultSignature ) where 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 import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments data ResultSignature = NoSig | Kind (GHC.LHsKind GHC.GhcPs) | TypeVariable (WithComments TypeVariable) instance CommentExtraction ResultSignature where nodeComments :: ResultSignature -> NodeComments nodeComments ResultSignature NoSig = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] nodeComments Kind {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] nodeComments TypeVariable {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] instance Pretty ResultSignature where pretty' :: ResultSignature -> Printer () pretty' ResultSignature NoSig = () -> Printer () forall a. a -> Printer a forall (m :: * -> *) a. Monad m => a -> m a return () pretty' (Kind LHsKind GhcPs x) = HasCallStack => String -> Printer () String -> Printer () string String " :: " Printer () -> Printer () -> Printer () forall a b. Printer a -> Printer b -> Printer b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer () forall a. Pretty a => a -> Printer () pretty LHsKind GhcPs GenLocated SrcSpanAnnA (HsType GhcPs) x pretty' (TypeVariable WithComments TypeVariable x) = HasCallStack => String -> Printer () String -> Printer () string String " = " Printer () -> Printer () -> Printer () forall a b. Printer a -> Printer b -> Printer b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> WithComments TypeVariable -> Printer () forall a. Pretty a => a -> Printer () pretty WithComments TypeVariable x mkResultSignature :: GHC.FamilyResultSig GHC.GhcPs -> ResultSignature mkResultSignature :: FamilyResultSig GhcPs -> ResultSignature mkResultSignature (GHC.NoSig XNoSig GhcPs _) = ResultSignature NoSig mkResultSignature (GHC.KindSig XCKindSig GhcPs _ LHsKind GhcPs x) = LHsKind GhcPs -> ResultSignature Kind LHsKind GhcPs x mkResultSignature (GHC.TyVarSig XTyVarSig GhcPs _ LHsTyVarBndr () GhcPs x) = WithComments TypeVariable -> ResultSignature TypeVariable WithComments TypeVariable var where var :: WithComments TypeVariable var = HsTyVarBndr () GhcPs -> TypeVariable forall a. HsTyVarBndr a GhcPs -> TypeVariable mkTypeVariable (HsTyVarBndr () GhcPs -> TypeVariable) -> WithComments (HsTyVarBndr () GhcPs) -> WithComments TypeVariable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> WithComments (HsTyVarBndr () GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated LHsTyVarBndr () GhcPs GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) x