{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} module HIndent.Ast.Declaration.Data.GADT.Constructor ( GADTConstructor , mkGADTConstructor ) where import Data.Maybe import qualified GHC.Types.SrcLoc as GHC import HIndent.Ast.Context import HIndent.Ast.Declaration.Data.GADT.Constructor.Signature import HIndent.Ast.Name.Prefix 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 #if MIN_VERSION_ghc_lib_parser(9, 6, 0) import qualified Data.List.NonEmpty as NE #endif data GADTConstructor = GADTConstructor { GADTConstructor -> [WithComments PrefixName] names :: [WithComments PrefixName] , GADTConstructor -> Maybe (WithComments [WithComments TypeVariable]) bindings :: Maybe (WithComments [WithComments TypeVariable]) , GADTConstructor -> Maybe (WithComments Context) context :: Maybe (WithComments Context) , GADTConstructor -> ConstructorSignature signature :: ConstructorSignature } instance CommentExtraction GADTConstructor where nodeComments :: GADTConstructor -> NodeComments nodeComments GADTConstructor {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] instance Pretty GADTConstructor where pretty' :: GADTConstructor -> Printer () pretty' (GADTConstructor {[WithComments PrefixName] Maybe (WithComments [WithComments TypeVariable]) Maybe (WithComments Context) ConstructorSignature names :: GADTConstructor -> [WithComments PrefixName] bindings :: GADTConstructor -> Maybe (WithComments [WithComments TypeVariable]) context :: GADTConstructor -> Maybe (WithComments Context) signature :: GADTConstructor -> ConstructorSignature names :: [WithComments PrefixName] bindings :: Maybe (WithComments [WithComments TypeVariable]) context :: Maybe (WithComments Context) signature :: ConstructorSignature ..}) = do [Printer ()] -> Printer () hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer () forall a b. (a -> b) -> a -> b $ (WithComments PrefixName -> Printer ()) -> [WithComments PrefixName] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (WithComments PrefixName -> (PrefixName -> Printer ()) -> Printer () forall a. WithComments a -> (a -> Printer ()) -> Printer () `prettyWith` PrefixName -> Printer () forall a. Pretty a => a -> Printer () pretty) [WithComments PrefixName] names Printer () hor Printer () -> Printer () -> Printer () forall a. Printer a -> Printer a -> Printer a <-|> Printer () ver where hor :: Printer () hor = HasCallStack => String -> Printer () String -> Printer () string String " :: " Printer () -> Printer () -> Printer () forall a. Printer () -> Printer a -> Printer a |=> Printer () body ver :: Printer () ver = Printer () newline Printer () -> Printer () -> Printer () forall a b. Printer a -> Printer b -> Printer b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Printer () -> Printer () forall a. Printer a -> Printer a indentedBlock (HasCallStack => String -> Printer () String -> Printer () string String ":: " Printer () -> Printer () -> Printer () forall a. Printer () -> Printer a -> Printer a |=> Printer () body) body :: Printer () body = case (Maybe (WithComments [WithComments TypeVariable]) bindings, Maybe (WithComments Context) context) of (Just WithComments [WithComments TypeVariable] bs, Just WithComments Context ctx) -> WithComments [WithComments TypeVariable] -> WithComments Context -> Printer () forall {a} {a}. (Pretty a, Pretty a) => WithComments [a] -> a -> Printer () withForallCtx WithComments [WithComments TypeVariable] bs WithComments Context ctx (Just WithComments [WithComments TypeVariable] bs, Maybe (WithComments Context) Nothing) -> WithComments [WithComments TypeVariable] -> Printer () forall {a}. Pretty a => WithComments [a] -> Printer () withForallOnly WithComments [WithComments TypeVariable] bs (Maybe (WithComments [WithComments TypeVariable]) Nothing, Just WithComments Context ctx) -> WithComments Context -> Printer () forall a. Pretty a => a -> Printer () withCtxOnly WithComments Context ctx (Maybe (WithComments [WithComments TypeVariable]) Nothing, Maybe (WithComments Context) Nothing) -> Printer () noForallCtx withForallCtx :: WithComments [a] -> a -> Printer () withForallCtx WithComments [a] bs a ctx = do HasCallStack => String -> Printer () String -> Printer () string String "forall" WithComments [a] -> ([a] -> Printer ()) -> Printer () forall a. WithComments a -> (a -> Printer ()) -> Printer () prettyWith WithComments [a] bs ([Printer ()] -> Printer () spacePrefixed ([Printer ()] -> Printer ()) -> ([a] -> [Printer ()]) -> [a] -> Printer () forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> Printer ()) -> [a] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> Printer () forall a. Pretty a => a -> Printer () pretty) Printer () dot (Printer () space Printer () -> Printer () -> Printer () forall a b. Printer a -> Printer b -> Printer b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> a -> Printer () forall a. Pretty a => a -> Printer () pretty a ctx) Printer () -> Printer () -> Printer () forall a. Printer a -> Printer a -> Printer a <-|> (Printer () newline Printer () -> Printer () -> Printer () forall a b. Printer a -> Printer b -> Printer b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> a -> Printer () forall a. Pretty a => a -> Printer () pretty a ctx) Printer () newline String -> Printer () -> Printer () prefixed String "=> " (Printer () -> Printer ()) -> Printer () -> Printer () forall a b. (a -> b) -> a -> b $ ConstructorSignature -> Printer () prettyVertically ConstructorSignature signature withForallOnly :: WithComments [a] -> Printer () withForallOnly WithComments [a] bs = do HasCallStack => String -> Printer () String -> Printer () string String "forall" WithComments [a] -> ([a] -> Printer ()) -> Printer () forall a. WithComments a -> (a -> Printer ()) -> Printer () prettyWith WithComments [a] bs ([Printer ()] -> Printer () spacePrefixed ([Printer ()] -> Printer ()) -> ([a] -> [Printer ()]) -> [a] -> Printer () forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> Printer ()) -> [a] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> Printer () forall a. Pretty a => a -> Printer () pretty) Printer () dot (Printer () space Printer () -> Printer () -> Printer () forall a b. Printer a -> Printer b -> Printer b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> ConstructorSignature -> Printer () prettyHorizontally ConstructorSignature signature) Printer () -> Printer () -> Printer () forall a. Printer a -> Printer a -> Printer a <-|> (Printer () newline Printer () -> Printer () -> Printer () forall a b. Printer a -> Printer b -> Printer b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> ConstructorSignature -> Printer () prettyVertically ConstructorSignature signature) withCtxOnly :: a -> Printer () withCtxOnly a ctx = (a -> Printer () forall a. Pretty a => a -> Printer () pretty a ctx Printer () -> Printer () -> Printer () forall a b. Printer a -> Printer b -> Printer b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> 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 >> ConstructorSignature -> Printer () prettyHorizontally ConstructorSignature signature) Printer () -> Printer () -> Printer () forall a. Printer a -> Printer a -> Printer a <-|> (a -> Printer () forall a. Pretty a => a -> Printer () pretty a ctx Printer () -> Printer () -> Printer () forall a b. Printer a -> Printer b -> Printer b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> String -> Printer () -> Printer () prefixed String "=> " (ConstructorSignature -> Printer () prettyVertically ConstructorSignature signature)) noForallCtx :: Printer () noForallCtx = ConstructorSignature -> Printer () prettyHorizontally ConstructorSignature signature Printer () -> Printer () -> Printer () forall a. Printer a -> Printer a -> Printer a <-|> ConstructorSignature -> Printer () prettyVertically ConstructorSignature signature mkGADTConstructor :: GHC.ConDecl GHC.GhcPs -> Maybe GADTConstructor mkGADTConstructor :: ConDecl GhcPs -> Maybe GADTConstructor mkGADTConstructor decl :: ConDecl GhcPs decl@GHC.ConDeclGADT {Maybe (LHsContext GhcPs) Maybe (LHsDoc GhcPs) NonEmpty (LIdP GhcPs) XConDeclGADT GhcPs LHsType GhcPs XRec GhcPs (HsOuterSigTyVarBndrs GhcPs) HsConDeclGADTDetails GhcPs con_g_ext :: XConDeclGADT GhcPs con_names :: NonEmpty (LIdP GhcPs) con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs) con_mb_cxt :: Maybe (LHsContext GhcPs) con_g_args :: HsConDeclGADTDetails GhcPs con_res_ty :: LHsType 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_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails 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 ..} = GADTConstructor -> Maybe GADTConstructor forall a. a -> Maybe a Just (GADTConstructor -> Maybe GADTConstructor) -> GADTConstructor -> Maybe GADTConstructor forall a b. (a -> b) -> a -> b $ GADTConstructor {[WithComments PrefixName] Maybe (WithComments [WithComments TypeVariable]) Maybe (WithComments Context) ConstructorSignature names :: [WithComments PrefixName] bindings :: Maybe (WithComments [WithComments TypeVariable]) context :: Maybe (WithComments Context) signature :: ConstructorSignature names :: [WithComments PrefixName] bindings :: Maybe (WithComments [WithComments TypeVariable]) signature :: ConstructorSignature context :: Maybe (WithComments Context) ..} where names :: [WithComments PrefixName] names = [WithComments PrefixName] -> Maybe [WithComments PrefixName] -> [WithComments PrefixName] forall a. a -> Maybe a -> a fromMaybe (String -> [WithComments PrefixName] forall a. HasCallStack => String -> a error String "Couldn't get names.") (Maybe [WithComments PrefixName] -> [WithComments PrefixName]) -> Maybe [WithComments PrefixName] -> [WithComments PrefixName] forall a b. (a -> b) -> a -> b $ ConDecl GhcPs -> Maybe [WithComments PrefixName] getNames ConDecl GhcPs decl bindings :: Maybe (WithComments [WithComments TypeVariable]) bindings = case XRec GhcPs (HsOuterSigTyVarBndrs GhcPs) con_bndrs of GHC.L SrcSpanAnnA _ GHC.HsOuterImplicit {} -> Maybe (WithComments [WithComments TypeVariable]) forall a. Maybe a Nothing GHC.L SrcSpanAnnA l GHC.HsOuterExplicit {[LHsTyVarBndr Specificity (NoGhcTc GhcPs)] XHsOuterExplicit GhcPs Specificity hso_xexplicit :: XHsOuterExplicit GhcPs Specificity hso_bndrs :: [LHsTyVarBndr Specificity (NoGhcTc GhcPs)] hso_bndrs :: forall flag pass. HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)] hso_xexplicit :: forall flag pass. HsOuterTyVarBndrs flag pass -> XHsOuterExplicit pass flag ..} -> WithComments [WithComments TypeVariable] -> Maybe (WithComments [WithComments TypeVariable]) forall a. a -> Maybe a Just (WithComments [WithComments TypeVariable] -> Maybe (WithComments [WithComments TypeVariable])) -> WithComments [WithComments TypeVariable] -> Maybe (WithComments [WithComments TypeVariable]) forall a b. (a -> b) -> a -> b $ GenLocated SrcSpanAnnA [WithComments TypeVariable] -> WithComments [WithComments TypeVariable] forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated (GenLocated SrcSpanAnnA [WithComments TypeVariable] -> WithComments [WithComments TypeVariable]) -> GenLocated SrcSpanAnnA [WithComments TypeVariable] -> WithComments [WithComments TypeVariable] forall a b. (a -> b) -> a -> b $ ([GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)] -> [WithComments TypeVariable]) -> GenLocated SrcSpanAnnA [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)] -> GenLocated SrcSpanAnnA [WithComments TypeVariable] forall a b. (a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs) -> WithComments TypeVariable) -> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)] -> [WithComments TypeVariable] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((HsTyVarBndr Specificity GhcPs -> TypeVariable) -> WithComments (HsTyVarBndr Specificity GhcPs) -> WithComments TypeVariable forall a b. (a -> b) -> WithComments a -> WithComments b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap HsTyVarBndr Specificity GhcPs -> TypeVariable forall a. HsTyVarBndr a GhcPs -> TypeVariable mkTypeVariable (WithComments (HsTyVarBndr Specificity GhcPs) -> WithComments TypeVariable) -> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs) -> WithComments (HsTyVarBndr Specificity GhcPs)) -> GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs) -> WithComments TypeVariable forall b c a. (b -> c) -> (a -> b) -> a -> c . GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs) -> WithComments (HsTyVarBndr Specificity GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated)) (SrcSpanAnnA -> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)] -> GenLocated SrcSpanAnnA [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)] forall l e. l -> e -> GenLocated l e GHC.L SrcSpanAnnA l [LHsTyVarBndr Specificity (NoGhcTc GhcPs)] [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)] hso_bndrs) signature :: ConstructorSignature signature = ConstructorSignature -> Maybe ConstructorSignature -> ConstructorSignature forall a. a -> Maybe a -> a fromMaybe (String -> ConstructorSignature forall a. HasCallStack => String -> a error String "Couldn't get signature.") (Maybe ConstructorSignature -> ConstructorSignature) -> Maybe ConstructorSignature -> ConstructorSignature forall a b. (a -> b) -> a -> b $ ConDecl GhcPs -> Maybe ConstructorSignature mkConstructorSignature ConDecl GhcPs decl context :: Maybe (WithComments Context) context = (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)] -> WithComments Context) -> Maybe (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]) -> Maybe (WithComments Context) forall a b. (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Context) -> WithComments [GenLocated SrcSpanAnnA (HsType GhcPs)] -> WithComments Context forall a b. (a -> b) -> WithComments a -> WithComments b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap HsContext GhcPs -> Context [GenLocated SrcSpanAnnA (HsType GhcPs)] -> Context mkContext (WithComments [GenLocated SrcSpanAnnA (HsType GhcPs)] -> WithComments Context) -> (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)] -> WithComments [GenLocated SrcSpanAnnA (HsType GhcPs)]) -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)] -> WithComments Context forall b c a. (b -> c) -> (a -> b) -> a -> c . GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)] -> WithComments [GenLocated SrcSpanAnnA (HsType GhcPs)] forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated) Maybe (LHsContext GhcPs) Maybe (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]) con_mb_cxt mkGADTConstructor ConDecl GhcPs _ = Maybe GADTConstructor forall a. Maybe a Nothing getNames :: GHC.ConDecl GHC.GhcPs -> Maybe [WithComments PrefixName] #if MIN_VERSION_ghc_lib_parser(9, 6, 0) getNames :: ConDecl GhcPs -> Maybe [WithComments PrefixName] getNames GHC.ConDeclGADT {Maybe (LHsContext GhcPs) Maybe (LHsDoc GhcPs) NonEmpty (LIdP GhcPs) XConDeclGADT GhcPs LHsType GhcPs XRec GhcPs (HsOuterSigTyVarBndrs GhcPs) HsConDeclGADTDetails GhcPs con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass) con_res_ty :: forall pass. ConDecl pass -> LHsType pass con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails 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_g_args :: HsConDeclGADTDetails GhcPs con_res_ty :: LHsType GhcPs con_doc :: Maybe (LHsDoc GhcPs) ..} = [WithComments PrefixName] -> Maybe [WithComments PrefixName] forall a. a -> Maybe a Just ([WithComments PrefixName] -> Maybe [WithComments PrefixName]) -> [WithComments PrefixName] -> Maybe [WithComments PrefixName] forall a b. (a -> b) -> a -> b $ NonEmpty (WithComments PrefixName) -> [WithComments PrefixName] forall a. NonEmpty a -> [a] NE.toList (NonEmpty (WithComments PrefixName) -> [WithComments PrefixName]) -> NonEmpty (WithComments PrefixName) -> [WithComments PrefixName] forall a b. (a -> b) -> a -> b $ (GenLocated SrcSpanAnnN RdrName -> WithComments PrefixName) -> NonEmpty (GenLocated SrcSpanAnnN RdrName) -> NonEmpty (WithComments PrefixName) forall a b. (a -> b) -> NonEmpty a -> NonEmpty b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName) -> (GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN PrefixName) -> GenLocated SrcSpanAnnN RdrName -> WithComments PrefixName forall b c a. (b -> c) -> (a -> b) -> a -> c . (RdrName -> PrefixName) -> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN PrefixName forall a b. (a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap RdrName -> PrefixName mkPrefixName) NonEmpty (LIdP GhcPs) NonEmpty (GenLocated SrcSpanAnnN RdrName) con_names #else getNames GHC.ConDeclGADT {..} = Just $ fmap (fromGenLocated . fmap mkPrefixName) con_names #endif getNames ConDecl GhcPs _ = Maybe [WithComments PrefixName] forall a. Maybe a Nothing