Fingerprint the 'Buuka' and use it as context

src/Data/Buuka.hs

@@ -9,35 +9,44 @@ module Data.Buuka
 
   , insert
   , elements
+  , fingerprint
   )
   where
 
 import Database.Migrations
 
 import Data.Aeson
+import Data.Bits
+       (finiteBitSize, shiftR, (.&.))
+import Data.Hashable
+       (Hashable, hash)
 import GHC.Generics
        (Generic)
 
 import Control.Monad.Reader
 import Control.Monad.State
 
+import Data.ByteString
+       (ByteString)
+import qualified Data.ByteString as B
+
 newtype URL = URL String
   deriving stock (Show, Eq, Generic, Ord)
-  deriving newtype (ToJSON, FromJSON, FromJSONKey, ToJSONKey)
+  deriving newtype (ToJSON, FromJSON, FromJSONKey, ToJSONKey, Hashable)
 
 data BuukaEntry
   = BuukaEntry { url :: URL
                , title :: Maybe String
                }
   deriving stock (Show, Eq, Generic)
-  deriving anyclass (ToJSON, FromJSON)
+  deriving anyclass (ToJSON, FromJSON, Hashable)
 
 instance SafeJSON BuukaEntry where
   type Version BuukaEntry = 0
 
 newtype Buuka = Buuka [BuukaEntry]
   deriving stock (Show, Eq)
-  deriving newtype (Semigroup, Monoid, FromJSON, ToJSON)
+  deriving newtype (Semigroup, Monoid, FromJSON, ToJSON, Hashable)
 
 insert :: BuukaEntry -> Buuka -> Buuka
 insert e (Buuka b) = Buuka (e : b)
@@ -45,6 +54,14 @@ insert e (Buuka b) = Buuka (e : b)
 elements :: Buuka -> [BuukaEntry]
 elements (Buuka b) = b
 
+-- | Create a (non-cryptographic) hash out of the 'Buuka'
+fingerprint :: Buuka -> ByteString
+fingerprint = toBS . hash
+  where
+    toBS x =
+      let bs = finiteBitSize x
+      in B.pack [fromIntegral ((x `shiftR` s) .&. 255) | s <- [0..bs - 1]]
+
 instance SafeJSON Buuka where
   type Version Buuka = 0