{-# 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
    { importAlign    :: ImportAlign
    , listAlign      :: ListAlign
    , padModuleNames :: Bool
    , longListAlign  :: LongListAlign
    , emptyListAlign :: EmptyListAlign
    , listPadding    :: ListPadding
    , separateLists  :: Bool
    , spaceSurround  :: Bool
    , postQualified  :: Bool
    , groupImports   :: Bool
    , groupRules     :: [GroupRule]
    } deriving (Eq, Show)

defaultOptions :: Options
defaultOptions = Options
    { importAlign    = Global
    , listAlign      = AfterAlias
    , padModuleNames = True
    , longListAlign  = Inline
    , emptyListAlign = Inherit
    , listPadding    = LPConstant 4
    , separateLists  = True
    , spaceSurround  = False
    , postQualified  = False
    , groupImports   = False
    , groupRules     = [defaultGroupRule]
    }
  where defaultGroupRule = GroupRule
          { match    = unsafeParsePattern ".*"
          , subGroup = Just $ unsafeParsePattern "^[^.]+"
          }

data ListPadding
    = LPConstant Int
    | LPModuleName
    deriving (Eq, Show)

data ImportAlign
    = Global
    | File
    | Group
    | None
    deriving (Eq, Show)

data ListAlign
    = NewLine
    | WithModuleName
    | WithAlias
    | AfterAlias
    | Repeat
    deriving (Eq, Show)

data EmptyListAlign
    = Inherit
    | RightAfter
    deriving (Eq, Show)

data LongListAlign
    = Inline -- inline
    | InlineWithBreak -- new_line
    | InlineToMultiline -- new_line_multiline
    | Multiline -- multiline
    deriving (Eq, 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
  { match    :: Pattern
    -- ^ The pattern that determines whether a rule applies to a
    -- module name.
  , subGroup :: Maybe Pattern
    -- ^ An optional pattern for breaking the group up into smaller
    -- sub-groups.
  } deriving (Show, Eq)

instance A.FromJSON GroupRule where
  parseJSON = A.withObject "group_rule" parse
    where parse o = GroupRule
                <$> (o A..: "match")
                <*> (o A..:? "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
  { regex  :: Regex
    -- ^ The compiled regular expression.
  , string :: String
    -- ^ The valid regex string that 'regex' was compiled from.
  }

instance Show Pattern where show = show . string

instance Eq Pattern where (==) = (==) `on` string

instance A.FromJSON Pattern where
  parseJSON = A.withText "regex" parse
    where parse text = case parsePattern $ T.unpack text of
            Left err  -> fail $ "Invalid regex:\n" <> err
            Right pat -> pure pat


-- | Parse a string into a compiled regular expression ('Pattern').
--
-- Returns a human-readable parse error message if the string is not
-- valid regex syntax.
--
-- >>> parsePattern "^([^.]+)"
-- Right "^([^.]+)"
--
-- >>> parsePattern "("
-- Left "\"(\" (line 1, column 2):\nunexpected end of input\nexpecting empty () or anchor ^ or $ or an atom"
parsePattern :: String -> Either String Pattern
parsePattern string = case parseRegex string of
  Right _  -> Right $ Pattern { string, regex = Regex.makeRegex string }
  Left err -> Left (show 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 = either error id . parsePattern

--------------------------------------------------------------------------------
step :: Maybe Int -> Options -> Step
step columns = makeStep "Imports (ghc-lib-parser)" . printImports columns


--------------------------------------------------------------------------------
printImports :: Maybe Int -> Options -> Lines -> Module -> Lines
printImports maxCols options ls m = Editor.apply changes ls
  where
    groups = moduleImportGroups m
    moduleStats = foldMap importStats . fmap GHC.unLoc $ concatMap toList groups
    changes
      | groupImports options =
          groupAndFormat maxCols options moduleStats groups
      | otherwise =
          foldMap (formatGroup maxCols options moduleStats) groups

formatGroup
    :: Maybe Int -> Options -> ImportStats
    -> NonEmpty (GHC.LImportDecl GHC.GhcPs) -> Editor.Edits
formatGroup maxCols options moduleStats imports =
    let newLines = formatImports maxCols options moduleStats imports in
    Editor.changeLines (importBlock imports) (const newLines)

importBlock :: NonEmpty (GHC.LImportDecl GHC.GhcPs)  -> Block String
importBlock group = Block
    (GHC.srcSpanStartLine . src $ NonEmpty.head group)
    (GHC.srcSpanEndLine   . src $ NonEmpty.last group)
  where
    src = fromMaybe (error "importBlock: missing location") .
        GHC.srcSpanToRealSrcSpan . GHC.getLocA

formatImports
    :: Maybe Int    -- ^ Max columns.
    -> Options      -- ^ Options.
    -> ImportStats  -- ^ Module stats.
    -> NonEmpty (GHC.LImportDecl GHC.GhcPs) -> Lines
formatImports maxCols options moduleStats rawGroup =
  runPrinter_ (PrinterConfig maxCols) do
  let
    group :: NonEmpty (GHC.LImportDecl GHC.GhcPs)
    group
      = NonEmpty.sortBy (compareImports `on` GHC.unLoc) rawGroup
      & mergeImports

    unLocatedGroup = fmap GHC.unLoc $ toList group

    align' = importAlign options
    padModuleNames' = padModuleNames options
    padNames = align' /= None && padModuleNames'

    stats = case align' of
        Global -> moduleStats {isAnyQualified = True}
        File   -> moduleStats
        Group  -> foldMap importStats unLocatedGroup
        None   -> mempty

  forM_ group \imp -> printQualified options padNames stats imp >> 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 _ _ _ [] = mempty
groupAndFormat maxCols options moduleStats groups =
  Editor.changeLines block (const regroupedLines)
  where
    regroupedLines :: Lines
    regroupedLines = intercalate [""] $
      map (formatImports maxCols options moduleStats) grouped

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

    imports :: [GHC.LImportDecl GHC.GhcPs]
    imports = concatMap toList groups

    -- groups is non-empty by the pattern for this case
    -- imports is non-empty as long as groups is non-empty
    block = Block
      (GHC.srcSpanStartLine . src $ head imports)
      (GHC.srcSpanEndLine   . src $ last imports)
    src = fromMaybe (error "regroupImports: missing location") .
      GHC.srcSpanToRealSrcSpan . 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 rules allImports = toList $ go rules allImports Seq.empty
  where
    go :: [GroupRule]
       -> [GHC.LImportDecl GHC.GhcPs]
       -> Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs))
       -> Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs))
    go [] [] groups            = groups
    go [] imports groups       = groups :|> NonEmpty.fromList imports
    go (r : rs) imports groups =
      let
        (groups', rest) = extract r imports
      in
        go rs rest (groups <> groups')

    extract :: GroupRule
            -> [GHC.LImportDecl GHC.GhcPs]
            -> ( Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs))
               , [GHC.LImportDecl GHC.GhcPs]
               )
    extract GroupRule { match, subGroup } imports =
      let
        (matched, rest) = partition (matches match) imports
        subgroups = groupBy ((==) `on` firstMatch subGroup) $
                      sortOn (firstMatch subGroup) matched
      in
        -- groupBy never produces empty groups, so this mapMaybe will
        -- not discard anything from subgroups
        (Seq.fromList $ mapMaybe NonEmpty.nonEmpty subgroups, rest)

    matches :: Pattern -> GHC.LImportDecl GHC.GhcPs -> Bool
    matches Pattern { regex } import_ = Regex.match regex $ moduleName import_

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

    moduleName = importModuleName . GHC.unLoc


