{-# 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
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)
[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 ()
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)
= \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 ()
= \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 ()
= \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
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 ()
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