-- | An abstract key/value store.
module Build.Store (
    -- * Hashing
    Hash, Hashable (..),

    -- * Store
    Store, getValue, putValue, getHash, getInfo, putInfo, mapInfo,
    initialise
    ) where

-- | A 'Hash' is used for efficient tracking and sharing of build results. We
-- use @newtype Hash a = Hash a@ for prototyping.
newtype Hash a = Hash a deriving (Hash a -> Hash a -> Bool
(Hash a -> Hash a -> Bool)
-> (Hash a -> Hash a -> Bool) -> Eq (Hash a)
forall a. Eq a => Hash a -> Hash a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Hash a -> Hash a -> Bool
== :: Hash a -> Hash a -> Bool
$c/= :: forall a. Eq a => Hash a -> Hash a -> Bool
/= :: Hash a -> Hash a -> Bool
Eq, Eq (Hash a)
Eq (Hash a) =>
(Hash a -> Hash a -> Ordering)
-> (Hash a -> Hash a -> Bool)
-> (Hash a -> Hash a -> Bool)
-> (Hash a -> Hash a -> Bool)
-> (Hash a -> Hash a -> Bool)
-> (Hash a -> Hash a -> Hash a)
-> (Hash a -> Hash a -> Hash a)
-> Ord (Hash a)
Hash a -> Hash a -> Bool
Hash a -> Hash a -> Ordering
Hash a -> Hash a -> Hash a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Hash a)
forall a. Ord a => Hash a -> Hash a -> Bool
forall a. Ord a => Hash a -> Hash a -> Ordering
forall a. Ord a => Hash a -> Hash a -> Hash a
$ccompare :: forall a. Ord a => Hash a -> Hash a -> Ordering
compare :: Hash a -> Hash a -> Ordering
$c< :: forall a. Ord a => Hash a -> Hash a -> Bool
< :: Hash a -> Hash a -> Bool
$c<= :: forall a. Ord a => Hash a -> Hash a -> Bool
<= :: Hash a -> Hash a -> Bool
$c> :: forall a. Ord a => Hash a -> Hash a -> Bool
> :: Hash a -> Hash a -> Bool
$c>= :: forall a. Ord a => Hash a -> Hash a -> Bool
>= :: Hash a -> Hash a -> Bool
$cmax :: forall a. Ord a => Hash a -> Hash a -> Hash a
max :: Hash a -> Hash a -> Hash a
$cmin :: forall a. Ord a => Hash a -> Hash a -> Hash a
min :: Hash a -> Hash a -> Hash a
Ord,Int -> Hash a -> ShowS
[Hash a] -> ShowS
Hash a -> String
(Int -> Hash a -> ShowS)
-> (Hash a -> String) -> ([Hash a] -> ShowS) -> Show (Hash a)
forall a. Show a => Int -> Hash a -> ShowS
forall a. Show a => [Hash a] -> ShowS
forall a. Show a => Hash a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Hash a -> ShowS
showsPrec :: Int -> Hash a -> ShowS
$cshow :: forall a. Show a => Hash a -> String
show :: Hash a -> String
$cshowList :: forall a. Show a => [Hash a] -> ShowS
showList :: [Hash a] -> ShowS
Show)

instance Functor Hash where
    fmap :: forall a b. (a -> b) -> Hash a -> Hash b
fmap a -> b
f (Hash a
a) = b -> Hash b
forall a. a -> Hash a
Hash (a -> b
f a
a)

instance Applicative Hash where
    pure :: forall a. a -> Hash a
pure = a -> Hash a
forall a. a -> Hash a
Hash
    Hash a -> b
f <*> :: forall a b. Hash (a -> b) -> Hash a -> Hash b
<*> Hash a
a = b -> Hash b
forall a. a -> Hash a
Hash (a -> b
f a
a)

class Ord a => Hashable a where
    -- | Compute the hash of a given value. We typically assume cryptographic
    -- hashing, e.g. SHA256.
    hash :: a -> Hash a

instance Hashable Int where
    hash :: Int -> Hash Int
hash = Int -> Hash Int
forall a. a -> Hash a
Hash

instance Hashable Integer where
    hash :: Integer -> Hash Integer
hash = Integer -> Hash Integer
forall a. a -> Hash a
Hash

instance Hashable a => Hashable [a] where
    hash :: [a] -> Hash [a]
hash = [a] -> Hash [a]
forall a. a -> Hash a
Hash

instance Hashable a => Hashable (Hash a) where
    hash :: Hash a -> Hash (Hash a)
hash = Hash a -> Hash (Hash a)
forall a. a -> Hash a
Hash

instance (Hashable a, Hashable b) => Hashable (a, b) where
    hash :: (a, b) -> Hash (a, b)
hash = (a, b) -> Hash (a, b)
forall a. a -> Hash a
Hash

-- | An abstract datatype for a key/value store with build information of type @i@.
data Store i k v = Store { forall i k v. Store i k v -> i
info :: i, forall i k v. Store i k v -> k -> v
values :: k -> v }

-- | Read the build information.
getInfo :: Store i k v -> i
getInfo :: forall i k v. Store i k v -> i
getInfo = Store i k v -> i
forall i k v. Store i k v -> i
info

-- | Read the value of a key.
getValue :: k -> Store i k v -> v
getValue :: forall k i v. k -> Store i k v -> v
getValue = (Store i k v -> k -> v) -> k -> Store i k v -> v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Store i k v -> k -> v
forall i k v. Store i k v -> k -> v
values

-- | Read the hash of a key's value. In some cases may be implemented more
-- efficiently than @hash . getValue k@.
getHash :: Hashable v => k -> Store i k v -> Hash v
getHash :: forall v k i. Hashable v => k -> Store i k v -> Hash v
getHash k
k = v -> Hash v
forall a. Hashable a => a -> Hash a
hash (v -> Hash v) -> (Store i k v -> v) -> Store i k v -> Hash v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Store i k v -> v
forall k i v. k -> Store i k v -> v
getValue k
k

-- | Write the build information.
putInfo :: i -> Store i k v -> Store i k v
putInfo :: forall i k v. i -> Store i k v -> Store i k v
putInfo i
i Store i k v
s = Store i k v
s { info = i }

-- | Modify the build information.
mapInfo :: (i -> j) -> Store i k v -> Store j k v
mapInfo :: forall i j k v. (i -> j) -> Store i k v -> Store j k v
mapInfo i -> j
f (Store i
i k -> v
kv) = j -> (k -> v) -> Store j k v
forall i k v. i -> (k -> v) -> Store i k v
Store (i -> j
f i
i) k -> v
kv

-- | Update the value of a key.
putValue :: Eq k => k -> v -> Store i k v -> Store i k v
putValue :: forall k v i. Eq k => k -> v -> Store i k v -> Store i k v
putValue k
k v
v Store i k v
s = Store i k v
s { values = \k
key -> if k
key k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k then v
v else Store i k v -> k -> v
forall i k v. Store i k v -> k -> v
values Store i k v
s k
key }

-- | Initialise the store.
initialise :: i -> (k -> v) -> Store i k v
initialise :: forall i k v. i -> (k -> v) -> Store i k v
initialise = i -> (k -> v) -> Store i k v
forall i k v. i -> (k -> v) -> Store i k v
Store