buuka/src/Data/Buuka.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Buuka
  ( BuukaQ(..)
  , BuukaU(..)
  , BuukaEntry(..)
  , URL(..)
  , 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 Data.Text

import Control.Monad.Reader
import Control.Monad.State

import Data.ByteString
       (ByteString)
import qualified Data.ByteString as B

newtype URL = URL Text
  deriving stock (Show, Eq, Generic, Ord)
  deriving newtype (ToJSON, FromJSON, FromJSONKey, ToJSONKey, Hashable)

data BuukaEntry
  = BuukaEntry { url :: URL
               , title :: Maybe Text
               }
  deriving stock (Show, Eq, Generic)
  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, Hashable)

insert :: BuukaEntry -> Buuka -> Buuka
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

newtype BuukaQ a = BuukaQ { runBuukaQ :: Reader Buuka a }
  deriving newtype (Functor, Applicative, Monad, MonadReader Buuka)

-- Last write wins
newtype BuukaU a = BuukaU { runBuukaU :: State Buuka a }
  deriving newtype (Functor, Applicative, Monad, MonadState Buuka)