{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Language.Haskell.Stylish.Step.Imports
( Options (..)
, defaultOptions
, ImportAlign (..)
, ListAlign (..)
, LongListAlign (..)
, EmptyListAlign (..)
, ListPadding (..)
, step
, printImport
) where
import Control.Monad (forM_, void, when)
import Data.Foldable (toList)
import Data.Function (on, (&))
import Data.Functor (($>))
import Data.List (sortBy)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Set as Set
import qualified GHC.Data.FastString as GHC
import qualified GHC.Hs as GHC
import qualified GHC.Types.Name.Reader as GHC
import qualified GHC.Types.SourceText as GHC
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Unit.Module.Name as GHC
import qualified GHC.Unit.Types as GHC
import Language.Haskell.Stylish.Block
import qualified Language.Haskell.Stylish.Editor as Editor
import Language.Haskell.Stylish.Module
import Language.Haskell.Stylish.Ordering
import Language.Haskell.Stylish.Printer
import Language.Haskell.Stylish.Step
import Language.Haskell.Stylish.Util
data Options = Options
{ Options -> ImportAlign
importAlign :: ImportAlign
, Options -> ListAlign
listAlign :: ListAlign
, Options -> Bool
padModuleNames :: Bool
, Options -> LongListAlign
longListAlign :: LongListAlign
, Options -> EmptyListAlign
emptyListAlign :: EmptyListAlign
, Options -> ListPadding
listPadding :: ListPadding
, Options -> Bool
separateLists :: Bool
, Options -> Bool
spaceSurround :: Bool
, Options -> Bool
postQualified :: Bool
} deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options :: ImportAlign
-> ListAlign
-> Bool
-> LongListAlign
-> EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Options
Options
{ importAlign :: ImportAlign
importAlign = ImportAlign
Global
, listAlign :: ListAlign
listAlign = ListAlign
AfterAlias
, padModuleNames :: Bool
padModuleNames = Bool
True
, longListAlign :: LongListAlign
longListAlign = LongListAlign
Inline
, emptyListAlign :: EmptyListAlign
emptyListAlign = EmptyListAlign
Inherit
, listPadding :: ListPadding
listPadding = Int -> ListPadding
LPConstant Int
4
, separateLists :: Bool
separateLists = Bool
True
, spaceSurround :: Bool
spaceSurround = Bool
False
, postQualified :: Bool
postQualified = Bool
False
}
data ListPadding
= LPConstant Int
| LPModuleName
deriving (ListPadding -> ListPadding -> Bool
(ListPadding -> ListPadding -> Bool)
-> (ListPadding -> ListPadding -> Bool) -> Eq ListPadding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPadding -> ListPadding -> Bool
$c/= :: ListPadding -> ListPadding -> Bool
== :: ListPadding -> ListPadding -> Bool
$c== :: ListPadding -> ListPadding -> Bool
Eq, Int -> ListPadding -> ShowS
[ListPadding] -> ShowS
ListPadding -> String
(Int -> ListPadding -> ShowS)
-> (ListPadding -> String)
-> ([ListPadding] -> ShowS)
-> Show ListPadding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPadding] -> ShowS
$cshowList :: [ListPadding] -> ShowS
show :: ListPadding -> String
$cshow :: ListPadding -> String
showsPrec :: Int -> ListPadding -> ShowS
$cshowsPrec :: Int -> ListPadding -> ShowS
Show)
data ImportAlign
= Global
| File
| Group
| None
deriving (ImportAlign -> ImportAlign -> Bool
(ImportAlign -> ImportAlign -> Bool)
-> (ImportAlign -> ImportAlign -> Bool) -> Eq ImportAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportAlign -> ImportAlign -> Bool
$c/= :: ImportAlign -> ImportAlign -> Bool
== :: ImportAlign -> ImportAlign -> Bool
$c== :: ImportAlign -> ImportAlign -> Bool
Eq, Int -> ImportAlign -> ShowS
[ImportAlign] -> ShowS
ImportAlign -> String
(Int -> ImportAlign -> ShowS)
-> (ImportAlign -> String)
-> ([ImportAlign] -> ShowS)
-> Show ImportAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportAlign] -> ShowS
$cshowList :: [ImportAlign] -> ShowS
show :: ImportAlign -> String
$cshow :: ImportAlign -> String
showsPrec :: Int -> ImportAlign -> ShowS
$cshowsPrec :: Int -> ImportAlign -> ShowS
Show)
data ListAlign
= NewLine
| WithModuleName
| WithAlias
| AfterAlias
| Repeat
deriving (ListAlign -> ListAlign -> Bool
(ListAlign -> ListAlign -> Bool)
-> (ListAlign -> ListAlign -> Bool) -> Eq ListAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAlign -> ListAlign -> Bool
$c/= :: ListAlign -> ListAlign -> Bool
== :: ListAlign -> ListAlign -> Bool
$c== :: ListAlign -> ListAlign -> Bool
Eq, Int -> ListAlign -> ShowS
[ListAlign] -> ShowS
ListAlign -> String
(Int -> ListAlign -> ShowS)
-> (ListAlign -> String)
-> ([ListAlign] -> ShowS)
-> Show ListAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAlign] -> ShowS
$cshowList :: [ListAlign] -> ShowS
show :: ListAlign -> String
$cshow :: ListAlign -> String
showsPrec :: Int -> ListAlign -> ShowS
$cshowsPrec :: Int -> ListAlign -> ShowS
Show)
data EmptyListAlign
= Inherit
| RightAfter
deriving (EmptyListAlign -> EmptyListAlign -> Bool
(EmptyListAlign -> EmptyListAlign -> Bool)
-> (EmptyListAlign -> EmptyListAlign -> Bool) -> Eq EmptyListAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyListAlign -> EmptyListAlign -> Bool
$c/= :: EmptyListAlign -> EmptyListAlign -> Bool
== :: EmptyListAlign -> EmptyListAlign -> Bool
$c== :: EmptyListAlign -> EmptyListAlign -> Bool
Eq, Int -> EmptyListAlign -> ShowS
[EmptyListAlign] -> ShowS
EmptyListAlign -> String
(Int -> EmptyListAlign -> ShowS)
-> (EmptyListAlign -> String)
-> ([EmptyListAlign] -> ShowS)
-> Show EmptyListAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyListAlign] -> ShowS
$cshowList :: [EmptyListAlign] -> ShowS
show :: EmptyListAlign -> String
$cshow :: EmptyListAlign -> String
showsPrec :: Int -> EmptyListAlign -> ShowS
$cshowsPrec :: Int -> EmptyListAlign -> ShowS
Show)
data LongListAlign
= Inline
| InlineWithBreak
| InlineToMultiline
| Multiline
deriving (LongListAlign -> LongListAlign -> Bool
(LongListAlign -> LongListAlign -> Bool)
-> (LongListAlign -> LongListAlign -> Bool) -> Eq LongListAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LongListAlign -> LongListAlign -> Bool
$c/= :: LongListAlign -> LongListAlign -> Bool
== :: LongListAlign -> LongListAlign -> Bool
$c== :: LongListAlign -> LongListAlign -> Bool
Eq, Int -> LongListAlign -> ShowS
[LongListAlign] -> ShowS
LongListAlign -> String
(Int -> LongListAlign -> ShowS)
-> (LongListAlign -> String)
-> ([LongListAlign] -> ShowS)
-> Show LongListAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LongListAlign] -> ShowS
$cshowList :: [LongListAlign] -> ShowS
show :: LongListAlign -> String
$cshow :: LongListAlign -> String
showsPrec :: Int -> LongListAlign -> ShowS
$cshowsPrec :: Int -> LongListAlign -> ShowS
Show)
step :: Maybe Int -> Options -> Step
step :: Maybe Int -> Options -> Step
step Maybe Int
columns = String -> (Lines -> Module -> Lines) -> Step
makeStep String
"Imports (ghc-lib-parser)" ((Lines -> Module -> Lines) -> Step)
-> (Options -> Lines -> Module -> Lines) -> Options -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Options -> Lines -> Module -> Lines
printImports Maybe Int
columns
printImports :: Maybe Int -> Options -> Lines -> Module -> Lines
printImports :: Maybe Int -> Options -> Lines -> Module -> Lines
printImports Maybe Int
maxCols Options
align Lines
ls Module
m = Edits -> Lines -> Lines
Editor.apply Edits
changes Lines
ls
where
groups :: [NonEmpty (LImportDecl GhcPs)]
groups = Module -> [NonEmpty (LImportDecl GhcPs)]
moduleImportGroups Module
m
moduleStats :: ImportStats
moduleStats = (ImportDecl GhcPs -> ImportStats)
-> [ImportDecl GhcPs] -> ImportStats
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ImportDecl GhcPs -> ImportStats
importStats ([ImportDecl GhcPs] -> ImportStats)
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [ImportDecl GhcPs])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> ImportStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [ImportDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> ImportStats)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> ImportStats
forall a b. (a -> b) -> a -> b
$ (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
groups
changes :: Edits
changes = (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)) -> Edits)
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))] -> Edits
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Int
-> Options -> ImportStats -> NonEmpty (LImportDecl GhcPs) -> Edits
formatGroup Maybe Int
maxCols Options
align ImportStats
moduleStats) [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
groups
formatGroup
:: Maybe Int -> Options -> ImportStats
-> NonEmpty (GHC.LImportDecl GHC.GhcPs) -> Editor.Edits
formatGroup :: Maybe Int
-> Options -> ImportStats -> NonEmpty (LImportDecl GhcPs) -> Edits
formatGroup Maybe Int
maxCols Options
options ImportStats
moduleStats NonEmpty (LImportDecl GhcPs)
imports =
let newLines :: Lines
newLines = Maybe Int
-> Options -> ImportStats -> NonEmpty (LImportDecl GhcPs) -> Lines
formatImports Maybe Int
maxCols Options
options ImportStats
moduleStats NonEmpty (LImportDecl GhcPs)
imports in
Block String -> (Lines -> Lines) -> Edits
Editor.changeLines (NonEmpty (LImportDecl GhcPs) -> Block String
importBlock NonEmpty (LImportDecl GhcPs)
imports) (Lines -> Lines -> Lines
forall a b. a -> b -> a
const Lines
newLines)
importBlock :: NonEmpty (GHC.LImportDecl GHC.GhcPs) -> Block String
importBlock :: NonEmpty (LImportDecl GhcPs) -> Block String
importBlock NonEmpty (LImportDecl GhcPs)
group = Int -> Int -> Block String
forall a. Int -> Int -> Block a
Block
(RealSrcSpan -> Int
GHC.srcSpanStartLine (RealSrcSpan -> Int)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
group)
(RealSrcSpan -> Int
GHC.srcSpanEndLine (RealSrcSpan -> Int)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
group)
where
src :: GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src = RealSrcSpan -> Maybe RealSrcSpan -> RealSrcSpan
forall a. a -> Maybe a -> a
fromMaybe (String -> RealSrcSpan
forall a. HasCallStack => String -> a
error String
"importBlock: missing location") (Maybe RealSrcSpan -> RealSrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> Maybe RealSrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcSpanAnn' a) e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA
formatImports
:: Maybe Int
-> Options
-> ImportStats
-> NonEmpty (GHC.LImportDecl GHC.GhcPs) -> Lines
formatImports :: Maybe Int
-> Options -> ImportStats -> NonEmpty (LImportDecl GhcPs) -> Lines
formatImports Maybe Int
maxCols Options
options ImportStats
moduleStats NonEmpty (LImportDecl GhcPs)
rawGroup =
PrinterConfig -> Printer () -> Lines
forall a. PrinterConfig -> Printer a -> Lines
runPrinter_ (Maybe Int -> PrinterConfig
PrinterConfig Maybe Int
maxCols) do
let
group :: NonEmpty (GHC.LImportDecl GHC.GhcPs)
group :: NonEmpty (LImportDecl GhcPs)
group
= (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Ordering)
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NonEmpty.sortBy (ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering
compareImports (ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc) NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
rawGroup
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a b. a -> (a -> b) -> b
& NonEmpty (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
mergeImports
unLocatedGroup :: [ImportDecl GhcPs]
unLocatedGroup = (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [ImportDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> [ImportDecl GhcPs])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [ImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
group
align' :: ImportAlign
align' = Options -> ImportAlign
importAlign Options
options
padModuleNames' :: Bool
padModuleNames' = Options -> Bool
padModuleNames Options
options
padNames :: Bool
padNames = ImportAlign
align' ImportAlign -> ImportAlign -> Bool
forall a. Eq a => a -> a -> Bool
/= ImportAlign
None Bool -> Bool -> Bool
&& Bool
padModuleNames'
stats :: ImportStats
stats = case ImportAlign
align' of
ImportAlign
Global -> ImportStats
moduleStats {isAnyQualified :: Bool
isAnyQualified = Bool
True}
ImportAlign
File -> ImportStats
moduleStats
ImportAlign
Group -> (ImportDecl GhcPs -> ImportStats)
-> [ImportDecl GhcPs] -> ImportStats
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ImportDecl GhcPs -> ImportStats
importStats [ImportDecl GhcPs]
unLocatedGroup
ImportAlign
None -> ImportStats
forall a. Monoid a => a
mempty
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
group \GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp -> Options -> Bool -> ImportStats -> LImportDecl GhcPs -> Printer ()
printQualified Options
options Bool
padNames ImportStats
stats LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline
printQualified
:: Options -> Bool -> ImportStats -> GHC.LImportDecl GHC.GhcPs -> P ()
printQualified :: Options -> Bool -> ImportStats -> LImportDecl GhcPs -> Printer ()
printQualified Options{Bool
LongListAlign
EmptyListAlign
ListAlign
ImportAlign
ListPadding
postQualified :: Bool
spaceSurround :: Bool
separateLists :: Bool
listPadding :: ListPadding
emptyListAlign :: EmptyListAlign
longListAlign :: LongListAlign
padModuleNames :: Bool
listAlign :: ListAlign
importAlign :: ImportAlign
postQualified :: Options -> Bool
spaceSurround :: Options -> Bool
separateLists :: Options -> Bool
listPadding :: Options -> ListPadding
emptyListAlign :: Options -> EmptyListAlign
longListAlign :: Options -> LongListAlign
padModuleNames :: Options -> Bool
listAlign :: Options -> ListAlign
importAlign :: Options -> ImportAlign
..} Bool
padNames ImportStats
stats LImportDecl GhcPs
ldecl = do
String -> Printer ()
putText String
"import" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
case (ImportDecl GhcPs -> Bool
isSource ImportDecl GhcPs
decl, ImportStats -> Bool
isAnySource ImportStats
stats) of
(Bool
True, Bool
_) -> String -> Printer ()
putText String
"{-# SOURCE #-}" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
(Bool
_, Bool
True) -> String -> Printer ()
putText String
" " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
(Bool, Bool)
_ -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
GHC.ideclSafe ImportDecl GhcPs
decl) (String -> Printer ()
putText String
"safe" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space)
let module_ :: Printer Int
module_ = do
Int
moduleNamePosition <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Printer String -> Printer Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Printer String
getCurrentLine
Maybe StringLiteral -> (StringLiteral -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
GHC.ideclPkgQual ImportDecl GhcPs
decl) ((StringLiteral -> Printer ()) -> Printer ())
-> (StringLiteral -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \StringLiteral
pkg ->
String -> Printer ()
putText (StringLiteral -> String
stringLiteral StringLiteral
pkg) Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
String -> Printer ()
putText (ImportDecl GhcPs -> String
importModuleName ImportDecl GhcPs
decl)
let somethingFollows :: Bool
somethingFollows =
Maybe (GenLocated SrcSpanAnnA ModuleName) -> Bool
forall a. Maybe a -> Bool
isJust (ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
GHC.ideclAs ImportDecl GhcPs
decl) Bool -> Bool -> Bool
|| ImportDecl GhcPs -> Bool
isHiding ImportDecl GhcPs
decl Bool -> Bool -> Bool
||
Bool -> Bool
not (Maybe
(Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe
(Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Bool)
-> Maybe
(Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Bool
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Maybe (Bool, XRec GhcPs [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
GHC.ideclHiding ImportDecl GhcPs
decl)
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
padNames Bool -> Bool -> Bool
&& Bool
somethingFollows) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
putText (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate
(ImportStats -> Int
isLongestImport ImportStats
stats Int -> Int -> Int
forall a. Num a => a -> a -> a
- ImportDecl GhcPs -> Int
importModuleNameLength ImportDecl GhcPs
decl)
Char
' '
Int -> Printer Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
moduleNamePosition
Int
moduleNamePosition <-
case (Bool
postQualified, ImportDecl GhcPs -> Bool
isQualified ImportDecl GhcPs
decl, ImportStats -> Bool
isAnyQualified ImportStats
stats) of
(Bool
False, Bool
True , Bool
_ ) -> String -> Printer ()
putText String
"qualified" Printer () -> Printer () -> Printer ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer ()
space Printer () -> Printer Int -> Printer Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer Int
module_
(Bool
False, Bool
_ , Bool
True) -> String -> Printer ()
putText String
" " Printer () -> Printer () -> Printer ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer ()
space Printer () -> Printer Int -> Printer Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer Int
module_
(Bool
True , Bool
True , Bool
_ ) -> Printer Int
module_ Printer Int -> Printer () -> Printer Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Printer ()
space Printer Int -> Printer () -> Printer Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Printer ()
putText String
"qualified"
(Bool, Bool, Bool)
_ -> Printer Int
module_
Int
beforeAliasPosition <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Printer String -> Printer Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Printer String
getCurrentLine
Maybe (GenLocated SrcSpanAnnA ModuleName)
-> (GenLocated SrcSpanAnnA ModuleName -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
GHC.ideclAs ImportDecl GhcPs
decl) ((GenLocated SrcSpanAnnA ModuleName -> Printer ()) -> Printer ())
-> (GenLocated SrcSpanAnnA ModuleName -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA ModuleName
lname -> do
Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"as" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
String -> Printer ()
putText (String -> Printer ())
-> (ModuleName -> String) -> ModuleName -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
GHC.moduleNameString (ModuleName -> Printer ()) -> ModuleName -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA ModuleName
lname
Int
afterAliasPosition <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Printer String -> Printer Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Printer String
getCurrentLine
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ImportDecl GhcPs -> Bool
isHiding ImportDecl GhcPs
decl) (Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"hiding")
let putOffset :: Printer ()
putOffset = String -> Printer ()
putText (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
offset Char
' '
offset :: Int
offset = case ListPadding
listPadding of
LPConstant Int
n -> Int
n
ListPadding
LPModuleName -> Int
moduleNamePosition
() -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
case (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a b. (a, b) -> b
snd ((Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
(Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
(GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImportDecl GhcPs -> Maybe (Bool, XRec GhcPs [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
GHC.ideclHiding ImportDecl GhcPs
decl of
Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
Nothing -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports | [GenLocated SrcSpanAnnA (IE GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports) -> case EmptyListAlign
emptyListAlign of
EmptyListAlign
RightAfter -> ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight 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
"()"
EmptyListAlign
Inherit -> case ListAlign
listAlign of
ListAlign
NewLine -> do
ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight
Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
putOffset Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"()"
ListAlign
_ -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"()"
Just GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports -> do
let imports :: [GenLocated SrcSpanAnnA (IE GhcPs)]
imports = GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports
printedImports :: [(Printer (), Bool, Bool)]
printedImports = [Printer ()] -> [(Printer (), Bool, Bool)]
forall a. [a] -> [(a, Bool, Bool)]
flagEnds ([Printer ()] -> [(Printer (), Bool, Bool)])
-> [Printer ()] -> [(Printer (), Bool, Bool)]
forall a b. (a -> b) -> a -> b
$
(Bool -> IE GhcPs -> Printer ()
printImport Bool
separateLists) (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 (GenLocated SrcSpanAnnA (IE GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (IE GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[LIE GhcPs] -> [LIE GhcPs]
prepareImportList [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
imports
String
wrapPrefix <- case ListAlign
listAlign of
ListAlign
AfterAlias -> String -> Printer String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Printer String) -> String -> Printer String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
afterAliasPosition Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' '
ListAlign
WithAlias -> String -> Printer String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Printer String) -> String -> Printer String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
beforeAliasPosition Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' '
ListAlign
Repeat -> ShowS -> Printer String -> Printer String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (") Printer String
getCurrentLine
ListAlign
WithModuleName -> String -> Printer String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Printer String) -> String -> Printer String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
moduleNamePosition Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) Char
' '
ListAlign
NewLine -> String -> Printer String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Printer String) -> String -> Printer String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
offset Char
' '
let doSpaceSurround :: Printer ()
doSpaceSurround = Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
spaceSurround Printer ()
space
let printAsSingleLine :: Printer ()
printAsSingleLine = [(Printer (), Bool, Bool)]
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Printer (), Bool, Bool)]
printedImports (((Printer (), Bool, Bool) -> Printer ()) -> Printer ())
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(Printer ()
imp, Bool
start, Bool
end) -> do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
start (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
putText String
"(" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doSpaceSurround
Printer ()
imp
if Bool
end then Printer ()
doSpaceSurround Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
")" else Printer ()
comma Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
let printAsInlineWrapping :: Printer a -> Printer ()
printAsInlineWrapping Printer a
wprefix = [(Printer (), Bool, Bool)]
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Printer (), Bool, Bool)]
printedImports (((Printer (), Bool, Bool) -> Printer ()) -> Printer ())
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$
\(Printer ()
imp, Bool
start, Bool
end) ->
Printer () -> Printer ()
forall a. P a -> P a
patchForRepeatHiding (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
(do
if Bool
start then String -> Printer ()
putText String
"(" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doSpaceSurround else Printer ()
space
Printer ()
imp
if Bool
end then Printer ()
doSpaceSurround Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
")" else Printer ()
comma)
(do
case ListAlign
listAlign of
ListAlign
Repeat | Bool -> Bool
not Bool
start -> ShowS -> Printer ()
modifyCurrentLine (ShowS -> Printer ())
-> ((Char -> Char) -> ShowS) -> (Char -> Char) -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a. (a -> a) -> [a] -> [a]
withLast ((Char -> Char) -> Printer ()) -> (Char -> Char) -> Printer ()
forall a b. (a -> b) -> a -> b
$
\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' then Char
')' else Char
c
ListAlign
_ | Bool
start Bool -> Bool -> Bool
&& Bool
spaceSurround ->
ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight
ListAlign
_ -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Printer ()
newline
Printer a -> Printer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Printer a
wprefix
case ListAlign
listAlign of
ListAlign
Repeat -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
_ | Bool
start -> String -> Printer ()
putText String
"(" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doSpaceSurround
ListAlign
_ | LongListAlign
longListAlign LongListAlign -> LongListAlign -> Bool
forall a. Eq a => a -> a -> Bool
/= LongListAlign
Inline -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
AfterAlias -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doSpaceSurround
ListAlign
WithModuleName -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
WithAlias -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
NewLine -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Printer ()
imp
if Bool
end then Printer ()
doSpaceSurround Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
")" else Printer ()
comma)
let printAsMultiLine :: Printer ()
printAsMultiLine = [(Printer (), Bool, Bool)]
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Printer (), Bool, Bool)]
printedImports (((Printer (), Bool, Bool) -> Printer ()) -> Printer ())
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(Printer ()
imp, Bool
start, Bool
end) -> do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
start (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight
Printer ()
newline
Printer ()
putOffset
if Bool
start then String -> Printer ()
putText String
"( " else String -> Printer ()
putText String
", "
Printer ()
imp
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
end (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
putOffset Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
")"
case LongListAlign
longListAlign of
LongListAlign
Multiline -> Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
(Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
printAsSingleLine)
Printer ()
printAsMultiLine
LongListAlign
Inline | ListAlign
NewLine <- ListAlign
listAlign -> do
ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight
Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
putOffset Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer ()
printAsInlineWrapping (String -> Printer ()
putText String
wrapPrefix)
LongListAlign
Inline -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer ()
printAsInlineWrapping (String -> Printer ()
putText String
wrapPrefix)
LongListAlign
InlineWithBreak -> Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
(Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
printAsSingleLine)
(do
ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight
Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
putOffset Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer ()
printAsInlineWrapping Printer ()
putOffset)
LongListAlign
InlineToMultiline -> Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
(Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
printAsSingleLine)
(Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
(do
ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight
Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
putOffset Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
printAsSingleLine)
Printer ()
printAsMultiLine)
where
decl :: ImportDecl GhcPs
decl = GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
ldecl
patchForRepeatHiding :: P a -> P a
patchForRepeatHiding = case ListAlign
listAlign of
ListAlign
Repeat | ImportDecl GhcPs -> Bool
isHiding ImportDecl GhcPs
decl -> Maybe Int -> P a -> P a
forall a. Maybe Int -> P a -> P a
withColumns Maybe Int
forall a. Maybe a
Nothing
ListAlign
_ -> P a -> P a
forall a. a -> a
id
printImport :: Bool -> GHC.IE GHC.GhcPs -> P ()
printImport :: Bool -> IE GhcPs -> Printer ()
printImport Bool
_ (GHC.IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
name) = do
LIEWrappedName RdrName -> Printer ()
printIeWrappedName LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
name
printImport Bool
_ (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
name) = do
LIEWrappedName RdrName -> Printer ()
printIeWrappedName LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
name
printImport Bool
separateLists (GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
name) = do
LIEWrappedName RdrName -> Printer ()
printIeWrappedName LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
name
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
separateLists Printer ()
space
String -> Printer ()
putText String
"(..)"
printImport Bool
_ (GHC.IEModuleContents XIEModuleContents GhcPs
_ XRec GhcPs ModuleName
modu) = do
String -> Printer ()
putText String
"module"
Printer ()
space
String -> Printer ()
putText (String -> Printer ())
-> (ModuleName -> String) -> ModuleName -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
GHC.moduleNameString (ModuleName -> Printer ()) -> ModuleName -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
GHC.unLoc XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
modu
printImport Bool
separateLists (GHC.IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
name IEWildcard
wildcard [LIEWrappedName (IdP GhcPs)]
imps) = do
LIEWrappedName RdrName -> Printer ()
printIeWrappedName LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
name
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
separateLists Printer ()
space
let ellipsis :: [Printer ()]
ellipsis = case IEWildcard
wildcard of
GHC.IEWildcard Int
_position -> [String -> Printer ()
putText String
".."]
IEWildcard
GHC.NoIEWildcard -> []
Printer () -> Printer ()
forall a. P a -> P a
parenthesize (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep (Printer ()
comma Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) ([Printer ()]
ellipsis [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. Semigroup a => a -> a -> a
<> (LIEWrappedName RdrName -> Printer ())
-> [LIEWrappedName RdrName] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LIEWrappedName RdrName -> Printer ()
printIeWrappedName [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
imps)
printImport Bool
_ (GHC.IEGroup XIEGroup GhcPs
_ Int
_ HsDocString
_ ) =
String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEGroup'"
printImport Bool
_ (GHC.IEDoc XIEDoc GhcPs
_ HsDocString
_) =
String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDoc'"
printImport Bool
_ (GHC.IEDocNamed XIEDocNamed GhcPs
_ String
_) =
String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDocNamed'"
printIeWrappedName :: GHC.LIEWrappedName GHC.RdrName -> P ()
printIeWrappedName :: LIEWrappedName RdrName -> Printer ()
printIeWrappedName LIEWrappedName RdrName
lie = case LIEWrappedName RdrName -> IEWrappedName RdrName
forall l e. GenLocated l e -> e
GHC.unLoc LIEWrappedName RdrName
lie of
GHC.IEName LocatedN RdrName
n -> LocatedN RdrName -> Printer ()
putRdrName LocatedN RdrName
n
GHC.IEPattern EpaLocation
_ LocatedN RdrName
n -> String -> Printer ()
putText String
"pattern" 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
>> LocatedN RdrName -> Printer ()
putRdrName LocatedN RdrName
n
GHC.IEType EpaLocation
_ LocatedN RdrName
n -> String -> Printer ()
putText String
"type" 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
>> LocatedN RdrName -> Printer ()
putRdrName LocatedN RdrName
n
mergeImports
:: NonEmpty (GHC.LImportDecl GHC.GhcPs)
-> NonEmpty (GHC.LImportDecl GHC.GhcPs)
mergeImports :: NonEmpty (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs)
mergeImports (LImportDecl GhcPs
x :| []) = LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> [a] -> NonEmpty a
:| []
mergeImports (LImportDecl GhcPs
h :| (LImportDecl GhcPs
t : [LImportDecl GhcPs]
ts))
| ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
canMergeImport (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
h) (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
t) = NonEmpty (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs)
mergeImports (LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs
mergeModuleImport LImportDecl GhcPs
h LImportDecl GhcPs
t GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ts)
| Bool
otherwise = LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
h GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail (LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
t GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ts)
where
mergeImportsTail :: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x : GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y : [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ys)
| ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
canMergeImport (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x) (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y) = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail ((LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs
mergeModuleImport LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y) GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ys)
| Bool
otherwise = GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ys)
mergeImportsTail [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
xs = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
xs
data ImportStats = ImportStats
{ ImportStats -> Int
isLongestImport :: !Int
, ImportStats -> Bool
isAnySource :: !Bool
, ImportStats -> Bool
isAnyQualified :: !Bool
, ImportStats -> Bool
isAnySafe :: !Bool
}
instance Semigroup ImportStats where
ImportStats
l <> :: ImportStats -> ImportStats -> ImportStats
<> ImportStats
r = ImportStats :: Int -> Bool -> Bool -> Bool -> ImportStats
ImportStats
{ isLongestImport :: Int
isLongestImport = ImportStats -> Int
isLongestImport ImportStats
l Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` ImportStats -> Int
isLongestImport ImportStats
r
, isAnySource :: Bool
isAnySource = ImportStats -> Bool
isAnySource ImportStats
l Bool -> Bool -> Bool
|| ImportStats -> Bool
isAnySource ImportStats
r
, isAnyQualified :: Bool
isAnyQualified = ImportStats -> Bool
isAnyQualified ImportStats
l Bool -> Bool -> Bool
|| ImportStats -> Bool
isAnyQualified ImportStats
r
, isAnySafe :: Bool
isAnySafe = ImportStats -> Bool
isAnySafe ImportStats
l Bool -> Bool -> Bool
|| ImportStats -> Bool
isAnySafe ImportStats
r
}
instance Monoid ImportStats where
mappend :: ImportStats -> ImportStats -> ImportStats
mappend = ImportStats -> ImportStats -> ImportStats
forall a. Semigroup a => a -> a -> a
(<>)
mempty :: ImportStats
mempty = Int -> Bool -> Bool -> Bool -> ImportStats
ImportStats Int
0 Bool
False Bool
False Bool
False
importStats :: GHC.ImportDecl GHC.GhcPs -> ImportStats
importStats :: ImportDecl GhcPs -> ImportStats
importStats ImportDecl GhcPs
i =
Int -> Bool -> Bool -> Bool -> ImportStats
ImportStats (ImportDecl GhcPs -> Int
importModuleNameLength ImportDecl GhcPs
i) (ImportDecl GhcPs -> Bool
isSource ImportDecl GhcPs
i) (ImportDecl GhcPs -> Bool
isQualified ImportDecl GhcPs
i) (ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
GHC.ideclSafe ImportDecl GhcPs
i)
importModuleNameLength :: GHC.ImportDecl GHC.GhcPs -> Int
importModuleNameLength :: ImportDecl GhcPs -> Int
importModuleNameLength ImportDecl GhcPs
imp =
(case ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
GHC.ideclPkgQual ImportDecl GhcPs
imp of
Maybe StringLiteral
Nothing -> Int
0
Just StringLiteral
sl -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (StringLiteral -> String
stringLiteral StringLiteral
sl)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
(String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> String
importModuleName ImportDecl GhcPs
imp)
stringLiteral :: GHC.StringLiteral -> String
stringLiteral :: StringLiteral -> String
stringLiteral StringLiteral
sl = case StringLiteral -> SourceText
GHC.sl_st StringLiteral
sl of
SourceText
GHC.NoSourceText -> ShowS
forall a. Show a => a -> String
show ShowS -> (FastString -> String) -> FastString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
GHC.unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ StringLiteral -> FastString
GHC.sl_fs StringLiteral
sl
GHC.SourceText String
s -> String
s
isQualified :: GHC.ImportDecl GHC.GhcPs -> Bool
isQualified :: ImportDecl GhcPs -> Bool
isQualified = ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
(/=) ImportDeclQualifiedStyle
GHC.NotQualified (ImportDeclQualifiedStyle -> Bool)
-> (ImportDecl GhcPs -> ImportDeclQualifiedStyle)
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
GHC.ideclQualified
isHiding :: GHC.ImportDecl GHC.GhcPs -> Bool
isHiding :: ImportDecl GhcPs -> Bool
isHiding = Bool
-> ((Bool,
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Bool)
-> Maybe
(Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Bool
forall a b. (a, b) -> a
fst (Maybe
(Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Bool)
-> (ImportDecl GhcPs
-> Maybe
(Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs
-> Maybe
(Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
GHC.ideclHiding
isSource :: GHC.ImportDecl GHC.GhcPs -> Bool
isSource :: ImportDecl GhcPs -> Bool
isSource = IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
(==) IsBootInterface
GHC.IsBoot (IsBootInterface -> Bool)
-> (ImportDecl GhcPs -> IsBootInterface)
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> IsBootInterface
forall pass. ImportDecl pass -> IsBootInterface
GHC.ideclSource
prepareImportList :: [GHC.LIE GHC.GhcPs] -> [GHC.LIE GHC.GhcPs]
prepareImportList :: [LIE GhcPs] -> [LIE GhcPs]
prepareImportList =
(GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs) -> Ordering)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy LIE GhcPs -> LIE GhcPs -> Ordering
GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs) -> Ordering
compareLIE ([GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map ((IE GhcPs -> IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IE GhcPs -> IE GhcPs
prepareInner) ([GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
-> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ((RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> (RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a b. (a, b) -> b
snd) ([(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
-> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
-> Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LIE GhcPs] -> Map RdrName (NonEmpty (LIE GhcPs))
[GenLocated SrcSpanAnnA (IE GhcPs)]
-> Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
mergeByName
where
mergeByName
:: [GHC.LIE GHC.GhcPs]
-> Map.Map GHC.RdrName (NonEmpty (GHC.LIE GHC.GhcPs))
mergeByName :: [LIE GhcPs] -> Map RdrName (NonEmpty (LIE GhcPs))
mergeByName [LIE GhcPs]
imports0 = (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
-> Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
(\(GenLocated SrcSpanAnnA (IE GhcPs)
x :| [GenLocated SrcSpanAnnA (IE GhcPs)]
xs) (GenLocated SrcSpanAnnA (IE GhcPs)
y :| [GenLocated SrcSpanAnnA (IE GhcPs)]
ys) -> case IE GhcPs -> IE GhcPs -> Maybe (IE GhcPs)
ieMerge (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
x) (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
y) of
Just IE GhcPs
z -> (GenLocated SrcSpanAnnA (IE GhcPs)
x GenLocated SrcSpanAnnA (IE GhcPs)
-> IE GhcPs -> GenLocated SrcSpanAnnA (IE GhcPs)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IE GhcPs
z) GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a. a -> [a] -> NonEmpty a
:| ([GenLocated SrcSpanAnnA (IE GhcPs)]
xs [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (IE GhcPs)]
ys)
Maybe (IE GhcPs)
Nothing -> GenLocated SrcSpanAnnA (IE GhcPs)
x GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a. a -> [a] -> NonEmpty a
:| ([GenLocated SrcSpanAnnA (IE GhcPs)]
xs [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (IE GhcPs)
y GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (IE GhcPs)]
ys))
[(IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
GHC.ieName (IE GhcPs -> IdP GhcPs) -> IE GhcPs -> IdP GhcPs
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
imp, GenLocated SrcSpanAnnA (IE GhcPs)
imp GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a. a -> [a] -> NonEmpty a
:| []) | GenLocated SrcSpanAnnA (IE GhcPs)
imp <- [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
imports0]
prepareInner :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs
prepareInner :: IE GhcPs -> IE GhcPs
prepareInner = \case
GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
n IEWildcard
GHC.NoIEWildcard [] -> XIEThingAbs GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
GHC.IEThingAbs XIEThingAbs GhcPs
XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
n
GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
n IEWildcard
w [LIEWrappedName (IdP GhcPs)]
ns ->
XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
n IEWildcard
w ((LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering)
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareWrappedName (IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering)
-> (LIEWrappedName RdrName -> IEWrappedName RdrName)
-> LIEWrappedName RdrName
-> LIEWrappedName RdrName
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LIEWrappedName RdrName -> IEWrappedName RdrName
forall l e. GenLocated l e -> e
GHC.unLoc) [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
ns)
IE GhcPs
ie -> IE GhcPs
ie
ieMerge :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs -> Maybe (GHC.IE GHC.GhcPs)
ieMerge :: IE GhcPs -> IE GhcPs -> Maybe (IE GhcPs)
ieMerge l :: IE GhcPs
l@(GHC.IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
_) IE GhcPs
_ = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
ieMerge IE GhcPs
_ r :: IE GhcPs
r@(GHC.IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
_) = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
r
ieMerge (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
_) IE GhcPs
r = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
r
ieMerge IE GhcPs
l (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
_) = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
ieMerge l :: IE GhcPs
l@(GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
_) IE GhcPs
_ = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
ieMerge IE GhcPs
_ r :: IE GhcPs
r@(GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
_) = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
r
ieMerge (GHC.IEThingWith XIEThingWith GhcPs
x0 LIEWrappedName (IdP GhcPs)
n0 IEWildcard
w0 [LIEWrappedName (IdP GhcPs)]
ns0) (GHC.IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
_ IEWildcard
w1 [LIEWrappedName (IdP GhcPs)]
ns1)
| IEWildcard
w0 IEWildcard -> IEWildcard -> Bool
forall a. Eq a => a -> a -> Bool
/= IEWildcard
w1 = Maybe (IE GhcPs)
forall a. Maybe a
Nothing
| Bool
otherwise = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just (IE GhcPs -> Maybe (IE GhcPs)) -> IE GhcPs -> Maybe (IE GhcPs)
forall a b. (a -> b) -> a -> b
$
XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
GHC.IEThingWith XIEThingWith GhcPs
x0 LIEWrappedName (IdP GhcPs)
n0 IEWildcard
w0 ((LIEWrappedName RdrName -> RdrName)
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall k a. Ord k => (a -> k) -> [a] -> [a]
nubOn LIEWrappedName RdrName -> RdrName
forall name. LIEWrappedName name -> name
GHC.lieWrappedName ([LIEWrappedName RdrName] -> [LIEWrappedName RdrName])
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a b. (a -> b) -> a -> b
$ [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
ns0 [LIEWrappedName RdrName]
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a. [a] -> [a] -> [a]
++ [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
ns1)
ieMerge IE GhcPs
_ IE GhcPs
_ = Maybe (IE GhcPs)
forall a. Maybe a
Nothing
nubOn :: Ord k => (a -> k) -> [a] -> [a]
nubOn :: (a -> k) -> [a] -> [a]
nubOn a -> k
f = Set k -> [a] -> [a]
go Set k
forall a. Set a
Set.empty
where
go :: Set k -> [a] -> [a]
go Set k
_ [] = []
go Set k
acc (a
x : [a]
xs)
| k
y k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set k
acc = Set k -> [a] -> [a]
go Set k
acc [a]
xs
| Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set k -> [a] -> [a]
go (k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
y Set k
acc) [a]
xs
where
y :: k
y = a -> k
f a
x