{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Ormolu.Printer.Meat.ImportExport
( p_hsmodExports,
p_hsmodImport,
)
where
import Control.Monad
import Data.Foldable (for_)
import Data.List (inits)
import Data.Text qualified as T
import GHC.Hs
import GHC.LanguageExtensions.Type
import GHC.Types.PkgQual
import GHC.Types.SrcLoc
import Ormolu.Config
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common
import Ormolu.Printer.Meat.Declaration.Warning
import Ormolu.Utils (RelativePos (..), attachRelativePos)
p_hsmodExports :: [LIE GhcPs] -> R ()
p_hsmodExports :: [LIE GhcPs] -> R ()
p_hsmodExports [LIE GhcPs]
xs =
Bool -> R () -> R ()
parens' Bool
False (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Layout
layout <- R Layout
getLayout
R ()
-> ((Bool, RelativePos, GenLocated SrcSpanAnnA (IE GhcPs)) -> R ())
-> [(Bool, RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
breakpoint
(\(Bool
isAllPrevDoc, RelativePos
p, GenLocated SrcSpanAnnA (IE GhcPs)
l) -> R () -> R ()
sitcc (GenLocated SrcSpanAnnA (IE GhcPs) -> (IE GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (IE GhcPs)
l (Layout -> Bool -> RelativePos -> IE GhcPs -> R ()
p_lie Layout
layout Bool
isAllPrevDoc RelativePos
p)))
([(RelativePos, LIE GhcPs)] -> [(Bool, RelativePos, LIE GhcPs)]
withAllPrevDoc ([(RelativePos, LIE GhcPs)] -> [(Bool, RelativePos, LIE GhcPs)])
-> [(RelativePos, LIE GhcPs)] -> [(Bool, RelativePos, LIE GhcPs)]
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [(RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
xs)
p_hsmodImport :: ImportDecl GhcPs -> R ()
p_hsmodImport :: ImportDecl GhcPs -> R ()
p_hsmodImport ImportDecl {Bool
Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
ImportDeclPkgQual GhcPs
XCImportDecl GhcPs
XRec GhcPs ModuleName
IsBootInterface
ImportDeclQualifiedStyle
ideclExt :: XCImportDecl GhcPs
ideclName :: XRec GhcPs ModuleName
ideclPkgQual :: ImportDeclPkgQual GhcPs
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImportList :: Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
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
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
..} = do
Bool
useQualifiedPost <- Extension -> R Bool
isExtensionEnabled Extension
ImportQualifiedPost
Text -> R ()
txt Text
"import"
R ()
space
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IsBootInterface
ideclSource IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot) (Text -> R ()
txt Text
"{-# SOURCE #-}")
R ()
space
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ideclSafe (Text -> R ()
txt Text
"safe")
R ()
space
Bool -> R () -> R ()
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 -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
RawPkgQual StringLiteral
slit -> StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom StringLiteral
slit
R ()
space
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ 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
ideclName ModuleName -> R ()
forall a. Outputable a => a -> R ()
atom
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
(ImportDeclQualifiedStyle -> Bool
isImportDeclQualified ImportDeclQualifiedStyle
ideclQualified Bool -> Bool -> Bool
&& Bool
useQualifiedPost)
(R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
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 -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just XRec GhcPs ModuleName
l -> do
R ()
space
Text -> R ()
txt Text
"as"
R ()
space
GenLocated SrcSpanAnnA ModuleName -> (ModuleName -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
l ModuleName -> R ()
forall a. Outputable a => a -> R ()
atom
R ()
space
case Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
ideclImportList of
Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Nothing -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (ImportListInterpretation
hiding, L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcPs)]
xs) -> do
case ImportListInterpretation
hiding of
ImportListInterpretation
Exactly -> () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ImportListInterpretation
EverythingBut -> Text -> R ()
txt Text
"hiding"
R ()
breakIfNotDiffFriendly
Bool -> R () -> R ()
parens' Bool
True (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Layout
layout <- R Layout
getLayout
R ()
-> ((RelativePos, GenLocated SrcSpanAnnA (IE GhcPs)) -> R ())
-> [(RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
breakpoint
(\(RelativePos
p, GenLocated SrcSpanAnnA (IE GhcPs)
l) -> R () -> R ()
sitcc (GenLocated SrcSpanAnnA (IE GhcPs) -> (IE GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (IE GhcPs)
l (Layout -> Bool -> RelativePos -> IE GhcPs -> R ()
p_lie Layout
layout Bool
False RelativePos
p)))
([GenLocated SrcSpanAnnA (IE GhcPs)]
-> [(RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated SrcSpanAnnA (IE GhcPs)]
xs)
R ()
newline
p_lie :: Layout -> Bool -> RelativePos -> IE GhcPs -> R ()
p_lie :: Layout -> Bool -> RelativePos -> IE GhcPs -> R ()
p_lie Layout
encLayout Bool
isAllPrevDoc RelativePos
relativePos = \case
IEVar XIEVar GhcPs
mwarn LIEWrappedName GhcPs
l1 -> do
Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
-> (GenLocated SrcSpanAnnP (WarningTxt GhcPs) -> R ()) -> R ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
XIEVar GhcPs
mwarn ((GenLocated SrcSpanAnnP (WarningTxt GhcPs) -> R ()) -> R ())
-> (GenLocated SrcSpanAnnP (WarningTxt GhcPs) -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnP (WarningTxt GhcPs)
warnTxt -> do
GenLocated SrcSpanAnnP (WarningTxt GhcPs)
-> (WarningTxt GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnP (WarningTxt GhcPs)
warnTxt WarningTxt GhcPs -> R ()
p_warningTxt
R ()
breakpoint
R () -> R ()
withComma (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> (IEWrappedName GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
l1 IEWrappedName GhcPs -> R ()
p_ieWrappedName
IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
l1 ->
R () -> R ()
withComma (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> (IEWrappedName GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
l1 IEWrappedName GhcPs -> R ()
p_ieWrappedName
IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
l1 -> R () -> R ()
withComma (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> (IEWrappedName GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
l1 IEWrappedName GhcPs -> R ()
p_ieWrappedName
R ()
space
Text -> R ()
txt Text
"(..)"
IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
l1 IEWildcard
w [LIEWrappedName GhcPs]
xs -> R () -> R ()
sitcc (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
withComma (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> (IEWrappedName GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
l1 IEWrappedName GhcPs -> R ()
p_ieWrappedName
R ()
breakIfNotDiffFriendly
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
let names :: [R ()]
names :: [R ()]
names = (IEWrappedName GhcPs -> R ())
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' IEWrappedName GhcPs -> R ()
p_ieWrappedName (GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
xs
Bool -> R () -> R ()
parens' Bool
False (R () -> R ()) -> ([R ()] -> R ()) -> [R ()] -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> (R () -> R ()) -> [R ()] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDelImportExport R () -> R ()
sitcc ([R ()] -> R ()) -> [R ()] -> R ()
forall a b. (a -> b) -> a -> b
$
case IEWildcard
w of
IEWildcard
NoIEWildcard -> [R ()]
names
IEWildcard Int
n ->
let ([R ()]
before, [R ()]
after) = Int -> [R ()] -> ([R ()], [R ()])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [R ()]
names
in [R ()]
before [R ()] -> [R ()] -> [R ()]
forall a. [a] -> [a] -> [a]
++ [Text -> R ()
txt Text
".."] [R ()] -> [R ()] -> [R ()]
forall a. [a] -> [a] -> [a]
++ [R ()]
after
IEModuleContents XIEModuleContents GhcPs
_ XRec GhcPs ModuleName
l1 ->
R () -> R ()
withComma (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
GenLocated SrcSpanAnnA ModuleName -> (ModuleName -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
l1 ModuleName -> R ()
p_hsmodName
IEGroup XIEGroup GhcPs
NoExtField
NoExtField Int
n LHsDoc GhcPs
str -> do
case RelativePos
relativePos of
RelativePos
SinglePos -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
RelativePos
FirstPos -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
RelativePos
MiddlePos -> R ()
newline
RelativePos
LastPos -> R ()
newline
R () -> R ()
indentDoc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ HaddockStyle -> Bool -> LHsDoc GhcPs -> R ()
p_hsDoc (Int -> HaddockStyle
Asterisk Int
n) Bool
False LHsDoc GhcPs
str
IEDoc XIEDoc GhcPs
NoExtField
NoExtField LHsDoc GhcPs
str ->
R () -> R ()
indentDoc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
HaddockStyle -> Bool -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe Bool
False LHsDoc GhcPs
str
IEDocNamed XIEDocNamed GhcPs
NoExtField
NoExtField String
str -> R () -> R ()
indentDoc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ Text
"-- $" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str
where
withComma :: R () -> R ()
withComma R ()
m =
case Layout
encLayout of
Layout
SingleLine ->
case RelativePos
relativePos of
RelativePos
SinglePos -> R () -> R ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void R ()
m
RelativePos
FirstPos -> R ()
m R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
comma
RelativePos
MiddlePos -> R ()
m R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
comma
RelativePos
LastPos -> R () -> R ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void R ()
m
Layout
MultiLine -> do
CommaStyle
commaStyle <- R CommaStyle
getCommaStyle
case CommaStyle
commaStyle of
CommaStyle
Leading ->
case RelativePos
relativePos of
RelativePos
FirstPos -> R ()
m
RelativePos
_ | Bool
isAllPrevDoc -> Int -> R () -> R ()
inciBy Int
2 R ()
m
RelativePos
SinglePos -> R ()
m
RelativePos
_ -> R ()
comma R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
m
CommaStyle
Trailing -> R ()
m R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
comma
indentDoc :: R () -> R ()
indentDoc R ()
m = do
CommaStyle
commaStyle <- R CommaStyle
getCommaStyle
case CommaStyle
commaStyle of
CommaStyle
Trailing -> R ()
m
CommaStyle
Leading ->
case RelativePos
relativePos of
RelativePos
SinglePos -> R ()
m
RelativePos
FirstPos -> R ()
m
RelativePos
_ -> Int -> R () -> R ()
inciBy Int
2 R ()
m
withAllPrevDoc :: [(RelativePos, LIE GhcPs)] -> [(Bool, RelativePos, LIE GhcPs)]
withAllPrevDoc :: [(RelativePos, LIE GhcPs)] -> [(Bool, RelativePos, LIE GhcPs)]
withAllPrevDoc [(RelativePos, LIE GhcPs)]
xs = ([(RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]
-> (RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))
-> (Bool, RelativePos, GenLocated SrcSpanAnnA (IE GhcPs)))
-> [[(RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]]
-> [(RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]
-> [(Bool, RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [(RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]
-> (RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))
-> (Bool, RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))
forall {t :: * -> *} {a} {l} {pass} {b} {c}.
Foldable t =>
t (a, GenLocated l (IE pass)) -> (b, c) -> (Bool, b, c)
go ([(RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]
-> [[(RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]]
forall a. [a] -> [[a]]
inits [(RelativePos, LIE GhcPs)]
[(RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]
xs) [(RelativePos, LIE GhcPs)]
[(RelativePos, GenLocated SrcSpanAnnA (IE GhcPs))]
xs
where
go :: t (a, GenLocated l (IE pass)) -> (b, c) -> (Bool, b, c)
go t (a, GenLocated l (IE pass))
prevElems (b
p, c
l) = (((a, GenLocated l (IE pass)) -> Bool)
-> t (a, GenLocated l (IE pass)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (GenLocated l (IE pass) -> Bool
forall {l} {pass}. GenLocated l (IE pass) -> Bool
isDoc (GenLocated l (IE pass) -> Bool)
-> ((a, GenLocated l (IE pass)) -> GenLocated l (IE pass))
-> (a, GenLocated l (IE pass))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, GenLocated l (IE pass)) -> GenLocated l (IE pass)
forall a b. (a, b) -> b
snd) t (a, GenLocated l (IE pass))
prevElems, b
p, c
l)
isDoc :: GenLocated l (IE pass) -> Bool
isDoc = \case
L l
_ IEDoc {} -> Bool
True
L l
_ IEGroup {} -> Bool
True
L l
_ IEDocNamed {} -> Bool
True
GenLocated l (IE pass)
_ -> Bool
False
parens' :: Bool -> R () -> R ()
parens' :: Bool -> R () -> R ()
parens' Bool
topLevelImport R ()
m =
(forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle)
-> R ImportExportStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f ImportExportStyle
forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle R ImportExportStyle -> (ImportExportStyle -> R ()) -> R ()
forall a b. R a -> (a -> R b) -> R b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ImportExportStyle
ImportExportDiffFriendly -> do
Text -> R ()
txt Text
"("
R ()
breakpoint'
R () -> R ()
sitcc R ()
body
R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout (Text -> R ()
txt Text
")") (Rational -> R () -> R ()
inciByFrac (-Rational
1) R ()
trailingParen)
ImportExportStyle
_ -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"("
R ()
body
Text -> R ()
txt Text
")"
where
body :: R ()
body = R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
singleLine R ()
multiLine
singleLine :: R ()
singleLine = R ()
m
multiLine :: R ()
multiLine = do
CommaStyle
commaStyle <- R CommaStyle
getCommaStyle
case CommaStyle
commaStyle of
CommaStyle
Leading -> do
R ()
space
R ()
m
R ()
newline
CommaStyle
Trailing -> do
R ()
space
R () -> R ()
sitcc R ()
m
R ()
newline
trailingParen :: R ()
trailingParen = if Bool
topLevelImport then Text -> R ()
txt Text
" )" else Text -> R ()
txt Text
")"
getCommaStyle :: R CommaStyle
getCommaStyle :: R CommaStyle
getCommaStyle =
(forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle)
-> R ImportExportStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f ImportExportStyle
forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle R ImportExportStyle
-> (ImportExportStyle -> R CommaStyle) -> R CommaStyle
forall a b. R a -> (a -> R b) -> R b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ImportExportStyle
ImportExportLeading -> CommaStyle -> R CommaStyle
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CommaStyle
Leading
ImportExportStyle
ImportExportTrailing -> CommaStyle -> R CommaStyle
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CommaStyle
Trailing
ImportExportStyle
ImportExportDiffFriendly -> CommaStyle -> R CommaStyle
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CommaStyle
Trailing
breakIfNotDiffFriendly :: R ()
breakIfNotDiffFriendly :: R ()
breakIfNotDiffFriendly =
(forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle)
-> R ImportExportStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f ImportExportStyle
forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle R ImportExportStyle -> (ImportExportStyle -> R ()) -> R ()
forall a b. R a -> (a -> R b) -> R b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ImportExportStyle
ImportExportDiffFriendly -> R ()
space
ImportExportStyle
_ -> R ()
breakpoint