{-# LANGUAGE BlockArguments    #-}
{-# LANGUAGE DoAndIfThenElse   #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Language.Haskell.Stylish.Step.Imports
  ( Options (..)
  , defaultOptions
  , ImportAlign (..)
  , ListAlign (..)
  , LongListAlign (..)
  , EmptyListAlign (..)
  , ListPadding (..)
  , GroupRule (..)
  , step

  , printImport

  , parsePattern
  , unsafeParsePattern
  ) where

--------------------------------------------------------------------------------
import           Control.Monad                     (forM_, void, when)
import qualified Data.Aeson                        as A
import           Data.Foldable                     (toList)
import           Data.Function                     (on, (&))
import           Data.Functor                      (($>))
import           Data.List                         (groupBy, intercalate,
                                                    partition, sortBy, sortOn)
import           Data.List.NonEmpty                (NonEmpty (..))
import qualified Data.List.NonEmpty                as NonEmpty
import qualified Data.Map                          as Map
import           Data.Maybe                        (fromMaybe, isJust, mapMaybe)
import           Data.Sequence                     (Seq ((:|>)))
import qualified Data.Sequence                     as Seq
import qualified Data.Set                          as Set
import qualified Data.Text                         as T
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.PkgQual                 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 qualified Text.Regex.TDFA                   as Regex
import           Text.Regex.TDFA                   (Regex)
import           Text.Regex.TDFA.ReadRegex         (parseRegex)

--------------------------------------------------------------------------------
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
    , Options -> Bool
groupImports   :: Bool
    , Options -> [GroupRule]
groupRules     :: [GroupRule]
    } deriving (Options -> Options -> Bool
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
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 :: 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
    , groupImports :: Bool
groupImports   = Bool
False
    , groupRules :: [GroupRule]
groupRules     = [GroupRule
defaultGroupRule]
    }
  where defaultGroupRule :: GroupRule
defaultGroupRule = GroupRule
          { match :: Pattern
match    = String -> Pattern
unsafeParsePattern String
".*"
          , subGroup :: Maybe Pattern
subGroup = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Pattern
unsafeParsePattern String
"^[^.]+"
          }

data ListPadding
    = LPConstant Int
    | LPModuleName
    deriving (ListPadding -> ListPadding -> Bool
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
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
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
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
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
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
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
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
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
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)

-- | A rule for grouping imports that specifies which module names
-- belong in a group and (optionally) how to break them up into
-- sub-groups.
--
-- See the documentation for the group_rules setting in
-- data/stylish-haskell.yaml for more details.
data GroupRule = GroupRule
  { GroupRule -> Pattern
match    :: Pattern
    -- ^ The pattern that determines whether a rule applies to a
    -- module name.
  , GroupRule -> Maybe Pattern
subGroup :: Maybe Pattern
    -- ^ An optional pattern for breaking the group up into smaller
    -- sub-groups.
  } deriving (Int -> GroupRule -> ShowS
[GroupRule] -> ShowS
GroupRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupRule] -> ShowS
$cshowList :: [GroupRule] -> ShowS
show :: GroupRule -> String
$cshow :: GroupRule -> String
showsPrec :: Int -> GroupRule -> ShowS
$cshowsPrec :: Int -> GroupRule -> ShowS
Show, GroupRule -> GroupRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupRule -> GroupRule -> Bool
$c/= :: GroupRule -> GroupRule -> Bool
== :: GroupRule -> GroupRule -> Bool
$c== :: GroupRule -> GroupRule -> Bool
Eq)

instance A.FromJSON GroupRule where
  parseJSON :: Value -> Parser GroupRule
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"group_rule" Object -> Parser GroupRule
parse
    where parse :: Object -> Parser GroupRule
parse Object
o = Pattern -> Maybe Pattern -> GroupRule
GroupRule
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"match")
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"sub_group")

-- | A compiled regular expression. Provides instances that 'Regex'
-- does not have (eg 'Show', 'Eq' and 'FromJSON').
--
-- Construct with 'parsePattern' to maintain the invariant that
-- 'string' is the exact regex string used to compile 'regex'.
data Pattern = Pattern
  { Pattern -> Regex
regex  :: Regex
    -- ^ The compiled regular expression.
  , Pattern -> String
string :: String
    -- ^ The valid regex string that 'regex' was compiled from.
  }

instance Show Pattern where show :: Pattern -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> String
string

instance Eq Pattern where == :: Pattern -> Pattern -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Pattern -> String
string

