{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase     #-}
module Language.Haskell.Stylish.Step.ModuleHeader
  ( Config (..)
  , BreakWhere (..)
  , OpenBracket (..)
  , defaultConfig
  , step
  ) where

--------------------------------------------------------------------------------
import           ApiAnnotation                         (AnnKeywordId (..),
                                                        AnnotationComment (..))
import           Control.Monad                         (forM_, join, when)
import           Data.Bifunctor                        (second)
import           Data.Foldable                         (find, toList)
import           Data.Function                         ((&))
import qualified Data.List                             as L
import           Data.List.NonEmpty                    (NonEmpty (..))
import qualified Data.List.NonEmpty                    as NonEmpty
import           Data.Maybe                            (isJust, listToMaybe)
import qualified GHC.Hs.Doc                            as GHC
import           GHC.Hs.Extension                      (GhcPs)
import qualified GHC.Hs.ImpExp                         as GHC
import qualified Module                                as GHC
import           SrcLoc                                (GenLocated (..),
                                                        Located, RealLocated,
                                                        SrcSpan (..),
                                                        srcSpanEndLine,
                                                        srcSpanStartLine, unLoc)
import           Util                                  (notNull)

--------------------------------------------------------------------------------
import           Language.Haskell.Stylish.Block
import           Language.Haskell.Stylish.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


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
printModuleHeader :: Maybe Int -> Config -> Lines -> Module -> Lines
printModuleHeader Maybe Int
maxCols Config
conf Lines
ls Module
m =
  let
    header :: ModuleHeader
header = Module -> ModuleHeader
moduleHeader Module
m
    name :: Maybe (Located ModuleName)
name = ModuleHeader -> Maybe (Located ModuleName)
rawModuleName ModuleHeader
header
    haddocks :: Maybe LHsDocString
haddocks = ModuleHeader -> Maybe LHsDocString
rawModuleHaddocks ModuleHeader
header
    exports :: Maybe (Located [LIE GhcPs])
exports = ModuleHeader -> Maybe (Located [LIE GhcPs])
rawModuleExports ModuleHeader
header
    annotations :: [(ApiAnnKey, [SrcSpan])]
annotations = Module -> [(ApiAnnKey, [SrcSpan])]
rawModuleAnnotations Module
m

    relevantComments :: [RealLocated AnnotationComment]
    relevantComments :: [RealLocated AnnotationComment]
relevantComments
      = Module -> Comments
moduleComments Module
m
      Comments
-> (Comments -> [RealLocated AnnotationComment])
-> [RealLocated AnnotationComment]
forall a b. a -> (a -> b) -> b
& Comments -> [RealLocated AnnotationComment]
rawComments
      [RealLocated AnnotationComment]
-> ([RealLocated AnnotationComment]
    -> [RealLocated AnnotationComment])
-> [RealLocated AnnotationComment]
forall a b. a -> (a -> b) -> b
& Maybe (Located [LIE GhcPs])
-> [RealLocated AnnotationComment]
-> [RealLocated AnnotationComment]
forall a b. Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
dropAfterLocated Maybe (Located [LIE GhcPs])
exports
      [RealLocated AnnotationComment]
-> ([RealLocated AnnotationComment]
    -> [RealLocated AnnotationComment])
-> [RealLocated AnnotationComment]
forall a b. a -> (a -> b) -> b
& Maybe (Located ModuleName)
-> [RealLocated AnnotationComment]
-> [RealLocated AnnotationComment]
forall a b. Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
dropBeforeLocated Maybe (Located ModuleName)
name

    printedModuleHeader :: Lines
printedModuleHeader = PrinterConfig
-> [RealLocated AnnotationComment] -> Module -> Printer () -> Lines
forall a.
PrinterConfig
-> [RealLocated AnnotationComment] -> Module -> Printer a -> Lines
runPrinter_ (Maybe Int -> PrinterConfig
PrinterConfig Maybe Int
maxCols) [RealLocated AnnotationComment]
relevantComments
        Module
m (Config
-> Maybe (Located ModuleName)
-> Maybe (Located [LIE GhcPs])
-> Maybe LHsDocString
-> Printer ()
printHeader Config
conf Maybe (Located ModuleName)
name Maybe (Located [LIE GhcPs])
exports Maybe LHsDocString
haddocks)

    getBlock :: f (Located a) -> f (Block a)
getBlock f (Located a)
loc =
      Int -> Int -> Block a
forall a. Int -> Int -> Block a
Block (Int -> Int -> Block a) -> f Int -> f (Int -> Block a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Located a -> Int) -> f (Located a) -> f Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located a -> Int
forall a. Located a -> Int
getStartLineUnsafe f (Located a)
loc f (Int -> Block a) -> f Int -> f (Block a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Located a -> Int) -> f (Located a) -> f Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located a -> Int
forall a. Located a -> Int
getEndLineUnsafe f (Located a)
loc

    adjustOffsetFrom :: Block a -> Block a -> Maybe (Block a)
    adjustOffsetFrom :: Block a -> Block a -> Maybe (Block a)
adjustOffsetFrom (Block Int
s0 Int
_) b2 :: Block a
b2@(Block Int
s1 Int
e1)
      | Int
s0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s1 Bool -> Bool -> Bool
&& Int
s0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
e1 = Maybe (Block a)
forall a. Maybe a
Nothing
      | Int
s0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s1 = Block a -> Maybe (Block a)
forall a. a -> Maybe a
Just (Int -> Int -> Block a
forall a. Int -> Int -> Block a
Block (Int
s0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
e1)
      | Bool
otherwise = Block a -> Maybe (Block a)
forall a. a -> Maybe a
Just Block a
b2

    nameBlock :: Maybe (Block a)
nameBlock =
      Maybe (Located ModuleName) -> Maybe (Block a)
forall (f :: * -> *) a a.
Applicative f =>
f (Located a) -> f (Block a)
getBlock Maybe (Located ModuleName)
name

    exportsBlock :: Maybe (Block a)
exportsBlock =
      Maybe (Maybe (Block a)) -> Maybe (Block a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (Block a)) -> Maybe (Block a))
-> Maybe (Maybe (Block a)) -> Maybe (Block a)
forall a b. (a -> b) -> a -> b
$ Block a -> Block a -> Maybe (Block a)
forall a. Block a -> Block a -> Maybe (Block a)
adjustOffsetFrom (Block a -> Block a -> Maybe (Block a))
-> Maybe (Block a) -> Maybe (Block a -> Maybe (Block a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Block a)
forall a. Maybe (Block a)
nameBlock Maybe (Block a -> Maybe (Block a))
-> Maybe (Block a) -> Maybe (Maybe (Block a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Located [LIE GhcPs]) -> Maybe (Block a)
forall (f :: * -> *) a a.
Applicative f =>
f (Located a) -> f (Block a)
getBlock Maybe (Located [LIE GhcPs])
exports

    whereM :: Maybe SrcSpan
    whereM :: Maybe SrcSpan
whereM
      = [(ApiAnnKey, [SrcSpan])]
annotations
      [(ApiAnnKey, [SrcSpan])]
-> ([(ApiAnnKey, [SrcSpan])] -> [(ApiAnnKey, [SrcSpan])])
-> [(ApiAnnKey, [SrcSpan])]
forall a b. a -> (a -> b) -> b
& ((ApiAnnKey, [SrcSpan]) -> Bool)
-> [(ApiAnnKey, [SrcSpan])] -> [(ApiAnnKey, [SrcSpan])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(((SrcSpan
_, AnnKeywordId
w), [SrcSpan]
_)) -> AnnKeywordId
w AnnKeywordId -> AnnKeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId
AnnWhere)
      [(ApiAnnKey, [SrcSpan])]
-> ([(ApiAnnKey, [SrcSpan])] -> [SrcSpan]) -> [SrcSpan]
forall a b. a -> (a -> b) -> b
& ((ApiAnnKey, [SrcSpan]) -> SrcSpan)
-> [(ApiAnnKey, [SrcSpan])] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SrcSpan] -> SrcSpan
forall a. [a] -> a
head ([SrcSpan] -> SrcSpan)
-> ((ApiAnnKey, [SrcSpan]) -> [SrcSpan])
-> (ApiAnnKey, [SrcSpan])
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApiAnnKey, [SrcSpan]) -> [SrcSpan]
forall a b. (a, b) -> b
snd) -- get position of annot
      [SrcSpan] -> ([SrcSpan] -> [SrcSpan]) -> [SrcSpan]
