{-# 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 -- inline
    | InlineWithBreak -- new_line
    | InlineToMultiline -- new_line_multiline
    | Multiline -- 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    -- ^ Max columns.
    -> Options      -- ^ Options.
    -> ImportStats  -- ^ Module stats.
    -> 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)

            -- Only print spaces if something follows.
            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
$ -- [P ()]
                    (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

            -- Since we might need to output the import module name several times, we
            -- need to save it to a variable:
            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
' '

            -- Helper
            let doSpaceSurround :: Printer ()
doSpaceSurround = Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
spaceSurround Printer ()
space

            -- Try to put everything on one line.
            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

            -- Try to put everything one by one, wrapping if that fails.
            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
                            -- In 'Repeat' mode, end lines with ')' rather than ','.
                            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 ->
                                -- Only necessary if spaceSurround is enabled.
                                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
                          -- '(' already included in repeat
                          ListAlign
Repeat         -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                          -- Print the much needed '('
                          ListAlign
_ | Bool
start      -> String -> Printer ()
putText String
"(" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doSpaceSurround
                          -- Don't bother aligning if we're not in inline mode.
                          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 ()
                          -- 'Inline + AfterAlias' is really where we want to be careful
                          -- with spacing.
                          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)

            -- Put everything on a separate line.  'spaceSurround' can be
            -- ignored.
            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  -- We added some spaces.
                    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

    -- We cannot wrap/repeat 'hiding' imports since then we would get multiple
    -- imports hiding different things.
    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)

-- Computes length till module name, includes package name.
-- TODO: this should reuse code with the printer
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


--------------------------------------------------------------------------------
-- | Cleans up an import item list.
--
-- * Sorts import items.
-- * Sort inner import lists, e.g. `import Control.Monad (Monad (return, join))`
-- * Removes duplicates from import lists.
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
    -- Note that ideally every NonEmpty will just have a single entry and we
    -- will be able to merge everything into that entry.  Exotic imports can
    -- mess this up, though.  So they end up in the tail of the list.
    (\(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)  -- Keep source from `x`
      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
    -- Simplify `A ()` to `A`.
    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

  -- Merge two import items, assuming they have the same name.
  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
$
        -- TODO: sort the `ns0 ++ ns1`?
        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