{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# 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 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

-- 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 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)
        (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 -> [String]
riBadIdents :: [String]
    ,RestrictItem -> Maybe String
riMessage :: Maybe String
    }

instance Semigroup RestrictItem where
    RestrictItem [String]
x1 [(String, String)]
x2 [String]
x3 Maybe String
x4 <> :: RestrictItem -> RestrictItem -> RestrictItem
<> RestrictItem [String]
y1 [(String, String)]
y2 [String]
y3 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)

-- 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
RestrictType
restrictMessage :: Restrict -> Maybe String
restrictBadIdents :: Restrict -> [String]
restrictWithin :: Restrict -> [(String, String)]
restrictAs :: Restrict -> [String]
restrictMessage :: Maybe String
restrictBadIdents :: [String]
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)] -> [String] -> Maybe String -> RestrictItem
RestrictItem [String]
restrictAs [(String, String)]
restrictWithin [String]
restrictBadIdents Maybe String
restrictMessage) | Restrict{Bool
[String]
[(String, String)]
Maybe String
RestrictType
restrictName :: [String]
restrictDefault :: Bool
restrictType :: RestrictType
restrictMessage :: Maybe String
restrictBadIdents :: [String]
restrictWithin :: [(String, String)]
restrictAs :: [String]
restrictMessage :: Restrict -> Maybe String
restrictBadIdents :: Restrict -> [String]
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]
imp (Bool
def, 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 String
"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 String
"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 String
"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 String
"checkImports: unexpected case"
    | i :: LImportDecl GhcPs
i@(L SrcSpan
_ ImportDecl {Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
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 -> Bool
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
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 :: Bool
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
..}) <- [LImportDecl GhcPs]
imp
    , let RestrictItem{[String]
[(String, String)]
Maybe String
riBadIdents :: [String]
riWithin :: [(String, String)]
riAs :: [String]
riMessage :: Maybe String
riMessage :: RestrictItem -> Maybe String
riBadIdents :: RestrictItem -> [String]
riWithin :: RestrictItem -> [(String, String)]
riAs :: RestrictItem -> [String]
..} = 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 [] [(String
"",String
"") | 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, 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 [] (\(Bool
b, 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 (\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 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 -> 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 -> (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 -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
n)
                         IEType    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 -> 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 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.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> 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) (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
    -- 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 :: 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 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