instance A.FromJSON Pattern where
  parseJSON :: Value -> Parser Pattern
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"regex" forall {m :: * -> *}. MonadFail m => Text -> m Pattern
parse
    where parse :: Text -> m Pattern
parse Text
text = case String -> Either String Pattern
parsePattern forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
text of
            Left String
err  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid regex:\n" forall a. Semigroup a => a -> a -> a
<> String
err
            Right Pattern
pat -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern
pat


-- | Parse a string into a compiled regular expression ('Pattern').
--
-- Returns a human-readable parse error message if the string is not
-- valid regex syntax.
--
-- >>> parsePattern "^([^.]+)"
-- Right "^([^.]+)"
--
-- >>> parsePattern "("
-- Left "\"(\" (line 1, column 2):\nunexpected end of input\nexpecting empty () or anchor ^ or $ or an atom"
parsePattern :: String -> Either String Pattern
parsePattern :: String -> Either String Pattern
parsePattern String
string = case String -> Either ParseError (Pattern, (Int, DoPa))
parseRegex String
string of
  Right (Pattern, (Int, DoPa))
_  -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Pattern { String
string :: String
string :: String
string, regex :: Regex
regex = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
Regex.makeRegex String
string }
  Left ParseError
err -> forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show ParseError
err)

-- | Parse a string into a regular expression, raising a runtime
-- exception if the string is not valid regex syntax.
--
-- >>> unsafeParsePattern "^([^.]+)"
-- "^([^.]+)"
--
-- >>> unsafeParsePattern "("
-- "*** Exception: "(" (line 1, column 2):
-- unexpected end of input
-- expecting empty () or anchor ^ or $ or an atom
unsafeParsePattern :: String -> Pattern
unsafeParsePattern :: String -> Pattern
unsafeParsePattern = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Pattern
parsePattern

--------------------------------------------------------------------------------
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)" 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
options 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 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ImportDecl GhcPs -> ImportStats
importStats forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l e. GenLocated l e -> e
GHC.unLoc forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
groups
    changes :: Edits
changes
      | Options -> Bool
groupImports Options
options =
          Maybe Int
-> Options
-> ImportStats
-> [NonEmpty (LImportDecl GhcPs)]
-> Edits
groupAndFormat Maybe Int
maxCols Options
options ImportStats
moduleStats [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
groups
      | Bool
otherwise =
          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
options 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) (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 = forall a. Int -> Int -> Block a
Block
    (RealSrcSpan -> Int
GHC.srcSpanStartLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NonEmpty.head NonEmpty (LImportDecl GhcPs)
group)
    (RealSrcSpan -> Int
GHC.srcSpanEndLine   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NonEmpty.last NonEmpty (LImportDecl GhcPs)
group)
  where
    src :: GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"importBlock: missing location") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  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
      = forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NonEmpty.sortBy (ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering
compareImports forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall l e. GenLocated l e -> e
GHC.unLoc) NonEmpty (LImportDecl GhcPs)
rawGroup
      forall a b. a -> (a -> b) -> b
& NonEmpty (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs)
mergeImports

    unLocatedGroup :: [ImportDecl GhcPs]
unLocatedGroup = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l e. GenLocated l e -> e
GHC.unLoc forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (LImportDecl GhcPs)
group

    align' :: ImportAlign
align' = Options -> ImportAlign
importAlign Options
options
    padModuleNames' :: Bool
padModuleNames' = Options -> Bool
padModuleNames Options
options
    padNames :: Bool
padNames = ImportAlign
align' 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  -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ImportDecl GhcPs -> ImportStats
importStats [ImportDecl GhcPs]
unLocatedGroup
        ImportAlign
None   -> forall a. Monoid a => a
mempty

  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ NonEmpty (LImportDecl GhcPs)
group \GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp -> Options -> Bool -> ImportStats -> LImportDecl GhcPs -> P ()
printQualified Options
options Bool
padNames ImportStats
stats GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
newline


--------------------------------------------------------------------------------
-- | Reorganize imports into groups based on 'groupPatterns', then
-- format each group as specified by the rest of 'Options'.
--
-- Note: this will discard blank lines and comments inside the imports
-- section.
groupAndFormat
  :: Maybe Int
  -> Options
  -> ImportStats
  -> [NonEmpty (GHC.LImportDecl GHC.GhcPs)]
  -> Editor.Edits
groupAndFormat :: Maybe Int
-> Options
-> ImportStats
-> [NonEmpty (LImportDecl GhcPs)]
-> Edits
groupAndFormat Maybe Int
_ Options
_ ImportStats
_ [] = forall a. Monoid a => a
mempty
groupAndFormat Maybe Int
maxCols Options
options ImportStats
moduleStats [NonEmpty (LImportDecl GhcPs)]
groups =
  Block String -> (Lines -> Lines) -> Edits
