-- | This stuff here is related to supporting the Safe Haskell extension,
-- primarily about storing under what trust type a module has been compiled.
module GHC.Types.SafeHaskell
   ( IsSafeImport
   , SafeHaskellMode(..)
   , IfaceTrustInfo
   , getSafeMode
   , setSafeMode
   , noIfaceTrustInfo
   )
where

import GHC.Prelude

import GHC.Utils.Binary
import GHC.Utils.Outputable

import Data.Word


-- | Is an import a safe import?
type IsSafeImport = Bool

-- | The various Safe Haskell modes
data SafeHaskellMode
   = Sf_None          -- ^ inferred unsafe
   | Sf_Unsafe        -- ^ declared and checked
   | Sf_Trustworthy   -- ^ declared and checked
   | Sf_Safe          -- ^ declared and checked
   | Sf_SafeInferred  -- ^ inferred as safe
   | Sf_Ignore        -- ^ @-fno-safe-haskell@ state
   deriving (SafeHaskellMode -> SafeHaskellMode -> Bool
(SafeHaskellMode -> SafeHaskellMode -> Bool)
-> (SafeHaskellMode -> SafeHaskellMode -> Bool)
-> Eq SafeHaskellMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SafeHaskellMode -> SafeHaskellMode -> Bool
== :: SafeHaskellMode -> SafeHaskellMode -> Bool
$c/= :: SafeHaskellMode -> SafeHaskellMode -> Bool
/= :: SafeHaskellMode -> SafeHaskellMode -> Bool
Eq)

instance Show SafeHaskellMode where
    show :: SafeHaskellMode -> String
show SafeHaskellMode
Sf_None         = String
"None"
    show SafeHaskellMode
Sf_Unsafe       = String
"Unsafe"
    show SafeHaskellMode
Sf_Trustworthy  = String
"Trustworthy"
    show SafeHaskellMode
Sf_Safe         = String
"Safe"
    show SafeHaskellMode
Sf_SafeInferred = String
"Safe-Inferred"
    show SafeHaskellMode
Sf_Ignore       = String
"Ignore"

instance Outputable SafeHaskellMode where
    ppr :: SafeHaskellMode -> SDoc
ppr = String -> SDoc
text (String -> SDoc)
-> (SafeHaskellMode -> String) -> SafeHaskellMode -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHaskellMode -> String
forall a. Show a => a -> String
show

-- | Safe Haskell information for 'ModIface'
-- Simply a wrapper around SafeHaskellMode to sepperate iface and flags
newtype IfaceTrustInfo = TrustInfo SafeHaskellMode

getSafeMode :: IfaceTrustInfo -> SafeHaskellMode
getSafeMode :: IfaceTrustInfo -> SafeHaskellMode
getSafeMode (TrustInfo SafeHaskellMode
x) = SafeHaskellMode
x

setSafeMode :: SafeHaskellMode -> IfaceTrustInfo
setSafeMode :: SafeHaskellMode -> IfaceTrustInfo
setSafeMode = SafeHaskellMode -> IfaceTrustInfo
TrustInfo

noIfaceTrustInfo :: IfaceTrustInfo
noIfaceTrustInfo :: IfaceTrustInfo
noIfaceTrustInfo = SafeHaskellMode -> IfaceTrustInfo
setSafeMode SafeHaskellMode
Sf_None

trustInfoToNum :: IfaceTrustInfo -> Word8
trustInfoToNum :: IfaceTrustInfo -> Word8
trustInfoToNum IfaceTrustInfo
it
  = case IfaceTrustInfo -> SafeHaskellMode
getSafeMode IfaceTrustInfo
it of
            SafeHaskellMode
Sf_None         -> Word8
0
            SafeHaskellMode
Sf_Unsafe       -> Word8
1
            SafeHaskellMode
Sf_Trustworthy  -> Word8
2
            SafeHaskellMode
Sf_Safe         -> Word8
3
            SafeHaskellMode
Sf_SafeInferred -> Word8
4
            SafeHaskellMode
Sf_Ignore       -> Word8
0

numToTrustInfo :: Word8 -> IfaceTrustInfo
numToTrustInfo :: Word8 -> IfaceTrustInfo
numToTrustInfo Word8
0 = SafeHaskellMode -> IfaceTrustInfo
setSafeMode SafeHaskellMode
Sf_None
numToTrustInfo Word8
1 = SafeHaskellMode -> IfaceTrustInfo
setSafeMode SafeHaskellMode
Sf_Unsafe
numToTrustInfo Word8
2 = SafeHaskellMode -> IfaceTrustInfo
setSafeMode SafeHaskellMode
Sf_Trustworthy
numToTrustInfo Word8
3 = SafeHaskellMode -> IfaceTrustInfo
setSafeMode SafeHaskellMode
Sf_Safe
numToTrustInfo Word8
4 = SafeHaskellMode -> IfaceTrustInfo
setSafeMode SafeHaskellMode
Sf_SafeInferred
numToTrustInfo Word8
n = String -> IfaceTrustInfo
forall a. HasCallStack => String -> a
error (String -> IfaceTrustInfo) -> String -> IfaceTrustInfo
forall a b. (a -> b) -> a -> b
$ String
"numToTrustInfo: bad input number! (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance Outputable IfaceTrustInfo where
    ppr :: IfaceTrustInfo -> SDoc
ppr (TrustInfo SafeHaskellMode
Sf_None)          = String -> SDoc
text String
"none"
    ppr (TrustInfo SafeHaskellMode
Sf_Ignore)        = String -> SDoc
text String
"none"
    ppr (TrustInfo SafeHaskellMode
Sf_Unsafe)        = String -> SDoc
text String
"unsafe"
    ppr (TrustInfo SafeHaskellMode
Sf_Trustworthy)   = String -> SDoc
text String
"trustworthy"
    ppr (TrustInfo SafeHaskellMode
Sf_Safe)          = String -> SDoc
text String
"safe"
    ppr (TrustInfo SafeHaskellMode
Sf_SafeInferred)  = String -> SDoc
text String
"safe-inferred"

instance Binary IfaceTrustInfo where
    put_ :: BinHandle -> IfaceTrustInfo -> IO ()
put_ BinHandle
bh IfaceTrustInfo
iftrust = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ IfaceTrustInfo -> Word8
trustInfoToNum IfaceTrustInfo
iftrust
    get :: BinHandle -> IO IfaceTrustInfo
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO IfaceTrustInfo) -> IO IfaceTrustInfo
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IfaceTrustInfo -> IO IfaceTrustInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTrustInfo -> IO IfaceTrustInfo)
-> (Word8 -> IfaceTrustInfo) -> Word8 -> IO IfaceTrustInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> IfaceTrustInfo
numToTrustInfo)