{-# LANGUAGE RecordWildCards #-}

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 = unsafePerformIO $ print 1
foo = unsafePerformOI
</TEST>
-}

import qualified Data.Map as Map
import Config.Type
import Hint.Type
import Data.List
import Data.Maybe
import Data.Semigroup
import Control.Applicative
import Prelude


-- FIXME: The settings should be partially applied, but that's hard to orchestrate right now
restrictHint :: [Setting] -> ModuHint
restrictHint :: [Setting] -> ModuHint
restrictHint settings :: [Setting]
settings scope :: Scope
scope m :: Module_
m =
        String
-> [ModulePragma S]
-> Map RestrictType (Bool, Map String RestrictItem)
-> [Idea]
checkPragmas String
modu (Module_ -> [ModulePragma S]
modulePragmas Module_
m) Map RestrictType (Bool, Map String RestrictItem)
restrict [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
-> [ImportDecl S] -> (Bool, Map String RestrictItem) -> [Idea]
checkImports String
modu ([ImportDecl S] -> (Bool, Map String RestrictItem) -> [Idea])
-> [ImportDecl S] -> (Bool, Map String RestrictItem) -> [Idea]
forall a b. (a -> b) -> a -> b
$ Module_ -> [ImportDecl S]
moduleImports Module_
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)
restrict) [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 -> [Decl_] -> (Bool, Map String RestrictItem) -> [Idea]
checkFunctions String
modu ([Decl_] -> (Bool, Map String RestrictItem) -> [Idea])
-> [Decl_] -> (Bool, Map String RestrictItem) -> [Idea]
forall a b. (a -> b) -> a -> b
$ Module_ -> [Decl_]
moduleDecls Module_
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
RestrictFunction Map RestrictType (Bool, Map String RestrictItem)
restrict)
    where
        modu :: String
modu = Module_ -> String
moduleName Module_
m
        restrict :: Map RestrictType (Bool, Map String RestrictItem)
restrict = [Setting] -> Map RestrictType (Bool, Map String RestrictItem)
restrictions [Setting]
settings

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

data RestrictItem = RestrictItem
    {RestrictItem -> [String]
riAs :: [String]
    ,RestrictItem -> [(String, String)]
riWithin :: [(String, String)]
    }
instance Semigroup RestrictItem where
    RestrictItem x1 :: [String]
x1 x2 :: [(String, String)]
x2 <> :: RestrictItem -> RestrictItem -> RestrictItem
<> RestrictItem y1 :: [String]
y1 y2 :: [(String, String)]
y2 = [String] -> [(String, String)] -> RestrictItem
RestrictItem ([String]
x1[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>[String]
y1) ([(String, String)]
x2[(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<>[(String, String)]
y2)
instance Monoid RestrictItem where
    mempty :: RestrictItem
mempty = [String] -> [(String, String)] -> RestrictItem
RestrictItem [] []
    mappend :: RestrictItem -> RestrictItem -> RestrictItem
mappend = RestrictItem -> RestrictItem -> RestrictItem
forall a. Semigroup a => a -> a -> a
(<>)

restrictions :: [Setting] -> Map.Map RestrictType (Bool, Map.Map String RestrictItem)
restrictions :: [Setting] -> Map RestrictType (Bool, Map String RestrictItem)
restrictions settings :: [Setting]
settings = ([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]
(++) [(Restrict -> RestrictType
restrictType Restrict
x, [Restrict
x]) | SettingRestrict x :: Restrict
x <- [Setting]
settings]
    where
        f :: [Restrict] -> (Bool, Map String RestrictItem)
f rs :: [Restrict]
rs = ((Restrict -> Bool) -> [Restrict] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Restrict -> Bool
restrictDefault [Restrict]
rs
               ,(RestrictItem -> RestrictItem -> RestrictItem)
-> [(String, RestrictItem)] -> Map String RestrictItem
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith RestrictItem -> RestrictItem -> RestrictItem
forall a. Semigroup a => a -> a -> a
(<>) [(String
s, [String] -> [(String, String)] -> RestrictItem
RestrictItem [String]
restrictAs [(String, String)]
restrictWithin) | Restrict{..} <- [Restrict]
rs, String
s <- [String]
restrictName])

ideaMayBreak :: Idea -> Idea
ideaMayBreak w :: Idea
w = Idea
w{ideaNote :: [Note]
ideaNote=[String -> Note
Note "may break the code"]}
ideaNoTo :: Idea -> Idea
ideaNoTo w :: Idea
w = Idea
w{ideaTo :: Maybe String
ideaTo=Maybe String
forall a. Maybe a
Nothing}

within :: String -> String -> RestrictItem -> Bool
within :: String -> String -> RestrictItem -> Bool
within modu :: String
modu func :: String
func RestrictItem{..} = ((String, String) -> Bool) -> [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(a :: String
a,b :: String
b) -> (String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
modu Bool -> Bool -> Bool
|| String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "") Bool -> Bool -> Bool
&& (String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
func Bool -> Bool -> Bool
|| String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "")) [(String, String)]
riWithin

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

checkPragmas :: String -> [ModulePragma S] -> Map.Map RestrictType (Bool, Map.Map String RestrictItem) -> [Idea]
checkPragmas :: String
-> [ModulePragma S]
-> Map RestrictType (Bool, Map String RestrictItem)
-> [Idea]
checkPragmas modu :: String
modu xs :: [ModulePragma S]
xs mps :: Map RestrictType (Bool, Map String RestrictItem)
mps = RestrictType
-> String
-> (ModulePragma S -> Maybe ([String], [String] -> ModulePragma S))
-> [Idea]
forall a.
Pretty a =>
RestrictType
-> String
-> (ModulePragma S -> Maybe ([String], [String] -> a))
-> [Idea]
f RestrictType
RestrictFlag "flags" ModulePragma S -> Maybe ([String], [String] -> ModulePragma S)
forall l.
ModulePragma l -> Maybe ([String], [String] -> ModulePragma l)
onFlags [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ RestrictType
-> String
-> (ModulePragma S -> Maybe ([String], [String] -> ModulePragma S))
-> [Idea]
forall a.
Pretty a =>
RestrictType
-> String
-> (ModulePragma S -> Maybe ([String], [String] -> a))
-> [Idea]
f RestrictType
RestrictExtension "extensions" ModulePragma S -> Maybe ([String], [String] -> ModulePragma S)
onExtensions
    where
        f :: RestrictType
-> String
-> (ModulePragma S -> Maybe ([String], [String] -> a))
-> [Idea]
f tag :: RestrictType
tag name :: String
name sel :: ModulePragma S -> Maybe ([String], [String] -> a)
sel =
            [ (if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
good then Idea -> Idea
ideaNoTo else Idea -> Idea
forall a. a -> a
id) (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ Idea -> Idea
ideaMayBreak (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ String -> ModulePragma S -> a -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn ("Avoid restricted " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) ModulePragma S
o ([String] -> a
regen [String]
good) []
            | Just mp :: (Bool, 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]
            , ModulePragma S
o <- [ModulePragma S]
xs, Just (xs :: [String]
xs, regen :: [String] -> a
regen) <- [ModulePragma S -> Maybe ([String], [String] -> a)
sel ModulePragma S
o]
            , let (good :: [String]
good, bad :: [String]
bad) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Bool, Map String RestrictItem) -> String -> Bool
forall k. Ord k => (Bool, Map k RestrictItem) -> k -> Bool
isGood (Bool, Map String RestrictItem)
mp) [String]
xs, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
bad]

        onFlags :: ModulePragma l -> Maybe ([String], [String] -> ModulePragma l)
onFlags (OptionsPragma s :: l
s t :: Maybe Tool
t x :: String
x) = ([String], [String] -> ModulePragma l)
-> Maybe ([String], [String] -> ModulePragma l)
forall a. a -> Maybe a
Just (String -> [String]
words String
x, l -> Maybe Tool -> String -> ModulePragma l
forall l. l -> Maybe Tool -> String -> ModulePragma l
OptionsPragma l
s Maybe Tool
t (String -> ModulePragma l)
-> ([String] -> String) -> [String] -> ModulePragma l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords)
        onFlags _ = Maybe ([String], [String] -> ModulePragma l)
forall a. Maybe a
Nothing

        onExtensions :: ModulePragma S -> Maybe ([String], [String] -> ModulePragma S)
onExtensions (LanguagePragma s :: S
s xs :: [Name S]
xs) = ([String], [String] -> ModulePragma S)
-> Maybe ([String], [String] -> ModulePragma S)
forall a. a -> Maybe a
Just ((Name S -> String) -> [Name S] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Name S -> String
forall a. Named a => a -> String
fromNamed [Name S]
xs, S -> [Name S] -> ModulePragma S
forall l. l -> [Name l] -> ModulePragma l
LanguagePragma (S
s :: S) ([Name S] -> ModulePragma S)
-> ([String] -> [Name S]) -> [String] -> ModulePragma S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Name S) -> [String] -> [Name S]
forall a b. (a -> b) -> [a] -> [b]
map String -> Name S
forall a. Named a => String -> a
toNamed)
        onExtensions _ = Maybe ([String], [String] -> ModulePragma S)
forall a. Maybe a
Nothing

        isGood :: (Bool, Map k RestrictItem) -> k -> Bool
isGood (def :: Bool
def, mp :: Map k RestrictItem
mp) x :: k
x = Bool -> (RestrictItem -> Bool) -> Maybe RestrictItem -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
def (String -> String -> RestrictItem -> Bool
within String
modu "") (Maybe RestrictItem -> Bool) -> Maybe RestrictItem -> Bool
forall a b. (a -> b) -> a -> b
$ k -> Map k RestrictItem -> Maybe RestrictItem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
x Map k RestrictItem
mp


checkImports :: String -> [ImportDecl S] -> (Bool, Map.Map String RestrictItem) -> [Idea]
checkImports :: String
-> [ImportDecl S] -> (Bool, Map String RestrictItem) -> [Idea]
checkImports modu :: String
modu imp :: [ImportDecl S]
imp (def :: Bool
def, mp :: Map String RestrictItem
mp) =
    [ Idea -> Idea
ideaMayBreak (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not Bool
allowImport
      then Idea -> Idea
ideaNoTo (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ String
-> ImportDecl S -> ImportDecl S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Avoid restricted module" ImportDecl S
i ImportDecl S
i []
      else String
-> ImportDecl S -> ImportDecl S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Avoid restricted qualification" ImportDecl S
i ImportDecl S
i{importAs :: Maybe (ModuleName S)
importAs=S -> String -> ModuleName S
forall l. l -> String -> ModuleName l
ModuleName S
an (String -> ModuleName S) -> Maybe String -> Maybe (ModuleName S)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe [String]
riAs} []
    | i :: ImportDecl S
i@ImportDecl{..} <- [ImportDecl S]
imp
    , let ri :: RestrictItem
ri@RestrictItem{..} = RestrictItem -> String -> Map String RestrictItem -> RestrictItem
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault ([String] -> [(String, String)] -> RestrictItem
RestrictItem [] [("","") | Bool
def]) (ModuleName S -> String
fromModuleName ModuleName S
importModule) Map String RestrictItem
mp
    , let allowImport :: Bool
allowImport = String -> String -> RestrictItem -> Bool
within String
modu "" RestrictItem
ri
    , let allowQual :: Bool
allowQual = Bool -> (ModuleName S -> Bool) -> Maybe (ModuleName S) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\x :: ModuleName S
x -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
riAs Bool -> Bool -> Bool
|| ModuleName S -> String
fromModuleName ModuleName S
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
riAs) Maybe (ModuleName S)
importAs
    , Bool -> Bool
not Bool
allowImport Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
allowQual
    ]


checkFunctions :: String -> [Decl_] -> (Bool, Map.Map String RestrictItem) -> [Idea]
checkFunctions :: String -> [Decl_] -> (Bool, Map String RestrictItem) -> [Idea]
checkFunctions modu :: String
modu decls :: [Decl_]
decls (def :: Bool
def, mp :: Map String RestrictItem
mp) =
    [ (Idea -> Idea
ideaMayBreak (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 -> QName S -> QName S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Avoid restricted function" QName S
x QName S
x []){ideaDecl :: [String]
ideaDecl = [String
dname]}
    | Decl_
d <- [Decl_]
decls
    , let dname :: String
dname = Decl_ -> String
forall a. Named a => a -> String
fromNamed Decl_
d
    , QName S
x <- Decl_ -> [QName S]
forall from to. Biplate from to => from -> [to]
universeBi Decl_
d :: [QName S]
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> (RestrictItem -> Bool) -> Maybe RestrictItem -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
def (String -> String -> RestrictItem -> Bool
within String
modu String
dname) (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 (QName S -> String
forall a. Named a => a -> String
fromNamed QName S
x) Map String RestrictItem
mp
    ]