{-# LANGUAGE RecordWildCards #-} module HIndent.Ast.Declaration.Family.Type ( TypeFamily , mkTypeFamily ) where import Control.Monad import qualified GHC.Types.Basic as GHC import HIndent.Applicative import HIndent.Ast.Declaration.Family.Type.Injectivity import HIndent.Ast.Declaration.Family.Type.ResultSignature import HIndent.Ast.Name.Prefix import HIndent.Ast.NodeComments hiding (fromEpAnn) 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 TypeFamily = TypeFamily { TypeFamily -> Bool isTopLevel :: Bool , TypeFamily -> WithComments PrefixName name :: WithComments PrefixName , TypeFamily -> [WithComments TypeVariable] typeVariables :: [WithComments TypeVariable] , TypeFamily -> WithComments ResultSignature signature :: WithComments ResultSignature , TypeFamily -> Maybe (WithComments Injectivity) injectivity :: Maybe (WithComments Injectivity) , TypeFamily -> Maybe [WithComments (TyFamInstEqn GhcPs)] equations :: Maybe [WithComments (GHC.TyFamInstEqn GHC.GhcPs)] } instance CommentExtraction TypeFamily where nodeComments :: TypeFamily -> NodeComments nodeComments TypeFamily {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] instance Pretty TypeFamily where pretty' :: TypeFamily -> Printer () pretty' TypeFamily {Bool [WithComments TypeVariable] Maybe [WithComments (TyFamInstEqn GhcPs)] Maybe (WithComments Injectivity) WithComments PrefixName WithComments ResultSignature isTopLevel :: TypeFamily -> Bool name :: TypeFamily -> WithComments PrefixName typeVariables :: TypeFamily -> [WithComments TypeVariable] signature :: TypeFamily -> WithComments ResultSignature injectivity :: TypeFamily -> Maybe (WithComments Injectivity) equations :: TypeFamily -> Maybe [WithComments (TyFamInstEqn GhcPs)] isTopLevel :: Bool name :: WithComments PrefixName typeVariables :: [WithComments TypeVariable] signature :: WithComments ResultSignature injectivity :: Maybe (WithComments Injectivity) equations :: Maybe [WithComments (TyFamInstEqn GhcPs)] ..} = do HasCallStack => String -> Printer () String -> Printer () string String "type " Bool -> Printer () -> Printer () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool isTopLevel (Printer () -> Printer ()) -> Printer () -> Printer () forall a b. (a -> b) -> a -> b $ HasCallStack => String -> Printer () String -> Printer () string String "family " WithComments PrefixName -> Printer () forall a. Pretty a => a -> Printer () pretty WithComments PrefixName name [Printer ()] -> Printer () spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer () forall a b. (a -> b) -> a -> b $ (WithComments TypeVariable -> Printer ()) -> [WithComments TypeVariable] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap WithComments TypeVariable -> Printer () forall a. Pretty a => a -> Printer () pretty [WithComments TypeVariable] typeVariables WithComments ResultSignature -> Printer () forall a. Pretty a => a -> Printer () pretty WithComments ResultSignature signature Maybe (WithComments Injectivity) -> (WithComments Injectivity -> Printer ()) -> Printer () forall (m :: * -> *) a. Applicative m => Maybe a -> (a -> m ()) -> m () whenJust Maybe (WithComments Injectivity) injectivity ((WithComments Injectivity -> Printer ()) -> Printer ()) -> (WithComments Injectivity -> Printer ()) -> Printer () forall a b. (a -> b) -> a -> b $ \WithComments Injectivity 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 Injectivity -> Printer () forall a. Pretty a => a -> Printer () pretty WithComments Injectivity x Maybe [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] -> ([WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] -> Printer ()) -> Printer () forall (m :: * -> *) a. Applicative m => Maybe a -> (a -> m ()) -> m () whenJust Maybe [WithComments (TyFamInstEqn GhcPs)] Maybe [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] equations (([WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] -> Printer ()) -> Printer ()) -> ([WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] -> Printer ()) -> Printer () forall a b. (a -> b) -> a -> b $ \[WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] xs -> HasCallStack => String -> Printer () String -> Printer () string String " where" 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 () 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 ([Printer ()] -> Printer () lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer () forall a b. (a -> b) -> a -> b $ (WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) -> Printer ()) -> [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) -> Printer () forall a. Pretty a => a -> Printer () pretty [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] xs) mkTypeFamily :: GHC.FamilyDecl GHC.GhcPs -> Maybe TypeFamily mkTypeFamily :: FamilyDecl GhcPs -> Maybe TypeFamily mkTypeFamily GHC.FamilyDecl {fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass fdTyVars = GHC.HsQTvs {[LHsTyVarBndr (HsBndrVis GhcPs) GhcPs] XHsQTvs GhcPs hsq_ext :: XHsQTvs GhcPs hsq_explicit :: [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs] hsq_explicit :: forall pass. LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass] hsq_ext :: forall pass. LHsQTyVars pass -> XHsQTvs pass ..}, Maybe (LInjectivityAnn GhcPs) XCFamilyDecl GhcPs LIdP GhcPs LFamilyResultSig GhcPs TopLevelFlag LexicalFixity FamilyInfo GhcPs fdExt :: XCFamilyDecl GhcPs fdInfo :: FamilyInfo GhcPs fdTopLevel :: TopLevelFlag fdLName :: LIdP GhcPs fdFixity :: LexicalFixity fdResultSig :: LFamilyResultSig GhcPs fdInjectivityAnn :: Maybe (LInjectivityAnn GhcPs) fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass) fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass fdFixity :: forall pass. FamilyDecl pass -> LexicalFixity fdLName :: forall pass. FamilyDecl pass -> LIdP pass fdTopLevel :: forall pass. FamilyDecl pass -> TopLevelFlag fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass fdExt :: forall pass. FamilyDecl pass -> XCFamilyDecl pass ..} | FamilyInfo GhcPs GHC.DataFamily <- FamilyInfo GhcPs fdInfo = Maybe TypeFamily forall a. Maybe a Nothing | Bool otherwise = TypeFamily -> Maybe TypeFamily forall a. a -> Maybe a Just TypeFamily {Bool [WithComments TypeVariable] Maybe [WithComments (TyFamInstEqn GhcPs)] Maybe [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] Maybe (WithComments Injectivity) WithComments PrefixName WithComments ResultSignature isTopLevel :: Bool name :: WithComments PrefixName typeVariables :: [WithComments TypeVariable] signature :: WithComments ResultSignature injectivity :: Maybe (WithComments Injectivity) equations :: Maybe [WithComments (TyFamInstEqn GhcPs)] isTopLevel :: Bool name :: WithComments PrefixName typeVariables :: [WithComments TypeVariable] signature :: WithComments ResultSignature injectivity :: Maybe (WithComments Injectivity) equations :: Maybe [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] ..} where isTopLevel :: Bool isTopLevel = case TopLevelFlag fdTopLevel of TopLevelFlag GHC.TopLevel -> Bool True TopLevelFlag GHC.NotTopLevel -> Bool False name :: WithComments PrefixName name = GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName) -> GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName forall a b. (a -> b) -> a -> b $ (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 LIdP GhcPs GenLocated SrcSpanAnnN RdrName fdLName typeVariables :: [WithComments TypeVariable] typeVariables = (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs) -> WithComments TypeVariable) -> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)] -> [WithComments TypeVariable] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((HsTyVarBndr (HsBndrVis GhcPs) GhcPs -> TypeVariable) -> WithComments (HsTyVarBndr (HsBndrVis GhcPs) 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 (HsBndrVis GhcPs) GhcPs -> TypeVariable forall a. HsTyVarBndr a GhcPs -> TypeVariable mkTypeVariable (WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs) -> WithComments TypeVariable) -> (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs) -> WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)) -> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs) -> WithComments TypeVariable forall b c a. (b -> c) -> (a -> b) -> a -> c . GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs) -> WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated) [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs] [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)] hsq_explicit signature :: WithComments ResultSignature signature = FamilyResultSig GhcPs -> ResultSignature mkResultSignature (FamilyResultSig GhcPs -> ResultSignature) -> WithComments (FamilyResultSig GhcPs) -> WithComments ResultSignature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenLocated EpAnnCO (FamilyResultSig GhcPs) -> WithComments (FamilyResultSig GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated LFamilyResultSig GhcPs GenLocated EpAnnCO (FamilyResultSig GhcPs) fdResultSig injectivity :: Maybe (WithComments Injectivity) injectivity = (GenLocated EpAnnCO (InjectivityAnn GhcPs) -> WithComments Injectivity) -> Maybe (GenLocated EpAnnCO (InjectivityAnn GhcPs)) -> Maybe (WithComments Injectivity) forall a b. (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((InjectivityAnn GhcPs -> Injectivity) -> WithComments (InjectivityAnn GhcPs) -> WithComments Injectivity forall a b. (a -> b) -> WithComments a -> WithComments b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap InjectivityAnn GhcPs -> Injectivity mkInjectivity (WithComments (InjectivityAnn GhcPs) -> WithComments Injectivity) -> (GenLocated EpAnnCO (InjectivityAnn GhcPs) -> WithComments (InjectivityAnn GhcPs)) -> GenLocated EpAnnCO (InjectivityAnn GhcPs) -> WithComments Injectivity forall b c a. (b -> c) -> (a -> b) -> a -> c . GenLocated EpAnnCO (InjectivityAnn GhcPs) -> WithComments (InjectivityAnn GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated) Maybe (LInjectivityAnn GhcPs) Maybe (GenLocated EpAnnCO (InjectivityAnn GhcPs)) fdInjectivityAnn equations :: Maybe [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] equations = case FamilyInfo GhcPs fdInfo of FamilyInfo GhcPs GHC.DataFamily -> String -> Maybe [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] forall a. HasCallStack => String -> a error String "Not a TypeFamily" FamilyInfo GhcPs GHC.OpenTypeFamily -> Maybe [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] forall a. Maybe a Nothing GHC.ClosedTypeFamily Maybe [LTyFamInstEqn GhcPs] Nothing -> [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] -> Maybe [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] forall a. a -> Maybe a Just [] GHC.ClosedTypeFamily (Just [LTyFamInstEqn GhcPs] xs) -> [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] -> Maybe [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] forall a. a -> Maybe a Just ([WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] -> Maybe [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]) -> [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] -> Maybe [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] forall a b. (a -> b) -> a -> b $ (GenLocated SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) -> WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))) -> [GenLocated SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] -> [WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap GenLocated SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) -> WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated [LTyFamInstEqn GhcPs] [GenLocated SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))] xs