module BTree.Types where
import Data.Binary
import GHC.Generics
import Control.Monad (when)
import Control.Applicative
import Control.Lens
import Data.Int
import qualified Data.ByteString as BS
type Offset = Int64
type Size = Word64
type Order = Word64
newtype OnDisk a = OnDisk Offset
deriving (Show, Eq, Ord)
instance Binary (OnDisk a) where
get = OnDisk <$> get
put (OnDisk off) = put off
data BLeaf k e = BLeaf !k !e
deriving (Generic)
deriving instance (Show k, Show e) => Show (BLeaf k e)
instance (Eq k) => Eq (BLeaf k e) where
BLeaf a _ == BLeaf b _ = a == b
instance Ord k => Ord (BLeaf k e) where
compare (BLeaf a _) (BLeaf b _) = compare a b
instance (Binary k, Binary e) => Binary (BLeaf k e) where
get = BLeaf <$> get <*> get
put (BLeaf k e) = put k >> put e
data BTree k f e = Node (f (BTree k f e)) [(k, f (BTree k f e))]
| Leaf !(BLeaf k e)
deriving (Generic)
deriving instance (Show e, Show k, Show (f (BTree k f e))) => Show (BTree k f e)
deriving instance (Eq e, Eq k, Eq (f (BTree k f e))) => Eq (BTree k f e)
instance (Binary k, Binary (f (BTree k f e)), Binary e)
=> Binary (BTree k f e) where
get = do typ <- getWord8
case typ of
0 -> Node <$> get <*> get
1 -> bleaf <$> get <*> get
_ -> fail "BTree.Types/get: Unknown node type"
where bleaf k v = Leaf (BLeaf k v)
put (Node e0 es) = putWord8 0 >> put e0 >> put es
put (Leaf (BLeaf k0 e)) = putWord8 1 >> put k0 >> put e
magic :: Word64
magic = 0xdeadbeefbbbbcccc
data BTreeHeader k e = BTreeHeader { _btMagic :: !Word64
, _btVersion :: !Word64
, _btOrder :: !Order
, _btSize :: !Size
, _btRoot :: !(OnDisk (BTree k OnDisk e))
}
deriving (Show, Eq, Generic)
makeLenses ''BTreeHeader
instance Binary (BTreeHeader k e)
validateHeader :: BTreeHeader k e -> Either String ()
validateHeader hdr = do
when (hdr^.btMagic /= magic) $ Left "Invalid magic number"
when (hdr^.btVersion > 1) $ Left "Invalid version"
data LookupTree k e = LookupTree { _ltData :: !BS.ByteString
, _ltHeader :: !(BTreeHeader k e)
}
makeLenses ''LookupTree