{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Ormolu.Printer.Meat.ImportExport
( p_hsmodExports,
p_hsmodImport,
)
where
import Control.Monad
import GHC
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 "("
R ()
breakpoint'
Text -> R ()
txt ")"
p_hsmodExports xs :: [LIE GhcPs]
xs =
BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Layout
layout <- R Layout
getLayout
R ()
-> ((RelativePos, LIE GhcPs) -> R ())
-> [(RelativePos, LIE GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
breakpoint
(\(p :: RelativePos
p, l :: LIE GhcPs
l) -> R () -> R ()
sitcc (LIE GhcPs -> (IE GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LIE GhcPs
l (Layout -> RelativePos -> IE GhcPs -> R ()
p_lie Layout
layout RelativePos
p)))
([LIE GhcPs] -> [(RelativePos, LIE GhcPs)]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos [LIE GhcPs]
xs)
p_hsmodImport :: Bool -> ImportDecl GhcPs -> R ()
p_hsmodImport :: Bool -> ImportDecl GhcPs -> R ()
p_hsmodImport useQualifiedPost :: Bool
useQualifiedPost ImportDecl {..} = do
Text -> R ()
txt "import"
R ()
space
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ideclSource (Text -> R ()
txt "{-# SOURCE #-}")
R ()
space
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ideclSafe (Text -> R ()
txt "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 "qualified")
R ()
space
case Maybe StringLiteral
ideclPkgQual of
Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just slit :: 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
Located ModuleName -> (ModuleName -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt "qualified")
case Maybe (Located ModuleName)
ideclAs of
Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just l :: Located ModuleName
l -> do
R ()
space
Text -> R ()
txt "as"
R ()
space
Located ModuleName -> (ModuleName -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located ModuleName
l ModuleName -> R ()
forall a. Outputable a => a -> R ()
atom
R ()
space
case Maybe (Bool, Located [LIE GhcPs])
ideclHiding of
Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (hiding :: Bool
hiding, _) ->
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hiding (Text -> R ()
txt "hiding")
case Maybe (Bool, Located [LIE GhcPs])
ideclHiding of
Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (_, L _ xs :: [LIE GhcPs]
xs) -> do
R ()
breakpoint
BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Layout
layout <- R Layout
getLayout
R ()
-> ((RelativePos, LIE GhcPs) -> R ())
-> [(RelativePos, LIE GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
breakpoint
(\(p :: RelativePos
p, l :: LIE GhcPs
l) -> R () -> R ()
sitcc (LIE GhcPs -> (IE GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LIE GhcPs
l (Layout -> RelativePos -> IE GhcPs -> R ()
p_lie Layout
layout RelativePos
p)))
([LIE GhcPs] -> [(RelativePos, LIE GhcPs)]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos [LIE GhcPs]
xs)
R ()
newline
p_hsmodImport _ (XImportDecl x :: XXImportDecl GhcPs
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXImportDecl GhcPs
x
p_lie :: Layout -> RelativePos -> IE GhcPs -> R ()
p_lie :: Layout -> RelativePos -> IE GhcPs -> R ()
p_lie encLayout :: Layout
encLayout relativePos :: RelativePos
relativePos = \case
IEVar NoExtField l1 :: LIEWrappedName (IdP GhcPs)
l1 -> do
Located (IEWrappedName RdrName)
-> (IEWrappedName RdrName -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
R ()
p_comma
IEThingAbs NoExtField l1 :: LIEWrappedName (IdP GhcPs)
l1 -> do
Located (IEWrappedName RdrName)
-> (IEWrappedName RdrName -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
R ()
p_comma
IEThingAll NoExtField l1 :: LIEWrappedName (IdP GhcPs)
l1 -> do
Located (IEWrappedName RdrName)
-> (IEWrappedName RdrName -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
R ()
space
Text -> R ()
txt "(..)"
R ()
p_comma
IEThingWith NoExtField l1 :: LIEWrappedName (IdP GhcPs)
l1 w :: IEWildcard
w xs :: [LIEWrappedName (IdP GhcPs)]
xs _ -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located (IEWrappedName RdrName)
-> (IEWrappedName RdrName -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
let names :: [R ()]
names :: [R ()]
names = (IEWrappedName RdrName -> R ())
-> Located (IEWrappedName RdrName) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' IEWrappedName RdrName -> R ()
p_ieWrappedName (Located (IEWrappedName RdrName) -> R ())
-> [Located (IEWrappedName RdrName)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LIEWrappedName (IdP GhcPs)]
[Located (IEWrappedName RdrName)]
xs
BracketStyle -> R () -> R ()
parens BracketStyle
N (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 ()
commaDel R () -> R ()
sitcc ([R ()] -> R ()) -> [R ()] -> R ()
forall a b. (a -> b) -> a -> b
$
case IEWildcard
w of
NoIEWildcard -> [R ()]
names
IEWildcard n :: Int
n ->
let (before :: [R ()]
before, after :: [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 ".."] [R ()] -> [R ()] -> [R ()]
forall a. [a] -> [a] -> [a]
++ [R ()]
after
R ()
p_comma
IEModuleContents NoExtField l1 :: Located ModuleName
l1 -> do
Located ModuleName -> (ModuleName -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located ModuleName
l1 ModuleName -> R ()
p_hsmodName
R ()
p_comma
IEGroup NoExtField n :: Int
n str :: HsDocString
str -> do
case RelativePos
relativePos of
SinglePos -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
FirstPos -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MiddlePos -> R ()
newline
LastPos -> R ()
newline
HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString (Int -> HaddockStyle
Asterisk Int
n) Bool
False (SrcSpanLess LHsDocString -> LHsDocString
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc HsDocString
SrcSpanLess LHsDocString
str)
IEDoc NoExtField str :: HsDocString
str ->
HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString HaddockStyle
Pipe Bool
False (SrcSpanLess LHsDocString -> LHsDocString
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc HsDocString
SrcSpanLess LHsDocString
str)
IEDocNamed NoExtField str :: String
str -> String -> R ()
p_hsDocName String
str
XIE x :: XXIE GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXIE GhcPs
x
where
p_comma :: R ()
p_comma =
case Layout
encLayout of
SingleLine ->
case RelativePos
relativePos of
SinglePos -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
FirstPos -> R ()
comma
MiddlePos -> R ()
comma
LastPos -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MultiLine -> R ()
comma