diff --git a/src/Zenith/Tree.hs b/src/Zenith/Tree.hs new file mode 100644 index 0000000..a2e1ec9 --- /dev/null +++ b/src/Zenith/Tree.hs @@ -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 = (<>)