{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Hint.Restrict(restrictHint) where
import Hint.Type(ModuHint,ModuleEx(..),Idea(..),Severity(..),warn,rawIdea,modComments)
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.List.NonEmpty (nonEmpty)
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.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
restrictHint :: [Setting] -> ModuHint
restrictHint :: [Setting] -> ModuHint
restrictHint [Setting]
settings Scope
scope ModuleEx
m =
let anns :: EpAnnComments
anns = ModuleEx -> EpAnnComments
modComments ModuleEx
m
ps :: [(LEpaComment, String)]
ps = EpAnnComments -> [(LEpaComment, String)]
pragmas EpAnnComments
anns
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 forall a. [a] -> [a] -> [a]
++
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String
-> [LImportDecl GhcPs] -> (Bool, Map String RestrictItem) -> [Idea]
checkImports String
modu forall a b. (a -> b) -> a -> b
$ HsModule -> [LImportDecl GhcPs]
hsmodImports (forall l e. GenLocated l e -> e
unLoc (ModuleEx -> Located HsModule
ghcModule ModuleEx
m))) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RestrictType
RestrictModule Map RestrictType (Bool, Map String RestrictItem)
rOthers) forall a. [a] -> [a] -> [a]
++
Scope -> String -> [LHsDecl GhcPs] -> RestrictFunctions -> [Idea]
checkFunctions Scope
scope String
modu (HsModule -> [LHsDecl GhcPs]
hsmodDecls (forall l e. GenLocated l e -> e
unLoc (ModuleEx -> Located HsModule
ghcModule ModuleEx
m))) RestrictFunctions
rFunction
where
modu :: String
modu = Located HsModule -> String
modName (ModuleEx -> Located HsModule
ghcModule ModuleEx
m)
(RestrictFunctions
rFunction, Map RestrictType (Bool, Map String RestrictItem)
rOthers) = [Setting]
-> (RestrictFunctions,
Map RestrictType (Bool, Map String RestrictItem))
restrictions [Setting]
settings
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]
x1forall a. Semigroup a => a -> a -> a
<>[String]
y1) (Alt Maybe Bool
x2forall a. Semigroup a => a -> a -> a
<>Alt Maybe Bool
y2) (Alt Maybe RestrictImportStyle
x3forall a. Semigroup a => a -> a -> a
<>Alt Maybe RestrictImportStyle
y3) (Alt Maybe QualifiedStyle
x4forall a. Semigroup a => a -> a -> a
<>Alt Maybe QualifiedStyle
y4) ([(String, String)]
x5forall a. Semigroup a => a -> a -> a
<>[(String, String)]
y5) (RestrictIdents
x6forall a. Semigroup a => a -> a -> a
<>RestrictIdents
y6) (Maybe String
x7forall a. Semigroup a => a -> a -> a
<>Maybe String
y7)
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 (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith 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
(forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd -> [Restrict]
rfs, [(RestrictType, Restrict)]
ros) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Eq a => a -> a -> Bool
== RestrictType
RestrictFunction) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Restrict -> RestrictType
restrictType Restrict
x, Restrict
x) | SettingRestrict Restrict
x <- [Setting]
settings]
rFunction :: RestrictFunctions
rFunction = (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Restrict -> Bool
restrictDefault [Restrict]
rfs, forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith 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
restrictMessage :: Restrict -> Maybe String
restrictIdents :: Restrict -> RestrictIdents
restrictWithin :: Restrict -> [(String, String)]
restrictQualifiedStyle :: Restrict -> Alt Maybe QualifiedStyle
restrictImportStyle :: Restrict -> Alt Maybe RestrictImportStyle
restrictAsRequired :: Restrict -> Alt Maybe Bool
restrictAs :: Restrict -> [String]
restrictMessage :: Maybe String
restrictIdents :: RestrictIdents
restrictWithin :: [(String, String)]
restrictQualifiedStyle :: Alt Maybe QualifiedStyle
restrictImportStyle :: Alt Maybe RestrictImportStyle
restrictAsRequired :: Alt Maybe Bool
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 forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton Maybe String
modu ([(String, String)]
restrictWithin, Maybe String
restrictMessage))
where
(Maybe String
modu, String
name) = forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NonEmpty a -> [a]
NonEmpty.init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty) (forall a. (a -> Bool) -> [a] -> ([a], [a])
breakEnd (forall a. Eq a => a -> a -> Bool
== Char
'.') String
s)
rOthers :: Map RestrictType (Bool, Map String RestrictItem)
rOthers = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [Restrict] -> (Bool, Map String RestrictItem)
f forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) (forall a b. (a -> b) -> [a] -> [b]
map (forall b b' a. (b -> b') -> (a, b) -> (a, b')
second forall (f :: * -> *) a. Applicative f => a -> f a
pure) [(RestrictType, Restrict)]
ros)
f :: [Restrict] -> (Bool, Map String RestrictItem)
f [Restrict]
rs = (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Restrict -> Bool
restrictDefault [Restrict]
rs
,forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith 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
restrictName :: [String]
restrictDefault :: Bool
restrictType :: RestrictType
restrictMessage :: Maybe String
restrictIdents :: RestrictIdents
restrictWithin :: [(String, String)]
restrictQualifiedStyle :: Alt Maybe QualifiedStyle
restrictImportStyle :: Alt Maybe RestrictImportStyle
restrictAsRequired :: Alt Maybe Bool
restrictAs :: [String]
restrictMessage :: Restrict -> Maybe String
restrictIdents :: Restrict -> RestrictIdents
restrictWithin :: Restrict -> [(String, String)]
restrictQualifiedStyle :: Restrict -> Alt Maybe QualifiedStyle
restrictImportStyle :: Restrict -> Alt Maybe RestrictImportStyle
restrictAsRequired :: Restrict -> Alt Maybe Bool
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=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 = 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 forall a. Eq a => a -> a -> Bool
== String
"") Bool -> Bool -> Bool
&& (String
b String -> String -> Bool
~= String
func Bool -> Bool -> Bool
|| String
b forall a. Eq a => a -> a -> Bool
== String
""))
where ~= :: String -> String -> Bool
(~=) = String -> String -> Bool
wildcardMatch
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 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
good then Idea -> Idea
ideaNoTo else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ Idea -> Idea
notes 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 " forall a. [a] -> [a] -> [a]
++ String
name) (forall a. GenLocated Anchor a -> SrcSpan
getAncLoc LEpaComment
l) String
c forall a. Maybe a
Nothing [] []
| Just (Bool
def, Map String RestrictItem
mp) <- [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) = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Note
noteMayBreak String -> Note
Note forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) RestrictItem -> Maybe String
riMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
bad}
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
def (String -> String -> [(String, String)] -> Bool
within String
modu String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. RestrictItem -> [(String, String)]
riWithin) forall a b. (a -> b) -> a -> b
$ 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) = 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 SrcSpanAnnA
_ ImportDecl{Bool
Maybe (Bool, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
ImportDeclQualifiedStyle
ImportDeclPkgQual GhcPs
XRec GhcPs ModuleName
XCImportDecl GhcPs
SourceText
IsBootInterface
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
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
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: ImportDeclPkgQual GhcPs
ideclName :: XRec GhcPs ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
..}) = do
let RestrictItem{[String]
[(String, String)]
Maybe String
Alt Maybe Bool
Alt Maybe QualifiedStyle
Alt Maybe RestrictImportStyle
RestrictIdents
riMessage :: Maybe String
riRestrictIdents :: RestrictIdents
riWithin :: [(String, String)]
riQualifiedStyle :: Alt Maybe QualifiedStyle
riImportStyle :: Alt Maybe RestrictImportStyle
riAsRequired :: Alt Maybe Bool
riAs :: [String]
riMessage :: RestrictItem -> Maybe String
riRestrictIdents :: RestrictItem -> RestrictIdents
riWithin :: RestrictItem -> [(String, String)]
riQualifiedStyle :: RestrictItem -> Alt Maybe QualifiedStyle
riImportStyle :: RestrictItem -> Alt Maybe RestrictImportStyle
riAsRequired :: RestrictItem -> Alt Maybe Bool
riAs :: RestrictItem -> [String]
..} = Bool
-> LocatedA ModuleName -> Map String RestrictItem -> RestrictItem
getRestrictItem Bool
def XRec GhcPs ModuleName
ideclName Map String RestrictItem
mp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Idea -> Idea
ideaMessage Maybe String
riMessage) (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> String -> [(String, String)] -> Bool
within String
modu String
"" [(String, String)]
riWithin) forall a b. (a -> b) -> a -> b
$
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Idea -> Idea
ideaNoTo forall a b. (a -> b) -> a -> b
$ forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted module" (forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
i) (forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
i) []
let importedIdents :: Set String
importedIdents = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$
case Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding of
Just (Bool
False, XRec GhcPs [LIE GhcPs]
lxs) -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IE GhcPs -> [String]
importListToIdents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) (forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LIE GhcPs]
lxs)
Maybe (Bool, XRec GhcPs [LIE GhcPs])
_ -> []
invalidIdents :: Set String
invalidIdents = case RestrictIdents
riRestrictIdents of
RestrictIdents
NoRestrictIdents -> forall a. Set a
Set.empty
ForbidIdents [String]
badIdents -> Set String
importedIdents forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` forall a. Ord a => [a] -> Set a
Set.fromList [String]
badIdents
OnlyIdents [String]
onlyIdents -> Set String
importedIdents forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` forall a. Ord a => [a] -> Set a
Set.fromList [String]
onlyIdents
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Set a -> Bool
Set.null Set String
invalidIdents) forall a b. (a -> b) -> a -> b
$
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Idea -> Idea
ideaNoTo forall a b. (a -> b) -> a -> b
$ forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted identifiers" (forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
i) (forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
i) []
let qualAllowed :: Bool
qualAllowed = case ([String]
riAs, Maybe (XRec GhcPs ModuleName)
ideclAs) of
([], Maybe (LocatedA ModuleName)
_) -> Bool
True
([String]
_, Maybe (LocatedA ModuleName)
Nothing) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
riAs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
qualAllowed forall a b. (a -> b) -> a -> b
$ do
let i' :: Located (ImportDecl GhcPs)
i' = forall e. e -> Located e
noLoc forall a b. (a -> b) -> a -> b
$ (forall l e. GenLocated l e -> e
unLoc LImportDecl GhcPs
i){ ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclAs = forall a an. a -> LocatedAn an a
noLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleName
mkModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
listToMaybe [String]
riAs }
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted alias" (forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
i) Located (ImportDecl GhcPs)
i' []
let (Maybe (ImportDeclQualifiedStyle, String)
expectedQual, Maybe
(Maybe
(Bool, LocatedAn AnnList [GenLocated SrcSpanAnnA (IE GhcPs)]))
expectedHiding) =
case forall a. a -> Maybe a -> a
fromMaybe RestrictImportStyle
ImportStyleUnrestricted forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt Alt Maybe RestrictImportStyle
riImportStyle of
RestrictImportStyle
ImportStyleUnrestricted
| ImportDeclQualifiedStyle
NotQualified <- ImportDeclQualifiedStyle
ideclQualified -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
| Bool
otherwise -> (forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (forall a. Semigroup a => a -> a -> a
<> String
" or unqualified") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyle, forall a. Maybe a
Nothing)
RestrictImportStyle
ImportStyleQualified -> (Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyleDef, forall a. Maybe a
Nothing)
RestrictImportStyle
ImportStyleExplicitOrQualified
| Just (Bool
False, XRec GhcPs [LIE GhcPs]
_) <- Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
| Bool
otherwise ->
( forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (forall a. Semigroup a => a -> a -> a
<> String
" or with an explicit import list") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyleDef
, forall a. Maybe a
Nothing )
RestrictImportStyle
ImportStyleExplicit
| Just (Bool
False, XRec GhcPs [LIE GhcPs]
_) <- Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
| Bool
otherwise ->
( forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
NotQualified, String
"unqualified")
, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Bool
False, forall a an. a -> LocatedAn an a
noLocA []) )
RestrictImportStyle
ImportStyleUnqualified -> (forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
NotQualified, String
"unqualified"), forall a. Maybe a
Nothing)
expectedQualStyleDef :: Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyleDef = Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
QualifiedPre, String
"qualified")
expectedQualStyle :: Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyle =
case forall a. a -> Maybe a -> a
fromMaybe QualifiedStyle
QualifiedStyleUnrestricted forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt Alt Maybe QualifiedStyle
riQualifiedStyle of
QualifiedStyle
QualifiedStyleUnrestricted -> forall a. Maybe a
Nothing
QualifiedStyle
QualifiedStylePost -> forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
QualifiedPost, String
"post-qualified")
QualifiedStyle
QualifiedStylePre -> forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
QualifiedPre, String
"pre-qualified")
qualIdea :: Maybe (ImportDeclQualifiedStyle, String)
qualIdea
| forall a. a -> Maybe a
Just ImportDeclQualifiedStyle
ideclQualified forall a. Eq a => a -> a -> Bool
== (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ImportDeclQualifiedStyle, String)
expectedQual) = forall a. Maybe a
Nothing
| Bool
otherwise = Maybe (ImportDeclQualifiedStyle, String)
expectedQual
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (ImportDeclQualifiedStyle, String)
qualIdea forall a b. (a -> b) -> a -> b
$ \(ImportDeclQualifiedStyle
qual, String
hint) -> do
let i' :: Located (ImportDecl GhcPs)
i' = forall e. e -> Located e
noLoc forall a b. (a -> b) -> a -> b
$ (forall l e. GenLocated l e -> e
unLoc LImportDecl GhcPs
i){ ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
qual
, ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding = forall a. a -> Maybe a -> a
fromMaybe Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding Maybe
(Maybe
(Bool, LocatedAn AnnList [GenLocated SrcSpanAnnA (IE GhcPs)]))
expectedHiding }
msg :: String
msg = ModuleName -> String
moduleNameString (forall l e. GenLocated l e -> e
unLoc XRec GhcPs ModuleName
ideclName) forall a. Semigroup a => a -> a -> a
<> String
" should be imported " forall a. Semigroup a => a -> a -> a
<> String
hint
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
msg (forall a e. LocatedAn a e -> Located e
reLoc LImportDecl 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 =
forall a. a -> Maybe a -> a
fromMaybe ([String]
-> Alt Maybe Bool
-> Alt Maybe RestrictImportStyle
-> Alt Maybe QualifiedStyle
-> [(String, String)]
-> RestrictIdents
-> Maybe String
-> RestrictItem
RestrictItem forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty [(String
"",String
"") | Bool
def] RestrictIdents
NoRestrictIdents forall a. Maybe a
Nothing)
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 forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc LocatedA ModuleName
ideclName
exact :: Maybe RestrictItem
exact = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
moduleName Map String RestrictItem
mp
wildcard :: Maybe (NonEmpty RestrictItem)
wildcard = forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
'*') (String -> String -> Bool
`wildcardMatch` String
moduleName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map String RestrictItem
mp
in Maybe RestrictItem
exact forall a. Semigroup a => a -> a -> a
<> forall a. Semigroup a => NonEmpty a -> a
sconcat (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Maybe (NonEmpty RestrictItem)
wildcard)
importListToIdents :: IE GhcPs -> [String]
importListToIdents :: IE GhcPs -> [String]
importListToIdents =
forall a. [Maybe a] -> [a]
catMaybes 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) -> LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map LIEWrappedName (IdP GhcPs) -> Maybe String
fromName [LIEWrappedName (IdP GhcPs)]
ns
IE GhcPs
_ -> []
where
fromName :: LIEWrappedName (IdP GhcPs) -> Maybe String
fromName :: LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
wrapped =
case forall l e. GenLocated l e -> e
unLoc LIEWrappedName (IdP GhcPs)
wrapped of
IEName LocatedN RdrName
n -> IdP GhcPs -> Maybe String
fromId (forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
n)
IEPattern EpaLocation
_ LocatedN RdrName
n -> (String
"pattern " forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdP GhcPs -> Maybe String
fromId (forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
n)
IEType EpaLocation
_ LocatedN RdrName
n -> (String
"type " forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdP GhcPs -> Maybe String
fromId (forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
n)
fromId :: IdP GhcPs -> Maybe String
fromId :: IdP GhcPs -> Maybe String
fromId (Unqual OccName
n) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString OccName
n
fromId (Qual ModuleName
_ OccName
n) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString OccName
n
fromId (Orig Module
_ OccName
n) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString OccName
n
fromId (Exact Name
_) = 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 forall a b. (a -> b) -> a -> b
$ Idea -> Idea
ideaNoTo forall a b. (a -> b) -> a -> b
$ forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted function" (forall a. LocatedN a -> Located a
reLocN LocatedN RdrName
x) (forall a. LocatedN a -> Located a
reLocN LocatedN RdrName
x) []){ideaDecl :: [String]
ideaDecl = [String
dname]}
| GenLocated SrcSpanAnnA (HsDecl GhcPs)
d <- [LHsDecl GhcPs]
decls
, let dname :: String
dname = forall a. a -> Maybe a -> a
fromMaybe String
"" (LHsDecl GhcPs -> Maybe String
declName GenLocated SrcSpanAnnA (HsDecl GhcPs)
d)
, LocatedN RdrName
x <- 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) = forall a. a -> Maybe a -> a
fromMaybe ([(String
"",String
"") | Bool
def], 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 forall a b. (a -> b) -> a -> b
$ String -> String -> [(String, String)] -> Bool
within String
modu String
dname [(String, String)]
withins
]
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) (forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
moduleNameString -> [String]
possMods) = do
(RestrictFun Map (Maybe String) ([(String, String)], Maybe String)
mp) <- 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 <- forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
possMods)) Map (Maybe String) ([(String, String)], Maybe String)
mp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Semigroup a => NonEmpty a -> a
sconcat NonEmpty ([(String, String)], Maybe String)
n)