{-# 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
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
/= :: Options -> Options -> Bool
Eq, Int -> Options -> ShowS
[Options] -> ShowS
Options -> [Char]
(Int -> Options -> ShowS)
-> (Options -> [Char]) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Options -> ShowS
showsPrec :: Int -> Options -> ShowS
$cshow :: Options -> [Char]
show :: Options -> [Char]
$cshowList :: [Options] -> ShowS
showList :: [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    = [Char] -> Pattern
unsafeParsePattern [Char]
".*"
          , subGroup :: Maybe Pattern
subGroup = Pattern -> Maybe Pattern
forall a. a -> Maybe a
Just (Pattern -> Maybe Pattern) -> Pattern -> Maybe Pattern
forall a b. (a -> b) -> a -> b
$ [Char] -> Pattern
unsafeParsePattern [Char]
"^[^.]+"
          }

data ListPadding
    = LPConstant Int
    | LPModuleName
    deriving (ListPadding -> ListPadding -> Bool
(ListPadding -> ListPadding -> Bool)
-> (ListPadding -> ListPadding -> Bool) -> Eq ListPadding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListPadding -> ListPadding -> Bool
== :: ListPadding -> ListPadding -> Bool
$c/= :: ListPadding -> ListPadding -> Bool
/= :: ListPadding -> ListPadding -> Bool
Eq, Int -> ListPadding -> ShowS
[ListPadding] -> ShowS
ListPadding -> [Char]
(Int -> ListPadding -> ShowS)
-> (ListPadding -> [Char])
-> ([ListPadding] -> ShowS)
-> Show ListPadding
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListPadding -> ShowS
showsPrec :: Int -> ListPadding -> ShowS
$cshow :: ListPadding -> [Char]
show :: ListPadding -> [Char]
$cshowList :: [ListPadding] -> ShowS
showList :: [ListPadding] -> ShowS
Show)

data ImportAlign
    = Global
    | File
    | Group
    | None
    deriving (ImportAlign -> ImportAlign -> Bool
(ImportAlign -> ImportAlign -> Bool)
-> (ImportAlign -> ImportAlign -> Bool) -> Eq ImportAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImportAlign -> ImportAlign -> Bool
== :: ImportAlign -> ImportAlign -> Bool
$c/= :: ImportAlign -> ImportAlign -> Bool
/= :: ImportAlign -> ImportAlign -> Bool
Eq, Int -> ImportAlign -> ShowS
[ImportAlign] -> ShowS
ImportAlign -> [Char]
(Int -> ImportAlign -> ShowS)
-> (ImportAlign -> [Char])
-> ([ImportAlign] -> ShowS)
-> Show ImportAlign
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportAlign -> ShowS
showsPrec :: Int -> ImportAlign -> ShowS
$cshow :: ImportAlign -> [Char]
show :: ImportAlign -> [Char]
$cshowList :: [ImportAlign] -> ShowS
showList :: [ImportAlign] -> ShowS
Show)

data ListAlign
    = NewLine
    | WithModuleName
    | WithAlias
    | AfterAlias
    | Repeat
    deriving (ListAlign -> ListAlign -> Bool
(ListAlign -> ListAlign -> Bool)
-> (ListAlign -> ListAlign -> Bool) -> Eq ListAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListAlign -> ListAlign -> Bool
== :: ListAlign -> ListAlign -> Bool
$c/= :: ListAlign -> ListAlign -> Bool
/= :: ListAlign -> ListAlign -> Bool
Eq, Int -> ListAlign -> ShowS
[ListAlign] -> ShowS
ListAlign -> [Char]
(Int -> ListAlign -> ShowS)
-> (ListAlign -> [Char])
-> ([ListAlign] -> ShowS)
-> Show ListAlign
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListAlign -> ShowS
showsPrec :: Int -> ListAlign -> ShowS
$cshow :: ListAlign -> [Char]
show :: ListAlign -> [Char]
$cshowList :: [ListAlign] -> ShowS
showList :: [ListAlign] -> ShowS
Show)

data EmptyListAlign
    = Inherit
    | RightAfter
    deriving (EmptyListAlign -> EmptyListAlign -> Bool
(EmptyListAlign -> EmptyListAlign -> Bool)
-> (EmptyListAlign -> EmptyListAlign -> Bool) -> Eq EmptyListAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EmptyListAlign -> EmptyListAlign -> Bool
== :: EmptyListAlign -> EmptyListAlign -> Bool
$c/= :: EmptyListAlign -> EmptyListAlign -> Bool
/= :: EmptyListAlign -> EmptyListAlign -> Bool
Eq, Int -> EmptyListAlign -> ShowS
[EmptyListAlign] -> ShowS
EmptyListAlign -> [Char]
(Int -> EmptyListAlign -> ShowS)
-> (EmptyListAlign -> [Char])
-> ([EmptyListAlign] -> ShowS)
-> Show EmptyListAlign
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EmptyListAlign -> ShowS
showsPrec :: Int -> EmptyListAlign -> ShowS
$cshow :: EmptyListAlign -> [Char]
show :: EmptyListAlign -> [Char]
$cshowList :: [EmptyListAlign] -> ShowS
showList :: [EmptyListAlign] -> ShowS
Show)

data LongListAlign
    = Inline -- inline
    | InlineWithBreak -- new_line
    | InlineToMultiline -- new_line_multiline
    | Multiline -- multiline
    deriving (LongListAlign -> LongListAlign -> Bool
(LongListAlign -> LongListAlign -> Bool)
-> (LongListAlign -> LongListAlign -> Bool) -> Eq LongListAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LongListAlign -> LongListAlign -> Bool
== :: LongListAlign -> LongListAlign -> Bool
$c/= :: LongListAlign -> LongListAlign -> Bool
/= :: LongListAlign -> LongListAlign -> Bool
Eq, Int -> LongListAlign -> ShowS
[LongListAlign] -> ShowS
LongListAlign -> [Char]
(Int -> LongListAlign -> ShowS)
-> (LongListAlign -> [Char])
-> ([LongListAlign] -> ShowS)
-> Show LongListAlign
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LongListAlign -> ShowS
showsPrec :: Int -> LongListAlign -> ShowS
$cshow :: LongListAlign -> [Char]
show :: LongListAlign -> [Char]
$cshowList :: [LongListAlign] -> ShowS
showList :: [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 -> [Char]
(Int -> GroupRule -> ShowS)
-> (GroupRule -> [Char])
-> ([GroupRule] -> ShowS)
-> Show GroupRule
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupRule -> ShowS
showsPrec :: Int -> GroupRule -> ShowS
$cshow :: GroupRule -> [Char]
show :: GroupRule -> [Char]
$cshowList :: [GroupRule] -> ShowS
showList :: [GroupRule] -> ShowS
Show, GroupRule -> GroupRule -> Bool
(GroupRule -> GroupRule -> Bool)
-> (GroupRule -> GroupRule -> Bool) -> Eq GroupRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupRule -> GroupRule -> Bool
== :: GroupRule -> GroupRule -> Bool
$c/= :: GroupRule -> GroupRule -> Bool
/= :: GroupRule -> GroupRule -> Bool
Eq)

instance A.FromJSON GroupRule where
  parseJSON :: Value -> Parser GroupRule
parseJSON = [Char] -> (Object -> Parser GroupRule) -> Value -> Parser GroupRule
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"group_rule" Object -> Parser GroupRule
parse
    where parse :: Object -> Parser GroupRule
parse Object
o = Pattern -> Maybe Pattern -> GroupRule
GroupRule
                (Pattern -> Maybe Pattern -> GroupRule)
-> Parser Pattern -> Parser (Maybe Pattern -> GroupRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Pattern
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"match")
                Parser (Maybe Pattern -> GroupRule)
-> Parser (Maybe Pattern) -> Parser GroupRule
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Pattern)
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 -> [Char]
string :: String
    -- ^ The valid regex string that 'regex' was compiled from.
  }

