{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

module Hint.Restrict(restrictHint) where

{-
-- These tests rely on the .hlint.yaml file in the root
<TEST>
foo = unsafePerformIO --
foo = bar `unsafePerformIO` baz --
module Util where otherFunc = unsafePerformIO $ print 1 --
module Util where exitMessageImpure = System.IO.Unsafe.unsafePerformIO $ print 1
foo = unsafePerformOI
import Data.List.NonEmpty as NE \
foo = NE.nub (NE.fromList [1, 2, 3]) --
import Hypothetical.Module \
foo = nub s
</TEST>
-}

import Hint.Type(ModuHint,ModuleEx(..),Idea(..),Severity(..),warn,rawIdea,modComments,firstDeclComments)
import Config.Type
import Util

import Data.Generics.Uniplate.DataOnly
import Data.List.NonEmpty qualified as NonEmpty
import Data.Set qualified as Set
import Data.Map qualified as Map
import Data.List.Extra
import Data.List.NonEmpty (nonEmpty)
import Data.Either
import Data.Maybe
import Data.Monoid
import Data.Semigroup
import Data.Tuple.Extra
import Control.Applicative
import Control.Monad
import Control.Monad.Extra
import Prelude

import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import GHC.Types.Name.Occurrence
import Language.Haskell.GhclibParserEx.GHC.Hs
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
import GHC.Util

-- FIXME: The settings should be partially applied, but that's hard to orchestrate right now
restrictHint :: [Setting] -> ModuHint
restrictHint :: [Setting] -> ModuHint
restrictHint [Setting]
settings Scope
scope ModuleEx
m =
    -- Comments appearing without an empty line 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 annsMod :: EpAnnComments
annsMod = ModuleEx -> EpAnnComments
modComments ModuleEx
m
        annsFirstDecl :: EpAnnComments
annsFirstDecl = ModuleEx -> EpAnnComments
firstDeclComments ModuleEx
m
        ps :: [(LEpaComment, String)]
ps   = EpAnnComments -> [(LEpaComment, String)]
pragmas EpAnnComments
annsMod [(LEpaComment, String)]
-> [(LEpaComment, String)] -> [(LEpaComment, String)]
forall a. [a] -> [a] -> [a]
++ EpAnnComments -> [(LEpaComment, String)]
pragmas EpAnnComments
annsFirstDecl
        opts :: [(LEpaComment, [String])]
opts = [(LEpaComment, String)] -> [(LEpaComment, [String])]
flags [(LEpaComment, String)]
ps
        exts :: [(LEpaComment, [String])]
exts = [(LEpaComment, String)] -> [(LEpaComment, [String])]
languagePragmas [(LEpaComment, String)]
ps in
    String
-> [(LEpaComment, [String])]
-> [(LEpaComment, [String])]
-> Map RestrictType (Bool, Map String RestrictItem)
-> [Idea]
checkPragmas String
modu [(LEpaComment, [String])]
opts [(LEpaComment, [String])]
exts Map RestrictType (Bool, Map String RestrictItem)
rOthers [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    [Idea]
-> ((Bool, Map String RestrictItem) -> [Idea])
-> Maybe (Bool, Map String RestrictItem)
-> [Idea]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String
-> [LImportDecl GhcPs] -> (Bool, Map String RestrictItem) -> [Idea]
checkImports String
modu ([LImportDecl GhcPs] -> (Bool, Map String RestrictItem) -> [Idea])
-> [LImportDecl GhcPs] -> (Bool, Map String RestrictItem) -> [Idea]
forall a b. (a -> b) -> a -> b
$ HsModule GhcPs -> [LImportDecl GhcPs]
forall p. HsModule p -> [LImportDecl p]
hsmodImports (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (ModuleEx -> GenLocated SrcSpan (HsModule GhcPs)
ghcModule ModuleEx
m))) (RestrictType
-> Map RestrictType (Bool, Map String RestrictItem)
-> Maybe (Bool, Map String RestrictItem)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RestrictType
RestrictModule Map RestrictType (Bool, Map String RestrictItem)
rOthers) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    Scope -> String -> [LHsDecl GhcPs] -> RestrictFunctions -> [Idea]
checkFunctions Scope
scope String
modu (HsModule GhcPs -> [LHsDecl GhcPs]
forall p. HsModule p -> [LHsDecl p]
hsmodDecls (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (ModuleEx -> GenLocated SrcSpan (HsModule GhcPs)
ghcModule ModuleEx
m))) RestrictFunctions
rFunction
    where
        modu :: String
modu = GenLocated SrcSpan (HsModule GhcPs) -> String
modName (ModuleEx -> GenLocated SrcSpan (HsModule GhcPs)
ghcModule ModuleEx
m)
        (RestrictFunctions
rFunction, Map RestrictType (Bool, Map String RestrictItem)
rOthers) = [Setting]
-> (RestrictFunctions,
    Map RestrictType (Bool, Map String RestrictItem))
restrictions [Setting]
settings

---------------------------------------------------------------------
-- UTILITIES

data RestrictItem = RestrictItem
    {RestrictItem -> [String]
riAs :: [String]
    ,RestrictItem -> Alt Maybe Bool
riAsRequired :: Alt Maybe Bool
    ,RestrictItem -> Alt Maybe RestrictImportStyle
riImportStyle :: Alt Maybe RestrictImportStyle
    ,RestrictItem -> Alt Maybe QualifiedStyle
riQualifiedStyle :: Alt Maybe QualifiedStyle
    ,RestrictItem -> [(String, String)]
riWithin :: [(String, String)]
    ,RestrictItem -> RestrictIdents
riRestrictIdents :: RestrictIdents
    ,RestrictItem -> Maybe String
riMessage :: Maybe String
    }

instance Semigroup RestrictItem where
    RestrictItem [String]
x1 Alt Maybe Bool
x2 Alt Maybe RestrictImportStyle
x3 Alt Maybe QualifiedStyle
x4 [(String, String)]
x5 RestrictIdents
x6 Maybe String
x7
      <> :: RestrictItem -> RestrictItem -> RestrictItem
<> RestrictItem [String]
y1 Alt Maybe Bool
y2 Alt Maybe RestrictImportStyle
y3 Alt Maybe QualifiedStyle
y4 [(String, String)]
y5 RestrictIdents
y6 Maybe String
y7
      = [String]
-> Alt Maybe Bool
-> Alt Maybe RestrictImportStyle
-> Alt Maybe QualifiedStyle
-> [(String, String)]
-> RestrictIdents
-> Maybe String
-> RestrictItem
RestrictItem ([String]
x1[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>[String]
y1) (Alt Maybe Bool
x2Alt Maybe Bool -> Alt Maybe Bool -> Alt Maybe Bool
forall a. Semigroup a => a -> a -> a
<>Alt Maybe Bool
y2) (Alt Maybe RestrictImportStyle
x3Alt Maybe RestrictImportStyle
-> Alt Maybe RestrictImportStyle -> Alt Maybe RestrictImportStyle
forall a. Semigroup a => a -> a -> a
<>Alt Maybe RestrictImportStyle
y3) (Alt Maybe QualifiedStyle
x4Alt Maybe QualifiedStyle
-> Alt Maybe QualifiedStyle -> Alt Maybe QualifiedStyle
forall a. Semigroup a => a -> a -> a
<>Alt Maybe QualifiedStyle
y4) ([(String, String)]
x5[(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<>[(String, String)]
y5) (RestrictIdents
x6RestrictIdents -> RestrictIdents -> RestrictIdents
forall a. Semigroup a => a -> a -> a
<>RestrictIdents
y6) (Maybe String
x7Maybe String -> Maybe String -> Maybe String
forall a. Semigroup a => a -> a -> a
<>Maybe String
y7)

-- Contains a map from module (Nothing if the rule is unqualified) to (within, message), so that we can
-- distinguish functions with the same name.
-- For example, this allows us to have separate rules for "Data.Map.fromList" and "Data.Set.fromList".
-- Using newtype rather than type because we want to define (<>) as 'Map.unionWith (<>)'.
newtype RestrictFunction = RestrictFun (Map.Map (Maybe String) ([(String, String)], Maybe String))

instance Semigroup RestrictFunction where
    RestrictFun Map (Maybe String) ([(String, String)], Maybe String)
m1 <> :: RestrictFunction -> RestrictFunction -> RestrictFunction
<> RestrictFun Map (Maybe String) ([(String, String)], Maybe String)
m2 = Map (Maybe String) ([(String, String)], Maybe String)
-> RestrictFunction
RestrictFun ((([(String, String)], Maybe String)
 -> ([(String, String)], Maybe String)
 -> ([(String, String)], Maybe String))
-> Map (Maybe String) ([(String, String)], Maybe String)
-> Map (Maybe String) ([(String, String)], Maybe String)
-> Map (Maybe String) ([(String, String)], Maybe String)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ([(String, String)], Maybe String)
-> ([(String, String)], Maybe String)
-> ([(String, String)], Maybe String)
forall a. Semigroup a => a -> a -> a
(<>) Map (Maybe String) ([(String, String)], Maybe String)
m1 Map (Maybe String) ([(String, String)], Maybe String)
m2)

type RestrictFunctions = (Bool, Map.Map String RestrictFunction)
type OtherRestrictItems = Map.Map RestrictType (Bool, Map.Map String RestrictItem)

restrictions :: [Setting] -> (RestrictFunctions, OtherRestrictItems)
restrictions :: [Setting]
-> (RestrictFunctions,
    Map RestrictType (Bool, Map String RestrictItem))
restrictions [Setting]
settings = (RestrictFunctions
rFunction, Map RestrictType (Bool, Map String RestrictItem)
rOthers)
    where
        (((RestrictType, Restrict) -> Restrict)
-> [(RestrictType, Restrict)] -> [Restrict]
forall a b. (a -> b) -> [a] -> [b]
map (RestrictType, Restrict) -> Restrict
forall a b. (a, b) -> b
snd -> [Restrict]
rfs, [(RestrictType, Restrict)]
ros) = ((RestrictType, Restrict) -> Bool)
-> [(RestrictType, Restrict)]
-> ([(RestrictType, Restrict)], [(RestrictType, Restrict)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((RestrictType -> RestrictType -> Bool
forall a. Eq a => a -> a -> Bool
== RestrictType
RestrictFunction) (RestrictType -> Bool)
-> ((RestrictType, Restrict) -> RestrictType)
-> (RestrictType, Restrict)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RestrictType, Restrict) -> RestrictType
forall a b. (a, b) -> a
fst) [(Restrict -> RestrictType
restrictType Restrict
x, Restrict
x) | SettingRestrict Restrict
x <- [Setting]
settings]
        rFunction :: RestrictFunctions
rFunction = ((Restrict -> Bool) -> [Restrict] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Restrict -> Bool
restrictDefault [Restrict]
rfs, (RestrictFunction -> RestrictFunction -> RestrictFunction)
-> [(String, RestrictFunction)] -> Map String RestrictFunction
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith RestrictFunction -> RestrictFunction -> RestrictFunction
forall a. Semigroup a => a -> a -> a
(<>) [String -> Restrict -> (String, RestrictFunction)
mkRf String
s Restrict
r | Restrict
r <- [Restrict]
rfs, String
s <- Restrict -> [String]
restrictName Restrict
r])
        mkRf :: String -> Restrict -> (String, RestrictFunction)
mkRf String
s Restrict{Bool
[String]
[(String, String)]
Maybe String
Alt Maybe Bool
Alt Maybe QualifiedStyle
Alt Maybe RestrictImportStyle
RestrictIdents
RestrictType
restrictType :: Restrict -> RestrictType
restrictDefault :: Restrict -> Bool
restrictName :: Restrict -> [String]
restrictType :: RestrictType
restrictDefault :: Bool
restrictName :: [String]
restrictAs :: [String]
restrictAsRequired :: Alt Maybe Bool
restrictImportStyle :: Alt Maybe RestrictImportStyle
restrictQualifiedStyle :: Alt Maybe QualifiedStyle
restrictWithin :: [(String, String)]
restrictIdents :: RestrictIdents
restrictMessage :: Maybe String
restrictAs :: Restrict -> [String]
restrictAsRequired :: Restrict -> Alt Maybe Bool
restrictImportStyle :: Restrict -> Alt Maybe RestrictImportStyle
restrictQualifiedStyle :: Restrict -> Alt Maybe QualifiedStyle
restrictWithin :: Restrict -> [(String, String)]
restrictIdents :: Restrict -> RestrictIdents
restrictMessage :: Restrict -> Maybe String
..} = (String
name, Map (Maybe String) ([(String, String)], Maybe String)
-> RestrictFunction
RestrictFun (Map (Maybe String) ([(String, String)], Maybe String)
 -> RestrictFunction)
-> Map (Maybe String) ([(String, String)], Maybe String)
-> RestrictFunction
forall a b. (a -> b) -> a -> b
$ Maybe String
-> ([(String, String)], Maybe String)
-> Map (Maybe String) ([(String, String)], Maybe String)
forall k a. k -> a -> Map k a
Map.singleton Maybe String
modu ([(String, String)]
restrictWithin, Maybe String
restrictMessage))
          where
            -- Parse module and name from s. module = Nothing if the rule is unqualified.
            (Maybe String
modu, String
name) = (String -> Maybe String)
-> (String, String) -> (Maybe String, String)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first ((NonEmpty Char -> String) -> Maybe (NonEmpty Char) -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NonEmpty.init (Maybe (NonEmpty Char) -> Maybe String)
-> (String -> Maybe (NonEmpty Char)) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty) ((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
breakEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
s)

        rOthers :: Map RestrictType (Bool, Map String RestrictItem)
rOthers = ([Restrict] -> (Bool, Map String RestrictItem))
-> Map RestrictType [Restrict]
-> Map RestrictType (Bool, Map String RestrictItem)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [Restrict] -> (Bool, Map String RestrictItem)
f (Map RestrictType [Restrict]
 -> Map RestrictType (Bool, Map String RestrictItem))
-> Map RestrictType [Restrict]
-> Map RestrictType (Bool, Map String RestrictItem)
forall a b. (a -> b) -> a -> b
$ ([Restrict] -> [Restrict] -> [Restrict])
-> [(RestrictType, [Restrict])] -> Map RestrictType [Restrict]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Restrict] -> [Restrict] -> [Restrict]
forall a. [a] -> [a] -> [a]
(++) (((RestrictType, Restrict) -> (RestrictType, [Restrict]))
-> [(RestrictType, Restrict)] -> [(RestrictType, [Restrict])]
forall a b. (a -> b) -> [a] -> [b]
map ((Restrict -> [Restrict])
-> (RestrictType, Restrict) -> (RestrictType, [Restrict])
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second Restrict -> [Restrict]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [(RestrictType, Restrict)]
ros)
        f :: [Restrict] -> (Bool, Map String RestrictItem)
f [Restrict]
rs = ((Restrict -> Bool) -> [Restrict] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Restrict -> Bool
restrictDefault [Restrict]
rs
               ,(RestrictItem -> RestrictItem -> RestrictItem)
-> [(String, RestrictItem)] -> Map String RestrictItem
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith RestrictItem -> RestrictItem -> RestrictItem
forall a. Semigroup a => a -> a -> a
(<>)
                  [(,) String
s RestrictItem
                    { riAs :: [String]
riAs             = [String]
restrictAs
                    , riAsRequired :: Alt Maybe Bool
riAsRequired     = Alt Maybe Bool
restrictAsRequired
                    , riImportStyle :: Alt Maybe RestrictImportStyle
riImportStyle    = Alt Maybe RestrictImportStyle
restrictImportStyle
                    , riQualifiedStyle :: Alt Maybe QualifiedStyle
riQualifiedStyle = Alt Maybe QualifiedStyle
restrictQualifiedStyle
                    , riWithin :: [(String, String)]
riWithin         = [(String, String)]
restrictWithin
                    , riRestrictIdents :: RestrictIdents
riRestrictIdents = RestrictIdents
restrictIdents
                    , riMessage :: Maybe String
riMessage        = Maybe String
restrictMessage
                    }
                  | Restrict{Bool
[String]
[(String, String)]
Maybe String
Alt Maybe Bool
Alt Maybe QualifiedStyle
Alt Maybe RestrictImportStyle
RestrictIdents
RestrictType
restrictType :: Restrict -> RestrictType
restrictDefault :: Restrict -> Bool
restrictName :: Restrict -> [String]
restrictAs :: Restrict -> [String]
restrictAsRequired :: Restrict -> Alt Maybe Bool
restrictImportStyle :: Restrict -> Alt Maybe RestrictImportStyle
restrictQualifiedStyle :: Restrict -> Alt Maybe QualifiedStyle
restrictWithin :: Restrict -> [(String, String)]
restrictIdents :: Restrict -> RestrictIdents
restrictMessage :: Restrict -> Maybe String
restrictAs :: [String]
restrictAsRequired :: Alt Maybe Bool
restrictImportStyle :: Alt Maybe RestrictImportStyle
restrictQualifiedStyle :: Alt Maybe QualifiedStyle
restrictWithin :: [(String, String)]
restrictIdents :: RestrictIdents
restrictMessage :: Maybe String
restrictType :: RestrictType
restrictDefault :: Bool
restrictName :: [String]
..} <- [Restrict]
rs, String
s <- [String]
restrictName])

ideaMessage :: Maybe String -> Idea -> Idea
ideaMessage :: Maybe String -> Idea -> Idea
ideaMessage (Just String
message) Idea
w = Idea
w{ideaNote=[Note message]}
ideaMessage Maybe String
Nothing Idea
w = Idea
w{ideaNote=[noteMayBreak]}

ideaNoTo :: Idea -> Idea
ideaNoTo :: Idea -> Idea
ideaNoTo Idea
w = Idea
w{ideaTo=Nothing}

noteMayBreak :: Note
noteMayBreak :: Note
noteMayBreak = String -> Note
Note String
"may break the code"

within :: String -> String -> [(String, String)] -> Bool
within :: String -> String -> [(String, String)] -> Bool
within String
modu String
func = ((String, String) -> Bool) -> [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(String
a,String
b) -> (String
a String -> String -> Bool
~= String
modu Bool -> Bool -> Bool
|| String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"") Bool -> Bool -> Bool
&& (String
b String -> String -> Bool
~= String
func Bool -> Bool -> Bool
|| String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
""))
  where ~= :: String -> String -> Bool
(~=) = String -> String -> Bool
wildcardMatch

---------------------------------------------------------------------
-- CHECKS

checkPragmas :: String
              -> [(LEpaComment, [String])]
              -> [(LEpaComment, [String])]
              ->  Map.Map RestrictType (Bool, Map.Map String RestrictItem)
              -> [Idea]
checkPragmas :: String
-> [(LEpaComment, [String])]
-> [(LEpaComment, [String])]
-> Map RestrictType (Bool, Map String RestrictItem)
-> [Idea]
checkPragmas String
modu [(LEpaComment, [String])]
flags [(LEpaComment, [String])]
exts Map RestrictType (Bool, Map String RestrictItem)
mps =
  RestrictType -> String -> [(LEpaComment, [String])] -> [Idea]
f RestrictType
RestrictFlag String
"flags" [(LEpaComment, [String])]
flags [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ RestrictType -> String -> [(LEpaComment, [String])] -> [Idea]
f RestrictType
RestrictExtension String
"extensions" [(LEpaComment, [String])]
exts
  where
   f :: RestrictType -> String -> [(LEpaComment, [String])] -> [Idea]
f RestrictType
tag String
name [(LEpaComment, [String])]
xs =
     [(if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
good then Idea -> Idea
ideaNoTo else Idea -> Idea
forall a. a -> a
id) (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ Idea -> Idea
notes (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Hint.Type.Warning (String
"Avoid restricted " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) (LEpaComment -> SrcSpan
forall a. GenLocated Anchor a -> SrcSpan
getAncLoc LEpaComment
l) String
c Maybe String
forall a. Maybe a
Nothing [] []
     | Just (Bool
def, Map String RestrictItem
mp) <- [RestrictType
-> Map RestrictType (Bool, Map String RestrictItem)
-> Maybe (Bool, Map String RestrictItem)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RestrictType
tag Map RestrictType (Bool, Map String RestrictItem)
mps]
     , (l :: LEpaComment
l@(L Anchor
_ (EpaComment (EpaBlockComment String
c) RealSrcSpan
_)), [String]
les) <- [(LEpaComment, [String])]
xs
     , let ([String]
good, [String]
bad) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Bool -> Map String RestrictItem -> String -> Bool
isGood Bool
def Map String RestrictItem
mp) [String]
les
     , let note :: String -> Note
note = Note -> (String -> Note) -> Maybe String -> Note
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Note
noteMayBreak String -> Note
Note (Maybe String -> Note)
-> (String -> Maybe String) -> String -> Note
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RestrictItem -> Maybe String)
-> Maybe RestrictItem -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) RestrictItem -> Maybe String
riMessage (Maybe RestrictItem -> Maybe String)
-> (String -> Maybe RestrictItem) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Map String RestrictItem -> Maybe RestrictItem)
-> Map String RestrictItem -> String -> Maybe RestrictItem
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String RestrictItem -> Maybe RestrictItem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map String RestrictItem
mp
     , let notes :: Idea -> Idea
notes Idea
w = Idea
w {ideaNote=note <$> bad}
     , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
bad]
   isGood :: Bool -> Map String RestrictItem -> String -> Bool
isGood Bool
def Map String RestrictItem
mp String
x = Bool -> (RestrictItem -> Bool) -> Maybe RestrictItem -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
def (String -> String -> [(String, String)] -> Bool
within String
modu String
"" ([(String, String)] -> Bool)
-> (RestrictItem -> [(String, String)]) -> RestrictItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RestrictItem -> [(String, String)]
riWithin) (Maybe RestrictItem -> Bool) -> Maybe RestrictItem -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Map String RestrictItem -> Maybe RestrictItem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
x Map String RestrictItem
mp


-- | Extension to GHC's 'ImportDeclQualifiedStyle', expressing @qualifiedStyle: unrestricted@,
-- i.e. the preference of "either pre- or post-, but qualified" in a rule.
data QualifiedPostOrPre = QualifiedPostOrPre deriving QualifiedPostOrPre -> QualifiedPostOrPre -> Bool
(QualifiedPostOrPre -> QualifiedPostOrPre -> Bool)
-> (QualifiedPostOrPre -> QualifiedPostOrPre -> Bool)
-> Eq QualifiedPostOrPre
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QualifiedPostOrPre -> QualifiedPostOrPre -> Bool
== :: QualifiedPostOrPre -> QualifiedPostOrPre -> Bool
$c/= :: QualifiedPostOrPre -> QualifiedPostOrPre -> Bool
/= :: QualifiedPostOrPre -> QualifiedPostOrPre -> Bool
Eq

checkImports :: String -> [LImportDecl GhcPs] -> (Bool, Map.Map String RestrictItem) -> [Idea]
checkImports :: String
-> [LImportDecl GhcPs] -> (Bool, Map String RestrictItem) -> [Idea]
checkImports String
modu [LImportDecl GhcPs]
lImportDecls (Bool
def, Map String RestrictItem
mp) = (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Maybe Idea)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> [Idea]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LImportDecl GhcPs -> Maybe Idea
GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Maybe Idea
getImportHint [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
lImportDecls
  where
    getImportHint :: LImportDecl GhcPs -> Maybe Idea
    getImportHint :: LImportDecl GhcPs -> Maybe Idea
getImportHint i :: LImportDecl GhcPs
i@(L SrcSpanAnnA
_ ImportDecl{Bool
Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
ImportDeclPkgQual GhcPs
XCImportDecl GhcPs
XRec GhcPs ModuleName
IsBootInterface
ImportDeclQualifiedStyle
ideclExt :: XCImportDecl GhcPs
ideclName :: XRec GhcPs ModuleName
ideclPkgQual :: ImportDeclPkgQual GhcPs
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImportList :: Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
..}) = do
      let RestrictItem{[String]
[(String, String)]
Maybe String
Alt Maybe Bool
Alt Maybe QualifiedStyle
Alt Maybe RestrictImportStyle
RestrictIdents
riAs :: RestrictItem -> [String]
riAsRequired :: RestrictItem -> Alt Maybe Bool
riImportStyle :: RestrictItem -> Alt Maybe RestrictImportStyle
riQualifiedStyle :: RestrictItem -> Alt Maybe QualifiedStyle
riWithin :: RestrictItem -> [(String, String)]
riRestrictIdents :: RestrictItem -> RestrictIdents
riMessage :: RestrictItem -> Maybe String
riAs :: [String]
riAsRequired :: Alt Maybe Bool
riImportStyle :: Alt Maybe RestrictImportStyle
riQualifiedStyle :: Alt Maybe QualifiedStyle
riWithin :: [(String, String)]
riRestrictIdents :: RestrictIdents
riMessage :: Maybe String
..} = Bool
-> LocatedA ModuleName -> Map String RestrictItem -> RestrictItem
getRestrictItem Bool
def XRec GhcPs ModuleName
LocatedA ModuleName
ideclName Map String RestrictItem
mp
      (Idea -> Maybe Idea)
-> (() -> Maybe Idea) -> Either Idea () -> Maybe Idea
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Idea -> Maybe Idea
forall a. a -> Maybe a
Just (Idea -> Maybe Idea) -> (Idea -> Idea) -> Idea -> Maybe Idea
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Idea -> Idea
ideaMessage Maybe String
riMessage) (Maybe Idea -> () -> Maybe Idea
forall a b. a -> b -> a
const Maybe Idea
forall a. Maybe a
Nothing) (Either Idea () -> Maybe Idea) -> Either Idea () -> Maybe Idea
forall a b. (a -> b) -> a -> b
$ do
        Bool -> Either Idea () -> Either Idea ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> String -> [(String, String)] -> Bool
within String
modu String
"" [(String, String)]
riWithin) (Either Idea () -> Either Idea ())
-> Either Idea () -> Either Idea ()
forall a b. (a -> b) -> a -> b
$
          Idea -> Either Idea ()
forall a b. a -> Either a b
Left (Idea -> Either Idea ()) -> Idea -> Either Idea ()
forall a b. (a -> b) -> a -> b
$ Idea -> Idea
ideaNoTo (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ String
-> Located (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted module" (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i) (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i) []

        let importedIdents :: Set String
importedIdents = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$
              case (ImportListInterpretation -> Bool)
-> (ImportListInterpretation,
    GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> (Bool,
    GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut) ((ImportListInterpretation,
  GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
 -> (Bool,
     GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
-> Maybe
     (ImportListInterpretation,
      GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe
  (ImportListInterpretation,
   GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
ideclImportList of
                Just (Bool
False, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
lxs) -> (GenLocated SrcSpanAnnA (IE GhcPs) -> [String])
-> [GenLocated SrcSpanAnnA (IE GhcPs)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IE GhcPs -> [String]
importListToIdents (IE GhcPs -> [String])
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
unLoc) (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
lxs)
                Maybe
  (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
_ -> []
            invalidIdents :: Set String
invalidIdents = case RestrictIdents
riRestrictIdents of
              RestrictIdents
NoRestrictIdents -> Set String
forall a. Set a
Set.empty
              ForbidIdents [String]
badIdents -> Set String
importedIdents Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
badIdents
              OnlyIdents [String]
onlyIdents -> Set String
importedIdents Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
onlyIdents
        Bool -> Either Idea () -> Either Idea ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set String -> Bool
forall a. Set a -> Bool
Set.null Set String
invalidIdents) (Either Idea () -> Either Idea ())
-> Either Idea () -> Either Idea ()
forall a b. (a -> b) -> a -> b
$
          Idea -> Either Idea ()
forall a b. a -> Either a b
Left (Idea -> Either Idea ()) -> Idea -> Either Idea ()
forall a b. (a -> b) -> a -> b
$ Idea -> Idea
ideaNoTo (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ String
-> Located (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted identifiers" (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i) (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i) []

        let qualAllowed :: Bool
qualAllowed = case ([String]
riAs, Maybe (XRec GhcPs ModuleName)
Maybe (LocatedA ModuleName)
ideclAs) of
              ([], Maybe (LocatedA ModuleName)
_) -> Bool
True
              ([String]
_, Maybe (LocatedA ModuleName)
Nothing) -> Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Bool -> Bool
not (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Alt Maybe Bool -> Maybe Bool
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt Alt Maybe Bool
riAsRequired
              ([String]
_, Just (L SrcSpanAnnA
_ ModuleName
modName)) -> ModuleName -> String
moduleNameString ModuleName
modName String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
riAs
        Bool -> Either Idea () -> Either Idea ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
qualAllowed (Either Idea () -> Either Idea ())
-> Either Idea () -> Either Idea ()
forall a b. (a -> b) -> a -> b
$ do
          let i' :: Located (ImportDecl GhcPs)
i' = ImportDecl GhcPs -> Located (ImportDecl GhcPs)
forall e. e -> Located e
noLoc (ImportDecl GhcPs -> Located (ImportDecl GhcPs))
-> ImportDecl GhcPs -> Located (ImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i){ ideclAs = noLocA . mkModuleName <$> listToMaybe riAs }
          Idea -> Either Idea ()
forall a b. a -> Either a b
Left (Idea -> Either Idea ()) -> Idea -> Either Idea ()
forall a b. (a -> b) -> a -> b
$ String
-> Located (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted alias" (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i) Located (ImportDecl GhcPs)
i' []

        let (Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
expectedQual, Maybe
  (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs]))
expectedHiding) =
              case RestrictImportStyle
-> Maybe RestrictImportStyle -> RestrictImportStyle
forall a. a -> Maybe a -> a
fromMaybe RestrictImportStyle
ImportStyleUnrestricted (Maybe RestrictImportStyle -> RestrictImportStyle)
-> Maybe RestrictImportStyle -> RestrictImportStyle
forall a b. (a -> b) -> a -> b
$ Alt Maybe RestrictImportStyle -> Maybe RestrictImportStyle
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt Alt Maybe RestrictImportStyle
riImportStyle of
                RestrictImportStyle
ImportStyleUnrestricted
                  | ImportDeclQualifiedStyle
NotQualified <- ImportDeclQualifiedStyle
ideclQualified -> (Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a. Maybe a
Nothing, Maybe
  (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs]))
forall a. Maybe a
Nothing)
                  | Bool
otherwise -> ((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> Maybe
     (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a. a -> Maybe a
Just ((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
 -> Maybe
      (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String))
-> (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> Maybe
     (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a b. (a -> b) -> a -> b
$ (String -> String)
-> (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" or unqualified") (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
expectedQualStyle, Maybe
  (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs]))
forall a. Maybe a
Nothing)
                RestrictImportStyle
ImportStyleQualified -> ((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> Maybe
     (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a. a -> Maybe a
Just (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
expectedQualStyle, Maybe
  (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs]))
forall a. Maybe a
Nothing)
                RestrictImportStyle
ImportStyleExplicitOrQualified
                  | Just (Bool
False, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
_) <- (ImportListInterpretation -> Bool)
-> (ImportListInterpretation,
    GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> (Bool,
    GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut) ((ImportListInterpretation,
  GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
 -> (Bool,
     GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
-> Maybe
     (ImportListInterpretation,
      GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe
  (ImportListInterpretation,
   GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
ideclImportList -> (Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a. Maybe a
Nothing, Maybe
  (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs]))
forall a. Maybe a
Nothing)
                  | Bool
otherwise ->
                      ( (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> Maybe
     (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a. a -> Maybe a
Just ((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
 -> Maybe
      (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String))
-> (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> Maybe
     (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a b. (a -> b) -> a -> b
$ (String -> String)
-> (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" or with an explicit import list") (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
expectedQualStyle
                      , Maybe
  (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs]))
forall a. Maybe a
Nothing )
                RestrictImportStyle
ImportStyleExplicit
                  | Just (Bool
False, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
_) <- (ImportListInterpretation -> Bool)
-> (ImportListInterpretation,
    GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> (Bool,
    GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (ImportListInterpretation -> ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut) ((ImportListInterpretation,
  GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
 -> (Bool,
     GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
-> Maybe
     (ImportListInterpretation,
      GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe
  (ImportListInterpretation,
   GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
ideclImportList -> (Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a. Maybe a
Nothing, Maybe
  (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs]))
forall a. Maybe a
Nothing)
                  | Bool
otherwise ->
                      ( (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> Maybe
     (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
-> Either QualifiedPostOrPre ImportDeclQualifiedStyle
forall a b. b -> Either a b
Right ImportDeclQualifiedStyle
NotQualified, String
"unqualified")
                      , Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs])
-> Maybe
     (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs]))
forall a. a -> Maybe a
Just (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs])
 -> Maybe
      (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs])))
-> Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs])
-> Maybe
     (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs]))
forall a b. (a -> b) -> a -> b
$ (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs])
-> Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs])
forall a. a -> Maybe a
Just (ImportListInterpretation
Exactly, [LIE GhcPs] -> LocatedAn AnnList [LIE GhcPs]
forall a an. a -> LocatedAn an a
noLocA []) )
                RestrictImportStyle
ImportStyleUnqualified -> ((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> Maybe
     (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
-> Either QualifiedPostOrPre ImportDeclQualifiedStyle
forall a b. b -> Either a b
Right ImportDeclQualifiedStyle
NotQualified, String
"unqualified"), Maybe
  (Maybe (ImportListInterpretation, LocatedAn AnnList [LIE GhcPs]))
forall a. Maybe a
Nothing)
            expectedQualStyle :: (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
expectedQualStyle =
              case QualifiedStyle -> Maybe QualifiedStyle -> QualifiedStyle
forall a. a -> Maybe a -> a
fromMaybe QualifiedStyle
QualifiedStyleUnrestricted (Maybe QualifiedStyle -> QualifiedStyle)
-> Maybe QualifiedStyle -> QualifiedStyle
forall a b. (a -> b) -> a -> b
$ Alt Maybe QualifiedStyle -> Maybe QualifiedStyle
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt Alt Maybe QualifiedStyle
riQualifiedStyle of
                QualifiedStyle
QualifiedStyleUnrestricted -> (QualifiedPostOrPre
-> Either QualifiedPostOrPre ImportDeclQualifiedStyle
forall a b. a -> Either a b
Left QualifiedPostOrPre
QualifiedPostOrPre, String
"qualified")
                QualifiedStyle
QualifiedStylePost -> (ImportDeclQualifiedStyle
-> Either QualifiedPostOrPre ImportDeclQualifiedStyle
forall a b. b -> Either a b
Right ImportDeclQualifiedStyle
QualifiedPost, String
"post-qualified")
                QualifiedStyle
QualifiedStylePre -> (ImportDeclQualifiedStyle
-> Either QualifiedPostOrPre ImportDeclQualifiedStyle
forall a b. b -> Either a b
Right ImportDeclQualifiedStyle
QualifiedPre, String
"pre-qualified")
            -- unless expectedQual is Nothing, it holds the Idea (hint) to ultimately emit,
            -- except in these cases when the rule's requirements are fulfilled in-source:
            qualIdea :: Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
qualIdea
              -- the rule demands a particular importStyle, and the decl obeys exactly
              | Either QualifiedPostOrPre ImportDeclQualifiedStyle
-> Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle)
forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
-> Either QualifiedPostOrPre ImportDeclQualifiedStyle
forall a b. b -> Either a b
Right ImportDeclQualifiedStyle
ideclQualified) Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle)
-> Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle)
-> Bool
forall a. Eq a => a -> a -> Bool
== ((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> Either QualifiedPostOrPre ImportDeclQualifiedStyle
forall a b. (a, b) -> a
fst ((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
 -> Either QualifiedPostOrPre ImportDeclQualifiedStyle)
-> Maybe
     (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
expectedQual) = Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a. Maybe a
Nothing
              -- the rule demands a QualifiedPostOrPre import, and the decl does either
              | Either QualifiedPostOrPre ImportDeclQualifiedStyle
-> Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle)
forall a. a -> Maybe a
Just (QualifiedPostOrPre
-> Either QualifiedPostOrPre ImportDeclQualifiedStyle
forall a b. a -> Either a b
Left QualifiedPostOrPre
QualifiedPostOrPre) Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle)
-> Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle)
-> Bool
forall a. Eq a => a -> a -> Bool
== ((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> Either QualifiedPostOrPre ImportDeclQualifiedStyle
forall a b. (a, b) -> a
fst ((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
 -> Either QualifiedPostOrPre ImportDeclQualifiedStyle)
-> Maybe
     (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
expectedQual)
                Bool -> Bool -> Bool
&& ImportDeclQualifiedStyle
ideclQualified ImportDeclQualifiedStyle -> [ImportDeclQualifiedStyle] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ImportDeclQualifiedStyle
QualifiedPost, ImportDeclQualifiedStyle
QualifiedPre] = Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
forall a. Maybe a
Nothing
              -- otherwise, expectedQual gets converted into a warning below (or is Nothing)
              | Bool
otherwise = Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
expectedQual
        Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
-> ((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
    -> Either Idea ())
-> Either Idea ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
qualIdea (((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
  -> Either Idea ())
 -> Either Idea ())
-> ((Either QualifiedPostOrPre ImportDeclQualifiedStyle, String)
    -> Either Idea ())
-> Either Idea ()
forall a b. (a -> b) -> a -> b
$ \(Either QualifiedPostOrPre ImportDeclQualifiedStyle
qual, String
hint) -> do
          -- convert non-Nothing qualIdea into hlint's refactoring Idea
          let i' :: Located (ImportDecl GhcPs)
i' = ImportDecl GhcPs -> Located (ImportDecl GhcPs)
forall e. e -> Located e
noLoc (ImportDecl GhcPs -> Located (ImportDecl GhcPs))
-> ImportDecl GhcPs -> Located (ImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i){ ideclQualified = fromRight QualifiedPre qual
                                    , ideclImportList = fromMaybe ideclImportList expectedHiding }
              msg :: String
msg = ModuleName -> String
moduleNameString (LocatedA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc XRec GhcPs ModuleName
LocatedA ModuleName
ideclName) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" should be imported " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
hint
          Idea -> Either Idea ()
forall a b. a -> Either a b
Left (Idea -> Either Idea ()) -> Idea -> Either Idea ()
forall a b. (a -> b) -> a -> b
$ String
-> Located (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
msg (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i) Located (ImportDecl GhcPs)
i' []

getRestrictItem :: Bool -> LocatedA ModuleName -> Map.Map String RestrictItem -> RestrictItem
getRestrictItem :: Bool
-> LocatedA ModuleName -> Map String RestrictItem -> RestrictItem
getRestrictItem Bool
def LocatedA ModuleName
ideclName =
  RestrictItem -> Maybe RestrictItem -> RestrictItem
forall a. a -> Maybe a -> a
fromMaybe ([String]
-> Alt Maybe Bool
-> Alt Maybe RestrictImportStyle
-> Alt Maybe QualifiedStyle
-> [(String, String)]
-> RestrictIdents
-> Maybe String
-> RestrictItem
RestrictItem [String]
forall a. Monoid a => a
mempty Alt Maybe Bool
forall a. Monoid a => a
mempty Alt Maybe RestrictImportStyle
forall a. Monoid a => a
mempty Alt Maybe QualifiedStyle
forall a. Monoid a => a
mempty [(String
"",String
"") | Bool
def] RestrictIdents
NoRestrictIdents Maybe String
forall a. Maybe a
Nothing)
    (Maybe RestrictItem -> RestrictItem)
-> (Map String RestrictItem -> Maybe RestrictItem)
-> Map String RestrictItem
-> RestrictItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA ModuleName
-> Map String RestrictItem -> Maybe RestrictItem
lookupRestrictItem LocatedA ModuleName
ideclName

lookupRestrictItem :: LocatedA ModuleName -> Map.Map String RestrictItem -> Maybe RestrictItem
lookupRestrictItem :: LocatedA ModuleName
-> Map String RestrictItem -> Maybe RestrictItem
lookupRestrictItem LocatedA ModuleName
ideclName Map String RestrictItem
mp =
    let moduleName :: String
moduleName = ModuleName -> String
moduleNameString (ModuleName -> String) -> ModuleName -> String
forall a b. (a -> b) -> a -> b
$ LocatedA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc LocatedA ModuleName
ideclName
        exact :: Maybe RestrictItem
exact = String -> Map String RestrictItem -> Maybe RestrictItem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
moduleName Map String RestrictItem
mp
        wildcard :: Maybe (NonEmpty RestrictItem)
wildcard = [RestrictItem] -> Maybe (NonEmpty RestrictItem)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
            ([RestrictItem] -> Maybe (NonEmpty RestrictItem))
-> ([(String, RestrictItem)] -> [RestrictItem])
-> [(String, RestrictItem)]
-> Maybe (NonEmpty RestrictItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, RestrictItem) -> RestrictItem)
-> [(String, RestrictItem)] -> [RestrictItem]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, RestrictItem) -> RestrictItem
forall a b. (a, b) -> b
snd
            ([(String, RestrictItem)] -> [RestrictItem])
-> ([(String, RestrictItem)] -> [(String, RestrictItem)])
-> [(String, RestrictItem)]
-> [RestrictItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, RestrictItem)] -> [(String, RestrictItem)]
forall a. [a] -> [a]
reverse -- the hope is less specific matches will end up last, but it's not guaranteed
            ([(String, RestrictItem)] -> [(String, RestrictItem)])
-> ([(String, RestrictItem)] -> [(String, RestrictItem)])
-> [(String, RestrictItem)]
-> [(String, RestrictItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, RestrictItem) -> Bool)
-> [(String, RestrictItem)] -> [(String, RestrictItem)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool)
-> (String -> Bool) -> (String -> Bool) -> String -> Bool
forall a b c.
(a -> b -> c) -> (String -> a) -> (String -> b) -> String -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
'*') (String -> String -> Bool
`wildcardMatch` String
moduleName) (String -> Bool)
-> ((String, RestrictItem) -> String)
-> (String, RestrictItem)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, RestrictItem) -> String
forall a b. (a, b) -> a
fst)
            ([(String, RestrictItem)] -> Maybe (NonEmpty RestrictItem))
-> [(String, RestrictItem)] -> Maybe (NonEmpty RestrictItem)
forall a b. (a -> b) -> a -> b
$ Map String RestrictItem -> [(String, RestrictItem)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String RestrictItem
mp
    in Maybe RestrictItem
exact Maybe RestrictItem -> Maybe RestrictItem -> Maybe RestrictItem
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Maybe RestrictItem) -> Maybe RestrictItem
forall a. Semigroup a => NonEmpty a -> a
sconcat (Maybe (NonEmpty RestrictItem) -> NonEmpty (Maybe RestrictItem)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
sequence Maybe (NonEmpty RestrictItem)
wildcard)

importListToIdents :: IE GhcPs -> [String]
importListToIdents :: IE GhcPs -> [String]
importListToIdents =
  [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> [String])
-> (IE GhcPs -> [Maybe String]) -> IE GhcPs -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  \case (IEVar XIEVar GhcPs
_ LIEWrappedName GhcPs
n)              -> [LIEWrappedName GhcPs -> Maybe String
fromName LIEWrappedName GhcPs
n]
        (IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
n)         -> [LIEWrappedName GhcPs -> Maybe String
fromName LIEWrappedName GhcPs
n]
        (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
n)         -> [LIEWrappedName GhcPs -> Maybe String
fromName LIEWrappedName GhcPs
n]
        (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
n IEWildcard
_ [LIEWrappedName GhcPs]
ns)   -> LIEWrappedName GhcPs -> Maybe String
fromName LIEWrappedName GhcPs
n Maybe String -> [Maybe String] -> [Maybe String]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Maybe String)
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map LIEWrappedName GhcPs -> Maybe String
GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Maybe String
fromName [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
ns
        IE GhcPs
_                        -> []
  where
    fromName :: LIEWrappedName GhcPs -> Maybe String
    fromName :: LIEWrappedName GhcPs -> Maybe String
fromName LIEWrappedName GhcPs
wrapped =
      case GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> IEWrappedName GhcPs
forall l e. GenLocated l e -> e
unLoc LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
wrapped of
        IEName    XIEName GhcPs
_ LIdP GhcPs
n -> IdP GhcPs -> Maybe String
fromId (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
LocatedN RdrName
n)
        IEPattern XIEPattern GhcPs
_ LIdP GhcPs
n -> (String
"pattern " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdP GhcPs -> Maybe String
fromId (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
LocatedN RdrName
n)
        IEType    XIEType GhcPs
_ LIdP GhcPs
n -> (String
"type " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdP GhcPs -> Maybe String
fromId (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
LocatedN RdrName
n)

    fromId :: IdP GhcPs -> Maybe String
    fromId :: IdP GhcPs -> Maybe String
fromId (Unqual OccName
n) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString OccName
n
    fromId (Qual ModuleName
_ OccName
n) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString OccName
n
    fromId (Orig Module
_ OccName
n) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString OccName
n
    fromId (Exact Name
_)  = Maybe String
forall a. Maybe a
Nothing

checkFunctions :: Scope -> String -> [LHsDecl GhcPs] -> RestrictFunctions -> [Idea]
checkFunctions :: Scope -> String -> [LHsDecl GhcPs] -> RestrictFunctions -> [Idea]
checkFunctions Scope
scope String
modu [LHsDecl GhcPs]
decls (Bool
def, Map String RestrictFunction
mp) =
    [ (Maybe String -> Idea -> Idea
ideaMessage Maybe String
message (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ Idea -> Idea
ideaNoTo (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ String
-> Located RdrName
-> Located RdrName
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted function" (LocatedN RdrName -> Located RdrName
forall a. LocatedN a -> Located a
reLocN LocatedN RdrName
x) (LocatedN RdrName -> Located RdrName
forall a. LocatedN a -> Located a
reLocN LocatedN RdrName
x) []){ideaDecl = [dname]}
    | GenLocated SrcSpanAnnA (HsDecl GhcPs)
d <- [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls
    , let dname :: String
dname = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (LHsDecl GhcPs -> Maybe String
declName LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
d)
    , LocatedN RdrName
x <- GenLocated SrcSpanAnnA (HsDecl GhcPs) -> [LocatedN RdrName]
forall from to. Biplate from to => from -> [to]
universeBi GenLocated SrcSpanAnnA (HsDecl GhcPs)
d :: [LocatedN RdrName]
    , let xMods :: [ModuleName]
xMods = Scope -> LocatedN RdrName -> [ModuleName]
possModules Scope
scope LocatedN RdrName
x
    , let ([(String, String)]
withins, Maybe String
message) = ([(String, String)], Maybe String)
-> Maybe ([(String, String)], Maybe String)
-> ([(String, String)], Maybe String)
forall a. a -> Maybe a -> a
fromMaybe ([(String
"",String
"") | Bool
def], Maybe String
forall a. Maybe a
Nothing) (Map String RestrictFunction
-> LocatedN RdrName
-> [ModuleName]
-> Maybe ([(String, String)], Maybe String)
findFunction Map String RestrictFunction
mp LocatedN RdrName
x [ModuleName]
xMods)
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> String -> [(String, String)] -> Bool
within String
modu String
dname [(String, String)]
withins
    ]

-- Returns Just iff there are rules for x, which are either unqualified, or qualified with a module that is
-- one of x's possible modules.
-- If there are multiple matching rules (e.g., there's both an unqualified version and a qualified version), their
-- withins and messages are concatenated with (<>).
findFunction
    :: Map.Map String RestrictFunction
    -> LocatedN RdrName
    -> [ModuleName]
    -> Maybe ([(String, String)], Maybe String)
findFunction :: Map String RestrictFunction
-> LocatedN RdrName
-> [ModuleName]
-> Maybe ([(String, String)], Maybe String)
findFunction Map String RestrictFunction
restrictMap (LocatedN RdrName -> String
rdrNameStr -> String
x) ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
moduleNameString -> [String]
possMods) = do
    (RestrictFun Map (Maybe String) ([(String, String)], Maybe String)
mp) <- String -> Map String RestrictFunction -> Maybe RestrictFunction
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
x Map String RestrictFunction
restrictMap
    NonEmpty ([(String, String)], Maybe String)
n <- [([(String, String)], Maybe String)]
-> Maybe (NonEmpty ([(String, String)], Maybe String))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([([(String, String)], Maybe String)]
 -> Maybe (NonEmpty ([(String, String)], Maybe String)))
-> (Map (Maybe String) ([(String, String)], Maybe String)
    -> [([(String, String)], Maybe String)])
-> Map (Maybe String) ([(String, String)], Maybe String)
-> Maybe (NonEmpty ([(String, String)], Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Maybe String) ([(String, String)], Maybe String)
-> [([(String, String)], Maybe String)]
forall k a. Map k a -> [a]
Map.elems (Map (Maybe String) ([(String, String)], Maybe String)
 -> Maybe (NonEmpty ([(String, String)], Maybe String)))
-> Map (Maybe String) ([(String, String)], Maybe String)
-> Maybe (NonEmpty ([(String, String)], Maybe String))
forall a b. (a -> b) -> a -> b
$ (Maybe String -> ([(String, String)], Maybe String) -> Bool)
-> Map (Maybe String) ([(String, String)], Maybe String)
-> Map (Maybe String) ([(String, String)], Maybe String)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (Bool -> ([(String, String)], Maybe String) -> Bool
forall a b. a -> b -> a
const (Bool -> ([(String, String)], Maybe String) -> Bool)
-> (Maybe String -> Bool)
-> Maybe String
-> ([(String, String)], Maybe String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
possMods)) Map (Maybe String) ([(String, String)], Maybe String)
mp
    ([(String, String)], Maybe String)
-> Maybe ([(String, String)], Maybe String)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty ([(String, String)], Maybe String)
-> ([(String, String)], Maybe String)
forall a. Semigroup a => NonEmpty a -> a
sconcat NonEmpty ([(String, String)], Maybe String)
n)