{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Hint.Restrict(restrictHint) where
import Hint.Type(ModuHint,ModuleEx(..),Idea(..),Severity(..),warn,rawIdea)
import Config.Type
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 RdrName
import ApiAnnotation
import Module
import SrcLoc
import OccName
import Language.Haskell.GhclibParserEx.GHC.Hs
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
import GHC.Util
restrictHint :: [Setting] -> ModuHint
restrictHint :: [Setting] -> ModuHint
restrictHint settings :: [Setting]
settings scope :: Scope
scope m :: 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 GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports (Located (HsModule GhcPs) -> SrcSpanLess (Located (HsModule GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ModuleEx -> Located (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 pass. HsModule pass -> [LHsDecl pass]
hsmodDecls (Located (HsModule GhcPs) -> SrcSpanLess (Located (HsModule GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ModuleEx -> Located (HsModule GhcPs)
ghcModule ModuleEx
m))) RestrictFunctions
rFunction
where
modu :: String
modu = Located (HsModule GhcPs) -> String
modName (ModuleEx -> Located (HsModule GhcPs)
ghcModule ModuleEx
m)
(rFunction :: RestrictFunctions
rFunction, rOthers :: 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 -> [(String, String)]
riWithin :: [(String, String)]
,RestrictItem -> [String]
riBadIdents :: [String]
,RestrictItem -> Maybe String
riMessage :: Maybe String
}
instance Semigroup RestrictItem where
RestrictItem x1 :: [String]
x1 x2 :: [(String, String)]
x2 x3 :: [String]
x3 x4 :: Maybe String
x4 <> :: RestrictItem -> RestrictItem -> RestrictItem
<> RestrictItem y1 :: [String]
y1 y2 :: [(String, String)]
y2 y3 :: [String]
y3 y4 :: Maybe String
y4 = [String]
-> [(String, String)] -> [String] -> 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) ([String]
x3[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>[String]
y3) (Maybe String
x4Maybe String -> Maybe String -> Maybe String
forall a. Semigroup a => a -> a -> a
<>Maybe String
y4)
newtype RestrictFunction = RestrictFun (Map.Map (Maybe String) ([(String, String)], Maybe String))
instance Semigroup RestrictFunction where
RestrictFun m1 :: Map (Maybe String) ([(String, String)], Maybe String)
m1 <> :: RestrictFunction -> RestrictFunction -> RestrictFunction
<> RestrictFun m2 :: 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 settings :: [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, ros :: [(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 x :: 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 s :: String
s Restrict{..} = (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
(modu :: Maybe String
modu, name :: 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
== '.') 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 rs :: [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)] -> [String] -> Maybe String -> RestrictItem
RestrictItem [String]
restrictAs [(String, String)]
restrictWithin [String]
restrictBadIdents Maybe String
restrictMessage) | Restrict{..} <- [Restrict]
rs, String
s <- [String]
restrictName])
ideaMessage :: Maybe String -> Idea -> Idea
ideaMessage :: Maybe String -> Idea -> Idea
ideaMessage (Just message :: String
message) w :: Idea
w = Idea
w{ideaNote :: [Note]
ideaNote=[String -> Note
Note String
message]}
ideaMessage Nothing w :: Idea
w = Idea
w{ideaNote :: [Note]
ideaNote=[Note
noteMayBreak]}
ideaNoTo :: Idea -> Idea
ideaNoTo :: Idea -> Idea
ideaNoTo w :: Idea
w = Idea
w{ideaTo :: Maybe String
ideaTo=Maybe String
forall a. Maybe a
Nothing}
noteMayBreak :: Note
noteMayBreak :: Note
noteMayBreak = String -> Note
Note "may break the code"
within :: String -> String -> [(String, String)] -> Bool
within :: String -> String -> [(String, String)] -> Bool
within modu :: String
modu func :: String
func = ((String, String) -> Bool) -> [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(a :: String
a,b :: 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
== "") 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
== ""))
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 modu :: String
modu flags :: [(Located AnnotationComment, [String])]
flags exts :: [(Located AnnotationComment, [String])]
exts mps :: Map RestrictType (Bool, Map String RestrictItem)
mps =
RestrictType
-> String -> [(Located AnnotationComment, [String])] -> [Idea]
f RestrictType
RestrictFlag "flags" [(Located AnnotationComment, [String])]
flags [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ RestrictType
-> String -> [(Located AnnotationComment, [String])] -> [Idea]
f RestrictType
RestrictExtension "extensions" [(Located AnnotationComment, [String])]
exts
where
f :: RestrictType
-> String -> [(Located AnnotationComment, [String])] -> [Idea]
f tag :: RestrictType
tag name :: String
name xs :: [(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 ("Avoid restricted " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) SrcSpan
l String
c Maybe String
forall a. Maybe a
Nothing [] []
| Just (def :: Bool
def, mp :: 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 l :: SrcSpan
l (AnnBlockComment c :: String
c), les :: [String]
les) <- [(Located AnnotationComment, [String])]
xs
, let (good :: [String]
good, bad :: [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 w :: 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 def :: Bool
def mp :: Map String RestrictItem
mp x :: 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)] -> 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 modu :: String
modu imp :: [LImportDecl GhcPs]
imp (def :: Bool
def, mp :: Map String RestrictItem
mp) =
[ Maybe String -> Idea -> Idea
ideaMessage Maybe String
riMessage
(Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ if | Bool -> Bool
not Bool
allowImport -> 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.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
warn "Avoid restricted module" LImportDecl GhcPs
i LImportDecl GhcPs
i []
| Bool -> Bool
not Bool
allowIdent -> 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.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
warn "Avoid restricted identifiers" LImportDecl GhcPs
i LImportDecl GhcPs
i []
| Bool -> Bool
not Bool
allowQual -> String
-> LImportDecl GhcPs
-> LImportDecl GhcPs
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
warn "Avoid restricted qualification" LImportDecl GhcPs
i (SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs)
-> SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs
forall a b. (a -> b) -> a -> b
$ (LImportDecl GhcPs -> SrcSpanLess (LImportDecl GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LImportDecl GhcPs
i){ ideclAs :: Maybe (Located ModuleName)
ideclAs=ModuleName -> Located ModuleName
forall a. HasSrcSpan a => SrcSpanLess a -> a
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} :: Located (ImportDecl GhcPs)) []
| Bool
otherwise -> String -> Idea
forall a. HasCallStack => String -> a
error "checkImports: unexpected case"
| i :: LImportDecl GhcPs
i@(L _ ImportDecl {..}) <- [LImportDecl GhcPs]
imp
, let RestrictItem{..} = RestrictItem -> String -> Map String RestrictItem -> RestrictItem
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault ([String]
-> [(String, String)] -> [String] -> Maybe String -> RestrictItem
RestrictItem [] [("","") | Bool
def] [] Maybe String
forall a. Maybe a
Nothing) (ModuleName -> String
moduleNameString (Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
ideclName)) Map String RestrictItem
mp
, let allowImport :: Bool
allowImport = String -> String -> [(String, String)] -> Bool
within String
modu "" [(String, String)]
riWithin
, let allowIdent :: Bool
allowIdent = Set String -> Set String -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.disjoint
([String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
riBadIdents)
([String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String]
-> ((Bool, Located [LIE GhcPs]) -> [String])
-> Maybe (Bool, Located [LIE GhcPs])
-> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(b :: Bool
b, lxs :: Located [LIE GhcPs]
lxs) -> if Bool
b then [] else (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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) (Located [LIE GhcPs] -> SrcSpanLess (Located [LIE GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LIE GhcPs]
lxs)) Maybe (Bool, Located [LIE GhcPs])
ideclHiding))
, let allowQual :: Bool
allowQual = Bool
-> (Located ModuleName -> Bool)
-> Maybe (Located ModuleName)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\x :: Located ModuleName
x -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
riAs Bool -> Bool -> Bool
|| ModuleName -> String
moduleNameString (Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
x) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
riAs) Maybe (Located ModuleName)
ideclAs
, Bool -> Bool
not Bool
allowImport Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
allowQual Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
allowIdent
]
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 _ n :: LIEWrappedName (IdP GhcPs)
n) -> [LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n]
(IEThingAbs _ n :: LIEWrappedName (IdP GhcPs)
n) -> [LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n]
(IEThingAll _ n :: LIEWrappedName (IdP GhcPs)
n) -> [LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n]
(IEThingWith _ n :: LIEWrappedName (IdP GhcPs)
n _ ns :: [LIEWrappedName (IdP GhcPs)]
ns _) -> 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
_ -> []
where
fromName :: LIEWrappedName (IdP GhcPs) -> Maybe String
fromName :: LIEWrappedName (IdP GhcPs) -> Maybe String
fromName wrapped :: LIEWrappedName (IdP GhcPs)
wrapped = case LIEWrappedName RdrName -> SrcSpanLess (LIEWrappedName RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
wrapped of
IEName n -> IdP GhcPs -> Maybe String
fromId (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
n)
IEPattern n -> ("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 -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
n)
IEType n -> ("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 -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
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
scope modu :: String
modu decls :: [LHsDecl GhcPs]
decls (def :: Bool
def, mp :: 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.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
warn "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 "" (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 (withins :: [(String, String)]
withins, message :: Maybe String
message) = ([(String, String)], Maybe String)
-> Maybe ([(String, String)], Maybe String)
-> ([(String, String)], Maybe String)
forall a. a -> Maybe a -> a
fromMaybe ([("","") | Bool
def], Maybe String
forall a. Maybe a
Nothing) (Located RdrName
-> [ModuleName] -> Maybe ([(String, String)], Maybe String)
findFunction 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
]
where
findFunction :: Located RdrName -> [ModuleName] -> Maybe ([(String, String)], Maybe String)
findFunction :: Located RdrName
-> [ModuleName] -> Maybe ([(String, String)], Maybe String)
findFunction (Located RdrName -> String
rdrNameStr -> String
x) ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
moduleNameString -> [String]
possMods)
| Just (RestrictFun mp :: 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
mp =
(NonEmpty ([(String, String)], Maybe String)
-> ([(String, String)], Maybe String))
-> Maybe (NonEmpty ([(String, String)], Maybe String))
-> Maybe ([(String, String)], Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty ([(String, String)], Maybe String)
-> ([(String, String)], Maybe String)
forall a. Semigroup a => NonEmpty a -> a
sconcat (Maybe (NonEmpty ([(String, String)], Maybe String))
-> Maybe ([(String, String)], Maybe String))
-> (Map (Maybe String) ([(String, String)], Maybe String)
-> Maybe (NonEmpty ([(String, String)], Maybe String)))
-> Map (Maybe String) ([(String, String)], Maybe String)
-> Maybe ([(String, String)], Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([(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 ([(String, String)], Maybe String))
-> Map (Maybe String) ([(String, String)], Maybe String)
-> Maybe ([(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
| Bool
otherwise = Maybe ([(String, String)], Maybe String)
forall a. Maybe a
Nothing