Editor.changeLines forall {a}. Block a
block (forall a b. a -> b -> a
const Lines
regroupedLines)
  where
    regroupedLines :: Lines
    regroupedLines :: Lines
regroupedLines = forall a. [a] -> [[a]] -> [a]
intercalate [String
""] forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int
-> Options -> ImportStats -> NonEmpty (LImportDecl GhcPs) -> Lines
formatImports Maybe Int
maxCols Options
options ImportStats
moduleStats) [NonEmpty (LImportDecl GhcPs)]
grouped

    grouped :: [NonEmpty (GHC.LImportDecl GHC.GhcPs)]
    grouped :: [NonEmpty (LImportDecl GhcPs)]
grouped = [GroupRule]
-> [LImportDecl GhcPs] -> [NonEmpty (LImportDecl GhcPs)]
groupByRules (Options -> [GroupRule]
groupRules Options
options) [LImportDecl GhcPs]
imports

    imports :: [GHC.LImportDecl GHC.GhcPs]
    imports :: [LImportDecl GhcPs]
imports = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [NonEmpty (LImportDecl GhcPs)]
groups

    -- groups is non-empty by the pattern for this case
    -- imports is non-empty as long as groups is non-empty
    block :: Block a
block = forall a. Int -> Int -> Block a
Block
      (RealSrcSpan -> Int
GHC.srcSpanStartLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [LImportDecl GhcPs]
imports)
      (RealSrcSpan -> Int
GHC.srcSpanEndLine   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [LImportDecl GhcPs]
imports)
    src :: GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"regroupImports: missing location") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA

-- | Group imports based on a list of patterns.
--
-- See the documentation for @group_patterns@ in
-- @data/stylish-haskell.yaml@ for details about the patterns and
-- grouping logic.
groupByRules
  :: [GroupRule]
  -- ^ The patterns specifying the groups to build. Order matters:
  -- earlier patterns take precedence over later ones.
  -> [GHC.LImportDecl GHC.GhcPs]
  -- ^ The imports to group. Order does not matter.
  -> [NonEmpty (GHC.LImportDecl GHC.GhcPs)]
groupByRules :: [GroupRule]
-> [LImportDecl GhcPs] -> [NonEmpty (LImportDecl GhcPs)]
groupByRules [GroupRule]
rules [LImportDecl GhcPs]
allImports = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ [GroupRule]
-> [LImportDecl GhcPs]
-> Seq (NonEmpty (LImportDecl GhcPs))
-> Seq (NonEmpty (LImportDecl GhcPs))
go [GroupRule]
rules [LImportDecl GhcPs]
allImports forall a. Seq a
Seq.empty
  where
    go :: [GroupRule]
       -> [GHC.LImportDecl GHC.GhcPs]
       -> Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs))
       -> Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs))
    go :: [GroupRule]
-> [LImportDecl GhcPs]
-> Seq (NonEmpty (LImportDecl GhcPs))
-> Seq (NonEmpty (LImportDecl GhcPs))
go [] [] Seq (NonEmpty (LImportDecl GhcPs))
groups            = Seq (NonEmpty (LImportDecl GhcPs))
groups
    go [] [LImportDecl GhcPs]
imports Seq (NonEmpty (LImportDecl GhcPs))
groups       = Seq (NonEmpty (LImportDecl GhcPs))
groups forall a. Seq a -> a -> Seq a
:|> forall a. [a] -> NonEmpty a
NonEmpty.fromList [LImportDecl GhcPs]
imports
    go (GroupRule
r : [GroupRule]
rs) [LImportDecl GhcPs]
imports Seq (NonEmpty (LImportDecl GhcPs))
groups =
      let
        (Seq (NonEmpty (LImportDecl GhcPs))
groups', [LImportDecl GhcPs]
rest) = GroupRule
-> [LImportDecl GhcPs]
-> (Seq (NonEmpty (LImportDecl GhcPs)), [LImportDecl GhcPs])
extract GroupRule
r [LImportDecl GhcPs]
imports
      in
        [GroupRule]
-> [LImportDecl GhcPs]
-> Seq (NonEmpty (LImportDecl GhcPs))
-> Seq (NonEmpty (LImportDecl GhcPs))
go [GroupRule]
rs [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
rest (Seq (NonEmpty (LImportDecl GhcPs))
groups forall a. Semigroup a => a -> a -> a
<> Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
groups')

    extract :: GroupRule
            -> [GHC.LImportDecl GHC.GhcPs]
            -> ( Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs))
               , [GHC.LImportDecl GHC.GhcPs]
               )
    extract :: GroupRule