--------------------------------------------------------------------------------
printQualified
    :: Options -> Bool -> ImportStats -> GHC.LImportDecl GHC.GhcPs -> P ()
printQualified Options{..} padNames stats ldecl = do
    putText "import" >> space

    case (isSource decl, isAnySource stats) of
      (True, _) -> putText "{-# SOURCE #-}" >> space
      (_, True) -> putText "              " >> space
      _         -> pure ()

    when (GHC.ideclSafe decl) (putText "safe" >> space)

    let module_ = do
            moduleNamePosition <- length <$> getCurrentLine
            case GHC.ideclPkgQual decl of
              GHC.NoRawPkgQual   -> pure ()
              GHC.RawPkgQual pkg -> putText (stringLiteral pkg) >> space
            putText (importModuleName decl)

            -- Only print spaces if something follows.
            let somethingFollows =
                    isJust (GHC.ideclAs decl) || isHiding decl ||
                    not (null $ GHC.ideclImportList decl)
            when (padNames && somethingFollows) $ putText $ replicate
                (isLongestImport stats - importModuleNameLength decl)
                ' '
            pure moduleNamePosition

    moduleNamePosition <-
        case (postQualified, isQualified decl, isAnyQualified stats) of
            (False, True , _   ) -> putText "qualified" *> space *> module_
            (False, _    , True) -> putText "         " *> space *> module_
            (True , True , _   ) -> module_ <* space <* putText "qualified"
            _                    -> module_

    beforeAliasPosition <- length <$> getCurrentLine
    forM_ (GHC.ideclAs decl) $ \lname -> do
        space >> putText "as" >> space
        putText . GHC.moduleNameString $ GHC.unLoc lname

    afterAliasPosition <- length <$> getCurrentLine

    when (isHiding decl) (space >> putText "hiding")

    let putOffset = putText $ replicate offset ' '
        offset = case listPadding of
            LPConstant n -> n
            LPModuleName -> moduleNamePosition

    pure ()

    case snd <$> GHC.ideclImportList decl of
        Nothing -> pure ()
        Just limports | null (GHC.unLoc limports) -> case emptyListAlign of
            RightAfter -> modifyCurrentLine trimRight >> space >> putText "()"
            Inherit -> case listAlign of
                NewLine -> do
                    modifyCurrentLine trimRight
                    newline >> putOffset >> putText "()"
                _ -> space >> putText "()"

        Just limports -> do
            let imports = GHC.unLoc limports
                printedImports = flagEnds $ -- [P ()]
                    (printImport separateLists) . GHC.unLoc <$>
                    prepareImportList imports

            -- Since we might need to output the import module name several times, we
            -- need to save it to a variable:
            wrapPrefix <- case listAlign of
                AfterAlias -> pure $ replicate (afterAliasPosition + 1) ' '
                WithAlias -> pure $ replicate (beforeAliasPosition + 1) ' '
                Repeat -> fmap (++ " (") getCurrentLine
                WithModuleName -> pure $ replicate (moduleNamePosition + offset) ' '
                NewLine -> pure $ replicate offset ' '

            -- Helper
            let doSpaceSurround = when spaceSurround space

            -- Try to put everything on one line.
            let printAsSingleLine = forM_ printedImports $ \(imp, start, end) -> do
                    when start $ putText "(" >> doSpaceSurround
                    imp
                    if end then doSpaceSurround >> putText ")" else comma >> space

            -- Try to put everything one by one, wrapping if that fails.
            let printAsInlineWrapping wprefix = forM_ printedImports $
                    \(imp, start, end) ->
                    patchForRepeatHiding $ wrapping
                       (do
                         if start then putText "(" >> doSpaceSurround else space
                         imp
                         if end then doSpaceSurround >> putText ")" else comma)
                      (do
                        case listAlign of
                            -- In 'Repeat' mode, end lines with ')' rather than ','.
                            Repeat | not start -> modifyCurrentLine . withLast $
                                \c -> if c == ',' then ')' else c
                            _ | start && spaceSurround ->
                                -- Only necessary if spaceSurround is enabled.
                                modifyCurrentLine trimRight
                            _ -> pure ()
                        newline
                        void wprefix
                        case listAlign of
                          -- '(' already included in repeat
                          Repeat         -> pure ()
                          -- Print the much needed '('
                          _ | start      -> putText "(" >> doSpaceSurround
                          -- Don't bother aligning if we're not in inline mode.
                          _ | longListAlign /= Inline -> pure ()
                          -- 'Inline + AfterAlias' is really where we want to be careful
                          -- with spacing.
                          AfterAlias -> space >> doSpaceSurround
                          WithModuleName -> pure ()
                          WithAlias -> pure ()
                          NewLine -> pure ()
                        imp
                        if end then doSpaceSurround >> putText ")" else comma)

            -- Put everything on a separate line.  'spaceSurround' can be
            -- ignored.
            let printAsMultiLine = forM_ printedImports $ \(imp, start, end) -> do
                    when start $ modifyCurrentLine trimRight  -- We added some spaces.
                    newline
                    putOffset
                    if start then putText "( " else putText ", "
                    imp
                    when end $ newline >> putOffset >> putText ")"

            case longListAlign of
              Multiline -> wrapping
                (space >> printAsSingleLine)
                printAsMultiLine
              Inline | NewLine <- listAlign -> do
                modifyCurrentLine trimRight
                newline >> putOffset >> printAsInlineWrapping (putText wrapPrefix)
              Inline -> space >> printAsInlineWrapping (putText wrapPrefix)
              InlineWithBreak -> wrapping
                (space >> printAsSingleLine)
                (do
                  modifyCurrentLine trimRight
                  newline >> putOffset >> printAsInlineWrapping putOffset)
              InlineToMultiline -> wrapping
                (space >> printAsSingleLine)
                (wrapping
                  (do
                    modifyCurrentLine trimRight
                    newline >> putOffset >> printAsSingleLine)
                  printAsMultiLine)
  where
    decl = GHC.unLoc ldecl

    -- We cannot wrap/repeat 'hiding' imports since then we would get multiple
    -- imports hiding different things.
    patchForRepeatHiding = case listAlign of
        Repeat | isHiding decl -> withColumns Nothing
        _                      -> id


