{-# 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)
import Config.Type
import Util

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

import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Parser.Annotation
import GHC.Unit.Module
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 =
    let anns :: ApiAnns
anns = ModuleEx -> ApiAnns
ghcAnnotations ModuleEx
m
        ps :: [(Located AnnotationComment, String)]
ps   = ApiAnns -> [(Located AnnotationComment, String)]
pragmas ApiAnns
anns
        opts :: [(Located AnnotationComment, [String])]
opts = [(Located AnnotationComment, String)]
-> [(Located AnnotationComment, [String])]
flags [(Located AnnotationComment, String)]
ps
        exts :: [(Located AnnotationComment, [String])]
exts = [(Located AnnotationComment, String)]
-> [(Located AnnotationComment, [String])]
languagePragmas [(Located AnnotationComment, String)]
ps in
    String
-> [(Located AnnotationComment, [String])]
-> [(Located AnnotationComment, [String])]
-> Map RestrictType (Bool, Map String RestrictItem)
-> [Idea]
checkPragmas String
modu [(Located AnnotationComment, [String])]
opts [(Located AnnotationComment, [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 -> [LImportDecl GhcPs]
hsmodImports (GenLocated SrcSpan HsModule -> HsModule
forall l e. GenLocated l e -> e
unLoc (ModuleEx -> GenLocated SrcSpan HsModule
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 -> [LHsDecl GhcPs]
hsmodDecls (GenLocated SrcSpan HsModule -> HsModule
forall l e. GenLocated l e -> e
unLoc (ModuleEx -> GenLocated SrcSpan HsModule
ghcModule ModuleEx
m))) RestrictFunctions
rFunction
    where
        modu :: String
modu = GenLocated SrcSpan HsModule -> String
modName (ModuleEx -> GenLocated SrcSpan HsModule
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 -> [(String, String)]
riWithin :: [(String, String)]
    ,RestrictItem -> RestrictIdents
riRestrictIdents :: RestrictIdents
    ,RestrictItem -> Maybe String
riMessage :: Maybe String
    }

instance Semigroup RestrictItem where
    RestrictItem [String]
x1 [(String, String)]
x2 RestrictIdents
x3 Maybe String
x4 <> :: RestrictItem -> RestrictItem -> RestrictItem
<> RestrictItem [String]
y1 [(String, String)]
y2 RestrictIdents
y3 Maybe String
y4 = [String]
-> [(String, String)]
-> RestrictIdents
-> Maybe String
-> RestrictItem
RestrictItem ([String]
x1[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>[String]
y1) ([(String, String)]
x2[(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<>[(String, String)]
y2) (RestrictIdents
x3RestrictIdents -> RestrictIdents -> RestrictIdents
forall a. Semigroup a => a -> a -> a
<>RestrictIdents
y3) (Maybe String
x4Maybe String -> Maybe String -> Maybe String
forall a. Semigroup a => a -> a -> a
<>Maybe String
y4)

-- 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
RestrictIdents
RestrictType
restrictMessage :: Restrict -> Maybe String
restrictIdents :: Restrict -> RestrictIdents
restrictWithin :: Restrict -> [(String, String)]
restrictAs :: Restrict -> [String]
restrictMessage :: Maybe String
restrictIdents :: RestrictIdents
restrictWithin :: [(String, String)]
restrictAs :: [String]
restrictName :: [String]
restrictDefault :: Bool
restrictType :: RestrictType
restrictName :: Restrict -> [String]
restrictDefault :: Restrict -> Bool
restrictType :: Restrict -> RestrictType
..} = (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 (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 (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, [String]
-> [(String, String)]
-> RestrictIdents
-> Maybe String
-> RestrictItem
RestrictItem [String]
restrictAs [(String, String)]
restrictWithin RestrictIdents
restrictIdents Maybe String
restrictMessage) | Restrict{Bool
[String]
[(String, String)]
Maybe String
RestrictIdents
RestrictType
restrictName :: [String]
restrictDefault :: Bool
restrictType :: RestrictType
restrictMessage :: Maybe String
restrictIdents :: RestrictIdents
restrictWithin :: [(String, String)]
restrictAs :: [String]
restrictMessage :: Restrict -> Maybe String
restrictIdents :: Restrict -> RestrictIdents
restrictWithin :: Restrict -> [(String, String)]
restrictAs :: Restrict -> [String]
restrictName :: Restrict -> [String]
restrictDefault :: Restrict -> Bool
restrictType :: Restrict -> RestrictType
..} <- [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]
ideaNote=[String -> Note
Note String
message]}
ideaMessage Maybe String
Nothing Idea
w = Idea
w{ideaNote :: [Note]
ideaNote=[Note
noteMayBreak]}

ideaNoTo :: Idea -> Idea
ideaNoTo :: Idea -> Idea
ideaNoTo Idea
w = Idea
w{ideaTo :: Maybe String
ideaTo=Maybe String
forall a. Maybe a
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
forall a. Eq a => a -> a -> 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
forall a. Eq a => a -> a -> Bool
== String
func Bool -> Bool -> Bool
|| String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
""))

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

checkPragmas :: String
              -> [(Located AnnotationComment, [String])]
              -> [(Located AnnotationComment, [String])]
              ->  Map.Map RestrictType (Bool, Map.Map String RestrictItem)
              -> [Idea]
checkPragmas :: String
-> [(Located AnnotationComment, [String])]
-> [(Located AnnotationComment, [String])]
-> Map RestrictType (Bool, Map String RestrictItem)
-> [Idea]
checkPragmas String
modu [(Located AnnotationComment, [String])]
flags [(Located AnnotationComment, [String])]
exts Map RestrictType (Bool, Map String RestrictItem)
mps =
  RestrictType
-> String -> [(Located AnnotationComment, [String])] -> [Idea]
f RestrictType
RestrictFlag String
"flags" [(Located AnnotationComment, [String])]
flags [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ RestrictType
-> String -> [(Located AnnotationComment, [String])] -> [Idea]
f RestrictType
RestrictExtension String
"extensions" [(Located AnnotationComment, [String])]
exts
  where
   f :: RestrictType
-> String -> [(Located AnnotationComment, [String])] -> [Idea]
f RestrictType
tag String
name [(Located AnnotationComment, [String])]
xs =
     [(if [String] -> 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) SrcSpan
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 SrcSpan
l (AnnBlockComment String
c), [String]
les) <- [(Located AnnotationComment, [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]
ideaNote=String -> Note
note (String -> Note) -> [String] -> [Note]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
bad}
     , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> 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

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) = (LImportDecl GhcPs -> Maybe Idea) -> [LImportDecl GhcPs] -> [Idea]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LImportDecl GhcPs -> Maybe Idea
getImportHint [LImportDecl GhcPs]
lImportDecls
  where
    getImportHint :: LImportDecl GhcPs -> Maybe Idea
    getImportHint :: LImportDecl GhcPs -> Maybe Idea
getImportHint i :: LImportDecl GhcPs
i@(L SrcSpan
_ ImportDecl{Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
IsBootInterface
SourceText
Located ModuleName
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
..}) = do
      let RestrictItem{[String]
[(String, String)]
Maybe String
RestrictIdents
riMessage :: Maybe String
riRestrictIdents :: RestrictIdents
riWithin :: [(String, String)]
riAs :: [String]
riMessage :: RestrictItem -> Maybe String
riRestrictIdents :: RestrictItem -> RestrictIdents
riWithin :: RestrictItem -> [(String, String)]
riAs :: RestrictItem -> [String]
..} = Bool
-> Located ModuleName -> Map String RestrictItem -> RestrictItem
getRestrictItem Bool
def Located 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
-> LImportDecl GhcPs
-> LImportDecl GhcPs
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted module" LImportDecl GhcPs
i LImportDecl 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 Maybe (Bool, Located [LIE GhcPs])
ideclHiding of
                Just (Bool
False, Located [LIE GhcPs]
lxs) -> (LIE GhcPs -> [String]) -> [LIE GhcPs] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IE GhcPs -> [String]
importListToIdents (IE GhcPs -> [String])
-> (LIE GhcPs -> IE GhcPs) -> LIE GhcPs -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcPs -> IE GhcPs
forall l e. GenLocated l e -> e
unLoc) (Located [LIE GhcPs] -> [LIE GhcPs]
forall l e. GenLocated l e -> e
unLoc Located [LIE GhcPs]
lxs)
                Maybe (Bool, Located [LIE 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
-> LImportDecl GhcPs
-> LImportDecl GhcPs
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted identifiers" LImportDecl GhcPs
i LImportDecl GhcPs
i []

        let qualAllowed :: Bool
qualAllowed = case ([String]
riAs, Maybe (Located ModuleName)
ideclAs) of
              ([], Maybe (Located ModuleName)
_) -> Bool
True
              ([String]
_, Maybe (Located ModuleName)
Nothing) -> Bool
True
              ([String]
_, Just (L SrcSpan
_ ModuleName
modName)) -> ModuleName -> String
moduleNameString ModuleName
modName String -> [String] -> 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' :: LImportDecl GhcPs
i' = ImportDecl GhcPs -> LImportDecl GhcPs
forall e. e -> Located e
noLoc (ImportDecl GhcPs -> LImportDecl GhcPs)
-> ImportDecl GhcPs -> LImportDecl GhcPs
forall a b. (a -> b) -> a -> b
$ (LImportDecl GhcPs -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc LImportDecl GhcPs
i){ ideclAs :: Maybe (Located ModuleName)
ideclAs = ModuleName -> Located ModuleName
forall e. e -> Located e
noLoc (ModuleName -> Located ModuleName)
-> (String -> ModuleName) -> String -> Located ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleName
mkModuleName (String -> Located ModuleName)
-> Maybe String -> Maybe (Located ModuleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe [String]
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
-> LImportDecl GhcPs
-> LImportDecl GhcPs
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted qualification" LImportDecl GhcPs
i LImportDecl GhcPs
i' []

getRestrictItem :: Bool -> Located ModuleName -> Map.Map String RestrictItem -> RestrictItem
getRestrictItem :: Bool
-> Located ModuleName -> Map String RestrictItem -> RestrictItem
getRestrictItem Bool
def Located ModuleName
ideclName = RestrictItem -> Maybe RestrictItem -> RestrictItem
forall a. a -> Maybe a -> a
fromMaybe ([String]
-> [(String, String)]
-> RestrictIdents
-> Maybe String
-> RestrictItem
RestrictItem [] [(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
. Located ModuleName -> Map String RestrictItem -> Maybe RestrictItem
lookupRestrictItem Located ModuleName
ideclName

lookupRestrictItem :: Located ModuleName -> Map.Map String RestrictItem -> Maybe RestrictItem
lookupRestrictItem :: Located ModuleName -> Map String RestrictItem -> Maybe RestrictItem
lookupRestrictItem Located ModuleName
ideclName Map String RestrictItem
mp =
    let moduleName :: String
moduleName = ModuleName -> String
moduleNameString (ModuleName -> String) -> ModuleName -> String
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located 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 RestrictItem
wildcard = ((String, RestrictItem) -> RestrictItem)
-> Maybe (String, RestrictItem) -> Maybe RestrictItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, RestrictItem) -> RestrictItem
forall a b. (a, b) -> b
snd
            (Maybe (String, RestrictItem) -> Maybe RestrictItem)
-> ([(String, RestrictItem)] -> Maybe (String, RestrictItem))
-> [(String, RestrictItem)]
-> Maybe RestrictItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, RestrictItem) -> Bool)
-> [(String, RestrictItem)] -> Maybe (String, RestrictItem)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool) -> String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 (String, RestrictItem))
-> ([(String, RestrictItem)] -> [(String, RestrictItem)])
-> [(String, RestrictItem)]
-> Maybe (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 (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
'*' (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 RestrictItem)
-> [(String, RestrictItem)] -> Maybe 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe 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 (IdP GhcPs)
n)              -> [LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n]
        (IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
n)         -> [LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n]
        (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
n)         -> [LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n]
        (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
n IEWildcard
_ [LIEWrappedName (IdP GhcPs)]
ns [Located (FieldLbl (IdP GhcPs))]
_) -> LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n Maybe String -> [Maybe String] -> [Maybe String]
forall a. a -> [a] -> [a]
: (LIEWrappedName RdrName -> Maybe String)
-> [LIEWrappedName RdrName] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map LIEWrappedName (IdP GhcPs) -> Maybe String
LIEWrappedName RdrName -> Maybe String
fromName [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
ns
        IE GhcPs
_                        -> []
  where
    fromName :: LIEWrappedName (IdP GhcPs) -> Maybe String
    fromName :: LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
wrapped = case LIEWrappedName RdrName -> IEWrappedName RdrName
forall l e. GenLocated l e -> e
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
wrapped of
                         IEName    Located RdrName
n -> IdP GhcPs -> Maybe String
fromId (Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
n)
                         IEPattern Located RdrName
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 (Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
n)
                         IEType    Located RdrName
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 (Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
n)

    fromId :: IdP GhcPs -> Maybe String
    fromId :: IdP GhcPs -> Maybe String
fromId (Unqual 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 _ 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 _ 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 _)  = 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" Located RdrName
x Located RdrName
x []){ideaDecl :: [String]
ideaDecl = [String
dname]}
    | LHsDecl GhcPs
d <- [LHsDecl 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
d)
    , Located RdrName
x <- LHsDecl GhcPs -> [Located RdrName]
forall from to. Biplate from to => from -> [to]
universeBi LHsDecl GhcPs
d :: [Located RdrName]
    , let xMods :: [ModuleName]
xMods = Scope -> Located RdrName -> [ModuleName]
possModules Scope
scope Located 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
-> Located RdrName
-> [ModuleName]
-> Maybe ([(String, String)], Maybe String)
findFunction Map String RestrictFunction
mp Located 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
    -> Located RdrName
    -> [ModuleName]
    -> Maybe ([(String, String)], Maybe String)
findFunction :: Map String RestrictFunction
-> Located RdrName
-> [ModuleName]
-> Maybe ([(String, String)], Maybe String)
findFunction Map String RestrictFunction
restrictMap (Located 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 (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 (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)