-> [LImportDecl GhcPs]
-> (Seq (NonEmpty (LImportDecl GhcPs)), [LImportDecl GhcPs])
extract GroupRule { Pattern
match :: Pattern
match :: GroupRule -> Pattern
match, Maybe Pattern
subGroup :: Maybe Pattern
subGroup :: GroupRule -> Maybe Pattern
subGroup } [LImportDecl GhcPs]
imports =
      let
        ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
matched, [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Pattern -> LImportDecl GhcPs -> Bool
matches Pattern
match) [LImportDecl GhcPs]
imports
        subgroups :: [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
subgroups = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Maybe Pattern -> LImportDecl GhcPs -> String
firstMatch Maybe Pattern
subGroup) forall a b. (a -> b) -> a -> b
$
                      forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Maybe Pattern -> LImportDecl GhcPs -> String
firstMatch Maybe Pattern
subGroup) [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
matched
      in
        -- groupBy never produces empty groups, so this mapMaybe will
        -- not discard anything from subgroups
        (forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
subgroups, [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
rest)

    matches :: Pattern -> GHC.LImportDecl GHC.GhcPs -> Bool
    matches :: Pattern -> LImportDecl GhcPs -> Bool
matches Pattern { Regex
regex :: Regex
regex :: Pattern -> Regex
regex } LImportDecl GhcPs
import_ = forall regex source target.
RegexContext regex source target =>
regex -> source -> target
Regex.match Regex
regex forall a b. (a -> b) -> a -> b
$ forall {l}. GenLocated l (ImportDecl GhcPs) -> String
moduleName LImportDecl GhcPs
import_

    firstMatch :: Maybe Pattern -> GHC.LImportDecl GHC.GhcPs -> String
    firstMatch :: Maybe Pattern -> LImportDecl GhcPs -> String
firstMatch (Just Pattern { Regex
regex :: Regex
regex :: Pattern -> Regex
regex }) LImportDecl GhcPs
import_ =
      forall regex source target.
RegexContext regex source target =>
regex -> source -> target
Regex.match Regex
regex forall a b. (a -> b) -> a -> b
$ forall {l}. GenLocated l (ImportDecl GhcPs) -> String
moduleName LImportDecl GhcPs
import_
    firstMatch Maybe Pattern
Nothing LImportDecl GhcPs
_ =
      String
"" -- constant grouping key, so everything will be grouped together

    moduleName :: GenLocated l (ImportDecl GhcPs) -> String
moduleName = ImportDecl GhcPs -> String
importModuleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
GHC.unLoc


--------------------------------------------------------------------------------
printQualified
    :: Options -> Bool -> ImportStats -> GHC.LImportDecl GHC.GhcPs -> P ()
printQualified :: Options -> Bool -> ImportStats -> LImportDecl GhcPs -> P ()
printQualified Options{Bool
[GroupRule]
LongListAlign
EmptyListAlign
ListAlign
ImportAlign
ListPadding
groupRules :: [GroupRule]
groupImports :: Bool
postQualified :: Bool
spaceSurround :: Bool
separateLists :: Bool
listPadding :: ListPadding
emptyListAlign :: EmptyListAlign
longListAlign :: LongListAlign
padModuleNames :: Bool
listAlign :: ListAlign
importAlign :: ImportAlign
groupRules :: Options -> [GroupRule]
groupImports :: Options -> Bool
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 -> P ()
putText String
"import" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space

    case (ImportDecl GhcPs -> Bool
isSource ImportDecl GhcPs
decl, ImportStats -> Bool
isAnySource ImportStats
stats) of
      (Bool
True, Bool
_) -> String -> P ()
putText String
"{-# SOURCE #-}" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
      (Bool
_, Bool
True) -> String -> P ()
putText String
"              " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
      (Bool, Bool)
_         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall pass. ImportDecl pass -> Bool
GHC.ideclSafe ImportDecl GhcPs
decl) (String -> P ()
putText String
"safe" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space)

    let module_ :: Printer Int
module_ = do
            Int
moduleNamePosition <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P String
getCurrentLine
            case forall pass. ImportDecl pass -> ImportDeclPkgQual pass
GHC.ideclPkgQual ImportDecl GhcPs
decl of
              RawPkgQual
ImportDeclPkgQual GhcPs
GHC.NoRawPkgQual   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              GHC.RawPkgQual StringLiteral
pkg -> String -> P ()
putText (StringLiteral -> String
stringLiteral StringLiteral
pkg) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
            String -> P ()
putText (ImportDecl GhcPs -> String
importModuleName ImportDecl GhcPs
decl)

            -- Only print spaces if something follows.
            let somethingFollows :: Bool
somethingFollows =
                    forall a. Maybe a -> Bool
isJust (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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
GHC.ideclImportList ImportDecl GhcPs
decl)
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
padNames Bool -> Bool -> Bool
&& Bool
somethingFollows) forall a b. (a -> b) -> a -> b
$ String -> P ()
putText forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate
                (ImportStats -> Int
isLongestImport ImportStats
stats forall a. Num a => a -> a -> a
- ImportDecl GhcPs -> Int
importModuleNameLength ImportDecl GhcPs
decl)
                Char
' '
            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 -> P ()
putText String
"qualified" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer Int
module_
            (Bool
False, Bool
_    , Bool
True) -> String -> P ()
putText String
"         " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer Int
module_
            (Bool
True , Bool
True , Bool
_   ) -> Printer Int
module_ forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> P ()
putText String
"qualified"
            (Bool, Bool, Bool)
_                    -> Printer Int
module_

    Int
beforeAliasPosition <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P String
getCurrentLine
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
GHC.ideclAs ImportDecl GhcPs
decl) forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA ModuleName
lname -> do
        P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> P ()