--------------------------------------------------------------------------------
printImport :: Bool -> GHC.IE GHC.GhcPs -> P ()
printImport _ (GHC.IEVar _ name) = do
    printIeWrappedName name
printImport _ (GHC.IEThingAbs _ name) = do
    printIeWrappedName name
printImport separateLists (GHC.IEThingAll _ name) = do
    printIeWrappedName name
    when separateLists space
    putText "(..)"
printImport _ (GHC.IEModuleContents _ modu) = do
    putText "module"
    space
    putText . GHC.moduleNameString $ GHC.unLoc modu
printImport separateLists (GHC.IEThingWith _ name wildcard imps) = do
    printIeWrappedName name
    when separateLists space
    let ellipsis = case wildcard of
          GHC.IEWildcard _position -> [putText ".."]
          GHC.NoIEWildcard         -> []
    parenthesize $
      sep (comma >> space) (ellipsis <> fmap printIeWrappedName imps)
printImport _ (GHC.IEGroup _ _ _ ) =
    error "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEGroup'"
printImport _ (GHC.IEDoc _ _) =
    error "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDoc'"
printImport _ (GHC.IEDocNamed _ _) =
    error "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDocNamed'"


--------------------------------------------------------------------------------
printIeWrappedName :: GHC.LIEWrappedName GHC.GhcPs -> P ()
printIeWrappedName lie = case GHC.unLoc lie of
    GHC.IEName    _ n -> putRdrName n
    GHC.IEPattern _ n -> putText "pattern" >> space >> putRdrName n
    GHC.IEType    _ n -> putText "type" >> space >> putRdrName n


