{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Rendering of modules.
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

-- | Render a module-like entity (either a regular module or a backpack
-- signature).
p_hsModule ::
  -- | Stack header
  Maybe (RealLocated Comment) ->
  -- | Pragmas and the associated comments
  [([RealLocated Comment], Pragma)] ->
  -- | AST to print
  HsModule ->
  R ()
p_hsModule :: Maybe (RealLocated Comment)
-> [([RealLocated Comment], Pragma)] -> HsModule -> R ()
p_hsModule Maybe (RealLocated Comment)
mstackHeader [([RealLocated Comment], Pragma)]
pragmas HsModule {[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe LHsDocString
Maybe (LocatedP WarningTxt)
Maybe (LocatedL [LIE GhcPs])
Maybe (LocatedA ModuleName)
LayoutInfo
EpAnn AnnsModule
hsmodName :: HsModule -> Maybe (LocatedA ModuleName)
hsmodLayout :: HsModule -> LayoutInfo
hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodHaddockModHeader :: HsModule -> Maybe LHsDocString
hsmodExports :: HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodDeprecMessage :: HsModule -> Maybe (LocatedP WarningTxt)
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodAnn :: HsModule -> EpAnn AnnsModule
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (LocatedP WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (LocatedL [LIE GhcPs])
hsmodName :: Maybe (LocatedA ModuleName)
hsmodLayout :: LayoutInfo
hsmodAnn :: EpAnn AnnsModule
..} = do
  let deprecSpan :: [SrcSpan]
deprecSpan = [SrcSpan]
-> (LocatedP WarningTxt -> [SrcSpan])
-> Maybe (LocatedP WarningTxt)
-> [SrcSpan]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (SrcSpan -> [SrcSpan]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpan -> [SrcSpan])
-> (LocatedP WarningTxt -> SrcSpan)
-> LocatedP WarningTxt
-> [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedP WarningTxt -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) Maybe (LocatedP WarningTxt)
hsmodDeprecMessage
      exportSpans :: [SrcSpan]
exportSpans = [SrcSpan]
-> (GenLocated
      (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
    -> [SrcSpan])
-> Maybe
     (GenLocated
        (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)])
-> [SrcSpan]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (SrcSpan -> [SrcSpan]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpan -> [SrcSpan])
-> (GenLocated
      (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
    -> SrcSpan)
-> GenLocated
     (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) Maybe
  (GenLocated
     (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)])
Maybe (LocatedL [LIE 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 (RealLocated Comment)
-> (RealLocated Comment -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (RealLocated Comment)
mstackHeader ((RealLocated Comment -> R ()) -> R ())
-> (RealLocated Comment -> 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
    [([RealLocated Comment], Pragma)] -> R ()
p_pragmas [([RealLocated Comment], Pragma)]
pragmas
    R ()
newline
    case Maybe (LocatedA ModuleName)
hsmodName of
      Maybe (LocatedA ModuleName)
Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just LocatedA ModuleName
hsmodName' -> do
        LocatedA ModuleName -> (ModuleName -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA ModuleName
hsmodName' ((ModuleName -> R ()) -> R ()) -> (ModuleName -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \ModuleName
name -> do
          Maybe LHsDocString -> (LHsDocString -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe LHsDocString
hsmodHaddockModHeader (HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString HaddockStyle
Pipe Bool
True)
          ModuleName -> R ()
p_hsmodName ModuleName
name
        R ()
breakpoint
        Maybe (LocatedP WarningTxt)
-> (LocatedP WarningTxt -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LocatedP WarningTxt)
hsmodDeprecMessage ((LocatedP WarningTxt -> R ()) -> R ())
-> (LocatedP WarningTxt -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \LocatedP WarningTxt
w -> do
          (WarningTxt -> R ()) -> LocatedP WarningTxt -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' WarningTxt -> R ()
p_moduleWarning LocatedP WarningTxt
w
          R ()
breakpoint
        case Maybe (LocatedL [LIE GhcPs])
hsmodExports of
          Maybe (LocatedL [LIE GhcPs])
Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just LocatedL [LIE GhcPs]
l -> do
            GenLocated
  (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> ([GenLocated SrcSpanAnnA (IE GhcPs)] -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
  (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
LocatedL [LIE 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 [GenLocated SrcSpanAnnA (IE GhcPs)]
[LIE 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_ [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
[LImportDecl 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
<$> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl 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