putText String
"as" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
        String -> P ()
putText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
GHC.moduleNameString forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA ModuleName
lname

    Int
afterAliasPosition <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P String
getCurrentLine

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ImportDecl GhcPs -> Bool
isHiding ImportDecl GhcPs
decl) (P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> P ()
putText String
"hiding")

    let putOffset :: P ()
putOffset = String -> P ()
putText forall a b. (a -> b) -> a -> b
$ 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

    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    case forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
GHC.ideclImportList ImportDecl GhcPs
decl of
        Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports) -> case EmptyListAlign
emptyListAlign of
            EmptyListAlign
RightAfter -> ShowS -> P ()
modifyCurrentLine ShowS
trimRight forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> P ()
putText String
"()"
            EmptyListAlign
Inherit -> case ListAlign
listAlign of
                ListAlign
NewLine -> do
                    ShowS -> P ()
modifyCurrentLine ShowS
trimRight
                    P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> P ()
putText String
"()"
                ListAlign
_ -> P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> P ()
putText String
"()"

        Just GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports -> do
            let imports :: [GenLocated SrcSpanAnnA (IE GhcPs)]
imports = forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports
                printedImports :: [(P (), Bool, Bool)]
printedImports = forall a. [a] -> [(a, Bool, Bool)]
flagEnds forall a b. (a -> b) -> a -> b
$ -- [P ()]
                    (Bool -> IE GhcPs -> P ()
printImport Bool
separateLists) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
GHC.unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    [LIE GhcPs] -> [LIE GhcPs]
prepareImportList [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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (Int
afterAliasPosition forall a. Num a => a -> a -> a
+ Int
1) Char
' '
                ListAlign
WithAlias -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (Int
beforeAliasPosition forall a. Num a => a -> a -> a
+ Int
1) Char
' '
                ListAlign
Repeat -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> [a] -> [a]
++ String
" (") P String
getCurrentLine
                ListAlign
WithModuleName -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (Int
moduleNamePosition forall a. Num a => a -> a -> a
+ Int
offset) Char
' '
                ListAlign
NewLine -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
offset Char
' '

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

            -- Try to put everything on one line.
            let printAsSingleLine :: P ()
printAsSingleLine = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(P (), Bool, Bool)]
printedImports forall a b. (a -> b) -> a -> b
$ \(P ()
imp, Bool
start, Bool
end) -> do
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
start forall a b. (a -> b) -> a -> b
$ String -> P ()
putText String
"(" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
doSpaceSurround
                    P ()
imp
                    if Bool
end then P ()
doSpaceSurround forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> P ()
putText String
")" else P ()
comma forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space

            -- Try to put everything one by one, wrapping if that fails.
            let printAsInlineWrapping :: Printer a -> P ()
printAsInlineWrapping Printer a
wprefix = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(P (), Bool, Bool)]
printedImports forall a b. (a -> b) -> a -> b
$
                    \(P ()
imp, Bool
start, Bool
end) ->
                    forall {a}. P a -> P a
