{-
    Find things that are unsafe

<TEST>
{-# NOINLINE slaves #-}; slaves = unsafePerformIO newIO
slaves = unsafePerformIO Multimap.newIO -- {-# NOINLINE slaves #-} ; slaves = unsafePerformIO Multimap.newIO
slaves = unsafePerformIO $ f y where foo = 1 -- {-# NOINLINE slaves #-} ; slaves = unsafePerformIO $ f y where foo = 1
slaves v = unsafePerformIO $ Multimap.newIO where foo = 1
slaves v = x where x = unsafePerformIO $ Multimap.newIO
slaves = x where x = unsafePerformIO $ Multimap.newIO -- {-# NOINLINE slaves #-} ; slaves = x where x = unsafePerformIO $ Multimap.newIO
slaves = unsafePerformIO . bar
slaves = unsafePerformIO . baz $ x -- {-# NOINLINE slaves #-} ; slaves = unsafePerformIO . baz $ x
slaves = unsafePerformIO . baz $ x -- {-# NOINLINE slaves #-} ; slaves = unsafePerformIO . baz $ x
</TEST>
-}


module Hint.Unsafe(unsafeHint) where

import Hint.Type
import Data.Char
import Refact.Types


unsafeHint :: DeclHint
unsafeHint :: DeclHint
unsafeHint _ m :: Module_
m = \d :: Decl_
d ->
        [ Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Warning "Missing NOINLINE pragma" (SrcSpanInfo -> SrcSpan
srcInfoSpan (SrcSpanInfo -> SrcSpan) -> SrcSpanInfo -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Decl_ -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Decl_
d)
            (Decl_ -> String
forall a. Pretty a => a -> String
prettyPrint Decl_
d)
            (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (Decl_ -> String
forall a. Pretty a => a -> String
prettyPrint (Decl_ -> String) -> Decl_ -> String
forall a b. (a -> b) -> a -> b
$ Name SrcSpanInfo -> Decl_
gen Name SrcSpanInfo
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Decl_ -> String
forall a. Pretty a => a -> String
prettyPrint Decl_
d)
            [] [SrcSpan -> String -> Refactoring SrcSpan
forall a. a -> String -> Refactoring a
InsertComment (Decl_ -> SrcSpan
forall (a :: * -> *). Annotated a => a SrcSpanInfo -> SrcSpan
toSS Decl_
d) (Decl_ -> String
forall a. Pretty a => a -> String
prettyPrint (Decl_ -> String) -> Decl_ -> String
forall a b. (a -> b) -> a -> b
$ Name SrcSpanInfo -> Decl_
gen Name SrcSpanInfo
x)]
        | d :: Decl_
d@(PatBind _ (PVar _ x :: Name SrcSpanInfo
x) _ _) <- [Decl_
d]
        , Decl_ -> Bool
isUnsafeDecl Decl_
d, Name SrcSpanInfo
x Name SrcSpanInfo -> [Name SrcSpanInfo] -> Bool
forall (f :: * -> *).
(Annotated f, Eq (f ())) =>
f SrcSpanInfo -> [f SrcSpanInfo] -> Bool
`notElem_` [Name SrcSpanInfo]
noinline]
    where
        gen :: Name SrcSpanInfo -> Decl_
gen x :: Name SrcSpanInfo
x = SrcSpanInfo
-> Bool
-> Maybe (Activation SrcSpanInfo)
-> QName SrcSpanInfo
-> Decl_
forall l. l -> Bool -> Maybe (Activation l) -> QName l -> Decl l
InlineSig SrcSpanInfo
an Bool
False Maybe (Activation SrcSpanInfo)
forall a. Maybe a
Nothing (QName SrcSpanInfo -> Decl_) -> QName SrcSpanInfo -> Decl_
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> Name SrcSpanInfo -> QName SrcSpanInfo
forall l. l -> Name l -> QName l
UnQual SrcSpanInfo
an Name SrcSpanInfo
x
        noinline :: [Name SrcSpanInfo]
noinline = [Name SrcSpanInfo
q | InlineSig _ False Nothing (UnQual _ q :: Name SrcSpanInfo
q) <- Module_ -> [Decl_]
moduleDecls Module_
m]

isUnsafeDecl :: Decl_ -> Bool
isUnsafeDecl :: Decl_ -> Bool
isUnsafeDecl (PatBind _ _ rhs :: Rhs SrcSpanInfo
rhs bind :: Maybe (Binds SrcSpanInfo)
bind) =
    (Exp_ -> Bool) -> [Exp_] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Exp_ -> Bool
isUnsafeApp (Rhs SrcSpanInfo -> [Exp_]
forall from to. Biplate from to => from -> [to]
childrenBi Rhs SrcSpanInfo
rhs) Bool -> Bool -> Bool
|| (Decl_ -> Bool) -> [Decl_] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Decl_ -> Bool
isUnsafeDecl (Maybe (Binds SrcSpanInfo) -> [Decl_]
forall from to. Biplate from to => from -> [to]
childrenBi Maybe (Binds SrcSpanInfo)
bind)
isUnsafeDecl _ = Bool
False

-- Am I equivalent to @unsafePerformIO x@
isUnsafeApp :: Exp_ -> Bool
isUnsafeApp :: Exp_ -> Bool
isUnsafeApp (InfixApp _ x :: Exp_
x d :: QOp SrcSpanInfo
d _) | QOp SrcSpanInfo -> Bool
isDol QOp SrcSpanInfo
d = Exp_ -> Bool
isUnsafeFun Exp_
x
isUnsafeApp (App _ x :: Exp_
x _) = Exp_ -> Bool
isUnsafeFun Exp_
x
isUnsafeApp _ = Bool
False

-- Am I equivalent to @unsafePerformIO . x@
isUnsafeFun :: Exp_ -> Bool
isUnsafeFun :: Exp_ -> Bool
isUnsafeFun (Var _ x :: QName SrcSpanInfo
x) | QName SrcSpanInfo
x QName SrcSpanInfo -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "unsafePerformIO" = Bool
True
isUnsafeFun (InfixApp _ x :: Exp_
x d :: QOp SrcSpanInfo
d _) | QOp SrcSpanInfo -> Bool
isDot QOp SrcSpanInfo
d = Exp_ -> Bool
isUnsafeFun Exp_
x
isUnsafeFun _ = Bool
False