    {-# LANGUAGE ImportQualifiedPost #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# LANGUAGE FlexibleContexts #-}

    {-
        Suggest better pragmas
        OPTIONS_GHC -cpp => LANGUAGE CPP
        OPTIONS_GHC -fglasgow-exts => LANGUAGE ... (in HSE)
        OPTIONS_GHC -XFoo => LANGUAGE Foo
        LANGUAGE A, A => LANGUAGE A
        -- do not do LANGUAGE A, LANGUAGE B to combine

    <TEST>
    {-# OPTIONS_GHC -cpp #-} -- {-# LANGUAGE CPP #-}
    {-# OPTIONS     -cpp #-} -- {-# LANGUAGE CPP #-}
    {-# OPTIONS_YHC -cpp #-}
    {-# OPTIONS_GHC -XFoo #-} -- {-# LANGUAGE Foo #-}
    {-# OPTIONS_GHC -fglasgow-exts #-} -- ??? @NoRefactor: refactor output has one LANGUAGE pragma per extension, while hlint suggestion has a single LANGUAGE pragma
    {-# LANGUAGE RebindableSyntax, EmptyCase, RebindableSyntax #-} -- {-# LANGUAGE RebindableSyntax, EmptyCase #-}
    {-# LANGUAGE RebindableSyntax, EmptyCase, DuplicateRecordFields, RebindableSyntax #-} -- {-# LANGUAGE RebindableSyntax, EmptyCase, DuplicateRecordFields #-}
    {-# LANGUAGE RebindableSyntax #-}
    {-# OPTIONS_GHC -cpp -foo #-} -- {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -foo #-} @NoRefactor -foo is not a valid flag
    {-# OPTIONS_GHC -cpp -w #-} -- {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -w #-}
    {-# OPTIONS_GHC -cpp #-} \
    {-# LANGUAGE CPP, Text #-} --
    {-# LANGUAGE RebindableSyntax #-} \
    {-# LANGUAGE DuplicateRecordFields #-}
    {-# LANGUAGE RebindableSyntax #-} \
    {-# LANGUAGE EmptyCase, RebindableSyntax #-} -- {-# LANGUAGE EmptyCase, RebindableSyntax #-}
    </TEST>
    -}

    module Hint.Pragma(pragmaHint) where

    import Hint.Type(ModuHint,Idea(..),Severity(..),toSSAnc,rawIdea,modComments,firstDeclComments)
    import Data.List.Extra
    import Data.List.NonEmpty qualified as NE
    import Data.Maybe
    import Refact.Types
    import Refact.Types qualified as R

    import GHC.Hs
    import GHC.Types.SrcLoc
    import GHC.Data.FastString

    import GHC.Util
    import GHC.Driver.Session

    pragmaHint :: ModuHint
    pragmaHint :: ModuHint
    pragmaHint Scope
    _ ModuleEx
    modu =
      -- Comments appearing without a line-break before the first
      -- declaration in a module are now associated with the declaration
      -- not the module so to be safe, look also at `firstDeclComments
      -- modu` (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).
      let ps :: [(LEpaComment, String)]
    ps = EpAnnComments -> [(LEpaComment, String)]
    pragmas (ModuleEx -> EpAnnComments
    modComments ModuleEx
    modu) [(LEpaComment, String)]
    -> [(LEpaComment, String)] -> [(LEpaComment, String)]
    forall a. [a] -> [a] -> [a]
    ++ EpAnnComments -> [(LEpaComment, String)]
    pragmas (ModuleEx -> EpAnnComments
    firstDeclComments ModuleEx
    modu)
          opts :: [(LEpaComment, [String])]
    opts = [(LEpaComment, String)] -> [(LEpaComment, [String])]
    flags [(LEpaComment, String)]
    ps
          lang :: [(LEpaComment, [String])]
    lang = [(LEpaComment, String)] -> [(LEpaComment, [String])]
    languagePragmas [(LEpaComment, String)]
    ps in
        [(LEpaComment, [String])] -> [Idea]
    languageDupes [(LEpaComment, [String])]
    lang [Idea] -> [Idea] -> [Idea]
    forall a. [a] -> [a] -> [a]
    ++ [(LEpaComment, [String])] -> [(LEpaComment, [String])] -> [Idea]
    optToPragma [(LEpaComment, [String])]
    opts [(LEpaComment, [String])]
    lang

    optToPragma :: [(LEpaComment, [String])]
                 -> [(LEpaComment, [String])]
                 -> [Idea]
    optToPragma :: [(LEpaComment, [String])] -> [(LEpaComment, [String])] -> [Idea]
    optToPragma [(LEpaComment, [String])]
    flags [(LEpaComment, [String])]
    languagePragmas =
      [PragmaIdea -> Idea
    pragmaIdea (NonEmpty LEpaComment
    -> [LEpaComment] -> [Refactoring SrcSpan] -> PragmaIdea
    OptionsToComment ((LEpaComment, [String]) -> LEpaComment
    forall a b. (a, b) -> a
    fst ((LEpaComment, [String]) -> LEpaComment)
    -> NonEmpty (LEpaComment, [String]) -> NonEmpty LEpaComment
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NonEmpty (LEpaComment, [String])
    old2) [LEpaComment]
    ys [Refactoring SrcSpan]
    rs) | Just NonEmpty (LEpaComment, [String])
    old2 <- [[(LEpaComment, [String])]
    -> Maybe (NonEmpty (LEpaComment, [String]))
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty [(LEpaComment, [String])]
    old]]
      where
          ([(LEpaComment, [String])]
    old, [Maybe LEpaComment]
    new, [[String]]
    ns, [Refactoring SrcSpan]
    rs) =
            [((LEpaComment, [String]), Maybe LEpaComment, [String],
      Refactoring SrcSpan)]
    -> ([(LEpaComment, [String])], [Maybe LEpaComment], [[String]],
        [Refactoring SrcSpan])
    forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
    unzip4 [((LEpaComment, [String])
    old, Maybe LEpaComment
    new, [String]
    ns, Refactoring SrcSpan
    r)
                   | (LEpaComment, [String])
    old <- [(LEpaComment, [String])]
    flags, Just (Maybe LEpaComment
    new, [String]
    ns) <- [(LEpaComment, [String])
    -> [String] -> Maybe (Maybe LEpaComment, [String])
    optToLanguage (LEpaComment, [String])
    old [String]
    ls]
                   , let r :: Refactoring SrcSpan
    r = (LEpaComment, [String])
    -> Maybe LEpaComment -> [String] -> Refactoring SrcSpan
    mkRefact (LEpaComment, [String])
    old Maybe LEpaComment
    new [String]
    ns]

          ls :: [String]
    ls = ((LEpaComment, [String]) -> [String])
    -> [(LEpaComment, [String])] -> [String]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (LEpaComment, [String]) -> [String]
    forall a b. (a, b) -> b
    snd [(LEpaComment, [String])]
    languagePragmas
          ns2 :: [String]
    ns2 = [String] -> [String]
    forall a. Ord a => [a] -> [a]
    nubOrd ([[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[String]]
    ns) [String] -> [String] -> [String]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [String]
    ls

          dummyLoc :: RealSrcLoc
    dummyLoc = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc (String -> FastString
    fsLit String
    "dummy") Int
    1 Int
    1
          dummySpan :: RealSrcSpan
    dummySpan = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
    mkRealSrcSpan RealSrcLoc
    dummyLoc RealSrcLoc
    dummyLoc
          dummyAnchor :: EpaLocation' a
    dummyAnchor = RealSrcSpan -> EpaLocation' a
    forall a. RealSrcSpan -> EpaLocation' a
    realSpanAsAnchor RealSrcSpan
    dummySpan

          ys :: [LEpaComment]
    ys = [NoCommentsLocation -> [String] -> LEpaComment
    mkLanguagePragmas NoCommentsLocation
    forall {a}. EpaLocation' a
    dummyAnchor [String]
    ns2 | [String]
    ns2 [String] -> [String] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []] [LEpaComment] -> [LEpaComment] -> [LEpaComment]
    forall a. [a] -> [a] -> [a]
    ++ [Maybe LEpaComment] -> [LEpaComment]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe LEpaComment]
    new
          mkRefact :: (LEpaComment, [String])
                   -> Maybe LEpaComment
                   -> [String]
                   -> Refactoring R.SrcSpan
          mkRefact :: (LEpaComment, [String])
    -> Maybe LEpaComment -> [String] -> Refactoring SrcSpan
    mkRefact (LEpaComment, [String])
    old (String -> (LEpaComment -> String) -> Maybe LEpaComment -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" LEpaComment -> String
    comment_ -> String
    new) [String]
    ns =
            let ns' :: [String]
    ns' = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    n -> LEpaComment -> String
    comment_ (NoCommentsLocation -> [String] -> LEpaComment
    mkLanguagePragmas NoCommentsLocation
    forall {a}. EpaLocation' a
    dummyAnchor [String
    n])) [String]
    ns
            in SrcSpan -> String -> Refactoring SrcSpan
    forall a. a -> String -> Refactoring a
    ModifyComment (LEpaComment -> SrcSpan
    forall e. GenLocated NoCommentsLocation e -> SrcSpan
    toSSAnc ((LEpaComment, [String]) -> LEpaComment
    forall a b. (a, b) -> a
    fst (LEpaComment, [String])
    old)) (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) ([String]
    ns' [String] -> String -> [String]
    forall a. [a] -> a -> [a]
    `snoc` String
    new)))

    data PragmaIdea = SingleComment LEpaComment LEpaComment
                     | MultiComment LEpaComment LEpaComment LEpaComment
                     | OptionsToComment (NE.NonEmpty LEpaComment) [LEpaComment] [Refactoring R.SrcSpan]

    pragmaIdea :: PragmaIdea -> Idea
    pragmaIdea :: PragmaIdea -> Idea
    pragmaIdea PragmaIdea
    pidea =
      case PragmaIdea
    pidea of
        SingleComment LEpaComment
    old LEpaComment
    new ->
          SrcSpan
    -> String
    -> Maybe String
    -> [Note]
    -> [Refactoring SrcSpan]
    -> Idea
    mkFewer (LEpaComment -> SrcSpan
    forall a. GenLocated NoCommentsLocation a -> SrcSpan
    getAncLoc LEpaComment
    old) (LEpaComment -> String
    comment_ LEpaComment
    old) (String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ LEpaComment -> String
    comment_ LEpaComment
    new) []
          [SrcSpan -> String -> Refactoring SrcSpan
    forall a. a -> String -> Refactoring a
    ModifyComment (LEpaComment -> SrcSpan
    forall e. GenLocated NoCommentsLocation e -> SrcSpan
    toSSAnc LEpaComment
    old) (LEpaComment -> String
    comment_ LEpaComment
    new)]
        MultiComment LEpaComment
    repl LEpaComment
    delete LEpaComment
    new ->
          SrcSpan
    -> String
    -> Maybe String
    -> [Note]
    -> [Refactoring SrcSpan]
    -> Idea
    mkFewer (LEpaComment -> SrcSpan
    forall a. GenLocated NoCommentsLocation a -> SrcSpan
    getAncLoc LEpaComment
    repl)
            ([LEpaComment] -> String
    f [LEpaComment
    repl, LEpaComment
    delete]) (String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ LEpaComment -> String
    comment_ LEpaComment
    new) []
            [ SrcSpan -> String -> Refactoring SrcSpan
    forall a. a -> String -> Refactoring a
    ModifyComment (LEpaComment -> SrcSpan
    forall e. GenLocated NoCommentsLocation e -> SrcSpan
    toSSAnc LEpaComment
    repl) (LEpaComment -> String
    comment_ LEpaComment
    new)
            , SrcSpan -> String -> Refactoring SrcSpan
    forall a. a -> String -> Refactoring a
    ModifyComment (LEpaComment -> SrcSpan
    forall e. GenLocated NoCommentsLocation e -> SrcSpan
    toSSAnc LEpaComment
    delete) String
    ""]
        OptionsToComment NonEmpty LEpaComment
    old [LEpaComment]
    new [Refactoring SrcSpan]
    r ->
          SrcSpan
    -> String
    -> Maybe String
    -> [Note]
    -> [Refactoring SrcSpan]
    -> Idea
    mkLanguage (LEpaComment -> SrcSpan
    forall a. GenLocated NoCommentsLocation a -> SrcSpan
    getAncLoc (LEpaComment -> SrcSpan)
    -> (NonEmpty LEpaComment -> LEpaComment)
    -> NonEmpty LEpaComment
    -> SrcSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty LEpaComment -> LEpaComment
    forall a. NonEmpty a -> a
    NE.head (NonEmpty LEpaComment -> SrcSpan)
    -> NonEmpty LEpaComment -> SrcSpan
    forall a b. (a -> b) -> a -> b
    $ NonEmpty LEpaComment
    old)
            ([LEpaComment] -> String
    f ([LEpaComment] -> String) -> [LEpaComment] -> String
    forall a b. (a -> b) -> a -> b
    $ NonEmpty LEpaComment -> [LEpaComment]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty LEpaComment
    old) (String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [LEpaComment] -> String
    f [LEpaComment]
    new) []
            [Refactoring SrcSpan]
    r
        where
              f :: [LEpaComment] -> String
    f = [String] -> String
    unlines ([String] -> String)
    -> ([LEpaComment] -> [String]) -> [LEpaComment] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LEpaComment -> String) -> [LEpaComment] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map LEpaComment -> String
    comment_
              mkFewer :: SrcSpan
    -> String
    -> Maybe String
    -> [Note]
    -> [Refactoring SrcSpan]
    -> Idea
    mkFewer = Severity
    -> String
    -> SrcSpan
    -> String
    -> Maybe String
    -> [Note]
    -> [Refactoring SrcSpan]
    -> Idea
    rawIdea Severity
    Hint.Type.Warning String
    "Use fewer LANGUAGE pragmas"
              mkLanguage :: SrcSpan
    -> String
    -> Maybe String
    -> [Note]
    -> [Refactoring SrcSpan]
    -> Idea
    mkLanguage = Severity
    -> String
    -> SrcSpan
    -> String
    -> Maybe String
    -> [Note]
    -> [Refactoring SrcSpan]
    -> Idea
    rawIdea Severity
    Hint.Type.Warning String
    "Use LANGUAGE pragmas"

    languageDupes :: [(LEpaComment, [String])] -> [Idea]
    languageDupes :: [(LEpaComment, [String])] -> [Idea]
    languageDupes ( (a :: LEpaComment
    a@(L NoCommentsLocation
    l EpaComment
    _), [String]
    les) : [(LEpaComment, [String])]
    cs ) =
      (if [String] -> [String]
    forall a. Ord a => [a] -> [a]
    nubOrd [String]
    les [String] -> [String] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [String]
    les
           then [PragmaIdea -> Idea
    pragmaIdea (LEpaComment -> LEpaComment -> PragmaIdea
    SingleComment LEpaComment
    a (NoCommentsLocation -> [String] -> LEpaComment
    mkLanguagePragmas NoCommentsLocation
    l ([String] -> LEpaComment) -> [String] -> LEpaComment
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. Ord a => [a] -> [a]
    nubOrd [String]
    les))]
           else [PragmaIdea -> Idea
    pragmaIdea (LEpaComment -> LEpaComment -> LEpaComment -> PragmaIdea
    MultiComment LEpaComment
    a LEpaComment
    b (NoCommentsLocation -> [String] -> LEpaComment
    mkLanguagePragmas NoCommentsLocation
    l ([String] -> [String]
    forall a. Ord a => [a] -> [a]
    nubOrd ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    les [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    les'))) | ( b :: LEpaComment
    b@(L NoCommentsLocation
    _ EpaComment
    _), [String]
    les' ) <- [(LEpaComment, [String])]
    cs, Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    disjoint [String]
    les [String]
    les']
      ) [Idea] -> [Idea] -> [Idea]
    forall a. [a] -> [a] -> [a]
    ++ [(LEpaComment, [String])] -> [Idea]
    languageDupes [(LEpaComment, [String])]
    cs
    languageDupes [(LEpaComment, [String])]
    _ = []

    -- Given a pragma, can you extract some language features out?
    strToLanguage :: String -> Maybe [String]
    strToLanguage :: String -> Maybe [String]
    strToLanguage String
    "-cpp" = [String] -> Maybe [String]
    forall a. a -> Maybe a
    Just [String
    "CPP"]
    strToLanguage String
    x | String
    "-X" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    x = [String] -> Maybe [String]
    forall a. a -> Maybe a
    Just [Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    2 String
    x]
    strToLanguage String
    "-fglasgow-exts" = [String] -> Maybe [String]
    forall a. a -> Maybe a
    Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
    forall a b. (a -> b) -> a -> b
    $ (Extension -> String) -> [Extension] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Extension -> String
    forall a. Show a => a -> String
    show [Extension]
    glasgowExtsFlags
    strToLanguage String
    _ = Maybe [String]
    forall a. Maybe a
    Nothing

    -- In 'optToLanguage p langexts', 'p' is an 'OPTIONS_GHC' pragma,
    -- 'langexts' a list of all language extensions in the module enabled
    -- by 'LANGUAGE' pragmas.
    --
    --  If ALL of the flags in the pragma enable language extensions,
    -- 'return Nothing'.
    --
    -- If some (or all) of the flags enable options that are not language
    -- extensions, compute a new options pragma with only non-language
    -- extension enabling flags. Return that together with a list of any
    -- language extensions enabled by this pragma that are not otherwise
    -- enabled by LANGUAGE pragmas in the module.
    optToLanguage :: (LEpaComment, [String])
                   -> [String]
                   -> Maybe (Maybe LEpaComment, [String])
    optToLanguage :: (LEpaComment, [String])
    -> [String] -> Maybe (Maybe LEpaComment, [String])
    optToLanguage (L NoCommentsLocation
    loc EpaComment
    _, [String]
    flags) [String]
    languagePragmas
      | (Maybe [String] -> Bool) -> [Maybe [String]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Maybe [String] -> Bool
    forall a. Maybe a -> Bool
    isJust [Maybe [String]]
    vs =
          -- 'ls' is a list of language features enabled by this
          -- OPTIONS_GHC pragma that are not enabled by LANGUAGE pragmas
          -- in this module.
          let ls :: [String]
    ls = ([String] -> [String]) -> [[String]] -> [String]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [String]
    languagePragmas)) ([[String]] -> [String]) -> [[String]] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [Maybe [String]] -> [[String]]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe [String]]
    vs in
          (Maybe LEpaComment, [String])
    -> Maybe (Maybe LEpaComment, [String])
    forall a. a -> Maybe a
    Just (Maybe LEpaComment
    res, [String]
    ls)
      where
        -- Try reinterpreting each flag as a list of language features
        -- (e.g. via '-X'..., '-fglasgow-exts').
        vs :: [Maybe [String]]
    vs = (String -> Maybe [String]) -> [String] -> [Maybe [String]]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Maybe [String]
    strToLanguage [String]
    flags -- e.g. '[Nothing, Just ["ScopedTypeVariables"], Nothing, ...]'
        -- Keep any flag that does not enable language extensions.
        keep :: [String]
    keep = [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[String]] -> [String]) -> [[String]] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (Maybe [String] -> String -> [String])
    -> [Maybe [String]] -> [String] -> [[String]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Maybe [String]
    v String
    f -> [String
    f | Maybe [String] -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe [String]
    v]) [Maybe [String]]
    vs [String]
    flags
        -- If there are flags to keep, 'res' is a new pragma setting just those flags.
        res :: Maybe LEpaComment
    res = if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    keep then Maybe LEpaComment
    forall a. Maybe a
    Nothing else LEpaComment -> Maybe LEpaComment
    forall a. a -> Maybe a
    Just (NoCommentsLocation -> [String] -> LEpaComment
    mkFlags NoCommentsLocation
    loc [String]
    keep)
    optToLanguage (LEpaComment, [String])
    _ [String]
    _ = Maybe (Maybe LEpaComment, [String])
    forall a. Maybe a
    Nothing