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 = (<>)