instance Show Pattern where show :: Pattern -> [Char]
show = ShowS
forall a. Show a => a -> [Char]
show ShowS -> (Pattern -> [Char]) -> Pattern -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [Char]
string

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

instance A.FromJSON Pattern where
  parseJSON :: Value -> Parser Pattern
parseJSON = [Char] -> (Text -> Parser Pattern) -> Value -> Parser Pattern
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
A.withText [Char]
"regex" Text -> Parser Pattern
forall {m :: * -> *}. MonadFail m => Text -> m Pattern
parse
    where parse :: Text -> m Pattern
parse Text
text = case [Char] -> Either [Char] Pattern
parsePattern ([Char] -> Either [Char] Pattern)
-> [Char] -> Either [Char] Pattern
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
text of
            Left [Char]
err  -> [Char] -> m Pattern
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m Pattern) -> [Char] -> m Pattern
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid regex:\n" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
err
            Right Pattern
pat -> Pattern -> m Pattern
forall a. a -> m a
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 :: [Char] -> Either [Char] Pattern
parsePattern [Char]
string = case [Char] -> Either ParseError (Pattern, (Int, DoPa))
parseRegex [Char]
string of
  Right (Pattern, (Int, DoPa))
_  -> Pattern -> Either [Char] Pattern
forall a b. b -> Either a b
Right (Pattern -> Either [Char] Pattern)
-> Pattern -> Either [Char] Pattern
forall a b. (a -> b) -> a -> b
$ Pattern { [Char]
string :: [Char]
string :: [Char]
string, regex :: Regex
regex = [Char] -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
Regex.makeRegex [Char]
string }
  Left ParseError
err -> [Char] -> Either [Char] Pattern
forall a b. a -> Either a b
Left (ParseError -> [Char]
forall a. Show a => a -> [Char]
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 :: [Char] -> Pattern
unsafeParsePattern = ([Char] -> Pattern)
-> (Pattern -> Pattern) -> Either [Char] Pattern -> Pattern
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Pattern
forall a. HasCallStack => [Char] -> a
error Pattern -> Pattern
forall a. a -> a
id (Either [Char] Pattern -> Pattern)
-> ([Char] -> Either [Char] Pattern) -> [Char] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] Pattern
parsePattern

