45 lines
945 B
Haskell
45 lines
945 B
Haskell
|
{-# 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 = (<>)
|