{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Language.Haskell.Stylish.Step.ModuleHeader
( Config (..)
, BreakWhere (..)
, OpenBracket (..)
, defaultConfig
, step
) where
import Control.Applicative ((<|>))
import Control.Monad (guard, unless, when)
import Data.Foldable (forM_)
import Data.Maybe (fromMaybe, isJust,
listToMaybe)
import qualified GHC.Hs as GHC
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Unit.Module.Name as GHC
import Language.Haskell.Stylish.Comments
import qualified Language.Haskell.Stylish.Editor as Editor
import Language.Haskell.Stylish.GHC
import Language.Haskell.Stylish.Module
import Language.Haskell.Stylish.Ordering
import Language.Haskell.Stylish.Printer
import Language.Haskell.Stylish.Step
import qualified Language.Haskell.Stylish.Step.Imports as Imports
import Language.Haskell.Stylish.Util (flagEnds)
data Config = Config
{ Config -> Int
indent :: Int
, Config -> Bool
sort :: Bool
, Config -> Bool
separateLists :: Bool
, Config -> BreakWhere
breakWhere :: BreakWhere
, Config -> OpenBracket
openBracket :: OpenBracket
}
data OpenBracket
= SameLine
| NextLine
deriving (OpenBracket -> OpenBracket -> Bool
(OpenBracket -> OpenBracket -> Bool)
-> (OpenBracket -> OpenBracket -> Bool) -> Eq OpenBracket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenBracket -> OpenBracket -> Bool
$c/= :: OpenBracket -> OpenBracket -> Bool
== :: OpenBracket -> OpenBracket -> Bool
$c== :: OpenBracket -> OpenBracket -> Bool
Eq, Int -> OpenBracket -> ShowS
[OpenBracket] -> ShowS
OpenBracket -> String
(Int -> OpenBracket -> ShowS)
-> (OpenBracket -> String)
-> ([OpenBracket] -> ShowS)
-> Show OpenBracket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenBracket] -> ShowS
$cshowList :: [OpenBracket] -> ShowS
show :: OpenBracket -> String
$cshow :: OpenBracket -> String
showsPrec :: Int -> OpenBracket -> ShowS
$cshowsPrec :: Int -> OpenBracket -> ShowS
Show)
data BreakWhere
= Exports
| Single
| Inline
| Always
deriving (BreakWhere -> BreakWhere -> Bool
(BreakWhere -> BreakWhere -> Bool)
-> (BreakWhere -> BreakWhere -> Bool) -> Eq BreakWhere
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BreakWhere -> BreakWhere -> Bool
$c/= :: BreakWhere -> BreakWhere -> Bool
== :: BreakWhere -> BreakWhere -> Bool
$c== :: BreakWhere -> BreakWhere -> Bool
Eq, Int -> BreakWhere -> ShowS
[BreakWhere] -> ShowS
BreakWhere -> String
(Int -> BreakWhere -> ShowS)
-> (BreakWhere -> String)
-> ([BreakWhere] -> ShowS)
-> Show BreakWhere
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BreakWhere] -> ShowS
$cshowList :: [BreakWhere] -> ShowS
show :: BreakWhere -> String
$cshow :: BreakWhere -> String
showsPrec :: Int -> BreakWhere -> ShowS
$cshowsPrec :: Int -> BreakWhere -> ShowS
Show)
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Int -> Bool -> Bool -> BreakWhere -> OpenBracket -> Config
Config
{ indent :: Int
indent = Int
4
, sort :: Bool
sort = Bool
True
, separateLists :: Bool
separateLists = Bool
True
, breakWhere :: BreakWhere
breakWhere = BreakWhere
Exports
, openBracket :: OpenBracket
openBracket = OpenBracket
NextLine
}
step :: Maybe Int -> Config -> Step
step :: Maybe Int -> Config -> Step
step Maybe Int
maxCols = String -> (Lines -> Module -> Lines) -> Step
makeStep String
"Module header" ((Lines -> Module -> Lines) -> Step)
-> (Config -> Lines -> Module -> Lines) -> Config -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Config -> Lines -> Module -> Lines
printModuleHeader Maybe Int
maxCols
printModuleHeader :: Maybe Int -> Config -> Lines -> Module -> Lines
Maybe Int
maxCols Config
conf Lines
ls Module
lmodul =
let modul :: HsModule
modul = Module -> HsModule
forall l e. GenLocated l e -> e
GHC.unLoc Module
lmodul
name :: Maybe ModuleName
name = GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
GHC.unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> Maybe (GenLocated SrcSpanAnnA ModuleName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsModule -> Maybe (GenLocated SrcSpanAnnA ModuleName)
GHC.hsmodName HsModule
modul
haddocks :: Maybe LHsDocString
haddocks = HsModule -> Maybe LHsDocString
GHC.hsmodHaddockModHeader HsModule
modul
startLine :: Int
startLine = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Maybe Int
moduleLine Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RealSrcSpan -> Int
GHC.srcSpanStartLine (Maybe RealSrcSpan -> Maybe Int)
-> (SrcSpan -> Maybe RealSrcSpan) -> SrcSpan -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan (SrcSpan -> Maybe Int) -> SrcSpan -> Maybe Int
forall a b. (a -> b) -> a -> b
$
Module -> SrcSpan
forall l e. GenLocated l e -> l
GHC.getLoc Module
lmodul)
endLine :: Int
endLine = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Maybe Int
whereLine Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(do
SrcSpan
loc <- GenLocated
(SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA (GenLocated
(SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> SrcSpan)
-> Maybe
(GenLocated
(SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsModule -> Maybe (LocatedL [LIE GhcPs])
GHC.hsmodExports HsModule
modul
RealSrcSpan -> Int
GHC.srcSpanEndLine (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan SrcSpan
loc)
keywordLine :: AnnKeywordId -> Maybe Int
keywordLine AnnKeywordId
kw = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe ([Int] -> Maybe Int) -> [Int] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ do
GHC.EpAnn {AnnsModule
Anchor
EpAnnComments
entry :: forall ann. EpAnn ann -> Anchor
anns :: forall ann. EpAnn ann -> ann
comments :: forall ann. EpAnn ann -> EpAnnComments
comments :: EpAnnComments
anns :: AnnsModule
entry :: Anchor
..} <- EpAnn AnnsModule -> [EpAnn AnnsModule]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpAnn AnnsModule -> [EpAnn AnnsModule])
-> EpAnn AnnsModule -> [EpAnn AnnsModule]
forall a b. (a -> b) -> a -> b
$ HsModule -> EpAnn AnnsModule
GHC.hsmodAnn HsModule
modul
GHC.AddEpAnn AnnKeywordId
kw' (GHC.EpaSpan RealSrcSpan
s) <- AnnsModule -> [AddEpAnn]
GHC.am_main AnnsModule
anns
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ AnnKeywordId
kw AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
kw'
Int -> [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> [Int]) -> Int -> [Int]
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
s
moduleLine :: Maybe Int
moduleLine = AnnKeywordId -> Maybe Int
keywordLine AnnKeywordId
GHC.AnnModule
whereLine :: Maybe Int
whereLine = AnnKeywordId -> Maybe Int
keywordLine AnnKeywordId
GHC.AnnWhere
commentOnLine :: Int -> Maybe LEpaComment
commentOnLine Int
l = [LEpaComment] -> Maybe LEpaComment
forall a. [a] -> Maybe a
listToMaybe ([LEpaComment] -> Maybe LEpaComment)
-> [LEpaComment] -> Maybe LEpaComment
forall a b. (a -> b) -> a -> b
$ do
LEpaComment
comment <- EpAnn AnnsModule -> [LEpaComment]
forall a. EpAnn a -> [LEpaComment]
epAnnComments (EpAnn AnnsModule -> [LEpaComment])
-> EpAnn AnnsModule -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ HsModule -> EpAnn AnnsModule
GHC.hsmodAnn HsModule
modul
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
GHC.srcSpanStartLine (Anchor -> RealSrcSpan
GHC.anchor (Anchor -> RealSrcSpan) -> Anchor -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LEpaComment -> Anchor
forall l e. GenLocated l e -> l
GHC.getLoc LEpaComment
comment) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l
LEpaComment -> [LEpaComment]
forall (f :: * -> *) a. Applicative f => a -> f a
pure LEpaComment
comment
moduleComment :: Maybe LEpaComment
moduleComment = Maybe Int
moduleLine Maybe Int -> (Int -> Maybe LEpaComment) -> Maybe LEpaComment
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Maybe LEpaComment
commentOnLine
whereComment :: Maybe LEpaComment
whereComment =
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Maybe Int
whereLine Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
moduleLine) Maybe () -> Maybe Int -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Int
whereLine Maybe Int -> (Int -> Maybe LEpaComment) -> Maybe LEpaComment
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Maybe LEpaComment
commentOnLine
exportGroups :: Maybe [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
exportGroups = case HsModule -> Maybe (LocatedL [LIE GhcPs])
GHC.hsmodExports HsModule
modul of
Maybe (LocatedL [LIE GhcPs])
Nothing -> Maybe [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
forall a. Maybe a
Nothing
Just LocatedL [LIE GhcPs]
lexports -> [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
-> Maybe [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
forall a. a -> Maybe a
Just ([CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
-> Maybe [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))])
-> [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
-> Maybe [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
forall a b. (a -> b) -> a -> b
$ [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
-> [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
doSort ([CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
-> [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))])
-> [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
-> [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (IE GhcPs) -> Maybe RealSrcSpan)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [LEpaComment]
-> [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
forall a.
(a -> Maybe RealSrcSpan)
-> [a] -> [LEpaComment] -> [CommentGroup a]
commentGroups
(SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan)
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> SrcSpan)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA)
(GenLocated
(SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l e. GenLocated l e -> e
GHC.unLoc LocatedL [LIE GhcPs]
GenLocated
(SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
lexports)
(EpAnn AnnList -> [LEpaComment]
forall a. EpAnn a -> [LEpaComment]
epAnnComments (EpAnn AnnList -> [LEpaComment])
-> (SrcSpanAnn' (EpAnn AnnList) -> EpAnn AnnList)
-> SrcSpanAnn' (EpAnn AnnList)
-> [LEpaComment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnn' (EpAnn AnnList) -> EpAnn AnnList
forall a. SrcSpanAnn' a -> a
GHC.ann (SrcSpanAnn' (EpAnn AnnList) -> [LEpaComment])
-> SrcSpanAnn' (EpAnn AnnList) -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ GenLocated
(SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> SrcSpanAnn' (EpAnn AnnList)
forall l e. GenLocated l e -> l
GHC.getLoc LocatedL [LIE GhcPs]
GenLocated
(SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
lexports)
printedModuleHeader :: Lines
printedModuleHeader = PrinterConfig -> Printer () -> Lines
forall a. PrinterConfig -> Printer a -> Lines
runPrinter_
(Maybe Int -> PrinterConfig
PrinterConfig Maybe Int
maxCols)
(Config
-> Maybe ModuleName
-> Maybe [CommentGroup (LIE GhcPs)]
-> Maybe LHsDocString
-> Maybe LEpaComment
-> Maybe LEpaComment
-> Printer ()
printHeader
Config
conf Maybe ModuleName
name Maybe [CommentGroup (LIE GhcPs)]
Maybe [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
exportGroups Maybe LHsDocString
haddocks Maybe LEpaComment
moduleComment Maybe LEpaComment
whereComment)
changes :: Edits
changes = Block String -> (Lines -> Lines) -> Edits
Editor.changeLines
(Int -> Int -> Block String
forall a. Int -> Int -> Block a
Editor.Block Int
startLine Int
endLine)
(Lines -> Lines -> Lines
forall a b. a -> b -> a
const Lines
printedModuleHeader) in
Edits -> Lines -> Lines
Editor.apply Edits
changes Lines
ls
where
doSort :: [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
-> [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
doSort = if Config -> Bool
sort Config
conf then (CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))
-> CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
-> [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs) -> Ordering)
-> CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))
-> CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))
forall a. (a -> a -> Ordering) -> CommentGroup a -> CommentGroup a
commentGroupSort LIE GhcPs -> LIE GhcPs -> Ordering
GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs) -> Ordering
compareLIE) else [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
-> [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
forall a. a -> a
id
printHeader
:: Config
-> Maybe GHC.ModuleName
-> Maybe [CommentGroup (GHC.LIE GHC.GhcPs)]
-> Maybe GHC.LHsDocString
-> Maybe GHC.LEpaComment
-> Maybe GHC.LEpaComment
-> P ()
Config
conf Maybe ModuleName
mbName Maybe [CommentGroup (LIE GhcPs)]
mbExps Maybe LHsDocString
_ Maybe LEpaComment
mbModuleComment Maybe LEpaComment
mbWhereComment = do
Maybe ModuleName -> (ModuleName -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ModuleName
mbName ((ModuleName -> Printer ()) -> Printer ())
-> (ModuleName -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \ModuleName
name -> do
String -> Printer ()
putText String
"module"
Printer ()
space
String -> Printer ()
putText (ModuleName -> String
forall a. Outputable a => a -> String
showOutputable ModuleName
name)
case Maybe [CommentGroup (LIE GhcPs)]
mbExps of
Maybe [CommentGroup (LIE GhcPs)]
Nothing -> do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ModuleName -> Bool
forall a. Maybe a -> Bool
isJust Maybe ModuleName
mbName) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ case Config -> BreakWhere
breakWhere Config
conf of
BreakWhere
Always -> do
Printer ()
attachModuleComment
Printer ()
newline
Int -> Printer ()
spaces (Config -> Int
indent Config
conf)
BreakWhere
_ -> Printer ()
space
String -> Printer ()
putText String
"where"
Just [CommentGroup (LIE GhcPs)]
exports -> case Config -> BreakWhere
breakWhere Config
conf of
BreakWhere
Single | [] <- [CommentGroup (LIE GhcPs)]
exports -> do
Config -> [LIE GhcPs] -> Printer ()
printSingleLineExportList Config
conf []
Printer ()
attachModuleComment
BreakWhere
Single | [CommentGroup (LIE GhcPs)
egroup] <- [CommentGroup (LIE GhcPs)]
exports
, Bool -> Bool
not (CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs)) -> Bool
forall a. CommentGroup a -> Bool
commentGroupHasComments CommentGroup (LIE GhcPs)
CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))
egroup)
, [(GenLocated SrcSpanAnnA (IE GhcPs)
export, Maybe LEpaComment
_)] <- (CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))
-> [(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems CommentGroup (LIE GhcPs)
CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))
egroup) -> do
Config -> [LIE GhcPs] -> Printer ()
printSingleLineExportList Config
conf [LIE GhcPs
GenLocated SrcSpanAnnA (IE GhcPs)
export]
Printer ()
attachModuleComment
BreakWhere
Inline | [] <- [CommentGroup (LIE GhcPs)]
exports -> do
Config -> [LIE GhcPs] -> Printer ()
printSingleLineExportList Config
conf []
Printer ()
attachModuleComment
BreakWhere
Inline | [CommentGroup (LIE GhcPs)
egroup] <- [CommentGroup (LIE GhcPs)]
exports, Bool -> Bool
not (CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs)) -> Bool
forall a. CommentGroup a -> Bool
commentGroupHasComments CommentGroup (LIE GhcPs)
CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))
egroup) -> do
Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
(Config -> [LIE GhcPs] -> Printer ()
printSingleLineExportList Config
conf ([LIE GhcPs] -> Printer ()) -> [LIE GhcPs] -> Printer ()
forall a b. (a -> b) -> a -> b
$ ((GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)
-> GenLocated SrcSpanAnnA (IE GhcPs))
-> [(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)
-> GenLocated SrcSpanAnnA (IE GhcPs)
forall a b. (a, b) -> a
fst ([(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> [(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a b. (a -> b) -> a -> b
$ CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))
-> [(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgItems CommentGroup (LIE GhcPs)
CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))
egroup)
(do
Printer ()
attachOpenBracket
Printer ()
attachModuleComment
Config -> [CommentGroup (LIE GhcPs)] -> Printer ()
printMultiLineExportList Config
conf [CommentGroup (LIE GhcPs)]
exports)
BreakWhere
_ -> do
Printer ()
attachOpenBracket
Printer ()
attachModuleComment
Config -> [CommentGroup (LIE GhcPs)] -> Printer ()
printMultiLineExportList Config
conf [CommentGroup (LIE GhcPs)]
exports
Maybe EpaComment -> Printer ()
putMaybeLineComment (Maybe EpaComment -> Printer ()) -> Maybe EpaComment -> Printer ()
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc (LEpaComment -> EpaComment)
-> Maybe LEpaComment -> Maybe EpaComment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LEpaComment
mbWhereComment
where
attachModuleComment :: Printer ()
attachModuleComment = Maybe EpaComment -> Printer ()
putMaybeLineComment (Maybe EpaComment -> Printer ()) -> Maybe EpaComment -> Printer ()
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc (LEpaComment -> EpaComment)
-> Maybe LEpaComment -> Maybe EpaComment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LEpaComment
mbModuleComment
attachOpenBracket :: Printer ()
attachOpenBracket
| Config -> OpenBracket
openBracket Config
conf OpenBracket -> OpenBracket -> Bool
forall a. Eq a => a -> a -> Bool
== OpenBracket
SameLine = String -> Printer ()
putText String
" ("
| Bool
otherwise = () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
printSingleLineExportList
:: Config -> [GHC.LIE GHC.GhcPs] -> P ()
printSingleLineExportList :: Config -> [LIE GhcPs] -> Printer ()
printSingleLineExportList Config
conf [LIE GhcPs]
exports = do
Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"("
[LIE GhcPs] -> Printer ()
printExports [LIE GhcPs]
exports
String -> Printer ()
putText String
")" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"where"
where
printExports :: [GHC.LIE GHC.GhcPs] -> P ()
printExports :: [LIE GhcPs] -> Printer ()
printExports = \case
[] -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[LIE GhcPs
e] -> Config -> LIE GhcPs -> Printer ()
putExport Config
conf LIE GhcPs
e
(LIE GhcPs
e:[LIE GhcPs]
es) -> Config -> LIE GhcPs -> Printer ()
putExport Config
conf LIE GhcPs
e Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
comma Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [LIE GhcPs] -> Printer ()
printExports [LIE GhcPs]
es
printMultiLineExportList
:: Config
-> [CommentGroup (GHC.LIE GHC.GhcPs)]
-> P ()
printMultiLineExportList :: Config -> [CommentGroup (LIE GhcPs)] -> Printer ()
printMultiLineExportList Config
conf [CommentGroup (LIE GhcPs)]
exports = do
Printer ()
newline
Printer ()
doIndent Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
firstChar Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CommentGroup (LIE GhcPs)]
[CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
exports) Printer ()
space
((CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs)), Bool, Bool)
-> Printer ())
-> [(CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs)), Bool, Bool)]
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs)), Bool, Bool)
-> Printer ()
forall c.
(CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs)), Bool, c)
-> Printer ()
printExport ([(CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs)), Bool, Bool)]
-> Printer ())
-> [(CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs)), Bool, Bool)]
-> Printer ()
forall a b. (a -> b) -> a -> b
$ [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
-> [(CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs)), Bool, Bool)]
forall a. [a] -> [(a, Bool, Bool)]
flagEnds [CommentGroup (LIE GhcPs)]
[CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
exports
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CommentGroup (LIE GhcPs)]
[CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
exports) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doIndent
String -> Printer ()
putText String
")" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"where"
where
printExport :: (CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs)), Bool, c)
-> Printer ()
printExport (CommentGroup {[(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
[LEpaComment]
Block String
cgFollowing :: forall a. CommentGroup a -> [LEpaComment]
cgPrior :: forall a. CommentGroup a -> [LEpaComment]
cgBlock :: forall a. CommentGroup a -> Block String
cgFollowing :: [LEpaComment]
cgItems :: [(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
cgPrior :: [LEpaComment]
cgBlock :: Block String
cgItems :: forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
..}, Bool
firstGroup, c
_lastGroup) = do
[(LEpaComment, Bool, Bool)]
-> ((LEpaComment, Bool, Bool) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([LEpaComment] -> [(LEpaComment, Bool, Bool)]
forall a. [a] -> [(a, Bool, Bool)]
flagEnds [LEpaComment]
cgPrior) (((LEpaComment, Bool, Bool) -> Printer ()) -> Printer ())
-> ((LEpaComment, Bool, Bool) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(LEpaComment
cmt, Bool
start, Bool
_end) -> do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
firstGroup Bool -> Bool -> Bool
&& Bool
start) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
EpaComment -> Printer ()
putComment (EpaComment -> Printer ()) -> EpaComment -> Printer ()
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc LEpaComment
cmt
Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doIndent
[((GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment), Bool,
Bool)]
-> (((GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment), Bool,
Bool)
-> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
-> [((GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment), Bool,
Bool)]
forall a. [a] -> [(a, Bool, Bool)]
flagEnds [(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
cgItems) ((((GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment), Bool,
Bool)
-> Printer ())
-> Printer ())
-> (((GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment), Bool,
Bool)
-> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \((GenLocated SrcSpanAnnA (IE GhcPs)
export, Maybe LEpaComment
mbComment), Bool
start, Bool
_end) -> do
if Bool
firstGroup Bool -> Bool -> Bool
&& Bool
start then
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LEpaComment] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LEpaComment]
cgPrior) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
else
Printer ()
comma Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
Config -> LIE GhcPs -> Printer ()
putExport Config
conf LIE GhcPs
GenLocated SrcSpanAnnA (IE GhcPs)
export
Maybe EpaComment -> Printer ()
putMaybeLineComment (Maybe EpaComment -> Printer ()) -> Maybe EpaComment -> Printer ()
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc (LEpaComment -> EpaComment)
-> Maybe LEpaComment -> Maybe EpaComment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LEpaComment
mbComment
Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doIndent
firstChar :: String
firstChar = case Config -> OpenBracket
openBracket Config
conf of
OpenBracket
SameLine -> String
" "
OpenBracket
NextLine -> String
"("
doIndent :: Printer ()
doIndent = Int -> Printer ()
spaces (Config -> Int
indent Config
conf)
putExport :: Config -> GHC.LIE GHC.GhcPs -> P ()
putExport :: Config -> LIE GhcPs -> Printer ()
putExport Config
conf = Bool -> IE GhcPs -> Printer ()
Imports.printImport (Config -> Bool
separateLists Config
conf) (IE GhcPs -> Printer ())
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc