{-# 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 [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    [Idea]
-> ((Bool, Map String RestrictItem) -> [Idea])
-> Maybe (Bool, Map String RestrictItem)
-> [Idea]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String
-> [LImportDecl GhcPs] -> (Bool, Map String RestrictItem) -> [Idea]
checkImports String
modu ([LImportDecl GhcPs] -> (Bool, Map String RestrictItem) -> [Idea])
-> [LImportDecl GhcPs] -> (Bool, Map String RestrictItem) -> [Idea]
forall a b. (a -> b) -> a -> b
$ HsModule -> [LImportDecl GhcPs]
hsmodImports (GenLocated SrcSpan HsModule -> HsModule
forall l e. GenLocated l e -> e
unLoc (ModuleEx -> GenLocated SrcSpan HsModule
ghcModule ModuleEx
m))) (RestrictType
-> Map RestrictType (Bool, Map String RestrictItem)
-> Maybe (Bool, Map String RestrictItem)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RestrictType
RestrictModule Map RestrictType (Bool, Map String RestrictItem)
rOthers) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    Scope -> String -> [LHsDecl GhcPs] -> RestrictFunctions -> [Idea]
checkFunctions Scope
scope String
modu (HsModule -> [LHsDecl GhcPs]
hsmodDecls (GenLocated SrcSpan HsModule -> HsModule
forall l e. GenLocated l e -> e
unLoc (ModuleEx -> GenLocated SrcSpan HsModule
ghcModule ModuleEx
m))) RestrictFunctions
rFunction
    where
        modu :: String
modu = GenLocated SrcSpan HsModule -> String
modName (ModuleEx -> GenLocated SrcSpan HsModule
ghcModule ModuleEx
m)
        (RestrictFunctions
rFunction, Map RestrictType (Bool, Map String RestrictItem)
rOthers) = [Setting]
-> (RestrictFunctions,
    Map RestrictType (Bool, Map String RestrictItem))
restrictions [Setting]
settings

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

data RestrictItem = RestrictItem
    {RestrictItem -> [String]
riAs :: [String]
    ,RestrictItem -> 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]