patchForRepeatHiding forall a b. (a -> b) -> a -> b
$ forall a. P a -> P a -> P a
wrapping
                       (do
                         if Bool
start then String -> P ()
putText String
"(" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
doSpaceSurround else P ()
space
                         P ()
imp
                         if Bool
end then P ()
doSpaceSurround forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> P ()
putText String
")" else P ()
comma)
                      (do
                        case ListAlign
listAlign of
                            -- In 'Repeat' mode, end lines with ')' rather than ','.
                            ListAlign
Repeat | Bool -> Bool
not Bool
start -> ShowS -> P ()
modifyCurrentLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> [a] -> [a]
withLast forall a b. (a -> b) -> a -> b
$
                                \Char
c -> if Char
c 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 -> P ()
modifyCurrentLine ShowS
trimRight
                            ListAlign
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                        P ()
newline
                        forall (f :: * -> *) a. Functor f => f a -> f ()
void Printer a
wprefix
                        case ListAlign
listAlign of
                          -- '(' already included in repeat
                          ListAlign
Repeat         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                          -- Print the much needed '('
                          ListAlign
_ | Bool
start      -> String -> P ()
putText String
"(" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
doSpaceSurround
                          -- Don't bother aligning if we're not in inline mode.
                          ListAlign
_ | LongListAlign
longListAlign forall a. Eq a => a -> a -> Bool
/= LongListAlign
Inline -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                          -- 'Inline + AfterAlias' is really where we want to be careful
                          -- with spacing.
                          ListAlign
AfterAlias -> P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
doSpaceSurround
                          ListAlign
WithModuleName -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                          ListAlign
WithAlias -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                          ListAlign
NewLine -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                        P ()
imp
                        if Bool
end then P ()
doSpaceSurround forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> P ()
putText String
")" else P ()
comma)

            -- Put everything on a separate line.  'spaceSurround' can be
            -- ignored.
            let printAsMultiLine :: P ()
printAsMultiLine = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(P (), Bool, Bool)]
printedImports forall a b. (a -> b) -> a -> b
$ \(P ()
imp, Bool
start, Bool
end) -> do
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
start forall a b. (a -> b) -> a -> b
$ ShowS -> P ()
modifyCurrentLine ShowS
trimRight  -- We added some spaces.
                    P ()
newline
                    P ()
putOffset
                    if Bool
start then String -> P ()
putText String
"( " else String -> P ()
putText String
", "
                    P ()
imp
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
end forall a b. (a -> b) -> a -> b
$ P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> P ()
putText String
")"

            case LongListAlign
longListAlign of
              LongListAlign
Multiline -> forall a. P a -> P a -> P a
wrapping
                (P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
printAsSingleLine)
                P ()
printAsMultiLine
              LongListAlign
Inline | ListAlign
NewLine <- ListAlign
listAlign -> do
                ShowS -> P ()
modifyCurrentLine ShowS
trimRight
                P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. Printer a -> P ()
printAsInlineWrapping (String -> P ()
putText String
wrapPrefix)
              LongListAlign
Inline -> P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. Printer a -> P ()
printAsInlineWrapping (String -> P ()
putText String
wrapPrefix)
              LongListAlign
InlineWithBreak -> forall a. P a -> P a -> P a
wrapping
                (P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
printAsSingleLine)
                (do
                  ShowS -> P ()
modifyCurrentLine ShowS
trimRight
                  P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. Printer a -> P ()
printAsInlineWrapping P ()
putOffset)
              LongListAlign
InlineToMultiline -> forall a. P a -> P a -> P a
wrapping
                (P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
printAsSingleLine)
                (forall a. P a -> P a -> P a
wrapping
                  (do
                    ShowS -> P ()
modifyCurrentLine ShowS
trimRight
                    P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
printAsSingleLine)
                  P ()
printAsMultiLine)
  where
    decl :: ImportDecl GhcPs
decl = forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl 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 -> forall a. Maybe Int -> P a -> P a
withColumns forall a. Maybe a
Nothing
        ListAlign
_                      -> forall a. a -> a
id


--------------------------------------------------------------------------------
printImport :: Bool -> GHC.IE GHC.GhcPs -> P ()
printImport :: Bool -> IE GhcPs -> P ()
printImport Bool
_ (GHC.IEVar XIEVar GhcPs
_ LIEWrappedName GhcPs
name) = do
    LIEWrappedName GhcPs -> P ()
printIeWrappedName LIEWrappedName GhcPs
name
printImport Bool
_ (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
name) = do
    LIEWrappedName GhcPs -> P ()
printIeWrappedName LIEWrappedName GhcPs
name
printImport Bool
separateLists (GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
name) = do
    LIEWrappedName GhcPs -> P ()
