{-# LANGUAGE ViewPatterns #-}

-- | The endpoints on the cloud server
module Development.Shake.Internal.History.Bloom(
    Bloom, bloomTest, bloomCreate
    ) where

import Data.Word
import Data.Bits
import Data.Hashable
import Data.Semigroup
import Foreign.Storable
import Foreign.Ptr
import Prelude


-- | Given an Int hash we store
data Bloom a = Bloom
    {-# UNPACK #-} !Word64
    {-# UNPACK #-} !Word64
    {-# UNPACK #-} !Word64
    {-# UNPACK #-} !Word64
    deriving (Bloom a -> Bloom a -> Bool
(Bloom a -> Bloom a -> Bool)
-> (Bloom a -> Bloom a -> Bool) -> Eq (Bloom a)
forall a. Bloom a -> Bloom a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bloom a -> Bloom a -> Bool
$c/= :: forall a. Bloom a -> Bloom a -> Bool
== :: Bloom a -> Bloom a -> Bool
$c== :: forall a. Bloom a -> Bloom a -> Bool
Eq,Int -> Bloom a -> ShowS
[Bloom a] -> ShowS
Bloom a -> String
(Int -> Bloom a -> ShowS)
-> (Bloom a -> String) -> ([Bloom a] -> ShowS) -> Show (Bloom a)
forall a. Int -> Bloom a -> ShowS
forall a. [Bloom a] -> ShowS
forall a. Bloom a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bloom a] -> ShowS
$cshowList :: forall a. [Bloom a] -> ShowS
show :: Bloom a -> String
$cshow :: forall a. Bloom a -> String
showsPrec :: Int -> Bloom a -> ShowS
$cshowsPrec :: forall a. Int -> Bloom a -> ShowS
Show)

instance Storable (Bloom a) where
    sizeOf :: Bloom a -> Int
sizeOf Bloom a
_ = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
0 :: Word64)
    alignment :: Bloom a -> Int
alignment Bloom a
_ = Word64 -> Int
forall a. Storable a => a -> Int
alignment (Word64
0 :: Word64)
    peek :: Ptr (Bloom a) -> IO (Bloom a)
peek (Ptr (Bloom a) -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr -> Ptr Word64
ptr) = Word64 -> Word64 -> Word64 -> Word64 -> Bloom a
forall a. Word64 -> Word64 -> Word64 -> Word64 -> Bloom a
Bloom (Word64 -> Word64 -> Word64 -> Word64 -> Bloom a)
-> IO Word64 -> IO (Word64 -> Word64 -> Word64 -> Bloom a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
ptr Int
0 IO (Word64 -> Word64 -> Word64 -> Bloom a)
-> IO Word64 -> IO (Word64 -> Word64 -> Bloom a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
ptr Int
1 IO (Word64 -> Word64 -> Bloom a)
-> IO Word64 -> IO (Word64 -> Bloom a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
ptr Int
2 IO (Word64 -> Bloom a) -> IO Word64 -> IO (Bloom a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
ptr Int
3
    poke :: Ptr (Bloom a) -> Bloom a -> IO ()
poke (Ptr (Bloom a) -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr -> Ptr Word64
ptr) (Bloom Word64
x1 Word64
x2 Word64
x3 Word64
x4) = do
        Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr Int
0 Word64
x1
        Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr Int
1 Word64
x2
        Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr Int
2 Word64
x3
        Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
ptr Int
3 Word64
x4

instance Semigroup (Bloom a) where
    Bloom Word64
x1 Word64
x2 Word64
x3 Word64
x4 <> :: Bloom a -> Bloom a -> Bloom a
<> Bloom Word64
y1 Word64
y2 Word64
y3 Word64
y4 =
        Word64 -> Word64 -> Word64 -> Word64 -> Bloom a
forall a. Word64 -> Word64 -> Word64 -> Word64 -> Bloom a
Bloom (Word64
x1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
y1) (Word64
x2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
y2) (Word64
x3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
y3) (Word64
x4 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
y4)

instance Monoid (Bloom a) where
    mempty :: Bloom a
mempty = Word64 -> Word64 -> Word64 -> Word64 -> Bloom a
forall a. Word64 -> Word64 -> Word64 -> Word64 -> Bloom a
Bloom Word64
0 Word64
0 Word64
0 Word64
0
    mappend :: Bloom a -> Bloom a -> Bloom a
mappend = Bloom a -> Bloom a -> Bloom a
forall a. Semigroup a => a -> a -> a
(<>)

-- Should the cloud need to know about Key's? It only needs to do Eq on them...
-- If you Key has a smart Eq your build tree might be more diverse
-- Have the Id resolved in Server.

bloomTest :: Hashable a => Bloom a -> a -> Bool
bloomTest :: Bloom a -> a -> Bool
bloomTest Bloom a
bloom a
x = a -> Bloom a
forall a. Hashable a => a -> Bloom a
bloomCreate a
x Bloom a -> Bloom a -> Bloom a
forall a. Semigroup a => a -> a -> a
<> Bloom a
bloom Bloom a -> Bloom a -> Bool
forall a. Eq a => a -> a -> Bool
== Bloom a
bloom

bloomCreate :: Hashable a => a -> Bloom a
bloomCreate :: a -> Bloom a
bloomCreate (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> (a -> Int) -> a -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Hashable a => a -> Int
hash -> Word64
x) =
    Word64 -> Word64 -> Word64 -> Word64 -> Bloom a
forall a. Word64 -> Word64 -> Word64 -> Word64 -> Bloom a
Bloom (Int -> Word64
f Int
1) (Int -> Word64
f Int
2) (Int -> Word64
f Int
3) (Int -> Word64
f Int
4)
    where f :: Int -> Word64
f Int
i = Word64
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
rotate Word64
x Int
i