{-# LANGUAGE TemplateHaskell #-} module Chiasma.Ui.Data.Tree where import Data.Text.Prettyprint.Doc (Pretty(..), vsep, nest) data Tree f l p = Tree { Tree f l p -> l _treeData :: l, Tree f l p -> f (Node f l p) _forest :: f (Node f l p) } deriving instance (Eq l, Eq p) => Eq (Tree [] l p) deriving instance (Show l, Show p) => Show (Tree [] l p) deriving instance (Eq l, Eq p) => Eq (Tree NonEmpty l p) deriving instance (Show l, Show p) => Show (Tree NonEmpty l p) data Node f l p = Sub { Node f l p -> Tree f l p _subTree :: Tree f l p } | Leaf { Node f l p -> p _leafData :: p } makeClassy ''Tree makeClassy ''Node deriving instance (Eq l, Eq p) => Eq (Node [] l p) deriving instance (Show l, Show p) => Show (Node [] l p) deriving instance (Eq l, Eq p) => Eq (Node NonEmpty l p) deriving instance (Show l, Show p) => Show (Node NonEmpty l p) type LTree l p = Tree [] l p type LNode l p = Node [] l p type NTree l p = Tree NonEmpty l p type NNode l p = Node NonEmpty l p instance (Foldable f, Pretty l, Pretty p) => Pretty (Tree f l p) where pretty :: Tree f l p -> Doc ann pretty (Tree l l f (Node f l p) sub) = Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann nest Int 2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann forall a b. (a -> b) -> a -> b $ [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall a b. (a -> b) -> a -> b $ l -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty l l Doc ann -> [Doc ann] -> [Doc ann] forall a. a -> [a] -> [a] : (Node f l p -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty (Node f l p -> Doc ann) -> [Node f l p] -> [Doc ann] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (Node f l p) -> [Node f l p] forall (t :: * -> *) a. Foldable t => t a -> [a] toList f (Node f l p) sub) instance (Foldable f, Pretty l, Pretty p) => Pretty (Node f l p) where pretty :: Node f l p -> Doc ann pretty (Sub Tree f l p tree') = Tree f l p -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty Tree f l p tree' pretty (Leaf p a) = p -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty p a