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