printIeWrappedName LIEWrappedName GhcPs
name
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
separateLists P ()
space
    String -> P ()
putText String
"(..)"
printImport Bool
_ (GHC.IEModuleContents XIEModuleContents GhcPs
_ XRec GhcPs ModuleName
modu) = do
    String -> P ()
putText String
"module"
    P ()
space
    String -> P ()
putText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
GHC.moduleNameString forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
GHC.unLoc XRec GhcPs ModuleName
modu
printImport Bool
separateLists (GHC.IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
name IEWildcard
wildcard [LIEWrappedName GhcPs]
imps) = do
    LIEWrappedName GhcPs -> P ()
printIeWrappedName LIEWrappedName GhcPs
name
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
separateLists P ()
space
    let ellipsis :: [P ()]
ellipsis = case IEWildcard
wildcard of
          GHC.IEWildcard Int
_position -> [String -> P ()
putText String
".."]
          IEWildcard
GHC.NoIEWildcard         -> []
    forall {a}. P a -> P a
parenthesize forall a b. (a -> b) -> a -> b
$
      forall a. P a -> [P a] -> P ()
sep (P ()
comma forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space) ([P ()]
ellipsis forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LIEWrappedName GhcPs -> P ()
printIeWrappedName [LIEWrappedName GhcPs]
imps)
printImport Bool
_ (GHC.IEGroup XIEGroup GhcPs
_ Int
_ LHsDoc GhcPs
_ ) =
    forall a. HasCallStack => String -> a
error String
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEGroup'"
printImport Bool
_ (GHC.IEDoc XIEDoc GhcPs
_ LHsDoc GhcPs
_) =
    forall a. HasCallStack => String -> a
error String
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDoc'"
printImport Bool
_ (GHC.IEDocNamed XIEDocNamed GhcPs
_ String
_) =
    forall a. HasCallStack => String -> a
error String
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDocNamed'"


--------------------------------------------------------------------------------
printIeWrappedName :: GHC.LIEWrappedName GHC.GhcPs -> P ()
printIeWrappedName :: LIEWrappedName GhcPs -> P ()
printIeWrappedName LIEWrappedName GhcPs
lie = case forall l e. GenLocated l e -> e
GHC.unLoc LIEWrappedName GhcPs
lie of
    GHC.IEName    XIEName GhcPs
_ LIdP GhcPs
n -> GenLocated SrcSpanAnnN RdrName -> P ()
putRdrName LIdP GhcPs
n
    GHC.IEPattern XIEPattern GhcPs
_ LIdP GhcPs
n -> String -> P ()
putText String
"pattern" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnN RdrName -> P ()
putRdrName LIdP GhcPs
n
    GHC.IEType    XIEType GhcPs
_ LIdP GhcPs
n -> String -> P ()
putText String
"type" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnN RdrName -> P ()
putRdrName LIdP GhcPs
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
x forall a. a -> [a] -> NonEmpty a
:| []
mergeImports (LImportDecl GhcPs
h :| (LImportDecl GhcPs
t : [LImportDecl GhcPs]
ts))
  | ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
canMergeImport (forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl GhcPs
h) (forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl GhcPs
t) = NonEmpty (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs)
mergeImports (LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs
mergeModuleImport LImportDecl GhcPs
h LImportDecl GhcPs
t forall a. a -> [a] -> NonEmpty a
:| [LImportDecl GhcPs]
ts)
  | Bool