forall a b. a -> (a -> b) -> b
& [SrcSpan] -> [SrcSpan]
forall a. Ord a => [a] -> [a]
L.sort
      [SrcSpan] -> ([SrcSpan] -> Maybe SrcSpan) -> Maybe SrcSpan
forall a b. a -> (a -> b) -> b
& [SrcSpan] -> Maybe SrcSpan
forall a. [a] -> Maybe a
listToMaybe

    isModuleHeaderWhere :: Block a -> Bool
    isModuleHeaderWhere :: Block a -> Bool
isModuleHeaderWhere Block a
w
      = Bool -> Bool
not
      (Bool -> Bool) -> ([Block a] -> Bool) -> [Block a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block a] -> Bool
forall a. [Block a] -> Bool
overlapping
      ([Block a] -> Bool) -> [Block a] -> Bool
forall a b. (a -> b) -> a -> b
$ [Block a
w] [Block a] -> [Block a] -> [Block a]
forall a. Semigroup a => a -> a -> a
<> Maybe (Block a) -> [Block a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (Block a)
forall a. Maybe (Block a)
nameBlock [Block a] -> [Block a] -> [Block a]
forall a. Semigroup a => a -> a -> a
<> Maybe (Block a) -> [Block a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (Block a)
forall a. Maybe (Block a)
exportsBlock

    toLineBlock :: SrcSpan -> Block a
    toLineBlock :: SrcSpan -> Block a
toLineBlock (RealSrcSpan RealSrcSpan
s) = Int -> Int -> Block a
forall a. Int -> Int -> Block a
Block (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
s) (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
s)
    toLineBlock SrcSpan
s
      = String -> Block a
forall a. HasCallStack => String -> a
error
      (String -> Block a) -> String -> Block a
forall a b. (a -> b) -> a -> b
$ String
"'where' block was not a RealSrcSpan" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SrcSpan -> String
forall a. Show a => a -> String
show SrcSpan
s

    whereBlock :: Maybe (Block a)
whereBlock
      = Maybe SrcSpan
whereM
      Maybe SrcSpan
-> (Maybe SrcSpan -> Maybe (Block a)) -> Maybe (Block a)
forall a b. a -> (a -> b) -> b
& (SrcSpan -> Block a) -> Maybe SrcSpan -> Maybe (Block a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SrcSpan -> Block a
forall a. SrcSpan -> Block a
toLineBlock
      Maybe (Block a)
-> (Maybe (Block a) -> Maybe (Block a)) -> Maybe (Block a)
forall a b. a -> (a -> b) -> b
& (Block a -> Bool) -> Maybe (Block a) -> Maybe (Block a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Block a -> Bool
forall a. Block a -> Bool
isModuleHeaderWhere

    deletes :: [Change a]
deletes =
      (Block a -> Change a) -> [Block a] -> [Change a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block a -> Change a
forall a. Block a -> Change a
delete ([Block a] -> [Change a]) -> [Block a] -> [Change a]
forall a b. (a -> b) -> a -> b
$ [Block a] -> [Block a]
forall a. [Block a] -> [Block a]
mergeAdjacent ([Block a] -> [Block a]) -> [Block a] -> [Block a]
forall a b. (a -> b) -> a -> b
$ Maybe (Block a) -> [Block a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (Block a)
forall a. Maybe (Block a)
nameBlock [Block a] -> [Block a] -> [Block a]
forall a. Semigroup a => a -> a -> a
<> Maybe (Block a) -> [Block a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (Block a)
forall a. Maybe (Block a)
exportsBlock [Block a] -> [Block a] -> [Block a]
forall a. Semigroup a => a -> a -> a
<> Maybe (Block a) -> [Block a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (Block a)
forall a. Maybe (Block a)
whereBlock

    startLine :: Int
startLine =
      Int -> (Block Any -> Int) -> Maybe (Block Any) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 Block Any -> Int
forall a. Block a -> Int
blockStart Maybe (Block Any)
forall a. Maybe (Block a)
nameBlock

    additions :: [Change String]
additions = [Int -> Lines -> Change String
forall a. Int -> [a] -> Change a
insert Int
startLine Lines
printedModuleHeader]

    changes :: [Change String]
changes = [Change String]
forall a. [Change a]
deletes [Change String] -> [Change String] -> [Change String]
forall a. Semigroup a => a -> a -> a
<> [Change String]
additions
  in
    [Change String] -> Lines -> Lines
forall a. [Change a] -> [a] -> [a]
applyChanges [Change String]
changes Lines
ls

printHeader
  :: Config
  -> Maybe (Located GHC.ModuleName)
  -> Maybe (Located [GHC.LIE GhcPs])
  -> Maybe GHC.LHsDocString
  -> P ()
printHeader :: Config
-> Maybe (Located ModuleName)
-> Maybe (Located [LIE GhcPs])
-> Maybe LHsDocString
-> Printer ()
printHeader Config
conf Maybe (Located ModuleName)
mname Maybe (Located [LIE GhcPs])
mexps Maybe LHsDocString
_ = do
  Maybe (Located ModuleName)
-> (Located ModuleName -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Located ModuleName)
mname \(L SrcSpan
_ 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 (Located [LIE GhcPs])
mexps of
    Maybe (Located [LIE GhcPs])
Nothing -> Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Located ModuleName) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Located ModuleName)
mname) do
      Maybe (Located ModuleName)
-> (Located ModuleName -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Located ModuleName)
mname \(L SrcSpan
nloc ModuleName
_) -> SrcSpan -> Printer ()
attachEolComment SrcSpan
nloc
      case Config -> BreakWhere
breakWhere Config
conf of
        BreakWhere
Always -> do
          Printer ()
newline
          Int -> Printer ()
spaces (Config -> Int
indent Config
conf)
        BreakWhere
_      -> Printer ()
space
      String -> Printer ()
putText String
"where"
    Just (L SrcSpan
loc [LIE GhcPs]
exps) -> do
      Maybe AnnotationComment
moduleComment <- Printer (Maybe AnnotationComment)
getModuleComment
      [([AnnotationComment], NonEmpty (LIE GhcPs))]
exportsWithComments <- (([AnnotationComment], NonEmpty (LIE GhcPs))
 -> ([AnnotationComment], NonEmpty (LIE GhcPs)))
-> [([AnnotationComment], NonEmpty (LIE GhcPs))]
-> [([AnnotationComment], NonEmpty (LIE GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty (LIE GhcPs) -> NonEmpty (LIE GhcPs))
-> ([AnnotationComment], NonEmpty (LIE GhcPs))
-> ([AnnotationComment], NonEmpty (LIE GhcPs))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second NonEmpty (LIE GhcPs) -> NonEmpty (LIE GhcPs)
doSort) ([([AnnotationComment], NonEmpty (LIE GhcPs))]
 -> [([AnnotationComment], NonEmpty (LIE GhcPs))])
-> Printer [([AnnotationComment], NonEmpty (LIE GhcPs))]
-> Printer [([AnnotationComment], NonEmpty (LIE GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LIE GhcPs]
-> Printer [([AnnotationComment], NonEmpty (LIE GhcPs))]
forall a.
[Located a] -> P [([AnnotationComment], NonEmpty (Located a))]
groupAttachedComments [LIE GhcPs]
exps
      case Config -> BreakWhere
breakWhere Config
conf of
        BreakWhere
Single
          | Just [LIE GhcPs]
exportsWithoutComments <- [([AnnotationComment], NonEmpty (LIE GhcPs))] -> Maybe [LIE GhcPs]
forall a.
[([AnnotationComment], NonEmpty (Located a))] -> Maybe [Located a]
groupWithoutComments [([AnnotationComment], NonEmpty (LIE GhcPs))]
exportsWithComments
          , [LIE GhcPs] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LIE GhcPs]
exportsWithoutComments Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
          -> do
              Maybe AnnotationComment -> Printer ()
forall (t :: * -> *).
Foldable t =>
t AnnotationComment -> Printer ()
attachModuleComment Maybe AnnotationComment
moduleComment
              Config -> Located [LIE GhcPs] -> Printer ()
printSingleLineExportList Config
conf (SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc [LIE GhcPs]
exportsWithoutComments)
        BreakWhere
Inline
          | Just [LIE GhcPs]
exportsWithoutComments <- [([AnnotationComment], NonEmpty (LIE GhcPs))] -> Maybe [LIE GhcPs]
forall a.
[([AnnotationComment], NonEmpty (Located a))] -> Maybe [Located a]
groupWithoutComments [([AnnotationComment], NonEmpty (LIE GhcPs))]
exportsWithComments
          -> do
              Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
               (   Maybe AnnotationComment -> Printer ()
forall (t :: * -> *).
Foldable t =>
t AnnotationComment -> Printer ()
attachModuleComment Maybe AnnotationComment
moduleComment
                Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Config -> Located [LIE GhcPs] -> Printer ()
printSingleLineExportList Config
conf (SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc [LIE GhcPs]
exportsWithoutComments))
               (   Printer ()
attachOpenBracket
                Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe AnnotationComment -> Printer ()
forall (t :: * -> *).
Foldable t =>
t AnnotationComment -> Printer ()
attachModuleComment Maybe AnnotationComment
moduleComment
                Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Config
-> Located [([AnnotationComment], NonEmpty (LIE GhcPs))]
-> Printer ()
printMultiLineExportList Config
conf (SrcSpan
-> [([AnnotationComment], NonEmpty (LIE GhcPs))]
-> Located [([AnnotationComment], NonEmpty (LIE GhcPs))]
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc [([AnnotationComment], NonEmpty (LIE GhcPs))]
exportsWithComments))
        BreakWhere
_ -> do
          Printer ()
attachOpenBracket
          Maybe AnnotationComment -> Printer ()
forall (t :: * -> *).
Foldable t =>
t AnnotationComment -> Printer ()
attachModuleComment Maybe AnnotationComment
moduleComment
          Config
-> Located [([AnnotationComment], NonEmpty (LIE GhcPs))]
-> Printer ()
printMultiLineExportList Config
conf (SrcSpan
-> [([AnnotationComment], NonEmpty (LIE GhcPs))]
-> Located [([AnnotationComment], NonEmpty (LIE GhcPs))]
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc [([AnnotationComment], NonEmpty (LIE GhcPs))]
exportsWithComments)
  where

    getModuleComment :: Printer (Maybe AnnotationComment)
getModuleComment = do
       Maybe (Maybe AnnotationComment)
maybemaybeComment <- (Located ModuleName -> Printer (Maybe AnnotationComment))
-> Maybe (Located ModuleName)
-> Printer (Maybe (Maybe AnnotationComment))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(L SrcSpan
nloc ModuleName
_) -> SrcSpan -> Printer (Maybe AnnotationComment)
removeModuleComment SrcSpan
nloc) Maybe (Located ModuleName)
mname
       Maybe AnnotationComment -> Printer (Maybe AnnotationComment)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AnnotationComment -> Printer (Maybe AnnotationComment))
-> Maybe AnnotationComment -> Printer (Maybe AnnotationComment)
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe AnnotationComment) -> Maybe AnnotationComment
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe AnnotationComment)
maybemaybeComment

    attachModuleComment :: t AnnotationComment -> Printer ()
attachModuleComment t AnnotationComment
moduleComment =
      (AnnotationComment -> Printer ())
-> t AnnotationComment -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\AnnotationComment
c -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnotationComment -> Printer ()
putComment AnnotationComment
c) t AnnotationComment
moduleComment

    doSort :: NonEmpty (LIE GhcPs) -> NonEmpty (LIE GhcPs)
doSort = if Config -> Bool
sort Config
conf then (LIE GhcPs -> LIE GhcPs -> Ordering)
-> NonEmpty (LIE GhcPs) -> NonEmpty (LIE GhcPs)
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NonEmpty.sortBy LIE GhcPs -> LIE GhcPs -> Ordering
compareLIE else NonEmpty (LIE GhcPs) -> NonEmpty (LIE GhcPs)
forall a. a -> a
id

    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 ()

removeModuleComment :: SrcSpan -> P (Maybe AnnotationComment)
removeModuleComment :: SrcSpan -> Printer (Maybe AnnotationComment)
removeModuleComment = \case
  UnhelpfulSpan FastString
_ -> Maybe AnnotationComment -> Printer (Maybe AnnotationComment)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe AnnotationComment
forall a. Maybe a
Nothing
  RealSrcSpan RealSrcSpan
rspan ->
    Int -> Printer (Maybe AnnotationComment)
removeLineComment (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
rspan)

attachEolComment :: SrcSpan -> P ()
attachEolComment :: SrcSpan -> Printer ()
attachEolComment = \case
  UnhelpfulSpan FastString
_ -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  RealSrcSpan RealSrcSpan
rspan ->
    Int -> Printer (Maybe AnnotationComment)
removeLineComment (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
rspan) Printer (Maybe AnnotationComment)
-> (Maybe AnnotationComment -> Printer ()) -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnnotationComment -> Printer ())
-> Maybe AnnotationComment -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \AnnotationComment
c -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnotationComment -> Printer ()
putComment AnnotationComment
c

attachEolCommentEnd :: SrcSpan -> P ()
attachEolCommentEnd :: SrcSpan -> Printer ()
attachEolCommentEnd = \case
  UnhelpfulSpan FastString
_ -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  RealSrcSpan RealSrcSpan
rspan ->
    Int -> Printer (Maybe AnnotationComment)
removeLineComment (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
rspan) Printer (Maybe AnnotationComment)
-> (Maybe AnnotationComment -> Printer ()) -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnnotationComment -> Printer ())
-> Maybe AnnotationComment -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \AnnotationComment
c -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnotationComment -> Printer ()
putComment AnnotationComment
c

printSingleLineExportList :: Config -> Located [GHC.LIE GhcPs] -> P ()
printSingleLineExportList :: Config -> Located [LIE GhcPs] -> Printer ()
printSingleLineExportList Config
conf (L SrcSpan
srcLoc [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 ()
printInlineExports [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" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpan -> Printer ()
attachEolCommentEnd SrcSpan
srcLoc
  where
    printInlineExports :: [GHC.LIE GhcPs] -> P ()
    printInlineExports :: [LIE GhcPs] -> Printer ()
printInlineExports = \case
      []     -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [LIE GhcPs
e]    -> Config -> LIE GhcPs -> Printer ()
printExport Config
conf LIE GhcPs
e
      (LIE GhcPs
e:[LIE GhcPs]
es) -> Config -> LIE GhcPs -> Printer ()
printExport 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 ()
printInlineExports [LIE GhcPs]
es

printMultiLineExportList
     :: Config
     -> Located [([AnnotationComment], NonEmpty (GHC.LIE GhcPs))]
     -> P ()
printMultiLineExportList :: Config
-> Located [([AnnotationComment], NonEmpty (LIE GhcPs))]
-> Printer ()
printMultiLineExportList Config
conf (L SrcSpan
srcLoc [([AnnotationComment], NonEmpty (LIE GhcPs))]
exportsWithComments) = 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 ()
when ([([AnnotationComment], NonEmpty (LIE GhcPs))] -> Bool
forall a. [a] -> Bool
notNull [([AnnotationComment], NonEmpty (LIE GhcPs))]
exportsWithComments) Printer ()
space
  [([AnnotationComment], NonEmpty (LIE GhcPs))] -> Printer ()
printExports [([AnnotationComment], NonEmpty (LIE GhcPs))]
exportsWithComments

  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" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpan -> Printer ()
attachEolCommentEnd SrcSpan
srcLoc
  where
    -- 'doIndent' is @x@:
    --
    -- > module Foo
    -- > xxxx( foo
    -- > xxxx, bar
    -- > xxxx) where
    --
    -- 'doHang' is @y@:
    --
    -- > module Foo
    -- > xxxx( -- Some comment
    -- > xxxxyyfoo
    -- > xxxx) where

    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)
    doHang :: Printer ()
doHang = Int -> Printer ()
pad (Config -> Int
indent Config
conf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)

    printExports :: [([AnnotationComment], NonEmpty (GHC.LIE GhcPs))] -> P ()
    printExports :: [([AnnotationComment], NonEmpty (LIE GhcPs))] -> Printer ()
printExports (([], LIE GhcPs
firstInGroup :| [LIE GhcPs]
groupRest) : [([AnnotationComment], NonEmpty (LIE GhcPs))]
rest) = do
      Config -> LIE GhcPs -> Printer ()
printExport Config
conf LIE GhcPs
firstInGroup
      Printer ()
newline
      Printer ()
doIndent
      [LIE GhcPs] -> Printer ()
printExportsGroupTail [LIE GhcPs]
groupRest
      [([AnnotationComment], NonEmpty (LIE GhcPs))] -> Printer ()
printExportsTail [([AnnotationComment], NonEmpty (LIE GhcPs))]
rest
    printExports ((AnnotationComment
firstComment : [AnnotationComment]
comments, LIE GhcPs
firstExport :| [LIE GhcPs]
groupRest) : [([AnnotationComment], NonEmpty (LIE GhcPs))]
rest) = do
      AnnotationComment -> Printer ()
putComment AnnotationComment
firstComment Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doIndent
      [AnnotationComment]
-> (AnnotationComment -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [AnnotationComment]
comments \AnnotationComment
c -> Printer ()
doHang Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnotationComment -> Printer ()
putComment AnnotationComment
c Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doIndent
      Printer ()
doHang
      Config -> LIE GhcPs -> Printer ()
printExport Config
conf LIE GhcPs
firstExport
      Printer ()
newline
      Printer ()
doIndent
      [LIE GhcPs] -> Printer ()
printExportsGroupTail [LIE GhcPs]
groupRest
      [([AnnotationComment], NonEmpty (LIE GhcPs))] -> Printer ()
printExportsTail [([AnnotationComment], NonEmpty (LIE GhcPs))]
rest
    printExports [] =
      Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doIndent

    printExportsTail :: [([AnnotationComment], NonEmpty (GHC.LIE GhcPs))] -> P ()
    printExportsTail :: [([AnnotationComment], NonEmpty (LIE GhcPs))] -> Printer ()
printExportsTail = (([AnnotationComment], NonEmpty (LIE GhcPs)) -> Printer ())
-> [([AnnotationComment], NonEmpty (LIE GhcPs))] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \([AnnotationComment]
comments, NonEmpty (LIE GhcPs)
exported) -> do
      [AnnotationComment]
-> (AnnotationComment -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [AnnotationComment]
comments \AnnotationComment
c -> Printer ()
doHang Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnotationComment -> Printer ()
putComment AnnotationComment
c Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doIndent
      NonEmpty (LIE GhcPs) -> (LIE GhcPs -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ NonEmpty (LIE GhcPs)
exported \LIE GhcPs
export -> do
        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
>> Config -> LIE GhcPs -> Printer ()
printExport Config
conf LIE GhcPs
export
        Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doIndent

    printExportsGroupTail :: [GHC.LIE GhcPs] -> P ()
    printExportsGroupTail :: [LIE GhcPs] -> Printer ()
printExportsGroupTail (LIE GhcPs
x : [LIE GhcPs]
xs) = [([AnnotationComment], NonEmpty (LIE GhcPs))] -> Printer ()
printExportsTail [([], LIE GhcPs
x LIE GhcPs -> [LIE GhcPs] -> NonEmpty (LIE GhcPs)
forall a. a -> [a] -> NonEmpty a
:| [LIE GhcPs]
xs)]
    printExportsGroupTail []       = () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- NOTE(jaspervdj): This code is almost the same as the import printing in
-- 'Imports' and should be merged.
printExport :: Config -> GHC.LIE GhcPs -> P ()
printExport :: Config -> LIE GhcPs -> Printer ()
printExport Config
conf = Bool -> IE GhcPs -> Printer ()
Imports.printImport (Config -> Bool
separateLists Config
conf) (IE GhcPs -> Printer ())
-> (LIE GhcPs -> IE GhcPs) -> LIE GhcPs -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcPs -> IE GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc