{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} module HIndent.Ast.Declaration.Data.GADT.Constructor.Signature ( ConstructorSignature , mkConstructorSignature , prettyHorizontally , prettyVertically ) where import HIndent.Ast.Declaration.Data.Record.Field import HIndent.Ast.NodeComments import HIndent.Ast.Type 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.Printer data ConstructorSignature = ByArrows { ConstructorSignature -> [WithComments Type] parameters :: [WithComments Type] , ConstructorSignature -> WithComments Type result :: WithComments Type } | Record { ConstructorSignature -> WithComments [WithComments RecordField] fields :: WithComments [WithComments RecordField] , result :: WithComments Type } instance CommentExtraction ConstructorSignature where nodeComments :: ConstructorSignature -> NodeComments nodeComments ByArrows {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] nodeComments Record {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] prettyHorizontally :: ConstructorSignature -> Printer () prettyHorizontally :: ConstructorSignature -> Printer () prettyHorizontally ByArrows {[WithComments Type] WithComments Type parameters :: ConstructorSignature -> [WithComments Type] result :: ConstructorSignature -> WithComments Type parameters :: [WithComments Type] result :: WithComments Type ..} = Printer () -> [Printer ()] -> Printer () inter (HasCallStack => String -> Printer () String -> Printer () string String " -> ") ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer () forall a b. (a -> b) -> a -> b $ (WithComments Type -> Printer ()) -> [WithComments Type] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap WithComments Type -> Printer () forall a. Pretty a => a -> Printer () pretty [WithComments Type] parameters [Printer ()] -> [Printer ()] -> [Printer ()] forall a. [a] -> [a] -> [a] ++ [WithComments Type -> Printer () forall a. Pretty a => a -> Printer () pretty WithComments Type result] prettyHorizontally Record {WithComments [WithComments RecordField] WithComments Type result :: ConstructorSignature -> WithComments Type fields :: ConstructorSignature -> WithComments [WithComments RecordField] fields :: WithComments [WithComments RecordField] result :: WithComments Type ..} = Printer () -> [Printer ()] -> Printer () inter (HasCallStack => String -> Printer () String -> Printer () string String " -> ") [WithComments [WithComments RecordField] -> ([WithComments RecordField] -> Printer ()) -> Printer () forall a. WithComments a -> (a -> Printer ()) -> Printer () prettyWith WithComments [WithComments RecordField] fields ([Printer ()] -> Printer () vFields' ([Printer ()] -> Printer ()) -> ([WithComments RecordField] -> [Printer ()]) -> [WithComments RecordField] -> Printer () forall b c a. (b -> c) -> (a -> b) -> a -> c . (WithComments RecordField -> Printer ()) -> [WithComments RecordField] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap WithComments RecordField -> Printer () forall a. Pretty a => a -> Printer () pretty), WithComments Type -> Printer () forall a. Pretty a => a -> Printer () pretty WithComments Type result] prettyVertically :: ConstructorSignature -> Printer () prettyVertically :: ConstructorSignature -> Printer () prettyVertically ByArrows {[WithComments Type] WithComments Type parameters :: ConstructorSignature -> [WithComments Type] result :: ConstructorSignature -> WithComments Type parameters :: [WithComments Type] result :: WithComments Type ..} = String -> [Printer ()] -> Printer () prefixedLined String "-> " ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer () forall a b. (a -> b) -> a -> b $ (WithComments Type -> Printer ()) -> [WithComments Type] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap WithComments Type -> Printer () forall a. Pretty a => a -> Printer () pretty [WithComments Type] parameters [Printer ()] -> [Printer ()] -> [Printer ()] forall a. [a] -> [a] -> [a] ++ [WithComments Type -> Printer () forall a. Pretty a => a -> Printer () pretty WithComments Type result] prettyVertically Record {WithComments [WithComments RecordField] WithComments Type result :: ConstructorSignature -> WithComments Type fields :: ConstructorSignature -> WithComments [WithComments RecordField] fields :: WithComments [WithComments RecordField] result :: WithComments Type ..} = String -> [Printer ()] -> Printer () prefixedLined String "-> " [WithComments [WithComments RecordField] -> ([WithComments RecordField] -> Printer ()) -> Printer () forall a. WithComments a -> (a -> Printer ()) -> Printer () prettyWith WithComments [WithComments RecordField] fields ([Printer ()] -> Printer () vFields' ([Printer ()] -> Printer ()) -> ([WithComments RecordField] -> [Printer ()]) -> [WithComments RecordField] -> Printer () forall b c a. (b -> c) -> (a -> b) -> a -> c . (WithComments RecordField -> Printer ()) -> [WithComments RecordField] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap WithComments RecordField -> Printer () forall a. Pretty a => a -> Printer () pretty), WithComments Type -> Printer () forall a. Pretty a => a -> Printer () pretty WithComments Type result] mkConstructorSignature :: GHC.ConDecl GHC.GhcPs -> Maybe ConstructorSignature #if MIN_VERSION_ghc_lib_parser(9, 10, 1) mkConstructorSignature :: ConDecl GhcPs -> Maybe ConstructorSignature mkConstructorSignature GHC.ConDeclGADT {con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass con_g_args = GHC.PrefixConGADT XPrefixConGADT GhcPs _ [HsScaled GhcPs (LBangType GhcPs)] xs, Maybe (LHsContext GhcPs) Maybe (LHsDoc GhcPs) NonEmpty (LIdP GhcPs) XConDeclGADT GhcPs LBangType GhcPs XRec GhcPs (HsOuterSigTyVarBndrs GhcPs) con_g_ext :: XConDeclGADT GhcPs con_names :: NonEmpty (LIdP GhcPs) con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs) con_mb_cxt :: Maybe (LHsContext GhcPs) con_res_ty :: LBangType GhcPs con_doc :: Maybe (LHsDoc GhcPs) con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass) con_res_ty :: forall pass. ConDecl pass -> LHsType pass con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass) con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass) con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass) con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass ..} = ConstructorSignature -> Maybe ConstructorSignature forall a. a -> Maybe a Just (ConstructorSignature -> Maybe ConstructorSignature) -> ConstructorSignature -> Maybe ConstructorSignature forall a b. (a -> b) -> a -> b $ ByArrows { parameters :: [WithComments Type] parameters = (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> WithComments Type) -> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))] -> [WithComments Type] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((HsType GhcPs -> Type) -> WithComments (HsType GhcPs) -> WithComments Type forall a b. (a -> b) -> WithComments a -> WithComments b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap HsType GhcPs -> Type mkType (WithComments (HsType GhcPs) -> WithComments Type) -> (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> WithComments (HsType GhcPs)) -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> WithComments Type forall b c a. (b -> c) -> (a -> b) -> a -> c . GenLocated SrcSpanAnnA (HsType GhcPs) -> WithComments (HsType GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated (GenLocated SrcSpanAnnA (HsType GhcPs) -> WithComments (HsType GhcPs)) -> (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> GenLocated SrcSpanAnnA (HsType GhcPs)) -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> WithComments (HsType GhcPs) forall b c a. (b -> c) -> (a -> b) -> a -> c . HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) -> GenLocated SrcSpanAnnA (HsType GhcPs) forall pass a. HsScaled pass a -> a GHC.hsScaledThing) [HsScaled GhcPs (LBangType GhcPs)] [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))] xs , result :: WithComments Type result = HsType GhcPs -> Type mkType (HsType GhcPs -> Type) -> WithComments (HsType GhcPs) -> WithComments Type forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenLocated SrcSpanAnnA (HsType GhcPs) -> WithComments (HsType GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated LBangType GhcPs GenLocated SrcSpanAnnA (HsType GhcPs) con_res_ty } #else mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.PrefixConGADT xs, ..} = Just $ ByArrows { parameters = fmap (fmap mkType . fromGenLocated . GHC.hsScaledThing) xs , result = mkType <$> fromGenLocated con_res_ty } #endif #if MIN_VERSION_ghc_lib_parser(9, 10, 1) mkConstructorSignature GHC.ConDeclGADT {con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass con_g_args = GHC.RecConGADT XRecConGADT GhcPs _ XRec GhcPs [LConDeclField GhcPs] xs, Maybe (LHsContext GhcPs) Maybe (LHsDoc GhcPs) NonEmpty (LIdP GhcPs) XConDeclGADT GhcPs LBangType GhcPs XRec GhcPs (HsOuterSigTyVarBndrs GhcPs) con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass) con_res_ty :: forall pass. ConDecl pass -> LHsType pass con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass) con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass) con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass) con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass con_g_ext :: XConDeclGADT GhcPs con_names :: NonEmpty (LIdP GhcPs) con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs) con_mb_cxt :: Maybe (LHsContext GhcPs) con_res_ty :: LBangType GhcPs con_doc :: Maybe (LHsDoc GhcPs) ..} = ConstructorSignature -> Maybe ConstructorSignature forall a. a -> Maybe a Just (ConstructorSignature -> Maybe ConstructorSignature) -> ConstructorSignature -> Maybe ConstructorSignature forall a b. (a -> b) -> a -> b $ Record { fields :: WithComments [WithComments RecordField] fields = GenLocated SrcSpanAnnL [WithComments RecordField] -> WithComments [WithComments RecordField] forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated (GenLocated SrcSpanAnnL [WithComments RecordField] -> WithComments [WithComments RecordField]) -> GenLocated SrcSpanAnnL [WithComments RecordField] -> WithComments [WithComments RecordField] forall a b. (a -> b) -> a -> b $ ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> [WithComments RecordField]) -> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> GenLocated SrcSpanAnnL [WithComments RecordField] forall a b. (a -> b) -> GenLocated SrcSpanAnnL a -> GenLocated SrcSpanAnnL b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> WithComments RecordField) -> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> [WithComments RecordField] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((ConDeclField GhcPs -> RecordField) -> WithComments (ConDeclField GhcPs) -> WithComments RecordField forall a b. (a -> b) -> WithComments a -> WithComments b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ConDeclField GhcPs -> RecordField mkRecordField (WithComments (ConDeclField GhcPs) -> WithComments RecordField) -> (GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> WithComments (ConDeclField GhcPs)) -> GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> WithComments RecordField forall b c a. (b -> c) -> (a -> b) -> a -> c . GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> WithComments (ConDeclField GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated)) XRec GhcPs [LConDeclField GhcPs] GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] xs , result :: WithComments Type result = HsType GhcPs -> Type mkType (HsType GhcPs -> Type) -> WithComments (HsType GhcPs) -> WithComments Type forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenLocated SrcSpanAnnA (HsType GhcPs) -> WithComments (HsType GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated LBangType GhcPs GenLocated SrcSpanAnnA (HsType GhcPs) con_res_ty } #elif MIN_VERSION_ghc_lib_parser(9, 4, 0) mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.RecConGADT xs _, ..} = Just $ Record { fields = fromGenLocated $ fmap (fmap (fmap mkRecordField . fromGenLocated)) xs , result = mkType <$> fromGenLocated con_res_ty } #else mkConstructorSignature GHC.ConDeclGADT {con_g_args = GHC.RecConGADT xs, ..} = Just $ Record { fields = fromGenLocated $ fmap (fmap (fmap mkRecordField . fromGenLocated)) xs , result = mkType <$> fromGenLocated con_res_ty } #endif mkConstructorSignature GHC.ConDeclH98 {} = Maybe ConstructorSignature forall a. Maybe a Nothing