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

-- | Rendering of import and export lists.
module Ormolu.Printer.Meat.ImportExport
  ( p_hsmodExports,
    p_hsmodImport,
  )
where

import Control.Monad
import GHC.Hs
import GHC.LanguageExtensions.Type
import GHC.Types.PkgQual
import GHC.Types.SrcLoc
import GHC.Unit.Types
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common
import Ormolu.Utils (RelativePos (..), attachRelativePos)

p_hsmodExports :: [LIE GhcPs] -> R ()
p_hsmodExports :: [LIE GhcPs] -> R ()
p_hsmodExports [] = do
  Text -> R ()
txt Text
"("
  R ()
breakpoint'
  Text -> R ()
txt Text
")"
p_hsmodExports [LIE GhcPs]
xs =
  BracketStyle -> R () -> R ()
parens BracketStyle
N forall a b. (a -> b) -> a -> b
$ do
    Layout
layout <- R Layout
getLayout
    forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
      R ()
breakpoint
      (\(RelativePos
p, GenLocated SrcSpanAnnA (IE GhcPs)
l) -> R () -> R ()
sitcc (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (IE GhcPs)
l (Layout -> RelativePos -> IE GhcPs -> R ()
p_lie Layout
layout RelativePos
p)))
      (forall a. [a] -> [(RelativePos, a)]
attachRelativePos [LIE GhcPs]
xs)

p_hsmodImport :: ImportDecl GhcPs -> R ()
p_hsmodImport :: ImportDecl GhcPs -> R ()
p_hsmodImport ImportDecl {Bool
Maybe (Bool, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
ImportDeclQualifiedStyle
ImportDeclPkgQual GhcPs
XRec GhcPs ModuleName
XCImportDecl GhcPs
SourceText
IsBootInterface
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: ImportDeclPkgQual GhcPs
ideclName :: XRec GhcPs ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
..} = do
  Bool
useQualifiedPost <- Extension -> R Bool
isExtensionEnabled Extension
ImportQualifiedPost
  Text -> R ()
txt Text
"import"
  R ()
space
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IsBootInterface
ideclSource forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot) (Text -> R ()
txt Text
"{-# SOURCE #-}")
  R ()
space
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ideclSafe (Text -> R ()
txt Text
"safe")
  R ()
space
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    (ImportDeclQualifiedStyle -> Bool
isImportDeclQualified ImportDeclQualifiedStyle
ideclQualified Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
useQualifiedPost)
    (Text -> R ()
txt Text
"qualified")
  R ()
space
  case ImportDeclPkgQual GhcPs
ideclPkgQual of
    ImportDeclPkgQual GhcPs
RawPkgQual
NoRawPkgQual -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    RawPkgQual StringLiteral
slit -> forall a. Outputable a => a -> R ()
atom StringLiteral
slit
  R ()
space
  R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs ModuleName
ideclName forall a. Outputable a => a -> R ()
atom
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
      (ImportDeclQualifiedStyle -> Bool
isImportDeclQualified ImportDeclQualifiedStyle
ideclQualified Bool -> Bool -> Bool
&& Bool
useQualifiedPost)
      (R ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"qualified")
    case Maybe (XRec GhcPs ModuleName)
ideclAs of
      Maybe (XRec GhcPs ModuleName)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just XRec GhcPs ModuleName
l -> do
        R ()
space
        Text -> R ()
txt Text
"as"
        R ()
space
        forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs ModuleName
l forall a. Outputable a => a -> R ()
atom
    R ()
space
    case Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding of
      Maybe (Bool, XRec GhcPs [LIE GhcPs])
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (Bool
hiding, XRec GhcPs [LIE GhcPs]
_) ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hiding (Text -> R ()
txt Text
"hiding")
    case Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding of
      Maybe (Bool, XRec GhcPs [LIE GhcPs])
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (Bool
_, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcPs)]
xs) -> do
        R ()
breakpoint
        BracketStyle -> R () -> R ()
parens BracketStyle
N forall a b. (a -> b) -> a -> b
$ do
          Layout
layout <- R Layout
getLayout
          forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
            R ()
breakpoint
            (\(RelativePos
p, GenLocated SrcSpanAnnA (IE GhcPs)
l) -> R () -> R ()
sitcc (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (IE GhcPs)
l (Layout -> RelativePos -> IE GhcPs -> R ()
p_lie Layout
layout RelativePos
p)))
            (forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated SrcSpanAnnA (IE GhcPs)]
xs)
    R ()
newline

p_lie :: Layout -> RelativePos -> IE GhcPs -> R ()
p_lie :: Layout -> RelativePos -> IE GhcPs -> R ()
p_lie Layout
encLayout RelativePos
relativePos = \case
  IEVar NoExtField
XIEVar GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
l1 -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
    R ()
p_comma
  IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
l1 -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
    R ()
p_comma
  IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
l1 -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
    R ()
space
    Text -> R ()
txt Text
"(..)"
    R ()
p_comma
  IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
l1 IEWildcard
w [LIEWrappedName (IdP GhcPs)]
xs -> R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
    R ()
breakpoint
    R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
      let names :: [R ()]
          names :: [R ()]
names = forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' IEWrappedName RdrName -> R ()
p_ieWrappedName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LIEWrappedName (IdP GhcPs)]
xs
      BracketStyle -> R () -> R ()
parens BracketStyle
N forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$
        case IEWildcard
w of
          IEWildcard
NoIEWildcard -> [R ()]
names
          IEWildcard Int
n ->
            let ([R ()]
before, [R ()]
after) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [R ()]
names
             in [R ()]
before forall a. [a] -> [a] -> [a]
++ [Text -> R ()
txt Text
".."] forall a. [a] -> [a] -> [a]
++ [R ()]
after
    R ()
p_comma
  IEModuleContents XIEModuleContents GhcPs
_ XRec GhcPs ModuleName
l1 -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs ModuleName
l1 ModuleName -> R ()
p_hsmodName
    R ()
p_comma
  IEGroup NoExtField
XIEGroup GhcPs
NoExtField Int
n LHsDoc GhcPs
str -> do
    case RelativePos
relativePos of
      RelativePos
SinglePos -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      RelativePos
FirstPos -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      RelativePos
MiddlePos -> R ()
newline
      RelativePos
LastPos -> R ()
newline
    HaddockStyle -> Bool -> LHsDoc GhcPs -> R ()
p_hsDoc (Int -> HaddockStyle
Asterisk Int
n) Bool
False LHsDoc GhcPs
str
  IEDoc NoExtField
XIEDoc GhcPs
NoExtField LHsDoc GhcPs
str ->
    HaddockStyle -> Bool -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe Bool
False LHsDoc GhcPs
str
  IEDocNamed NoExtField
XIEDocNamed GhcPs
NoExtField String
str -> String -> R ()
p_hsDocName String
str
  where
    p_comma :: R ()
p_comma =
      case Layout
encLayout of
        Layout
SingleLine ->
          case RelativePos
relativePos of
            RelativePos
SinglePos -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            RelativePos
FirstPos -> R ()
comma
            RelativePos
MiddlePos -> R ()
comma
            RelativePos
LastPos -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Layout
MultiLine -> R ()
comma