{-# 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 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)
import qualified GHC.Unit.Module.Warnings as GHC
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
$c== :: OpenBracket -> OpenBracket -> Bool
== :: OpenBracket -> OpenBracket -> Bool
$c/= :: OpenBracket -> OpenBracket -> Bool
/= :: 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
$cshowsPrec :: Int -> OpenBracket -> ShowS
showsPrec :: Int -> OpenBracket -> ShowS
$cshow :: OpenBracket -> String
show :: OpenBracket -> String
$cshowList :: [OpenBracket] -> ShowS
showList :: [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
$c== :: BreakWhere -> BreakWhere -> Bool
== :: BreakWhere -> BreakWhere -> Bool
$c/= :: BreakWhere -> BreakWhere -> Bool
/= :: 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
$cshowsPrec :: Int -> BreakWhere -> ShowS
showsPrec :: Int -> BreakWhere -> ShowS
$cshow :: BreakWhere -> String
show :: BreakWhere -> String
$cshowList :: [BreakWhere] -> ShowS
showList :: [BreakWhere] -> ShowS
Show)
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = 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 GhcPs
modul = Module -> HsModule GhcPs
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 GhcPs -> Maybe (XRec GhcPs ModuleName)
forall p. HsModule p -> Maybe (XRec p ModuleName)
GHC.hsmodName HsModule GhcPs
modul
deprecMsg :: Maybe (LocatedP (WarningTxt GhcPs))
deprecMsg = XModulePs -> Maybe (LocatedP (WarningTxt GhcPs))
GHC.hsmodDeprecMessage (XModulePs -> Maybe (LocatedP (WarningTxt GhcPs)))
-> XModulePs -> Maybe (LocatedP (WarningTxt GhcPs))
forall a b. (a -> b) -> a -> b
$ HsModule GhcPs -> XCModule GhcPs
forall p. HsModule p -> XCModule p
GHC.hsmodExt HsModule GhcPs
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 a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
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 a. Maybe a -> Maybe a -> Maybe a
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 GhcPs -> Maybe (XRec GhcPs [LIE GhcPs])
forall p. HsModule p -> Maybe (XRec p [LIE p])
GHC.hsmodExports HsModule GhcPs
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 {EpAnnComments
Anchor
AnnsModule
entry :: Anchor
anns :: AnnsModule
comments :: EpAnnComments
entry :: forall ann. EpAnn ann -> Anchor
anns :: forall ann. EpAnn ann -> ann
comments :: forall ann. EpAnn ann -> EpAnnComments
..} <- EpAnn AnnsModule -> [EpAnn AnnsModule]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpAnn AnnsModule -> [EpAnn AnnsModule])
-> EpAnn AnnsModule -> [EpAnn AnnsModule]
forall a b. (a -> b) -> a -> b
$ XModulePs -> EpAnn AnnsModule
GHC.hsmodAnn (XModulePs -> EpAnn AnnsModule) -> XModulePs -> EpAnn AnnsModule
forall a b. (a -> b) -> a -> b
$ HsModule GhcPs -> XCModule GhcPs
forall p. HsModule p -> XCModule p
GHC.hsmodExt HsModule GhcPs
modul
GHC.AddEpAnn AnnKeywordId
kw' (GHC.EpaSpan RealSrcSpan
s Maybe BufSpan
_) <- 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 a. a -> [a]
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
$ XModulePs -> EpAnn AnnsModule
GHC.hsmodAnn (XModulePs -> EpAnn AnnsModule) -> XModulePs -> EpAnn AnnsModule
forall a b. (a -> b) -> a -> b
$ HsModule GhcPs -> XCModule GhcPs
forall p. HsModule p -> XCModule p
GHC.hsmodExt HsModule GhcPs
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 a. a -> [a]
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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Int
whereLine Maybe Int -> (Int -> Maybe LEpaComment) -> Maybe LEpaComment
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 GhcPs -> Maybe (XRec GhcPs [LIE GhcPs])
forall p. HsModule p -> Maybe (XRec p [LIE p])
GHC.hsmodExports HsModule GhcPs
modul of
Maybe (XRec GhcPs [LIE GhcPs])
Nothing -> Maybe [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
forall a. Maybe a
Nothing
Just XRec GhcPs [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 XRec GhcPs [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 XRec GhcPs [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 (LocatedP (WarningTxt GhcPs))
-> Maybe [CommentGroup (LIE GhcPs)]
-> Maybe LEpaComment
-> Maybe LEpaComment
-> Printer ()
printHeader
Config
conf Maybe ModuleName
name Maybe (LocatedP (WarningTxt GhcPs))
deprecMsg Maybe [CommentGroup (LIE GhcPs)]
Maybe [CommentGroup (GenLocated SrcSpanAnnA (IE GhcPs))]
exportGroups 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 a b. (a -> b) -> [a] -> [b]
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 (GHC.LocatedP (GHC.WarningTxt GHC.GhcPs))
-> Maybe [CommentGroup (GHC.LIE GHC.GhcPs)]
-> Maybe GHC.LEpaComment
-> Maybe GHC.LEpaComment
-> P ()
Config
conf Maybe ModuleName
mbName Maybe (LocatedP (WarningTxt GhcPs))
mbDeprec Maybe [CommentGroup (LIE GhcPs)]
mbExps 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)
Maybe (LocatedP (WarningTxt GhcPs))
-> (LocatedP (WarningTxt GhcPs) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LocatedP (WarningTxt GhcPs))
mbDeprec \LocatedP (WarningTxt GhcPs)
deprec -> do
String -> Printer ()
putText String
" "
String -> Printer ()
putText (LocatedP (WarningTxt GhcPs) -> String
forall a. Outputable a => a -> String
showOutputable LocatedP (WarningTxt GhcPs)
deprec)
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)
-> LIE GhcPs)
-> [(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
-> [LIE GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment) -> LIE GhcPs
(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)
-> GenLocated SrcSpanAnnA (IE GhcPs)
forall a b. (a, b) -> a
fst ([(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
-> [LIE GhcPs])
-> [(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
-> [LIE 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 a. a -> Printer a
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 a b. Printer a -> Printer b -> Printer b
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 a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
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 a. a -> Printer a
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 a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
comma Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
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 a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
firstChar Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
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 a. [a] -> 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 a. [a] -> 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 a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doIndent
String -> Printer ()
putText String
")" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
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
cgItems :: forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgBlock :: Block String
cgPrior :: [LEpaComment]
cgItems :: [(GenLocated SrcSpanAnnA (IE GhcPs), Maybe LEpaComment)]
cgFollowing :: [LEpaComment]
cgBlock :: forall a. CommentGroup a -> Block String
cgPrior :: forall a. CommentGroup a -> [LEpaComment]
cgFollowing :: forall a. CommentGroup a -> [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 a b. Printer a -> Printer b -> Printer b
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 a b. Printer a -> Printer b -> Printer b
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 a. [a] -> 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 a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
else
Printer ()
comma Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
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 a b. Printer a -> Printer b -> Printer b
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