feat: draft commitment tree tracker
This commit is contained in:
parent
d72f355981
commit
d445ba3324
1 changed files with 44 additions and 0 deletions
44
src/Zenith/Tree.hs
Normal file
44
src/Zenith/Tree.hs
Normal file
|
@ -0,0 +1,44 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
module Zenith.Tree where
|
||||
|
||||
import Data.HexString
|
||||
|
||||
class Monoid v =>
|
||||
Measured a v
|
||||
where
|
||||
measure :: a -> v
|
||||
|
||||
data Tree v a
|
||||
= Leaf !v !a
|
||||
| Branch !v !(Tree v a) !(Tree v a)
|
||||
|
||||
value :: Tree v a -> v
|
||||
value (Leaf v _) = v
|
||||
value (Branch v _ _) = v
|
||||
|
||||
branch :: Monoid v => Tree v a -> Tree v a -> Tree v a
|
||||
branch x y = Branch (value x <> value y) x y
|
||||
|
||||
leaf :: Measured a v => a -> Tree v a
|
||||
leaf a = Leaf (measure a) a
|
||||
|
||||
data OrchardNode = OrchardNode
|
||||
{ on_position :: !Integer
|
||||
, on_value :: !String
|
||||
, on_level :: !Int
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance Semigroup OrchardNode where
|
||||
(<>) x y =
|
||||
if on_level x == on_level y
|
||||
then OrchardNode
|
||||
(max (on_position x) (on_position y))
|
||||
(on_value x <> on_value y)
|
||||
(on_level x)
|
||||
else x
|
||||
|
||||
instance Monoid OrchardNode where
|
||||
mempty = OrchardNode 0 "" (-1)
|
||||
mappend = (<>)
|
Loading…
Reference in a new issue