--------------------------------------------------------------------------------
step :: Maybe Int -> Options -> Step
step :: Maybe Int -> Options -> Step
step Maybe Int
columns = [Char] -> (Lines -> Module -> Lines) -> Step
makeStep [Char]
"Imports (ghc-lib-parser)" ((Lines -> Module -> Lines) -> Step)
-> (Options -> Lines -> Module -> Lines) -> Options -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Options -> Lines -> Module -> Lines
printImports Maybe Int
columns


--------------------------------------------------------------------------------
printImports :: Maybe Int -> Options -> Lines -> Module -> Lines
printImports :: Maybe Int -> Options -> Lines -> Module -> Lines
printImports Maybe Int
maxCols Options
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 = (ImportDecl GhcPs -> ImportStats)
-> [ImportDecl GhcPs] -> ImportStats
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ImportDecl GhcPs -> ImportStats
importStats ([ImportDecl GhcPs] -> ImportStats)
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [ImportDecl GhcPs])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> ImportStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [ImportDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> ImportStats)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> ImportStats
forall a b. (a -> b) -> a -> b
$ (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
 -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. NonEmpty a -> [a]
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 (LImportDecl GhcPs)]
[NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
groups
      | Bool
otherwise =
          (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)) -> Edits)
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))] -> Edits
forall m a. Monoid m => (a -> m) -> [a] -> m
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 [Char] -> (Lines -> Lines) -> Edits
Editor.changeLines (NonEmpty (LImportDecl GhcPs) -> Block [Char]
importBlock NonEmpty (LImportDecl GhcPs)
imports) (Lines -> Lines -> Lines
forall a b. a -> b -> a
const Lines
newLines)

