{-# LANGUAGE ExistentialQuantification, RecordWildCards, ScopedTypeVariables #-}
{-# LANGUAGE ConstraintKinds #-}

-- | This module implements the Key/Value types, to abstract over hetrogenous data types.
module Development.Shake.Internal.Value(
    Value, newValue, fromValue,
    Key, newKey, fromKey, typeKey,
    ShakeValue
    ) where

import Development.Shake.Classes
import Development.Shake.Internal.Errors
import Data.Typeable

import Unsafe.Coerce


-- | Define an alias for the six type classes required for things involved in Shake rules.
--   Using this alias requires the @ConstraintKinds@ extension.
--
--   To define your own values meeting the necessary constraints it is convenient to use the extensions
--   @GeneralizedNewtypeDeriving@ and @DeriveDataTypeable@ to write:
--
-- > newtype MyType = MyType (String, Bool) deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
--
--   Shake needs these instances on keys and values. They are used for:
--
-- * 'Show' is used to print out keys in errors, profiling, progress messages
--   and diagnostics.
--
-- * 'Typeable' is used because Shake indexes its database by the
--   type of the key and value involved in the rule (overlap is not
--   allowed for type classes and not allowed in Shake either).
--
-- * 'Eq' and 'Hashable' are used on keys in order to build hash maps
--   from keys to values.  'Eq' is used on values to test if the value
--   has changed or not (this is used to support unchanging rebuilds,
--   where Shake can avoid rerunning rules if it runs a dependency,
--   but it turns out that no changes occurred.)  The 'Hashable'
--   instances are only use at runtime (never serialised to disk),
--   so they do not have to be stable across runs.
--   Hashable on values is not used, and only required for a consistent interface.
--
-- * 'Binary' is used to serialize keys and values into Shake's
--   build database; this lets Shake cache values across runs and
--   implement unchanging rebuilds.
--
-- * 'NFData' is used to avoid space and thunk leaks, especially
--   when Shake is parallelized.
type ShakeValue a = (Show a, Typeable a, Eq a, Hashable a, Binary a, NFData a)

-- We deliberately avoid Typeable instances on Key/Value to stop them accidentally
-- being used inside themselves
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{a
TypeRep
a -> String
a -> ()
a -> a -> Bool
Int -> a -> Int
keyValue :: a
keyHash :: Int -> a -> Int
keyEq :: a -> a -> Bool
keyRnf :: a -> ()
keyShow :: a -> String
keyType :: TypeRep
keyValue :: ()
keyHash :: ()
keyEq :: ()
keyRnf :: ()
keyShow :: ()
keyType :: Key -> TypeRep
..} = TypeRep
keyType

fromKey :: forall a . Typeable a => Key -> a
fromKey :: Key -> a
fromKey Key{a
TypeRep
a -> String
a -> ()
a -> a -> Bool
Int -> a -> Int
keyValue :: a
keyHash :: Int -> a -> Int
keyEq :: a -> a -> Bool
keyRnf :: a -> ()
keyShow :: a -> String
keyType :: TypeRep
keyValue :: ()
keyHash :: ()
keyEq :: ()
keyRnf :: ()
keyShow :: ()
keyType :: Key -> TypeRep
..}
    | 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 = SomeException -> a
forall a. SomeException -> a
throwImpure (SomeException -> a) -> SomeException -> a
forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
String -> SomeException
errorInternal (String -> SomeException) -> String -> SomeException
forall a b. (a -> b) -> a -> b
$ String
"fromKey, bad cast, have " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show TypeRep
keyType String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", wanted " String -> String -> String
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{a
TypeRep
a -> String
a -> ()
valueValue :: a
valueRnf :: a -> ()
valueShow :: a -> String
valueType :: TypeRep
valueValue :: ()
valueRnf :: ()
valueShow :: ()
valueType :: Value -> TypeRep
..}
    | 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 = SomeException -> a
forall a. SomeException -> a
throwImpure (SomeException -> a) -> SomeException -> a
forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
String -> SomeException
errorInternal (String -> SomeException) -> String -> SomeException
forall a b. (a -> b) -> a -> b
$ String
"fromValue, bad cast, have " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show TypeRep
valueType String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", wanted " String -> String -> String
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
TypeRep
a -> String
a -> ()
a -> a -> Bool
Int -> a -> Int
keyValue :: a
keyHash :: Int -> a -> Int
keyEq :: a -> a -> Bool
keyRnf :: a -> ()
keyShow :: a -> String
keyType :: TypeRep
keyValue :: ()
keyHash :: ()
keyEq :: ()
keyRnf :: ()
keyShow :: ()
keyType :: Key -> TypeRep
..} = a -> String
keyShow a
keyValue

instance Show Value where
    show :: Value -> String
show Value{a
TypeRep
a -> String
a -> ()
valueValue :: a
valueRnf :: a -> ()
valueShow :: a -> String
valueType :: TypeRep
valueValue :: ()
valueRnf :: ()
valueShow :: ()
valueType :: Value -> TypeRep
..} = a -> String
valueShow a
valueValue

instance NFData Key where
    rnf :: Key -> ()
rnf Key{a
TypeRep
a -> String
a -> ()
a -> a -> Bool
Int -> a -> Int
keyValue :: a
keyHash :: Int -> a -> Int
keyEq :: a -> a -> Bool
keyRnf :: a -> ()
keyShow :: a -> String
keyType :: TypeRep
keyValue :: ()
keyHash :: ()
keyEq :: ()
keyRnf :: ()
keyShow :: ()
keyType :: Key -> TypeRep
..} = a -> ()
keyRnf a
keyValue

instance NFData Value where
    rnf :: Value -> ()
rnf Value{a
TypeRep
a -> String
a -> ()
valueValue :: a
valueRnf :: a -> ()
valueShow :: a -> String
valueType :: TypeRep
valueValue :: ()
valueRnf :: ()
valueShow :: ()
valueType :: Value -> TypeRep
..} = a -> ()
valueRnf a
valueValue

instance Hashable Key where
    hash :: Key -> Int
hash Key{a
TypeRep
a -> String
a -> ()
a -> a -> Bool
Int -> a -> Int
keyValue :: a
keyHash :: Int -> a -> Int
keyEq :: a -> a -> Bool
keyRnf :: a -> ()
keyShow :: a -> String
keyType :: TypeRep
keyValue :: ()
keyHash :: ()
keyEq :: ()
keyRnf :: ()
keyShow :: ()
keyType :: Key -> TypeRep
..} = Int -> a -> Int
keyHash (TypeRep -> Int
forall a. Hashable a => a -> Int
hash TypeRep
keyType) a
keyValue
    hashWithSalt :: Int -> Key -> Int
hashWithSalt Int
salt Key{a
TypeRep
a -> String
a -> ()
a -> a -> Bool
Int -> a -> Int
keyValue :: a
keyHash :: Int -> a -> Int
keyEq :: a -> a -> Bool
keyRnf :: a -> ()
keyShow :: a -> String
keyType :: TypeRep
keyValue :: ()
keyHash :: ()
keyEq :: ()
keyRnf :: ()
keyShow :: ()
keyType :: Key -> TypeRep
..} = Int -> a -> Int
keyHash (Int -> TypeRep -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt TypeRep
keyType) 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)