{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module HIndent.Ast.Declaration.Collection ( DeclarationCollection , mkDeclarationCollection , hasDeclarations ) where import Data.Maybe import qualified GHC.Hs as GHC import HIndent.Ast.Declaration import HIndent.Ast.NodeComments import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments newtype DeclarationCollection = DeclarationCollection [WithComments Declaration] instance CommentExtraction DeclarationCollection where nodeComments :: DeclarationCollection -> NodeComments nodeComments DeclarationCollection {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] instance Pretty DeclarationCollection where pretty' :: DeclarationCollection -> Printer () pretty' (DeclarationCollection [WithComments Declaration] decls) = ((WithComments Declaration, Maybe (Printer ())) -> Printer ()) -> [(WithComments Declaration, Maybe (Printer ()))] -> Printer () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (\(WithComments Declaration x, Maybe (Printer ()) sp) -> WithComments Declaration -> Printer () forall a. Pretty a => a -> Printer () pretty WithComments Declaration x 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 () -> Maybe (Printer ()) -> Printer () forall a. a -> Maybe a -> a fromMaybe (() -> Printer () forall a. a -> Printer a forall (m :: * -> *) a. Monad m => a -> m a return ()) Maybe (Printer ()) sp) ([(WithComments Declaration, Maybe (Printer ()))] -> Printer ()) -> [(WithComments Declaration, Maybe (Printer ()))] -> Printer () forall a b. (a -> b) -> a -> b $ [WithComments Declaration] -> [(WithComments Declaration, Maybe (Printer ()))] addDeclSeparator [WithComments Declaration] decls where addDeclSeparator :: [WithComments Declaration] -> [(WithComments Declaration, Maybe (Printer ()))] addDeclSeparator [] = [] addDeclSeparator [WithComments Declaration x] = [(WithComments Declaration x, Maybe (Printer ()) forall a. Maybe a Nothing)] addDeclSeparator (WithComments Declaration x:[WithComments Declaration] xs) = (WithComments Declaration x, Printer () -> Maybe (Printer ()) forall a. a -> Maybe a Just (Printer () -> Maybe (Printer ())) -> Printer () -> Maybe (Printer ()) forall a b. (a -> b) -> a -> b $ Declaration -> Printer () declSeparator (Declaration -> Printer ()) -> Declaration -> Printer () forall a b. (a -> b) -> a -> b $ WithComments Declaration -> Declaration forall a. WithComments a -> a getNode WithComments Declaration x) (WithComments Declaration, Maybe (Printer ())) -> [(WithComments Declaration, Maybe (Printer ()))] -> [(WithComments Declaration, Maybe (Printer ()))] forall a. a -> [a] -> [a] : [WithComments Declaration] -> [(WithComments Declaration, Maybe (Printer ()))] addDeclSeparator [WithComments Declaration] xs declSeparator :: Declaration -> Printer () declSeparator (Declaration -> Bool isSignature -> Bool True) = Printer () newline declSeparator Declaration _ = Printer () blankline mkDeclarationCollection :: GHC.HsModule' -> DeclarationCollection mkDeclarationCollection :: HsModule' -> DeclarationCollection mkDeclarationCollection GHC.HsModule {[LImportDecl GhcPs] [LHsDecl GhcPs] Maybe (XRec GhcPs [LIE GhcPs]) Maybe (XRec GhcPs ModuleName) XCModule GhcPs hsmodExt :: XCModule GhcPs hsmodName :: Maybe (XRec GhcPs ModuleName) hsmodExports :: Maybe (XRec GhcPs [LIE GhcPs]) hsmodImports :: [LImportDecl GhcPs] hsmodDecls :: [LHsDecl GhcPs] hsmodDecls :: forall p. HsModule p -> [LHsDecl p] hsmodImports :: forall p. HsModule p -> [LImportDecl p] hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p]) hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName) hsmodExt :: forall p. HsModule p -> XCModule p ..} = [WithComments Declaration] -> DeclarationCollection DeclarationCollection ([WithComments Declaration] -> DeclarationCollection) -> [WithComments Declaration] -> DeclarationCollection forall a b. (a -> b) -> a -> b $ (HsDecl GhcPs -> Declaration) -> WithComments (HsDecl GhcPs) -> WithComments Declaration forall a b. (a -> b) -> WithComments a -> WithComments b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap HsDecl GhcPs -> Declaration mkDeclaration (WithComments (HsDecl GhcPs) -> WithComments Declaration) -> (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> WithComments (HsDecl GhcPs)) -> GenLocated SrcSpanAnnA (HsDecl GhcPs) -> WithComments Declaration forall b c a. (b -> c) -> (a -> b) -> a -> c . GenLocated SrcSpanAnnA (HsDecl GhcPs) -> WithComments (HsDecl GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> WithComments Declaration) -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> [WithComments Declaration] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [LHsDecl GhcPs] [GenLocated SrcSpanAnnA (HsDecl GhcPs)] hsmodDecls hasDeclarations :: DeclarationCollection -> Bool hasDeclarations :: DeclarationCollection -> Bool hasDeclarations (DeclarationCollection [WithComments Declaration] xs) = Bool -> Bool not (Bool -> Bool) -> Bool -> Bool forall a b. (a -> b) -> a -> b $ [WithComments Declaration] -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [WithComments Declaration] xs