{-# 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
printModuleHeader :: Maybe Int -> Config -> Lines -> Module -> Lines
printModuleHeader 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  -- Comment attached to 'module'
    -> Maybe GHC.LEpaComment  -- Comment attached to 'where'
    -> P ()
printHeader :: Config
-> Maybe ModuleName
-> Maybe (LocatedP (WarningTxt GhcPs))
-> Maybe [CommentGroup (LIE GhcPs)]
-> Maybe LEpaComment
-> Maybe LEpaComment
-> Printer ()
printHeader 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)

-- NOTE(jaspervdj): This code is almost the same as the import printing in
-- 'Imports' and should be merged.
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