{-# LANGUAGE ExistentialQuantification, RecordWildCards, ScopedTypeVariables #-}
{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving #-}
module Development.Shake.Internal.Value(
QTypeRep(..),
Value, newValue, fromValue,
Key, newKey, fromKey, typeKey,
ShakeValue
) where
import Development.Shake.Classes
import Development.Shake.Internal.Errors
import Data.Typeable.Extra
import Numeric
import Data.Bits
import Unsafe.Coerce
newtype QTypeRep = QTypeRep {QTypeRep -> TypeRep
fromQTypeRep :: TypeRep}
deriving (QTypeRep -> QTypeRep -> Bool
(QTypeRep -> QTypeRep -> Bool)
-> (QTypeRep -> QTypeRep -> Bool) -> Eq QTypeRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QTypeRep -> QTypeRep -> Bool
$c/= :: QTypeRep -> QTypeRep -> Bool
== :: QTypeRep -> QTypeRep -> Bool
$c== :: QTypeRep -> QTypeRep -> Bool
Eq,Int -> QTypeRep -> Int
QTypeRep -> Int
(Int -> QTypeRep -> Int) -> (QTypeRep -> Int) -> Hashable QTypeRep
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: QTypeRep -> Int
$chash :: QTypeRep -> Int
hashWithSalt :: Int -> QTypeRep -> Int
$chashWithSalt :: Int -> QTypeRep -> Int
Hashable)
instance NFData QTypeRep where
rnf :: QTypeRep -> ()
rnf (QTypeRep x :: TypeRep
x) = TypeRep
x TypeRep -> () -> ()
forall a b. a -> b -> b
`seq` ()
instance Show QTypeRep where
show :: QTypeRep -> String
show (QTypeRep x :: TypeRep
x) = TypeRep -> String
forall a. Show a => a -> String
show TypeRep
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ " {" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> TypeRep -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt 0 TypeRep
x) "" String -> ShowS
forall a. [a] -> [a] -> [a]
++ "}"
type ShakeValue a = (Show a, Typeable a, Eq a, Hashable a, Binary a, NFData a)
data Key = forall a . Key
{Key -> TypeRep
keyType :: TypeRep
,()
keyShow :: a -> String
,()
keyRnf :: a -> ()
,()
keyEq :: a -> a -> Bool
,()
keyHash :: Int -> a -> Int
,()
keyValue :: a
}
data Value = forall a . Value
{Value -> TypeRep
valueType :: TypeRep
,()
valueShow :: a -> String
,()
valueRnf :: a -> ()
,()
valueValue :: a
}
newKey :: forall a . ShakeValue a => a -> Key
newKey :: a -> Key
newKey = TypeRep
-> (a -> String)
-> (a -> ())
-> (a -> a -> Bool)
-> (Int -> a -> Int)
-> a
-> Key
forall a.
TypeRep
-> (a -> String)
-> (a -> ())
-> (a -> a -> Bool)
-> (Int -> a -> Int)
-> a
-> Key
Key (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) a -> String
forall a. Show a => a -> String
show a -> ()
forall a. NFData a => a -> ()
rnf a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt
newValue :: forall a . (Typeable a, Show a, NFData a) => a -> Value
newValue :: a -> Value
newValue = TypeRep -> (a -> String) -> (a -> ()) -> a -> Value
forall a. TypeRep -> (a -> String) -> (a -> ()) -> a -> Value
Value (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) a -> String
forall a. Show a => a -> String
show a -> ()
forall a. NFData a => a -> ()
rnf
typeKey :: Key -> TypeRep
typeKey :: Key -> TypeRep
typeKey Key{..} = TypeRep
keyType
fromKey :: forall a . Typeable a => Key -> a
fromKey :: Key -> a
fromKey Key{..}
| TypeRep
keyType TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep
resType = a -> a
forall a b. a -> b
unsafeCoerce a
keyValue
| Bool
otherwise = String -> a
forall a. String -> a
errorInternal (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "fromKey, bad cast, have " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show TypeRep
keyType String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", wanted " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show TypeRep
resType
where resType :: TypeRep
resType = Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
fromValue :: forall a . Typeable a => Value -> a
fromValue :: Value -> a
fromValue Value{..}
| TypeRep
valueType TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep
resType = a -> a
forall a b. a -> b
unsafeCoerce a
valueValue
| Bool
otherwise = String -> a
forall a. String -> a
errorInternal (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "fromValue, bad cast, have " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show TypeRep
valueType String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", wanted " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show TypeRep
resType
where resType :: TypeRep
resType = Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance Show Key where
show :: Key -> String
show Key{..} = a -> String
keyShow a
keyValue
instance Show Value where
show :: Value -> String
show Value{..} = a -> String
valueShow a
valueValue
instance NFData Key where
rnf :: Key -> ()
rnf Key{..} = a -> ()
keyRnf a
keyValue
instance NFData Value where
rnf :: Value -> ()
rnf Value{..} = a -> ()
valueRnf a
valueValue
instance Hashable Key where
hashWithSalt :: Int -> Key -> Int
hashWithSalt salt :: Int
salt Key{..} = Int -> TypeRep -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt TypeRep
keyType Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int -> a -> Int
keyHash Int
salt a
keyValue
instance Eq Key where
Key{keyType :: Key -> TypeRep
keyType=TypeRep
at,keyValue :: ()
keyValue=a
a,keyEq :: ()
keyEq=a -> a -> Bool
eq} == :: Key -> Key -> Bool
== Key{keyType :: Key -> TypeRep
keyType=TypeRep
bt,keyValue :: ()
keyValue=a
b}
| TypeRep
at TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= TypeRep
bt = Bool
False
| Bool
otherwise = a -> a -> Bool
eq a
a (a -> a
forall a b. a -> b
unsafeCoerce a
b)