76 lines
1.7 KiB
Haskell
76 lines
1.7 KiB
Haskell
{-# 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)
|