mergeImports
    :: NonEmpty (GHC.LImportDecl GHC.GhcPs)
    -> NonEmpty (GHC.LImportDecl GHC.GhcPs)
mergeImports (x :| []) = x :| []
mergeImports (h :| (t : ts))
  | canMergeImport (GHC.unLoc h) (GHC.unLoc t) = mergeImports (mergeModuleImport h t :| ts)
  | otherwise = h :| mergeImportsTail (t : ts)
  where
    mergeImportsTail (x : y : ys)
      | canMergeImport (GHC.unLoc x) (GHC.unLoc y) = mergeImportsTail ((mergeModuleImport x y) : ys)
      | otherwise = x : mergeImportsTail (y : ys)
    mergeImportsTail xs = xs


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

instance Semigroup ImportStats where
    l <> r = ImportStats
        { isLongestImport = isLongestImport l `max` isLongestImport r
        , isAnySource     = isAnySource     l ||    isAnySource     r
        , isAnyQualified  = isAnyQualified  l ||    isAnyQualified  r
        , isAnySafe       = isAnySafe       l ||    isAnySafe       r
        }

instance Monoid ImportStats where
    mappend = (<>)
    mempty  = ImportStats 0 False False False

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

-- Computes length till module name, includes package name.
-- TODO: this should reuse code with the printer
importModuleNameLength :: GHC.ImportDecl GHC.GhcPs -> Int
importModuleNameLength imp =
    (case GHC.ideclPkgQual imp of
        GHC.NoRawPkgQual  -> 0
        GHC.RawPkgQual sl -> 1 + length (stringLiteral sl)) +
    (length $ importModuleName imp)


