{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Ormolu.Printer.Meat.Module
( p_hsModule,
)
where
import Control.Monad
import GHC.Hs hiding (comment)
import GHC.Types.SrcLoc
import Ormolu.Parser.CommentStream
import Ormolu.Parser.Pragma
import Ormolu.Printer.Combinators
import Ormolu.Printer.Comments
import Ormolu.Printer.Meat.Common
import Ormolu.Printer.Meat.Declaration
import Ormolu.Printer.Meat.Declaration.Warning
import Ormolu.Printer.Meat.ImportExport
import Ormolu.Printer.Meat.Pragma
p_hsModule ::
Maybe LComment ->
[([LComment], Pragma)] ->
HsModule GhcPs ->
R ()
p_hsModule :: Maybe LComment -> [([LComment], Pragma)] -> HsModule GhcPs -> R ()
p_hsModule Maybe LComment
mstackHeader [([LComment], Pragma)]
pragmas 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]
hsmodExt :: forall p. HsModule p -> XCModule p
hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
..} = do
let XModulePs {Maybe (LHsDoc GhcPs)
Maybe (LocatedP (WarningTxt GhcPs))
LayoutInfo GhcPs
EpAnn AnnsModule
hsmodAnn :: EpAnn AnnsModule
hsmodLayout :: LayoutInfo GhcPs
hsmodDeprecMessage :: Maybe (LocatedP (WarningTxt GhcPs))
hsmodHaddockModHeader :: Maybe (LHsDoc GhcPs)
hsmodAnn :: XModulePs -> EpAnn AnnsModule
hsmodLayout :: XModulePs -> LayoutInfo GhcPs
hsmodDeprecMessage :: XModulePs -> Maybe (LocatedP (WarningTxt GhcPs))
hsmodHaddockModHeader :: XModulePs -> Maybe (LHsDoc GhcPs)
..} = XCModule GhcPs
hsmodExt
deprecSpan :: [SrcSpan]
deprecSpan = [SrcSpan]
-> (LocatedP (WarningTxt GhcPs) -> [SrcSpan])
-> Maybe (LocatedP (WarningTxt GhcPs))
-> [SrcSpan]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (SrcSpan -> [SrcSpan]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpan -> [SrcSpan])
-> (LocatedP (WarningTxt GhcPs) -> SrcSpan)
-> LocatedP (WarningTxt GhcPs)
-> [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedP (WarningTxt GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) Maybe (LocatedP (WarningTxt GhcPs))
hsmodDeprecMessage
exportSpans :: [SrcSpan]
exportSpans = [SrcSpan]
-> (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [SrcSpan])
-> Maybe
(GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> [SrcSpan]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (SrcSpan -> [SrcSpan]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpan -> [SrcSpan])
-> (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> SrcSpan)
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) Maybe (XRec GhcPs [LIE GhcPs])
Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
hsmodExports
[SrcSpan] -> R () -> R ()
switchLayout ([SrcSpan]
deprecSpan [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. Semigroup a => a -> a -> a
<> [SrcSpan]
exportSpans) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Maybe LComment -> (LComment -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe LComment
mstackHeader ((LComment -> R ()) -> R ()) -> (LComment -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \(L RealSrcSpan
spn Comment
comment) -> do
RealSrcSpan -> Comment -> R ()
spitCommentNow RealSrcSpan
spn Comment
comment
R ()
newline
R ()
newline
[([LComment], Pragma)] -> R ()
p_pragmas [([LComment], Pragma)]
pragmas
R ()
newline
case Maybe (XRec GhcPs ModuleName)
hsmodName of
Maybe (XRec GhcPs ModuleName)
Nothing -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just XRec GhcPs ModuleName
hsmodName' -> do
GenLocated SrcSpanAnnA ModuleName -> (ModuleName -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
hsmodName' ((ModuleName -> R ()) -> R ()) -> (ModuleName -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \ModuleName
name -> do
Maybe (LHsDoc GhcPs) -> (LHsDoc GhcPs -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LHsDoc GhcPs)
hsmodHaddockModHeader (HaddockStyle -> Bool -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe Bool
True)
ModuleName -> R ()
p_hsmodName ModuleName
name
R ()
breakpoint
Maybe (LocatedP (WarningTxt GhcPs))
-> (LocatedP (WarningTxt GhcPs) -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LocatedP (WarningTxt GhcPs))
hsmodDeprecMessage ((LocatedP (WarningTxt GhcPs) -> R ()) -> R ())
-> (LocatedP (WarningTxt GhcPs) -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \LocatedP (WarningTxt GhcPs)
w -> do
(WarningTxt GhcPs -> R ()) -> LocatedP (WarningTxt GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' WarningTxt GhcPs -> R ()
p_warningTxt LocatedP (WarningTxt GhcPs)
w
R ()
breakpoint
case Maybe (XRec GhcPs [LIE GhcPs])
hsmodExports of
Maybe (XRec GhcPs [LIE GhcPs])
Nothing -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just XRec GhcPs [LIE GhcPs]
l -> do
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> ([GenLocated SrcSpanAnnA (IE GhcPs)] -> R ()) -> R ()
forall l a.
HasSrcSpan l =>
GenLocated l [a] -> ([a] -> R ()) -> R ()
encloseLocated XRec GhcPs [LIE GhcPs]
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
l (([GenLocated SrcSpanAnnA (IE GhcPs)] -> R ()) -> R ())
-> ([GenLocated SrcSpanAnnA (IE GhcPs)] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \[GenLocated SrcSpanAnnA (IE GhcPs)]
exports -> do
R () -> R ()
inci ([LIE GhcPs] -> R ()
p_hsmodExports [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
exports)
R ()
breakpoint
Text -> R ()
txt Text
"where"
R ()
newline
R ()
newline
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
hsmodImports ((ImportDecl GhcPs -> R ())
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' ImportDecl GhcPs -> R ()
p_hsmodImport)
R ()
newline
[SrcSpan] -> R () -> R ()
switchLayout (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
hsmodDecls) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls FamilyStyle
Free [LHsDecl GhcPs]
hsmodDecls
R ()
newline
R ()
spitRemainingComments