importBlock :: NonEmpty (GHC.LImportDecl GHC.GhcPs)  -> Block String
importBlock :: NonEmpty (LImportDecl GhcPs) -> Block [Char]
importBlock NonEmpty (LImportDecl GhcPs)
group = Int -> Int -> Block [Char]
forall a. Int -> Int -> Block a
Block
    (RealSrcSpan -> Int
GHC.srcSpanStartLine (RealSrcSpan -> Int)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
group)
    (RealSrcSpan -> Int
GHC.srcSpanEndLine   (RealSrcSpan -> Int)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
group)
  where
    src :: GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src = RealSrcSpan -> Maybe RealSrcSpan -> RealSrcSpan
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> RealSrcSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"importBlock: missing location") (Maybe RealSrcSpan -> RealSrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> Maybe RealSrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcSpanAnn' a) e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA

formatImports
    :: Maybe Int    -- ^ Max columns.
    -> Options      -- ^ Options.
    -> ImportStats  -- ^ Module stats.
    -> NonEmpty (GHC.LImportDecl GHC.GhcPs) -> Lines
formatImports :: Maybe Int
-> Options -> ImportStats -> NonEmpty (LImportDecl GhcPs) -> Lines
formatImports Maybe Int
maxCols Options
options ImportStats
moduleStats NonEmpty (LImportDecl GhcPs)
rawGroup =
  PrinterConfig -> P () -> Lines
forall a. PrinterConfig -> Printer a -> Lines
runPrinter_ (Maybe Int -> PrinterConfig
PrinterConfig Maybe Int
maxCols) do
  let
    group :: NonEmpty (GHC.LImportDecl GHC.GhcPs)
    group :: NonEmpty (LImportDecl GhcPs)
group
      = (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
 -> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Ordering)
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NonEmpty.sortBy (ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering
compareImports (ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc) NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
rawGroup
      NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
    -> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a b. a -> (a -> b) -> b
& NonEmpty (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
mergeImports

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

    align' :: ImportAlign
align' = Options -> ImportAlign
importAlign Options
options
    padModuleNames' :: Bool
padModuleNames' = Options -> Bool
padModuleNames Options
options
    padNames :: Bool
padNames = ImportAlign
align' ImportAlign -> ImportAlign -> Bool
forall a. Eq a => a -> a -> Bool
/= ImportAlign
None Bool -> Bool -> Bool
&& Bool
padModuleNames'

    stats :: ImportStats
stats = case ImportAlign
align' of
        ImportAlign
Global -> ImportStats
moduleStats {isAnyQualified = True}
        ImportAlign
File   -> ImportStats
moduleStats
        ImportAlign
Group  -> (ImportDecl GhcPs -> ImportStats)
-> [ImportDecl GhcPs] -> ImportStats
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ImportDecl GhcPs -> ImportStats
importStats [ImportDecl GhcPs]
unLocatedGroup
        ImportAlign
None   -> ImportStats
forall a. Monoid a => a
mempty

  NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> P ()) -> P ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
group \GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp -> Options -> Bool -> ImportStats -> LImportDecl GhcPs -> P ()
printQualified Options
options Bool
padNames ImportStats
stats LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
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
_ [] = Edits
forall a. Monoid a => a
mempty
groupAndFormat Maybe Int
maxCols Options
options ImportStats
moduleStats [NonEmpty (LImportDecl GhcPs)]
groups =
  Block [Char] -> (Lines -> Lines) -> Edits
Editor.changeLines Block [Char]
forall {a}. Block a
block (Lines -> Lines -> Lines
forall a b. a -> b -> a
const Lines
regroupedLines)
  where
    regroupedLines :: Lines
    regroupedLines :: Lines
regroupedLines = Lines -> [Lines] -> Lines
forall a. [a] -> [[a]] -> [a]
intercalate [[Char]
""] ([Lines] -> Lines) -> [Lines] -> Lines
forall a b. (a -> b) -> a -> b
$
      (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)) -> Lines)
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> [Lines]
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)]
[NonEmpty (GenLocated SrcSpanAnnA (ImportDecl 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 = (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
 -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [NonEmpty (LImportDecl GhcPs)]
[NonEmpty (GenLocated SrcSpanAnnA (ImportDecl 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 = Int -> Int -> Block a
forall a. Int -> Int -> Block a
Block
      (RealSrcSpan -> Int
GHC.srcSpanStartLine (RealSrcSpan -> Int)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. HasCallStack => [a] -> a
head [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
imports)
      (RealSrcSpan -> Int
GHC.srcSpanEndLine   (RealSrcSpan -> Int)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. HasCallStack => [a] -> a
last [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
imports)
    src :: GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src = RealSrcSpan -> Maybe RealSrcSpan -> RealSrcSpan
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> RealSrcSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"regroupImports: missing location") (Maybe RealSrcSpan -> RealSrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> Maybe RealSrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcSpanAnn' a) e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA

-- | 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 = Seq (NonEmpty (LImportDecl GhcPs))
-> [NonEmpty (LImportDecl GhcPs)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (NonEmpty (LImportDecl GhcPs))
 -> [NonEmpty (LImportDecl GhcPs)])
-> Seq (NonEmpty (LImportDecl GhcPs))
-> [NonEmpty (LImportDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ [GroupRule]
-> [LImportDecl GhcPs]
-> Seq (NonEmpty (LImportDecl GhcPs))
-> Seq (NonEmpty (LImportDecl GhcPs))
go [GroupRule]
rules [LImportDecl GhcPs]
allImports Seq (NonEmpty (LImportDecl GhcPs))
Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
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))
Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
groups Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a. Seq a -> a -> Seq a
:|> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl 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 [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
rest (Seq (NonEmpty (LImportDecl GhcPs))
Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
groups Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
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 :: GroupRule -> Pattern
match :: Pattern
match, Maybe Pattern
subGroup :: GroupRule -> Maybe Pattern
subGroup :: Maybe Pattern
subGroup } [LImportDecl GhcPs]
imports =
      let
        ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
matched, [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
rest) = (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)],
    [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Pattern -> LImportDecl GhcPs -> Bool
matches Pattern
match) [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
imports
        subgroups :: [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
subgroups = (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
 -> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Char] -> [Char] -> Bool)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> [Char])
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Maybe Pattern -> LImportDecl GhcPs -> [Char]
firstMatch Maybe Pattern
subGroup) ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
 -> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
forall a b. (a -> b) -> a -> b
$
                      (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> [Char])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Maybe Pattern -> LImportDecl GhcPs -> [Char]
firstMatch Maybe Pattern
subGroup) [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
matched
      in
        -- groupBy never produces empty groups, so this mapMaybe will
        -- not discard anything from subgroups
        ([NonEmpty (LImportDecl GhcPs)]
-> Seq (NonEmpty (LImportDecl GhcPs))
forall a. [a] -> Seq a
Seq.fromList ([NonEmpty (LImportDecl GhcPs)]
 -> Seq (NonEmpty (LImportDecl GhcPs)))
-> [NonEmpty (LImportDecl GhcPs)]
-> Seq (NonEmpty (LImportDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
 -> Maybe (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
-> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
subgroups, [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
rest)

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

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

    moduleName :: GenLocated l (ImportDecl GhcPs) -> [Char]
moduleName = ImportDecl GhcPs -> [Char]
importModuleName (ImportDecl GhcPs -> [Char])
-> (GenLocated l (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> GenLocated l (ImportDecl GhcPs)
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (ImportDecl GhcPs) -> ImportDecl GhcPs
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
importAlign :: Options -> ImportAlign
listAlign :: Options -> ListAlign
padModuleNames :: Options -> Bool
longListAlign :: Options -> LongListAlign
emptyListAlign :: Options -> EmptyListAlign
listPadding :: Options -> ListPadding
separateLists :: Options -> Bool
spaceSurround :: Options -> Bool
postQualified :: Options -> Bool
groupImports :: Options -> Bool
groupRules :: Options -> [GroupRule]
importAlign :: ImportAlign
listAlign :: ListAlign
padModuleNames :: Bool
longListAlign :: LongListAlign
emptyListAlign :: EmptyListAlign
listPadding :: ListPadding
separateLists :: Bool
spaceSurround :: Bool
postQualified :: Bool
groupImports :: Bool
groupRules :: [GroupRule]
..} Bool
padNames ImportStats
stats LImportDecl GhcPs
ldecl = do
    [Char] -> P ()
putText [Char]
"import" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
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
_) -> [Char] -> P ()
putText [Char]
"{-# SOURCE #-}" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
      (Bool
_, Bool
True) -> [Char] -> P ()
putText [Char]
"              " P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
      (Bool, Bool)
_         -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

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

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

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

    Int
afterAliasPosition <- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> Printer [Char] -> Printer Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Printer [Char]
getCurrentLine

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

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

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

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

        Just GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports -> do
            let imports :: [GenLocated SrcSpanAnnA (IE GhcPs)]
imports = GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports
                printedImports :: [(P (), Bool, Bool)]
printedImports = [P ()] -> [(P (), Bool, Bool)]
forall a. [a] -> [(a, Bool, Bool)]
flagEnds ([P ()] -> [(P (), Bool, Bool)]) -> [P ()] -> [(P (), Bool, Bool)]
forall a b. (a -> b) -> a -> b
$ -- [P ()]
                    (Bool -> IE GhcPs -> P ()
printImport Bool
separateLists) (IE GhcPs -> P ())
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc (GenLocated SrcSpanAnnA (IE GhcPs) -> P ())
-> [GenLocated SrcSpanAnnA (IE GhcPs)] -> [P ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    [LIE GhcPs] -> [LIE GhcPs]
prepareImportList [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
imports

            -- Since we might need to output the import module name several times, we
            -- need to save it to a variable:
            [Char]
wrapPrefix <- case ListAlign
listAlign of
                ListAlign
AfterAlias -> [Char] -> Printer [Char]
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Printer [Char]) -> [Char] -> Printer [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
afterAliasPosition Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' '
                ListAlign
WithAlias -> [Char] -> Printer [Char]
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Printer [Char]) -> [Char] -> Printer [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
beforeAliasPosition Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' '
                ListAlign
Repeat -> ShowS -> Printer [Char] -> Printer [Char]
forall a b. (a -> b) -> Printer a -> Printer b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" (") Printer [Char]
getCurrentLine
                ListAlign
WithModuleName -> [Char] -> Printer [Char]
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Printer [Char]) -> [Char] -> Printer [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
moduleNamePosition Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) Char
' '
                ListAlign
NewLine -> [Char] -> Printer [Char]
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Printer [Char]) -> [Char] -> Printer [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
offset Char
' '

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

            -- Try to put everything on one line.
            let printAsSingleLine :: P ()
printAsSingleLine = [(P (), Bool, Bool)] -> ((P (), Bool, Bool) -> P ()) -> P ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(P (), Bool, Bool)]
printedImports (((P (), Bool, Bool) -> P ()) -> P ())
-> ((P (), Bool, Bool) -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$ \(P ()
imp, Bool
start, Bool
end) -> do
                    Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
start (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ [Char] -> P ()
putText [Char]
"(" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
doSpaceSurround
                    P ()
imp
                    if Bool
end then P ()
doSpaceSurround P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
")" else P ()
comma P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
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 = [(P (), Bool, Bool)] -> ((P (), Bool, Bool) -> P ()) -> P ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(P (), Bool, Bool)]
printedImports (((P (), Bool, Bool) -> P ()) -> P ())
-> ((P (), Bool, Bool) -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$
                    \(P ()
imp, Bool
start, Bool
end) ->
                    P () -> P ()
forall {a}. P a -> P a
patchForRepeatHiding (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P () -> P () -> P ()
forall a. P a -> P a -> P a
wrapping
                       (do
                         if Bool
start then [Char] -> P ()
putText [Char]
"(" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
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 P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
")" 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 (ShowS -> P ())
-> ((Char -> Char) -> ShowS) -> (Char -> Char) -> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a. (a -> a) -> [a] -> [a]
withLast ((Char -> Char) -> P ()) -> (Char -> Char) -> P ()
forall a b. (a -> b) -> a -> b
$
                                \Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' then Char
')' else Char
c
                            ListAlign
_ | Bool
start Bool -> Bool -> Bool
&& Bool
spaceSurround ->
                                -- Only necessary if spaceSurround is enabled.
                                ShowS -> P ()
modifyCurrentLine ShowS
trimRight
                            ListAlign
_ -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                        P ()
newline
                        Printer a -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Printer a
wprefix
                        case ListAlign
listAlign of
                          -- '(' already included in repeat
                          ListAlign
Repeat         -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                          -- Print the much needed '('
                          ListAlign
_ | Bool
start      -> [Char] -> P ()
putText [Char]
"(" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
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 LongListAlign -> LongListAlign -> Bool
forall a. Eq a => a -> a -> Bool
/= LongListAlign
Inline -> () -> P ()
forall a. a -> Printer a
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 P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
doSpaceSurround
                          ListAlign
WithModuleName -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                          ListAlign
WithAlias -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                          ListAlign
NewLine -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                        P ()
imp
                        if Bool
end then P ()
doSpaceSurround P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
")" else P ()
comma)

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

            case LongListAlign
longListAlign of
              LongListAlign
Multiline -> P () -> P () -> P ()
forall a. P a -> P a -> P a
wrapping
                (P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
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 P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P () -> P ()
forall {a}. Printer a -> P ()
printAsInlineWrapping ([Char] -> P ()
putText [Char]
wrapPrefix)
              LongListAlign
Inline -> P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P () -> P ()
forall {a}. Printer a -> P ()
printAsInlineWrapping ([Char] -> P ()
putText [Char]
wrapPrefix)
              LongListAlign
InlineWithBreak -> P () -> P () -> P ()
forall a. P a -> P a -> P a
wrapping
                (P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
printAsSingleLine)
                (do
                  ShowS -> P ()
modifyCurrentLine ShowS
trimRight
                  P ()
newline P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P () -> P ()
forall {a}. Printer a -> P ()
printAsInlineWrapping P ()
putOffset)
              LongListAlign
InlineToMultiline -> P () -> P () -> P ()
forall a. P a -> P a -> P a
wrapping
                (P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
printAsSingleLine)
                (P () -> P () -> P ()
forall a. P a -> P a -> P a
wrapping
                  (do
                    ShowS -> P ()
modifyCurrentLine ShowS
trimRight
                    P ()
newline P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
printAsSingleLine)
                  P ()
printAsMultiLine)
  where
    decl :: ImportDecl GhcPs
decl = GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
ldecl

    -- We cannot wrap/repeat 'hiding' imports since then we would get multiple
    -- imports hiding different things.
    patchForRepeatHiding :: P a -> P a
patchForRepeatHiding = case ListAlign
listAlign of
        ListAlign
Repeat | ImportDecl GhcPs -> Bool
isHiding ImportDecl GhcPs
decl -> Maybe Int -> P a -> P a
forall a. Maybe Int -> P a -> P a
withColumns Maybe Int
forall a. Maybe a
Nothing
        ListAlign
_                      -> P a -> P a
forall a. a -> a
id


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


--------------------------------------------------------------------------------
printIeWrappedName :: GHC.LIEWrappedName GHC.GhcPs -> P ()
printIeWrappedName :: LIEWrappedName GhcPs -> P ()
printIeWrappedName LIEWrappedName GhcPs
lie = case GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> IEWrappedName GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
lie of
    GHC.IEName    XIEName GhcPs
_ LIdP GhcPs
n -> GenLocated SrcSpanAnnN RdrName -> P ()
putRdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n
    GHC.IEPattern XIEPattern GhcPs
_ LIdP GhcPs
n -> [Char] -> P ()
putText [Char]
"pattern" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnN RdrName -> P ()
putRdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n
    GHC.IEType    XIEType GhcPs
_ LIdP GhcPs
n -> [Char] -> P ()
putText [Char]
"type" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnN RdrName -> P ()
putRdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n


mergeImports
    :: NonEmpty (GHC.LImportDecl GHC.GhcPs)
    -> NonEmpty (GHC.LImportDecl GHC.GhcPs)
mergeImports :: NonEmpty (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs)
mergeImports (LImportDecl GhcPs
x :| []) = LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> [a] -> NonEmpty a
:| []
mergeImports (LImportDecl GhcPs
h :| (LImportDecl GhcPs
t : [LImportDecl GhcPs]
ts))
  | ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
canMergeImport (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
h) (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
t) = NonEmpty (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs)
mergeImports (LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs
mergeModuleImport LImportDecl GhcPs
h LImportDecl GhcPs
t GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ts)
  | Bool
otherwise = LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
h GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail (LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
t GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ts)
  where
    mergeImportsTail :: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x : GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y : [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ys)
      | ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
canMergeImport (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x) (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y) = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail ((LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs
mergeModuleImport LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y) GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ys)
      | Bool
otherwise = GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ys)
    mergeImportsTail [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
xs = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
xs


--------------------------------------------------------------------------------
data ImportStats = ImportStats
    { ImportStats -> Int
isLongestImport :: !Int
    , ImportStats -> Bool
isAnySource     :: !Bool
    , ImportStats -> Bool
isAnyQualified  :: !Bool
    , ImportStats -> Bool
isAnySafe       :: !Bool
    }

instance Semigroup ImportStats where
    ImportStats
l <> :: ImportStats -> ImportStats -> ImportStats
<> ImportStats
r = ImportStats
        { isLongestImport :: Int
isLongestImport = ImportStats -> Int
isLongestImport ImportStats
l Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` ImportStats -> Int
isLongestImport ImportStats
r
        , isAnySource :: Bool
isAnySource     = ImportStats -> Bool
isAnySource     ImportStats
l Bool -> Bool -> Bool
||    ImportStats -> Bool
isAnySource     ImportStats
r
        , isAnyQualified :: Bool
isAnyQualified  = ImportStats -> Bool
isAnyQualified  ImportStats
l Bool -> Bool -> Bool
||    ImportStats -> Bool
isAnyQualified  ImportStats
r
        , isAnySafe :: Bool
isAnySafe       = ImportStats -> Bool
isAnySafe       ImportStats
l Bool -> Bool -> Bool
||    ImportStats -> Bool
isAnySafe       ImportStats
r
        }

instance Monoid ImportStats where
    mappend :: ImportStats -> ImportStats -> ImportStats
mappend = ImportStats -> ImportStats -> ImportStats
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: ImportStats
mempty  = Int -> Bool -> Bool -> Bool -> ImportStats
ImportStats Int
0 Bool
False Bool
False Bool
False

importStats :: GHC.ImportDecl GHC.GhcPs -> ImportStats
importStats :: ImportDecl GhcPs -> ImportStats
importStats ImportDecl GhcPs
i =
    Int -> Bool -> Bool -> Bool -> ImportStats
ImportStats (ImportDecl GhcPs -> Int
importModuleNameLength ImportDecl GhcPs
i) (ImportDecl GhcPs -> Bool
isSource ImportDecl GhcPs
i) (ImportDecl GhcPs -> Bool
isQualified ImportDecl GhcPs
i) (ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
GHC.ideclSafe  ImportDecl GhcPs
i)

-- Computes length till module name, includes package name.
-- TODO: this should reuse code with the printer
importModuleNameLength :: GHC.ImportDecl GHC.GhcPs -> Int
importModuleNameLength :: ImportDecl GhcPs -> Int
importModuleNameLength ImportDecl GhcPs
imp =
    (case ImportDecl GhcPs -> ImportDeclPkgQual GhcPs
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (StringLiteral -> [Char]
stringLiteral StringLiteral
sl)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
    ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> [Char]
importModuleName ImportDecl GhcPs
imp)


--------------------------------------------------------------------------------
stringLiteral :: GHC.StringLiteral -> String
stringLiteral :: StringLiteral -> [Char]
stringLiteral StringLiteral
sl = case StringLiteral -> SourceText
GHC.sl_st StringLiteral
sl of
    SourceText
GHC.NoSourceText -> FastString -> [Char]
GHC.unpackFS (FastString -> [Char]) -> FastString -> [Char]
forall a b. (a -> b) -> a -> b
$ StringLiteral -> FastString
GHC.sl_fs StringLiteral
sl
    GHC.SourceText FastString
s -> FastString -> [Char]
GHC.unpackFS (FastString -> [Char]) -> FastString -> [Char]
forall a b. (a -> b) -> a -> b
$ FastString
s


--------------------------------------------------------------------------------
isQualified :: GHC.ImportDecl GHC.GhcPs -> Bool
isQualified :: ImportDecl GhcPs -> Bool
isQualified = ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
(/=) ImportDeclQualifiedStyle
GHC.NotQualified (ImportDeclQualifiedStyle -> Bool)
-> (ImportDecl GhcPs -> ImportDeclQualifiedStyle)
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
GHC.ideclQualified

isHiding :: GHC.ImportDecl GHC.GhcPs -> Bool
isHiding :: ImportDecl GhcPs -> Bool
isHiding ImportDecl GhcPs
d = case ImportDecl GhcPs
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
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 = IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
(==) IsBootInterface
GHC.IsBoot (IsBootInterface -> Bool)
-> (ImportDecl GhcPs -> IsBootInterface)
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> IsBootInterface
forall pass. ImportDecl pass -> IsBootInterface
GHC.ideclSource


--------------------------------------------------------------------------------
-- | Cleans up an import item list.
--
-- * Sorts import items.
-- * Sort inner import lists, e.g. `import Control.Monad (Monad (return, join))`
-- * Removes duplicates from import lists.
prepareImportList :: [GHC.LIE GHC.GhcPs] -> [GHC.LIE GHC.GhcPs]
prepareImportList :: [LIE GhcPs] -> [LIE GhcPs]
prepareImportList =
  (GenLocated SrcSpanAnnA (IE GhcPs)
 -> GenLocated SrcSpanAnnA (IE GhcPs) -> Ordering)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy LIE GhcPs -> LIE GhcPs -> Ordering
GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs) -> Ordering
compareLIE ([GenLocated SrcSpanAnnA (IE GhcPs)]
 -> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
    -> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (IE GhcPs)
 -> GenLocated SrcSpanAnnA (IE GhcPs))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map ((IE GhcPs -> IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IE GhcPs -> IE GhcPs
prepareInner) ([GenLocated SrcSpanAnnA (IE GhcPs)]
 -> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
    -> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ((RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
 -> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
 -> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ((RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
    -> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> (RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a b. (a, b) -> b
snd) ([(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
 -> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
    -> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
 -> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
    -> Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LIE GhcPs] -> Map RdrName (NonEmpty (LIE GhcPs))
[GenLocated SrcSpanAnnA (IE GhcPs)]
-> Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
mergeByName
 where
  mergeByName
      :: [GHC.LIE GHC.GhcPs]
      -> Map.Map GHC.RdrName (NonEmpty (GHC.LIE GHC.GhcPs))
  mergeByName :: [LIE GhcPs] -> Map RdrName (NonEmpty (LIE GhcPs))
mergeByName [LIE GhcPs]
imports0 = (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
 -> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
 -> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
-> Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
    -- Note that ideally every NonEmpty will just have a single entry and we
    -- will be able to merge everything into that entry.  Exotic imports can
    -- mess this up, though.  So they end up in the tail of the list.
    (\(GenLocated SrcSpanAnnA (IE GhcPs)
x :| [GenLocated SrcSpanAnnA (IE GhcPs)]
xs) (GenLocated SrcSpanAnnA (IE GhcPs)
y :| [GenLocated SrcSpanAnnA (IE GhcPs)]
ys) -> case IE GhcPs -> IE GhcPs -> Maybe (IE GhcPs)
ieMerge (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
x) (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
y) of
      Just IE GhcPs
z  -> (GenLocated SrcSpanAnnA (IE GhcPs)
x GenLocated SrcSpanAnnA (IE GhcPs)
-> IE GhcPs -> GenLocated SrcSpanAnnA (IE GhcPs)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IE GhcPs
z) GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a. a -> [a] -> NonEmpty a
:| ([GenLocated SrcSpanAnnA (IE GhcPs)]
xs [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (IE GhcPs)]
ys)  -- Keep source from `x`
      Maybe (IE GhcPs)
Nothing -> GenLocated SrcSpanAnnA (IE GhcPs)
x GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a. a -> [a] -> NonEmpty a
:| ([GenLocated SrcSpanAnnA (IE GhcPs)]
xs [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (IE GhcPs)
y GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (IE GhcPs)]
ys))
    [(IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
GHC.ieName (IE GhcPs -> IdP GhcPs) -> IE GhcPs -> IdP GhcPs
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
imp, GenLocated SrcSpanAnnA (IE GhcPs)
imp GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a. a -> [a] -> NonEmpty a
:| []) | GenLocated SrcSpanAnnA (IE GhcPs)
imp <- [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
imports0]

  prepareInner :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs
  prepareInner :: IE GhcPs -> IE GhcPs
prepareInner = \case
    -- Simplify `A ()` to `A`.
    GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName GhcPs
n IEWildcard
GHC.NoIEWildcard [] -> XIEThingAbs GhcPs -> LIEWrappedName GhcPs -> IE GhcPs
forall pass. XIEThingAbs pass -> LIEWrappedName pass -> IE pass
GHC.IEThingAbs XIEThingWith GhcPs
XIEThingAbs GhcPs
x LIEWrappedName GhcPs
n
    GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName GhcPs
n IEWildcard
w [LIEWrappedName GhcPs]
ns ->
      XIEThingWith GhcPs
-> LIEWrappedName GhcPs
-> IEWildcard
-> [LIEWrappedName GhcPs]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName GhcPs
n IEWildcard
w ((GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
 -> GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Ordering)
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (IEWrappedName GhcPs -> IEWrappedName GhcPs -> Ordering
compareWrappedName (IEWrappedName GhcPs -> IEWrappedName GhcPs -> Ordering)
-> (GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
    -> IEWrappedName GhcPs)
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> IEWrappedName GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc) [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName 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
_                  = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
  ieMerge IE GhcPs
_                  r :: IE GhcPs
r@(GHC.IEVar XIEVar GhcPs
_ LIEWrappedName GhcPs
_)      = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
r
  ieMerge (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
_)   IE GhcPs
r                  = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
r
  ieMerge IE GhcPs
l                  (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
_)   = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
  ieMerge l :: IE GhcPs
l@(GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
_) IE GhcPs
_                  = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
  ieMerge IE GhcPs
_                  r :: IE GhcPs
r@(GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
_) = IE GhcPs -> Maybe (IE 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 IEWildcard -> IEWildcard -> Bool
forall a. Eq a => a -> a -> Bool
/= IEWildcard
w1  = Maybe (IE GhcPs)
forall a. Maybe a
Nothing
    | Bool
otherwise = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just (IE GhcPs -> Maybe (IE GhcPs)) -> IE GhcPs -> Maybe (IE GhcPs)
forall a b. (a -> b) -> a -> b
$
        -- TODO: sort the `ns0 ++ ns1`?
        XIEThingWith GhcPs
-> LIEWrappedName GhcPs
-> IEWildcard
-> [LIEWrappedName GhcPs]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
GHC.IEThingWith XIEThingWith GhcPs
x0 LIEWrappedName GhcPs
n0 IEWildcard
w0 ((LIEWrappedName GhcPs -> RdrName)
-> [LIEWrappedName GhcPs] -> [LIEWrappedName GhcPs]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn LIEWrappedName GhcPs -> IdP GhcPs
LIEWrappedName GhcPs -> RdrName
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
GHC.lieWrappedName ([LIEWrappedName GhcPs] -> [LIEWrappedName GhcPs])
-> [LIEWrappedName GhcPs] -> [LIEWrappedName GhcPs]
forall a b. (a -> b) -> a -> b
$ [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
ns0 [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
forall a. [a] -> [a] -> [a]
++ [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
ns1)
  ieMerge IE GhcPs
_ IE GhcPs
_ = Maybe (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 Set k
forall a. Set a
Set.empty
 where
  go :: Set k -> [a] -> [a]
go Set k
_   []              = []
  go Set k
acc (a
x : [a]
xs)
    | k
y k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set k
acc = Set k -> [a] -> [a]
go Set k
acc [a]
xs
    | Bool
otherwise          = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set k -> [a] -> [a]
go (k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
y Set k
acc) [a]
xs
   where
    y :: k
y = a -> k
f a
x