{-# 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
              ImportDeclPkgQual GhcPs
RawPkgQual
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 (Bool, XRec pass [LIE pass])
GHC.ideclHiding 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 (Bool, XRec pass [LIE pass])
GHC.ideclHiding 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 (IdP GhcPs)
name) = do
    LIEWrappedName RdrName -> P ()
printIeWrappedName LIEWrappedName (IdP GhcPs)
name
printImport Bool
_ (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
name) = do
    LIEWrappedName RdrName -> P ()
printIeWrappedName LIEWrappedName (IdP GhcPs)
name
printImport Bool
separateLists (GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
name) = do
    LIEWrappedName RdrName -> P ()
printIeWrappedName LIEWrappedName (IdP 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 (IdP GhcPs)
name IEWildcard
wildcard [LIEWrappedName (IdP GhcPs)]
imps) = do
    LIEWrappedName RdrName -> P ()
printIeWrappedName LIEWrappedName (IdP 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 RdrName -> P ()
printIeWrappedName [LIEWrappedName (IdP 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.RdrName -> P ()
printIeWrappedName :: LIEWrappedName RdrName -> P ()
printIeWrappedName LIEWrappedName RdrName
lie = case forall l e. GenLocated l e -> e
GHC.unLoc LIEWrappedName RdrName
lie of
    GHC.IEName      LocatedN RdrName
n -> LocatedN RdrName -> P ()
putRdrName LocatedN RdrName
n
    GHC.IEPattern EpaLocation
_ LocatedN RdrName
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
>> LocatedN RdrName -> P ()
putRdrName LocatedN RdrName
n
    GHC.IEType    EpaLocation
_ LocatedN RdrName
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
>> LocatedN RdrName -> P ()
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
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
        ImportDeclPkgQual GhcPs
RawPkgQual
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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
GHC.ideclHiding

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 (IdP GhcPs)
n IEWildcard
GHC.NoIEWildcard [] -> forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
GHC.IEThingAbs XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
n
    GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
n IEWildcard
w [LIEWrappedName (IdP GhcPs)]
ns ->
      forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
n IEWildcard
w (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (IEWrappedName RdrName -> IEWrappedName RdrName -> 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 (IdP 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 (IdP GhcPs)
_)      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)
_)      = forall a. a -> Maybe a
Just IE GhcPs
r
  ieMerge (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
_)   IE GhcPs
r                  = forall a. a -> Maybe a
Just IE GhcPs
r
  ieMerge IE GhcPs
l                  (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
_)   = forall a. a -> Maybe a
Just IE GhcPs
l
  ieMerge l :: IE GhcPs
l@(GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
_) 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)
_) = 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 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 (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
GHC.IEThingWith XIEThingWith GhcPs
x0 LIEWrappedName (IdP GhcPs)
n0 IEWildcard
w0 (forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn forall name. LIEWrappedName name -> name
GHC.lieWrappedName forall a b. (a -> b) -> a -> b
$ [LIEWrappedName (IdP GhcPs)]
ns0 forall a. [a] -> [a] -> [a]
++ [LIEWrappedName (IdP 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