Module.hs

{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}

-- | Rendering of modules.
module Ormolu.Printer.Meat.Module
  ( p_hsModule,
  )
where

import Control.Monad
import Data.Choice (pattern With)
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 LComment ->
  -- | Pragmas and the associated comments
  [([LComment], Pragma)] ->
  -- | AST to print
  HsModule GhcPs ->
  R ()
p_hsModule mstackHeader pragmas HsModule {..} = do
  let XModulePs {..} = hsmodExt
      deprecSpan = maybe [] (pure . getLocA) hsmodDeprecMessage
      exportSpans = maybe [] (pure . getLocA) hsmodExports
  switchLayout (deprecSpan <> exportSpans) $
    enterMultilineLayoutIfContainsDocEntries (maybe [] unLoc hsmodExports) $ do
      forM_ mstackHeader $ \(L spn comment) -> do
        spitCommentNow spn comment
        newline
      newline
      p_pragmas pragmas
      newline
      case hsmodName of
        Nothing -> return ()
        Just hsmodName' -> do
          located hsmodName' $ \name -> do
            forM_ hsmodHaddockModHeader (p_hsDoc Pipe (With #endNewline))
            p_hsmodName name
          breakpoint
          forM_ hsmodDeprecMessage $ \w -> do
            located' p_warningTxt w
            breakpoint
          case hsmodExports of
            Nothing -> return ()
            Just l -> do
              encloseLocated l $ \exports -> do
                inci (p_hsmodExports exports)
              breakpoint
          txt "where"
          newline
      newline
      forM_ hsmodImports (located' p_hsmodImport)
      newline
      switchLayout (getLocA <$> hsmodDecls) $ do
        p_hsDecls Free hsmodDecls
        newline
        spitRemainingComments