{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} module HIndent.Ast.Module ( Module , mkModule ) where import Data.Maybe import HIndent.Ast.Declaration.Collection import HIndent.Ast.FileHeaderPragma.Collection import HIndent.Ast.Import.Collection import HIndent.Ast.Module.Declaration import HIndent.Ast.NodeComments hiding (fromEpAnn) import HIndent.Ast.WithComments import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC import HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments data Module = Module { Module -> FileHeaderPragmaCollection pragmas :: FileHeaderPragmaCollection , Module -> Maybe ModuleDeclaration moduleDeclaration :: Maybe ModuleDeclaration , Module -> ImportCollection imports :: ImportCollection , Module -> DeclarationCollection declarations :: DeclarationCollection } instance CommentExtraction Module where nodeComments :: Module -> NodeComments nodeComments Module {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] instance Pretty Module where pretty' :: Module -> Printer () pretty' Module {Maybe ModuleDeclaration ImportCollection FileHeaderPragmaCollection DeclarationCollection pragmas :: Module -> FileHeaderPragmaCollection moduleDeclaration :: Module -> Maybe ModuleDeclaration imports :: Module -> ImportCollection declarations :: Module -> DeclarationCollection pragmas :: FileHeaderPragmaCollection moduleDeclaration :: Maybe ModuleDeclaration imports :: ImportCollection declarations :: DeclarationCollection ..} | Bool isEmpty = () -> Printer () forall a. a -> Printer a forall (f :: * -> *) a. Applicative f => a -> f a pure () | Bool otherwise = [Printer ()] -> Printer () blanklined [Printer ()] printers 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 where isEmpty :: Bool isEmpty = Bool -> Bool not (FileHeaderPragmaCollection -> Bool hasPragmas FileHeaderPragmaCollection pragmas) Bool -> Bool -> Bool && Maybe ModuleDeclaration -> Bool forall a. Maybe a -> Bool isNothing Maybe ModuleDeclaration moduleDeclaration Bool -> Bool -> Bool && Bool -> Bool not (ImportCollection -> Bool hasImports ImportCollection imports) Bool -> Bool -> Bool && Bool -> Bool not (DeclarationCollection -> Bool hasDeclarations DeclarationCollection declarations) printers :: [Printer ()] printers = [Maybe (Printer ())] -> [Printer ()] forall a. [Maybe a] -> [a] catMaybes [ Bool -> Printer () -> Maybe (Printer ()) forall {a}. Bool -> a -> Maybe a toMaybe (FileHeaderPragmaCollection -> Bool hasPragmas FileHeaderPragmaCollection pragmas) (FileHeaderPragmaCollection -> Printer () forall a. Pretty a => a -> Printer () pretty FileHeaderPragmaCollection pragmas) , (ModuleDeclaration -> Printer ()) -> Maybe ModuleDeclaration -> Maybe (Printer ()) forall a b. (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ModuleDeclaration -> Printer () forall a. Pretty a => a -> Printer () pretty Maybe ModuleDeclaration moduleDeclaration , Bool -> Printer () -> Maybe (Printer ()) forall {a}. Bool -> a -> Maybe a toMaybe (ImportCollection -> Bool hasImports ImportCollection imports) (ImportCollection -> Printer () forall a. Pretty a => a -> Printer () pretty ImportCollection imports) , Bool -> Printer () -> Maybe (Printer ()) forall {a}. Bool -> a -> Maybe a toMaybe (DeclarationCollection -> Bool hasDeclarations DeclarationCollection declarations) (DeclarationCollection -> Printer () forall a. Pretty a => a -> Printer () pretty DeclarationCollection declarations) ] toMaybe :: Bool -> a -> Maybe a toMaybe Bool cond a x = if Bool cond then a -> Maybe a forall a. a -> Maybe a Just a x else Maybe a forall a. Maybe a Nothing mkModule :: GHC.HsModule' -> WithComments Module mkModule :: HsModule' -> WithComments Module mkModule HsModule' m = EpAnn AnnsModule -> Module -> WithComments Module forall a b. EpAnn a -> b -> WithComments b fromEpAnn (HsModule' -> EpAnn AnnsModule GHC.getModuleAnn HsModule' m) (Module -> WithComments Module) -> Module -> WithComments Module forall a b. (a -> b) -> a -> b $ Module {Maybe ModuleDeclaration ImportCollection FileHeaderPragmaCollection DeclarationCollection pragmas :: FileHeaderPragmaCollection moduleDeclaration :: Maybe ModuleDeclaration imports :: ImportCollection declarations :: DeclarationCollection pragmas :: FileHeaderPragmaCollection moduleDeclaration :: Maybe ModuleDeclaration imports :: ImportCollection declarations :: DeclarationCollection ..} where pragmas :: FileHeaderPragmaCollection pragmas = HsModule' -> FileHeaderPragmaCollection mkFileHeaderPragmaCollection HsModule' m moduleDeclaration :: Maybe ModuleDeclaration moduleDeclaration = HsModule' -> Maybe ModuleDeclaration mkModuleDeclaration HsModule' m imports :: ImportCollection imports = HsModule' -> ImportCollection mkImportCollection HsModule' m declarations :: DeclarationCollection declarations = HsModule' -> DeclarationCollection mkDeclarationCollection HsModule' m