otherwise = LImportDecl GhcPs
h forall a. a -> [a] -> NonEmpty a
:| [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail (LImportDecl GhcPs
t forall a. a -> [a] -> [a]
: [LImportDecl 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 (forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x) (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 GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y) forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ys)
      | Bool
otherwise = GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y 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
        { isLongestImport :: Int
isLongestImport = ImportStats -> Int
isLongestImport ImportStats
l 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 = 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) (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 forall pass. ImportDecl pass -> ImportDeclPkgQual pass
GHC.ideclPkgQual ImportDecl GhcPs
imp of
        RawPkgQual
ImportDeclPkgQual GhcPs
GHC.NoRawPkgQual  -> Int
0
        GHC.RawPkgQual StringLiteral
sl -> Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (StringLiteral -> String
stringLiteral StringLiteral
sl)) forall a. Num a => a -> a -> a
+
    (forall (t :: * -> *) a. Foldable t => t a -> Int
length 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 -> forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
GHC.unpackFS 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 = forall a. Eq a => a -> a -> Bool
(/=) ImportDeclQualifiedStyle
GHC.NotQualified forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
GHC.ideclQualified

isHiding :: GHC.ImportDecl GHC.GhcPs -> Bool
isHiding :: ImportDecl GhcPs -> Bool
isHiding ImportDecl GhcPs
d = case forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
GHC.ideclImportList ImportDecl GhcPs
d of
  Just (ImportListInterpretation
GHC.EverythingBut, XRec GhcPs [LIE GhcPs]
_) -> Bool
True
  Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
_ -> Bool
False

isSource :: GHC.ImportDecl GHC.GhcPs -> Bool
isSource :: ImportDecl GhcPs -> Bool
isSource = forall a. Eq a => a -> a -> Bool
(==) IsBootInterface
GHC.IsBoot forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy LIE GhcPs -> LIE GhcPs -> Ordering
compareLIE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IE GhcPs -> IE GhcPs
prepareInner) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LIE GhcPs] -> Map RdrName (NonEmpty (LIE 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 = 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 (forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
x) (forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
y) of
      Just IE GhcPs
z  -> (GenLocated SrcSpanAnnA (IE GhcPs)
x forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IE GhcPs
z) forall a. a -> [a] -> NonEmpty a
:| ([GenLocated SrcSpanAnnA (IE GhcPs)]
xs forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (IE GhcPs)]
ys)  -- Keep source from `x`
      Maybe (IE GhcPs)
Nothing -> GenLocated SrcSpanAnnA (IE GhcPs)
x forall a. a -> [a] -> NonEmpty a
:| ([GenLocated SrcSpanAnnA (IE GhcPs)]
xs forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (IE GhcPs)
y forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (IE GhcPs)]
ys))
    [(forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
GHC.ieName forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
imp, GenLocated SrcSpanAnnA (IE GhcPs)
imp forall a. a -> [a] -> NonEmpty a
:| []) | GenLocated SrcSpanAnnA (IE GhcPs)
imp <- [LIE 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 GhcPs
n IEWildcard
GHC.NoIEWildcard [] -> forall pass. XIEThingAbs pass -> LIEWrappedName pass -> IE pass
GHC.IEThingAbs XIEThingWith GhcPs
x LIEWrappedName GhcPs
n
    GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName GhcPs
n IEWildcard
w [LIEWrappedName GhcPs]
ns ->
      forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName GhcPs
n IEWildcard
w (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (IEWrappedName GhcPs -> IEWrappedName GhcPs -> Ordering
compareWrappedName forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall l e. GenLocated l e -> e
GHC.unLoc) [LIEWrappedName GhcPs]
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 GhcPs
_)      IE GhcPs
_                  = forall a. a -> Maybe a
Just IE GhcPs
l
  ieMerge IE GhcPs
_                  r :: IE GhcPs
r@(GHC.IEVar XIEVar GhcPs
_ LIEWrappedName GhcPs
_)      = forall a. a -> Maybe a
Just IE GhcPs
r
  ieMerge (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
_)   IE GhcPs
r                  = forall a. a -> Maybe a
Just IE GhcPs
r
  ieMerge IE GhcPs
l                  (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
_)   = forall a. a -> Maybe a
Just IE GhcPs
l
  ieMerge l :: IE GhcPs
l@(GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
_) IE GhcPs
_                  = forall a. a -> Maybe a
Just IE GhcPs
l
  ieMerge IE GhcPs
_                  r :: IE GhcPs
r@(GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
_) = forall a. a -> Maybe a
Just IE GhcPs
r
  ieMerge (GHC.IEThingWith XIEThingWith GhcPs
x0 LIEWrappedName GhcPs
n0 IEWildcard
w0 [LIEWrappedName GhcPs]
ns0) (GHC.IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
_ IEWildcard
w1 [LIEWrappedName GhcPs]
ns1)
    | IEWildcard
w0 forall a. Eq a => a -> a -> Bool
/= IEWildcard
w1  = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        -- TODO: sort the `ns0 ++ ns1`?
        forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
GHC.IEThingWith XIEThingWith GhcPs
x0 LIEWrappedName GhcPs
n0 IEWildcard
w0 (forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
GHC.lieWrappedName forall a b. (a -> b) -> a -> b
$ [LIEWrappedName GhcPs]
ns0 forall a. [a] -> [a] -> [a]
++ [LIEWrappedName GhcPs]
ns1)
  ieMerge IE GhcPs
_ IE GhcPs
_ = forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
nubOn :: Ord k => (a -> k) -> [a] -> [a]
nubOn :: forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn a -> k
f = Set k -> [a] -> [a]
go 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 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 forall a. a -> [a] -> [a]
: Set k -> [a] -> [a]
go (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