--------------------------------------------------------------------------------
stringLiteral :: GHC.StringLiteral -> String
stringLiteral sl = case GHC.sl_st sl of
    GHC.NoSourceText -> GHC.unpackFS $ GHC.sl_fs sl
    GHC.SourceText s -> GHC.unpackFS $ s


--------------------------------------------------------------------------------
isQualified :: GHC.ImportDecl GHC.GhcPs -> Bool
isQualified = (/=) GHC.NotQualified . GHC.ideclQualified

isHiding :: GHC.ImportDecl GHC.GhcPs -> Bool
isHiding d = case GHC.ideclImportList d of
  Just (GHC.EverythingBut, _) -> True
  _ -> False

isSource :: GHC.ImportDecl GHC.GhcPs -> Bool
isSource = (==) GHC.IsBoot . 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 =
  sortBy compareLIE . map (fmap prepareInner) .
  concatMap (toList . snd) . Map.toAscList . mergeByName
 where
  mergeByName
      :: [GHC.LIE GHC.GhcPs]
      -> Map.Map GHC.RdrName (NonEmpty (GHC.LIE GHC.GhcPs))
  mergeByName imports0 = 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.
    (\(x :| xs) (y :| ys) -> case ieMerge (GHC.unLoc x) (GHC.unLoc y) of
      Just z  -> (x $> z) :| (xs ++ ys)  -- Keep source from `x`
      Nothing -> x :| (xs ++ y : ys))
    [(GHC.ieName $ GHC.unLoc imp, imp :| []) | imp <- imports0]

  prepareInner :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs
  prepareInner = \case
    -- Simplify `A ()` to `A`.
    GHC.IEThingWith x n GHC.NoIEWildcard [] -> GHC.IEThingAbs x n
    GHC.IEThingWith x n w ns ->
      GHC.IEThingWith x n w (sortBy (compareWrappedName `on` GHC.unLoc) ns)
    ie -> 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 l@(GHC.IEVar _ _)      _                  = Just l
  ieMerge _                  r@(GHC.IEVar _ _)      = Just r
  ieMerge (GHC.IEThingAbs _ _)   r                  = Just r
  ieMerge l                  (GHC.IEThingAbs _ _)   = Just l
  ieMerge l@(GHC.IEThingAll _ _) _                  = Just l
  ieMerge _                  r@(GHC.IEThingAll _ _) = Just r
  ieMerge (GHC.IEThingWith x0 n0 w0 ns0) (GHC.IEThingWith _ _ w1 ns1)
    | w0 /= w1  = Nothing
    | otherwise = Just $
        -- TODO: sort the `ns0 ++ ns1`?
        GHC.IEThingWith x0 n0 w0 (nubOn GHC.lieWrappedName $ ns0 ++ ns1)
  ieMerge _ _ = Nothing


--------------------------------------------------------------------------------
nubOn :: Ord k => (a -> k) -> [a] -> [a]
nubOn f = go Set.empty
 where
  go _   []              = []
  go acc (x : xs)
    | y `Set.member` acc = go acc xs
    | otherwise          = x : go (Set.insert y acc) xs
   where
    y = f x