x1[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>[String]
y1) (Alt Maybe Bool
x2Alt Maybe Bool -> Alt Maybe Bool -> Alt Maybe Bool
forall a. Semigroup a => a -> a -> a
<>Alt Maybe Bool
y2) (Alt Maybe RestrictImportStyle
x3Alt Maybe RestrictImportStyle
-> Alt Maybe RestrictImportStyle -> Alt Maybe RestrictImportStyle
forall a. Semigroup a => a -> a -> a
<>Alt Maybe RestrictImportStyle
y3) (Alt Maybe QualifiedStyle
x4Alt Maybe QualifiedStyle
-> Alt Maybe QualifiedStyle -> Alt Maybe QualifiedStyle
forall a. Semigroup a => a -> a -> a
<>Alt Maybe QualifiedStyle
y4) ([(String, String)]
x5[(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<>[(String, String)]
y5) (RestrictIdents
x6RestrictIdents -> RestrictIdents -> RestrictIdents
forall a. Semigroup a => a -> a -> a
<>RestrictIdents
y6) (Maybe String
x7Maybe String -> Maybe String -> Maybe String
forall 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 ((([(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
Alt Maybe Bool
Alt Maybe QualifiedStyle
Alt Maybe RestrictImportStyle
RestrictIdents
RestrictType
restrictType :: Restrict -> RestrictType
restrictDefault :: Restrict -> Bool
restrictName :: Restrict -> [String]
restrictType :: RestrictType
restrictDefault :: Bool
restrictName :: [String]
restrictAs :: [String]
restrictAsRequired :: Alt Maybe Bool
restrictImportStyle :: Alt Maybe RestrictImportStyle
restrictQualifiedStyle :: Alt Maybe QualifiedStyle
restrictWithin :: [(String, String)]
restrictIdents :: RestrictIdents
restrictMessage :: Maybe String
restrictAs :: Restrict -> [String]
restrictAsRequired :: Restrict -> Alt Maybe Bool
restrictImportStyle :: Restrict -> Alt Maybe RestrictImportStyle
restrictQualifiedStyle :: Restrict -> Alt Maybe QualifiedStyle
restrictWithin :: Restrict -> [(String, String)]
restrictIdents :: Restrict -> RestrictIdents
restrictMessage :: Restrict -> Maybe String
..} = (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 a b. (a -> b) -> Maybe a -> Maybe b
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 a. a -> [a]
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 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
restrictType :: Restrict -> RestrictType
restrictDefault :: Restrict -> Bool
restrictName :: Restrict -> [String]
restrictAs :: Restrict -> [String]
restrictAsRequired :: Restrict -> Alt Maybe Bool
restrictImportStyle :: Restrict -> Alt Maybe RestrictImportStyle
restrictQualifiedStyle :: Restrict -> Alt Maybe QualifiedStyle
restrictWithin :: Restrict -> [(String, String)]
restrictIdents :: Restrict -> RestrictIdents
restrictMessage :: Restrict -> Maybe String
restrictAs :: [String]
restrictAsRequired :: Alt Maybe Bool
restrictImportStyle :: Alt Maybe RestrictImportStyle
restrictQualifiedStyle :: Alt Maybe QualifiedStyle
restrictWithin :: [(String, String)]
restrictIdents :: RestrictIdents
restrictMessage :: Maybe String
restrictType :: RestrictType
restrictDefault :: Bool
restrictName :: [String]
..} <- [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
~= 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
~= String
func Bool -> Bool -> Bool
|| String
b String -> String -> Bool
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 [Idea] -> [Idea] -> [Idea]
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 [String] -> Bool
forall a. [a] -> 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) (LEpaComment -> SrcSpan
forall a. GenLocated Anchor a -> SrcSpan
getAncLoc LEpaComment
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 :: LEpaComment
l@(L Anchor
_ (EpaComment (EpaBlockComment String
c) RealSrcSpan
_)), [String]
les) <- [(LEpaComment, [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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
bad]
   isGood :: Bool -> Map String RestrictItem -> String -> Bool
isGood Bool
def Map String RestrictItem
mp String
x = Bool -> (RestrictItem -> Bool) -> Maybe RestrictItem -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
def (String -> String -> [(String, String)] -> Bool
within String
modu String
"" ([(String, String)] -> Bool)
-> (RestrictItem -> [(String, String)]) -> RestrictItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RestrictItem -> [(String, String)]
riWithin) (Maybe RestrictItem -> Bool) -> Maybe RestrictItem -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Map String RestrictItem -> Maybe RestrictItem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
x Map String RestrictItem
mp

checkImports :: String -> [LImportDecl GhcPs] -> (Bool, Map.Map String RestrictItem) -> [Idea]
checkImports :: String
-> [LImportDecl GhcPs] -> (Bool, Map String RestrictItem) -> [Idea]
checkImports String
modu [LImportDecl GhcPs]
lImportDecls (Bool
def, Map String RestrictItem
mp) = (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Maybe Idea)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> [Idea]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Maybe Idea
LImportDecl GhcPs -> Maybe Idea
getImportHint [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
[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)
IsBootInterface
SourceText
XCImportDecl GhcPs
XRec GhcPs ModuleName
ImportDeclPkgQual GhcPs
ImportDeclQualifiedStyle
ideclExt :: XCImportDecl GhcPs
ideclSourceSrc :: SourceText
ideclName :: XRec GhcPs ModuleName
ideclPkgQual :: ImportDeclPkgQual GhcPs
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclImplicit :: Bool
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
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])
..}) = do
      let RestrictItem{[String]
[(String, String)]
Maybe String
Alt Maybe Bool
Alt Maybe QualifiedStyle
Alt Maybe RestrictImportStyle
RestrictIdents
riAs :: RestrictItem -> [String]
riAsRequired :: RestrictItem -> Alt Maybe Bool
riImportStyle :: RestrictItem -> Alt Maybe RestrictImportStyle
riQualifiedStyle :: RestrictItem -> Alt Maybe QualifiedStyle
riWithin :: RestrictItem -> [(String, String)]
riRestrictIdents :: RestrictItem -> RestrictIdents
riMessage :: RestrictItem -> Maybe String
riAs :: [String]
riAsRequired :: Alt Maybe Bool
riImportStyle :: Alt Maybe RestrictImportStyle
riQualifiedStyle :: Alt Maybe QualifiedStyle
riWithin :: [(String, String)]
riRestrictIdents :: RestrictIdents
riMessage :: Maybe String
..} = Bool
-> LocatedA ModuleName -> Map String RestrictItem -> RestrictItem
getRestrictItem Bool
def LocatedA ModuleName
XRec GhcPs ModuleName
ideclName Map String RestrictItem
mp
      (Idea -> Maybe Idea)
-> (() -> Maybe Idea) -> Either Idea () -> Maybe Idea
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Idea -> Maybe Idea
forall a. a -> Maybe a
Just (Idea -> Maybe Idea) -> (Idea -> Idea) -> Idea -> Maybe Idea
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Idea -> Idea
ideaMessage Maybe String
riMessage) (Maybe Idea -> () -> Maybe Idea
forall a b. a -> b -> a
const Maybe Idea
forall a. Maybe a
Nothing) (Either Idea () -> Maybe Idea) -> Either Idea () -> Maybe Idea
forall a b. (a -> b) -> a -> b
$ do
        Bool -> Either Idea () -> Either Idea ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> String -> [(String, String)] -> Bool
within String
modu String
"" [(String, String)]
riWithin) (Either Idea () -> Either Idea ())
-> Either Idea () -> Either Idea ()
forall a b. (a -> b) -> a -> b
$
          Idea -> Either Idea ()
forall a b. a -> Either a b
Left (Idea -> Either Idea ()) -> Idea -> Either Idea ()
forall a b. (a -> b) -> a -> b
$ Idea -> Idea
ideaNoTo (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ String
-> Located (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted module" (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
LImportDecl GhcPs
i) (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
LImportDecl GhcPs
i) []

        let importedIdents :: Set String
importedIdents = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$
              case Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding of
                Just (Bool
False, XRec GhcPs [LIE GhcPs]
lxs) -> (GenLocated SrcSpanAnnA (IE GhcPs) -> [String])
-> [GenLocated SrcSpanAnnA (IE GhcPs)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IE GhcPs -> [String]
importListToIdents (IE GhcPs -> [String])
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
unLoc) (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
XRec GhcPs [LIE GhcPs]
lxs)
                Maybe (Bool, XRec GhcPs [LIE GhcPs])
_ -> []
            invalidIdents :: Set String
invalidIdents = case RestrictIdents
riRestrictIdents of
              RestrictIdents
NoRestrictIdents -> Set String
forall a. Set a
Set.empty
              ForbidIdents [String]
badIdents -> Set String
importedIdents Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
badIdents
              OnlyIdents [String]
onlyIdents -> Set String
importedIdents Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
onlyIdents
        Bool -> Either Idea () -> Either Idea ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set String -> Bool
forall a. Set a -> Bool
Set.null Set String
invalidIdents) (Either Idea () -> Either Idea ())
-> Either Idea () -> Either Idea ()
forall a b. (a -> b) -> a -> b
$
          Idea -> Either Idea ()
forall a b. a -> Either a b
Left (Idea -> Either Idea ()) -> Idea -> Either Idea ()
forall a b. (a -> b) -> a -> b
$ Idea -> Idea
ideaNoTo (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ String
-> Located (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted identifiers" (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
LImportDecl GhcPs
i) (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
LImportDecl GhcPs
i) []

        let qualAllowed :: Bool
qualAllowed = case ([String]
riAs, Maybe (LocatedA ModuleName)
Maybe (XRec GhcPs ModuleName)
ideclAs) of
              ([], Maybe (LocatedA ModuleName)
_) -> Bool
True
              ([String]
_, Maybe (LocatedA ModuleName)
Nothing) -> Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Bool -> Bool
not (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Alt Maybe Bool -> Maybe Bool
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 String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
riAs
        Bool -> Either Idea () -> Either Idea ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
qualAllowed (Either Idea () -> Either Idea ())
-> Either Idea () -> Either Idea ()
forall a b. (a -> b) -> a -> b
$ do
          let i' :: Located (ImportDecl GhcPs)
i' = ImportDecl GhcPs -> Located (ImportDecl GhcPs)
forall e. e -> Located e
noLoc (ImportDecl GhcPs -> Located (ImportDecl GhcPs))
-> ImportDecl GhcPs -> Located (ImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
LImportDecl GhcPs
i){ ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclAs = ModuleName -> LocatedA ModuleName
forall a an. a -> LocatedAn an a
noLocA (ModuleName -> LocatedA ModuleName)
-> (String -> ModuleName) -> String -> LocatedA ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleName
mkModuleName (String -> LocatedA ModuleName)
-> Maybe String -> Maybe (LocatedA ModuleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe [String]
riAs }
          Idea -> Either Idea ()
forall a b. a -> Either a b
Left (Idea -> Either Idea ()) -> Idea -> Either Idea ()
forall a b. (a -> b) -> a -> b
$ String
-> Located (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted alias" (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
LImportDecl GhcPs
i) Located (ImportDecl GhcPs)
i' []

        let (Maybe (ImportDeclQualifiedStyle, String)
expectedQual, Maybe
  (Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
expectedHiding) =
              case RestrictImportStyle
-> Maybe RestrictImportStyle -> RestrictImportStyle
forall a. a -> Maybe a -> a
fromMaybe RestrictImportStyle
ImportStyleUnrestricted (Maybe RestrictImportStyle -> RestrictImportStyle)
-> Maybe RestrictImportStyle -> RestrictImportStyle
forall a b. (a -> b) -> a -> b
$ Alt Maybe RestrictImportStyle -> Maybe RestrictImportStyle
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt Alt Maybe RestrictImportStyle
riImportStyle of
                RestrictImportStyle
ImportStyleUnrestricted
                  | ImportDeclQualifiedStyle
NotQualified <- ImportDeclQualifiedStyle
ideclQualified -> (Maybe (ImportDeclQualifiedStyle, String)
forall a. Maybe a
Nothing, Maybe
  (Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a. Maybe a
Nothing)
                  | Bool
otherwise -> ((String -> String)
-> (ImportDeclQualifiedStyle, String)
-> (ImportDeclQualifiedStyle, String)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" or unqualified") ((ImportDeclQualifiedStyle, String)
 -> (ImportDeclQualifiedStyle, String))
-> Maybe (ImportDeclQualifiedStyle, String)
-> Maybe (ImportDeclQualifiedStyle, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyle, Maybe
  (Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a. Maybe a
Nothing)
                RestrictImportStyle
ImportStyleQualified -> (Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyleDef, Maybe
  (Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a. Maybe a
Nothing)
                RestrictImportStyle
ImportStyleExplicitOrQualified
                  | Just (Bool
False, XRec GhcPs [LIE GhcPs]
_) <- Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding -> (Maybe (ImportDeclQualifiedStyle, String)
forall a. Maybe a
Nothing, Maybe
  (Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a. Maybe a
Nothing)
                  | Bool
otherwise ->
                      ( (String -> String)
-> (ImportDeclQualifiedStyle, String)
-> (ImportDeclQualifiedStyle, String)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" or with an explicit import list") ((ImportDeclQualifiedStyle, String)
 -> (ImportDeclQualifiedStyle, String))
-> Maybe (ImportDeclQualifiedStyle, String)
-> Maybe (ImportDeclQualifiedStyle, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyleDef
                      , Maybe
  (Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a. Maybe a
Nothing )
                RestrictImportStyle
ImportStyleExplicit
                  | Just (Bool
False, XRec GhcPs [LIE GhcPs]
_) <- Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding -> (Maybe (ImportDeclQualifiedStyle, String)
forall a. Maybe a
Nothing, Maybe
  (Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a. Maybe a
Nothing)
                  | Bool
otherwise ->
                      ( (ImportDeclQualifiedStyle, String)
-> Maybe (ImportDeclQualifiedStyle, String)
forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
NotQualified, String
"unqualified")
                      , Maybe
  (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
     (Maybe
        (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a. a -> Maybe a
Just (Maybe
   (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
 -> Maybe
      (Maybe
         (Bool,
          GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])))
-> Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
     (Maybe
        (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a b. (a -> b) -> a -> b
$ (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a. a -> Maybe a
Just (Bool
False, [GenLocated SrcSpanAnnA (IE GhcPs)]
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a an. a -> LocatedAn an a
noLocA []) )
                RestrictImportStyle
ImportStyleUnqualified -> ((ImportDeclQualifiedStyle, String)
-> Maybe (ImportDeclQualifiedStyle, String)
forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
NotQualified, String
"unqualified"), Maybe
  (Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
forall a. Maybe a
Nothing)
            expectedQualStyleDef :: Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyleDef = Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyle Maybe (ImportDeclQualifiedStyle, String)
-> Maybe (ImportDeclQualifiedStyle, String)
-> Maybe (ImportDeclQualifiedStyle, String)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ImportDeclQualifiedStyle, String)
-> Maybe (ImportDeclQualifiedStyle, String)
forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
QualifiedPre, String
"qualified")
            expectedQualStyle :: Maybe (ImportDeclQualifiedStyle, String)
expectedQualStyle =
              case QualifiedStyle -> Maybe QualifiedStyle -> QualifiedStyle
forall a. a -> Maybe a -> a
fromMaybe QualifiedStyle
QualifiedStyleUnrestricted (Maybe QualifiedStyle -> QualifiedStyle)
-> Maybe QualifiedStyle -> QualifiedStyle
forall a b. (a -> b) -> a -> b
$ Alt Maybe QualifiedStyle -> Maybe QualifiedStyle
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt Alt Maybe QualifiedStyle
riQualifiedStyle of
                QualifiedStyle
QualifiedStyleUnrestricted -> Maybe (ImportDeclQualifiedStyle, String)
forall a. Maybe a
Nothing
                QualifiedStyle
QualifiedStylePost -> (ImportDeclQualifiedStyle, String)
-> Maybe (ImportDeclQualifiedStyle, String)
forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
QualifiedPost, String
"post-qualified")
                QualifiedStyle
QualifiedStylePre -> (ImportDeclQualifiedStyle, String)
-> Maybe (ImportDeclQualifiedStyle, String)
forall a. a -> Maybe a
Just (ImportDeclQualifiedStyle
QualifiedPre, String
"pre-qualified")
            qualIdea :: Maybe (ImportDeclQualifiedStyle, String)
qualIdea
              | ImportDeclQualifiedStyle -> Maybe ImportDeclQualifiedStyle
forall a. a -> Maybe a
Just ImportDeclQualifiedStyle
ideclQualified Maybe ImportDeclQualifiedStyle
-> Maybe ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ((ImportDeclQualifiedStyle, String) -> ImportDeclQualifiedStyle
forall a b. (a, b) -> a
fst ((ImportDeclQualifiedStyle, String) -> ImportDeclQualifiedStyle)
-> Maybe (ImportDeclQualifiedStyle, String)
-> Maybe ImportDeclQualifiedStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ImportDeclQualifiedStyle, String)
expectedQual) = Maybe (ImportDeclQualifiedStyle, String)
forall a. Maybe a
Nothing
              | Bool
otherwise = Maybe (ImportDeclQualifiedStyle, String)
expectedQual
        Maybe (ImportDeclQualifiedStyle, String)
-> ((ImportDeclQualifiedStyle, String) -> Either Idea ())
-> Either Idea ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (ImportDeclQualifiedStyle, String)
qualIdea (((ImportDeclQualifiedStyle, String) -> Either Idea ())
 -> Either Idea ())
-> ((ImportDeclQualifiedStyle, String) -> Either Idea ())
-> Either Idea ()
forall a b. (a -> b) -> a -> b
$ \(ImportDeclQualifiedStyle
qual, String
hint) -> do
          let i' :: Located (ImportDecl GhcPs)
i' = ImportDecl GhcPs -> Located (ImportDecl GhcPs)
forall e. e -> Located e
noLoc (ImportDecl GhcPs -> Located (ImportDecl GhcPs))
-> ImportDecl GhcPs -> Located (ImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
LImportDecl GhcPs
i){ ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
qual
                                    , ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding = Maybe
  (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
     (Maybe
        (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
-> Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a. a -> Maybe a -> a
fromMaybe Maybe
  (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding Maybe
  (Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
expectedHiding }
              msg :: String
msg = ModuleName -> String
moduleNameString (LocatedA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc LocatedA ModuleName
XRec GhcPs ModuleName
ideclName) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" should be imported " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
hint
          Idea -> Either Idea ()
forall a b. a -> Either a b
Left (Idea -> Either Idea ()) -> Idea -> Either Idea ()
forall a b. (a -> b) -> a -> b
$ String
-> Located (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
msg (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Located (ImportDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
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 =
  RestrictItem -> Maybe RestrictItem -> RestrictItem
forall a. a -> Maybe a -> a
fromMaybe ([String]
-> Alt Maybe Bool
-> Alt Maybe RestrictImportStyle
-> Alt Maybe QualifiedStyle
-> [(String, String)]
-> RestrictIdents
-> Maybe String
-> RestrictItem
RestrictItem [String]
forall a. Monoid a => a
mempty Alt Maybe Bool
forall a. Monoid a => a
mempty Alt Maybe RestrictImportStyle
forall a. Monoid a => a
mempty Alt Maybe QualifiedStyle
forall a. Monoid a => a
mempty [(String
"",String
"") | Bool
def] RestrictIdents
NoRestrictIdents Maybe String
forall a. Maybe a
Nothing)
    (Maybe RestrictItem -> RestrictItem)
-> (Map String RestrictItem -> Maybe RestrictItem)
-> Map String RestrictItem
-> RestrictItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (ModuleName -> String) -> ModuleName -> String
forall a b. (a -> b) -> a -> b
$ LocatedA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc LocatedA ModuleName
ideclName
        exact :: Maybe RestrictItem
exact = String -> Map String RestrictItem -> Maybe RestrictItem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
moduleName Map String RestrictItem
mp
        wildcard :: Maybe (NonEmpty RestrictItem)
wildcard = [RestrictItem] -> Maybe (NonEmpty RestrictItem)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
            ([RestrictItem] -> Maybe (NonEmpty RestrictItem))
-> ([(String, RestrictItem)] -> [RestrictItem])
-> [(String, RestrictItem)]
-> Maybe (NonEmpty RestrictItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, RestrictItem) -> RestrictItem)
-> [(String, RestrictItem)] -> [RestrictItem]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, RestrictItem) -> RestrictItem
forall a b. (a, b) -> b
snd
            ([(String, RestrictItem)] -> [RestrictItem])
-> ([(String, RestrictItem)] -> [(String, RestrictItem)])
-> [(String, RestrictItem)]
-> [RestrictItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, RestrictItem)] -> [(String, RestrictItem)]
forall a. [a] -> [a]
reverse -- the hope is less specific matches will end up last, but it's not guaranteed
            ([(String, RestrictItem)] -> [(String, RestrictItem)])
-> ([(String, RestrictItem)] -> [(String, RestrictItem)])
-> [(String, RestrictItem)]
-> [(String, RestrictItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, RestrictItem) -> Bool)
-> [(String, RestrictItem)] -> [(String, RestrictItem)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool)
-> (String -> Bool) -> (String -> Bool) -> String -> Bool
forall a b c.
(a -> b -> c) -> (String -> a) -> (String -> b) -> String -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
'*') (String -> String -> Bool
`wildcardMatch` String
moduleName) (String -> Bool)
-> ((String, RestrictItem) -> String)
-> (String, RestrictItem)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, RestrictItem) -> String
forall a b. (a, b) -> a
fst)
            ([(String, RestrictItem)] -> Maybe (NonEmpty RestrictItem))
-> [(String, RestrictItem)] -> Maybe (NonEmpty RestrictItem)
forall a b. (a -> b) -> a -> b
$ Map String RestrictItem -> [(String, RestrictItem)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String RestrictItem
mp
    in Maybe RestrictItem
exact Maybe RestrictItem -> Maybe RestrictItem -> Maybe RestrictItem
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Maybe RestrictItem) -> Maybe RestrictItem
forall a. Semigroup a => NonEmpty a -> a
sconcat (Maybe (NonEmpty RestrictItem) -> NonEmpty (Maybe RestrictItem)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
sequence Maybe (NonEmpty RestrictItem)
wildcard)

importListToIdents :: IE GhcPs -> [String]
importListToIdents :: IE GhcPs -> [String]
importListToIdents =
  [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> [String])
-> (IE GhcPs -> [Maybe String]) -> IE GhcPs -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  \case (IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
n)              -> [LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n]
        (IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
n)         -> [LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n]
        (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
n)         -> [LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n]
        (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
n IEWildcard
_ [LIEWrappedName (IdP GhcPs)]
ns)   -> LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
n Maybe String -> [Maybe String] -> [Maybe String]
forall a. a -> [a] -> [a]
: (LIEWrappedName RdrName -> Maybe String)
-> [LIEWrappedName RdrName] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map LIEWrappedName (IdP GhcPs) -> Maybe String
LIEWrappedName RdrName -> Maybe String
fromName [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
ns
        IE GhcPs
_                        -> []
  where
    fromName :: LIEWrappedName (IdP GhcPs) -> Maybe String
    fromName :: LIEWrappedName (IdP GhcPs) -> Maybe String
fromName LIEWrappedName (IdP GhcPs)
wrapped =
      case LIEWrappedName RdrName -> IEWrappedName RdrName
forall l e. GenLocated l e -> e
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
wrapped of
        IEName      LocatedN RdrName
n -> IdP GhcPs -> Maybe String
fromId (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
n)
        IEPattern EpaLocation
_ LocatedN RdrName
n -> (String
"pattern " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdP GhcPs -> Maybe String
fromId (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
n)
        IEType    EpaLocation
_ LocatedN RdrName
n -> (String
"type " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdP GhcPs -> Maybe String
fromId (LocatedN RdrName -> RdrName
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) = 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 ModuleName
_ OccName
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 Module
_ OccName
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 Name
_)  = Maybe String
forall a. Maybe a
Nothing

checkFunctions :: Scope -> String -> [LHsDecl GhcPs] -> RestrictFunctions -> [Idea]
checkFunctions :: Scope -> String -> [LHsDecl GhcPs] -> RestrictFunctions -> [Idea]
checkFunctions Scope
scope String
modu [LHsDecl GhcPs]
decls (Bool
def, Map String RestrictFunction
mp) =
    [ (Maybe String -> Idea -> Idea
ideaMessage Maybe String
message (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ Idea -> Idea
ideaNoTo (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ String
-> Located RdrName
-> Located RdrName
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Avoid restricted function" (LocatedN RdrName -> Located RdrName
forall a. LocatedN a -> Located a
reLocN LocatedN RdrName
x) (LocatedN RdrName -> Located RdrName
forall a. LocatedN a -> Located a
reLocN LocatedN RdrName
x) []){ideaDecl :: [String]
ideaDecl = [String
dname]}
    | GenLocated SrcSpanAnnA (HsDecl GhcPs)
d <- [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl GhcPs]
decls
    , let dname :: String
dname = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (LHsDecl GhcPs -> Maybe String
declName GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl GhcPs
d)
    , LocatedN RdrName
x <- GenLocated SrcSpanAnnA (HsDecl GhcPs) -> [LocatedN RdrName]
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) = ([(String, String)], Maybe String)
-> Maybe ([(String, String)], Maybe String)
-> ([(String, String)], Maybe String)
forall a. a -> Maybe a -> a
fromMaybe ([(String
"",String
"") | Bool
def], Maybe String
forall a. Maybe a
Nothing) (Map String RestrictFunction
-> LocatedN RdrName
-> [ModuleName]
-> Maybe ([(String, String)], Maybe String)
findFunction Map String RestrictFunction
mp LocatedN RdrName
x [ModuleName]
xMods)
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> String -> [(String, String)] -> Bool
within String
modu String
dname [(String, String)]
withins
    ]

-- Returns Just iff there are rules for x, which are either unqualified, or qualified with a module that is
-- one of x's possible modules.
-- If there are multiple matching rules (e.g., there's both an unqualified version and a qualified version), their
-- withins and messages are concatenated with (<>).
findFunction
    :: Map.Map String RestrictFunction
    -> 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) ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
moduleNameString -> [String]
possMods) = do
    (RestrictFun Map (Maybe String) ([(String, String)], Maybe String)
mp) <- String -> Map String RestrictFunction -> Maybe RestrictFunction
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
x Map String RestrictFunction
restrictMap
    NonEmpty ([(String, String)], Maybe String)
n <- [([(String, String)], Maybe String)]
-> Maybe (NonEmpty ([(String, String)], Maybe String))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([([(String, String)], Maybe String)]
 -> Maybe (NonEmpty ([(String, String)], Maybe String)))
-> (Map (Maybe String) ([(String, String)], Maybe String)
    -> [([(String, String)], Maybe String)])
-> Map (Maybe String) ([(String, String)], Maybe String)
-> Maybe (NonEmpty ([(String, String)], Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Maybe String) ([(String, String)], Maybe String)
-> [([(String, String)], Maybe String)]
forall k a. Map k a -> [a]
Map.elems (Map (Maybe String) ([(String, String)], Maybe String)
 -> Maybe (NonEmpty ([(String, String)], Maybe String)))
-> Map (Maybe String) ([(String, String)], Maybe String)
-> Maybe (NonEmpty ([(String, String)], Maybe String))
forall a b. (a -> b) -> a -> b
$ (Maybe String -> ([(String, String)], Maybe String) -> Bool)
-> Map (Maybe String) ([(String, String)], Maybe String)
-> Map (Maybe String) ([(String, String)], Maybe String)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (Bool -> ([(String, String)], Maybe String) -> Bool
forall a b. a -> b -> a
const (Bool -> ([(String, String)], Maybe String) -> Bool)
-> (Maybe String -> Bool)
-> Maybe String
-> ([(String, String)], Maybe String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
possMods)) Map (Maybe String) ([(String, String)], Maybe String)
mp
    ([(String, String)], Maybe String)
-> Maybe ([(String, String)], Maybe String)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty ([(String, String)], Maybe String)
-> ([(String, String)], Maybe String)
forall a. Semigroup a => NonEmpty a -> a
sconcat NonEmpty ([(String, String)], Maybe String)
n)