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

module Hint.Restrict(restrictHint) where

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

import Hint.Type(ModuHint,ModuleEx(..),Idea(..),Severity(..),warn,rawIdea,modComments)
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

-- 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 :: 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

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

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

instance Semigroup RestrictItem where
    RestrictItem [String]
x1 Alt Maybe Bool
x2 Alt Maybe RestrictImportStyle
x3 Alt Maybe QualifiedStyle
x4 [(String, String)]
x5 RestrictIdents
x6 Maybe String
x7
      <> :: RestrictItem -> RestrictItem -> RestrictItem
<> RestrictItem [String]
y1 Alt Maybe Bool
y2 Alt Maybe RestrictImportStyle
y3 Alt Maybe QualifiedStyle
y4 [(String, String)]
y5 RestrictIdents
y6 Maybe String
y7
      = [String]
-> Alt Maybe Bool
-> Alt Maybe RestrictImportStyle
-> Alt Maybe QualifiedStyle
-> [(String, String)]
-> RestrictIdents
-> Maybe String
-> RestrictItem
RestrictItem ([String]
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)

-- 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 (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
            -- Parse module and name from s. module = Nothing if the rule is unqualified.
            (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

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

checkPragmas :: String
              -> [(LEpaComment, [String])]
              -> [(LEpaComment, [String])]
              ->  Map.Map RestrictType (Bool, Map.Map String RestrictItem)
              -> [Idea]
checkPragmas :: String
-> [(LEpaComment, [String])]
-> [(LEpaComment, [String])]
-> Map RestrictType (Bool, Map String RestrictItem)
-> [Idea]
checkPragmas String
modu [(LEpaComment, [String])]
flags [(LEpaComment, [String])]
exts Map RestrictType (Bool, Map String RestrictItem)
mps =
  RestrictType -> String -> [(LEpaComment, [String])] -> [Idea]
f RestrictType
RestrictFlag String
"flags" [(LEpaComment, [String])]
flags 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 -- the hope is less specific matches will end up last, but it's not guaranteed
            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
    ]

-- Returns Just iff there are rules for x, which are either unqualified, or qualified with a module that is
-- one of x's possible modules.
-- If there are multiple matching rules (e.g., there's both an unqualified version and a qualified version), their
-- withins and messages are concatenated with (<>).
findFunction
    :: Map.Map String RestrictFunction
    -> LocatedN RdrName
    -> [ModuleName]
    -> Maybe ([(String, String)], Maybe String)
findFunction :: Map String RestrictFunction
-> LocatedN RdrName
-> [ModuleName]
-> Maybe ([(String, String)], Maybe String)
findFunction Map String RestrictFunction
restrictMap (LocatedN RdrName -> String
rdrNameStr -> String
x) (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)