module Mueval.Context (cleanModules, defaultModules, unsafe) where

import Data.List (elem, isInfixOf)

{- | Return true if the String contains anywhere in it any keywords associated
   with dangerous functions. Unfortunately, this blacklist leaks like a sieve
   and will return many false positives (eg. 'unsafed "id \"unsafed\""' will
   evaluate to True, even though the phrase \"unsafe\" appears only in a String). But it
   will at least catch naive and simplistic invocations of "unsafePerformIO",
   "inlinePerformIO", and "unsafeCoerce". -}
unsafe :: String -> Bool
unsafe = \z -> any (`isInfixOf` z) ["unsafe", "inlinePerform", "liftIO", "Coerce", "Foreign",
                                    "Typeable", "Array", "IOBase", "Handle", "ByteString",
                                    "Editline", "GLUT", "lock", "ObjectIO", "System.Time",
                                    "OpenGL", "Control.Concurrent", "System.Posix",
                                    "throw", "Dyn", "cache", "stdin", "stdout", "stderr"]

-- | Return false if any of the listed modules cannot be found in the whitelist.
cleanModules :: [String] -> Bool
cleanModules = and . map (`elem` safeModules)

{- | Modules which we should load by default. These are of course whitelisted.
   Specifically, we want the Prelude because otherwise things are horribly
   crippled; we want SimpleReflect so we can do neat things (for said neat
   things, see
   <http://twan.home.fmf.nl/blog/haskell/simple-reflection-of-expressions.details>);
   and we want ShowQ and ShowFun to neuter IO stuff even more.
   The rest should be safe to import without clashes, according to the Lambdabot
   sources. -}
defaultModules :: [String]
defaultModules = ["Prelude", "ShowQ", "ShowFun", "SimpleReflect", "Data.Function",
               "Control.Monad",
               "Control.Monad.Cont",
               "Control.Monad.Error",
               "Control.Monad.Fix",
               "Control.Monad.Identity",
               "Control.Monad.Instances",
               "Control.Monad.RWS",
               "Control.Monad.Reader",
               "Control.Monad.ST",
               "Control.Monad.State",
               "Control.Monad.State",
               "Control.Monad.Writer",
               "Control.Parallel",
               "Control.Parallel.Strategies",
               "Data.Array",
               "Data.Bits",
               "Data.Bool",
               "Data.Char",
               "Data.Complex",
               "Data.Dynamic",
               "Data.Either",
               "Data.Eq",
               "Data.Fixed",
               "Data.Graph",
               "Data.Int",
               "Data.Ix",
               "Data.List",
               "Data.Maybe",
               "Data.Monoid",
               "Data.Number.BigFloat",
               "Data.Number.CReal",
               "Data.Number.Dif",
               "Data.Number.Fixed",
               "Data.Number.Interval",
               "Data.Number.Natural",
               "Data.Number.Symbolic",
               "Data.Ord",
               "Data.Ratio",
               "Data.Tree",
               "Data.Tuple",
               "Data.Typeable",
               "Data.Word",
               "Math.OEIS",
               "System.Random",
               "Test.QuickCheck",
               "Text.PrettyPrint.HughesPJ",
               "Text.Printf"]

{- | Borrowed from Lambdabot, this is the whitelist of modules which should be
   safe to import functions from, but which we don't want to import by
   default.
   FIXME: make these qualified imports. The GHC API & Hint currently do not
   support qualified imports.
   WARNING: You can import these with --module, certainly, but the onus is on
   the user to make sure they fully disambiguate function names; ie:

   > mueval  --module Data.Map -e "Prelude.map (+1) [1..100]"
-}
safeModules :: [String]
safeModules = defaultModules ++ ["Control.Applicative",
               "Control.Arrow",
               "Control.Arrow.Operations",
               "Control.Arrow.Transformer",
               "Control.Arrow.Transformer.All",
               "Data.ByteString",
               "Data.ByteString.Char8",
               "Data.ByteString.Lazy",
               "Data.ByteString.Lazy.Char8",
               "Data.Foldable",
               "Data.Generics",
               "Data.IntMap",
               "Data.IntSet",
               "Data.Map",
               "Data.Sequence",
               "Data.Set",
               "Data.Traversable"]