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

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

import Control.Monad
import qualified Data.Text as T
import GHC
import Ormolu.Imports
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.
p_hsModule ::
  -- | Shebangs
  [Located String] ->
  -- | Pragmas
  [Pragma] ->
  -- | AST to print
  ParsedSource ->
  R ()
p_hsModule :: [Located String] -> [Pragma] -> ParsedSource -> R ()
p_hsModule shebangs :: [Located String]
shebangs pragmas :: [Pragma]
pragmas (L moduleSpan :: SrcSpan
moduleSpan HsModule {..}) = do
  -- If span of exports in multiline, the whole thing is multiline. This is
  -- especially important because span of module itself always seems to have
  -- length zero, so it's not reliable for layout selection.
  let exportSpans :: [SrcSpan]
exportSpans = [SrcSpan]
-> (Located [LIE GhcPs] -> [SrcSpan])
-> Maybe (Located [LIE GhcPs])
-> [SrcSpan]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(L s :: SrcSpan
s _) -> [SrcSpan
s]) Maybe (Located [LIE GhcPs])
hsmodExports
      deprecSpan :: [SrcSpan]
deprecSpan = [SrcSpan]
-> (Located WarningTxt -> [SrcSpan])
-> Maybe (Located WarningTxt)
-> [SrcSpan]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(L s :: SrcSpan
s _) -> [SrcSpan
s]) Maybe (Located WarningTxt)
hsmodDeprecMessage
      spans' :: [SrcSpan]
spans' = [SrcSpan]
exportSpans [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [SrcSpan]
deprecSpan [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [SrcSpan
moduleSpan]
  [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
spans' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    [Located String] -> (Located String -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Located String]
shebangs ((Located String -> R ()) -> R ())
-> (Located String -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \x :: Located String
x ->
      Located String -> (String -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located String
x ((String -> R ()) -> R ()) -> (String -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \shebang :: String
shebang -> do
        Text -> R ()
txt (String -> Text
T.pack String
shebang)
        R ()
newline
    R ()
spitStackHeader
    R ()
newline
    [Pragma] -> R ()
p_pragmas [Pragma]
pragmas
    R ()
newline
    case Maybe (Located ModuleName)
hsmodName of
      Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just hsmodName' :: Located ModuleName
hsmodName' -> do
        Located ModuleName -> (ModuleName -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located ModuleName
hsmodName' ((ModuleName -> R ()) -> R ()) -> (ModuleName -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \name :: 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
        Maybe (Located WarningTxt) -> (Located WarningTxt -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Located WarningTxt)
hsmodDeprecMessage ((Located WarningTxt -> R ()) -> R ())
-> (Located WarningTxt -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \w :: Located WarningTxt
w -> do
          R ()
breakpoint
          (WarningTxt -> R ()) -> Located WarningTxt -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' WarningTxt -> R ()
p_moduleWarning Located WarningTxt
w
        case Maybe (Located [LIE GhcPs])
hsmodExports of
          Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just hsmodExports' :: Located [LIE GhcPs]
hsmodExports' -> do
            R ()
breakpoint
            R () -> R ()
inci ([LIE GhcPs] -> R ()
p_hsmodExports (Located [LIE GhcPs] -> SrcSpanLess (Located [LIE GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LIE GhcPs]
hsmodExports'))
        R ()
breakpoint
        Text -> R ()
txt "where"
        R ()
newline
    R ()
newline
    [LImportDecl GhcPs] -> (LImportDecl GhcPs -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([LImportDecl GhcPs] -> [LImportDecl GhcPs]
sortImports [LImportDecl GhcPs]
hsmodImports) ((ImportDecl GhcPs -> R ()) -> LImportDecl GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' ImportDecl GhcPs -> R ()
p_hsmodImport)
    R ()
newline
    [SrcSpan] -> R () -> R ()
switchLayout (LHsDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LHsDecl GhcPs -> SrcSpan) -> [LHsDecl GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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