packages feed

polytree 0.0.10 → 0.1.0

raw patch · 3 files changed

+224/−736 lines, 3 files

Files

changelog.md view
@@ -1,3 +1,7 @@+0.1.0++* Complete refactor and change of data structure+ 0.0.10  * New combinators for traversing Node
polytree.cabal view
@@ -1,5 +1,5 @@ name:                 polytree-version:              0.0.10+version:              0.1.0 synopsis:             A polymorphic rose-tree description:          A rose-tree which has different data in the nodes and leaves license:              BSD3
src/Data/PolyTree.hs view
@@ -1,60 +1,52 @@ {-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}  module Data.PolyTree where -import Control.Applicative ( Applicative(liftA2), Alternative(empty) )+import Control.Applicative ( Applicative(liftA2) ) import Control.Lens-    ( preview,-      iso,+    ( iso,+      _Left,       _Right,-      prism,-      prism',-      review,       Plated(..),-      Field1(_1),-      Field2(_2),-      Iso,+      Iso',       Lens,       Lens',-      Prism,       Prism',       Traversal,       Traversal' )-import Control.Monad.Free ( Free(..) )-import qualified Control.Monad.Trans.Free as FreeT(Free, FreeF(..), free, runFree) import Data.Bifoldable ( Bifoldable(bifoldMap) ) import Data.Bifunctor ( Bifunctor(bimap) ) import Data.Bitraversable ( Bitraversable(..) )-import Data.Foldable ( traverse_ )-import Data.Functor ( void )-import Data.Functor.Apply ( Apply((<.>)) )-import Data.Functor.Bind ( Bind((>>-)) )+import Data.Functor.Apply ( Apply(liftF2, (<.>)) ) import Data.Functor.Classes     ( showsBinaryWith,-      showsUnaryWith,       Eq1(..),       Eq2(..),       Ord1(..),       Ord2(..),       Show1(liftShowsPrec),       Show2(..) )-import Data.Functor.Compose ( Compose(..) ) import Data.Functor.Identity ( Identity(..) )+import Data.List.NonEmpty ( NonEmpty(..), nonEmpty, toList ) import Data.Semigroup.Bifoldable ( Bifoldable1(bifoldMap1) ) import Data.Semigroup.Bitraversable ( Bitraversable1(bitraverse1) ) import Data.Semigroup.Foldable ( Foldable1(foldMap1) ) import Data.Semigroup.Traversable ( Traversable1(traverse1) ) import qualified Data.Tree as Tree-import Data.Void ( Void, absurd )  -- $setup -- >>> import Control.Lens +type TreeForest f a b =+  f (Either b (Tree f a b))++type TreeForest' f a =+  TreeForest f a a+ data Tree f a b =-  Leaf b-  | Node a (f (Tree f a b))+  Tree a (TreeForest f a b)  type Tree' f a =   Tree f a a@@ -72,30 +64,30 @@   Tree1 a a  instance Eq1 f => Eq2 (Tree f) where-  liftEq2 _ g (Leaf b1) (Leaf b2) =-    g b1 b2-  liftEq2 _ _ (Leaf _) (Node _ _) =-    False-  liftEq2 _ _ (Node _ _) (Leaf _) =-    False-  liftEq2 f g (Node a1 t1) (Node a2 t2) =-    f a1 a2 && liftEq (liftEq2 f g) t1 t2+  liftEq2 f g (Tree a t1) (Tree b t2) =+    f a b &&+    liftEq (liftEq2 g (liftEq2 f g)) t1 t2  instance Ord1 f => Ord2 (Tree f) where-  liftCompare2 _ g (Leaf b1) (Leaf b2) =-    g b1 b2-  liftCompare2 _ _ (Leaf _) (Node _ _) =-    GT-  liftCompare2 _ _ (Node _ _) (Leaf _) =-    LT-  liftCompare2 f g (Node a1 t1) (Node a2 t2) =-    f a1 a2 <> liftCompare (liftCompare2 f g) t1 t2+  liftCompare2 f g (Tree a t1) (Tree b t2) =+    f a b <>+    liftCompare (liftCompare2 g (liftCompare2 f g)) t1 t2  instance Show1 f => Show2 (Tree f) where-  liftShowsPrec2 _ _ spB _ d (Leaf b) =-    showsUnaryWith spB "Leaf" d b-  liftShowsPrec2 spA slA spB slB d (Node a ts) =-    showsBinaryWith spA (liftShowsPrec (liftShowsPrec2 spA slA spB slB) (liftShowList2 spA slA spB slB)) "Node" d a ts+  liftShowsPrec2 spA slA spB slB d (Tree a t) =+    let spT =+          liftShowsPrec2 spA slA spB slB+        slT =+          liftShowList2 spA slA spB slB+    in  showsBinaryWith+          spA+          (liftShowsPrec+            (liftShowsPrec2 spB slB spT slT)+            (liftShowList2 spB slB spT slT))+          "Tree"+          d+          a+          t  instance (Eq a, Eq1 f) => Eq1 (Tree f a) where   liftEq =@@ -121,755 +113,247 @@   showsPrec =     liftShowsPrec showsPrec shows --- |------ >>> Leaf "ABC" <> Leaf "DEF" :: Tree1' String--- Leaf "ABCDEF"------ >>> Leaf "ABC" <> Node "DEF" [] :: TreeList' String--- Node "DEF" []------ >>> Leaf "ABC" <> Node "DEF" [Leaf "GHI"] :: TreeList' String--- Node "DEF" [Leaf "ABCGHI"]------ >>> Node "ABC" [] <> Leaf "DEF" :: TreeList' String--- Node "ABC" []------ >>> Node "ABC" [] <> Node "DEF" [Leaf "GHI"] :: TreeList' String--- Node "ABCDEF" []------ >>> Node "ABC" [] <> Node "DEF" [Leaf "GHI", Node "JKL" []] :: TreeList' String--- Node "ABCDEF" []-instance (Applicative f, Semigroup a, Semigroup b) => Semigroup (Tree f a b) where-  Leaf a1 <> Leaf a2 =-    Leaf (a1 <> a2)-  Leaf a <> Node b t =-    Node b (fmap (Leaf a <>) t)-  Node b t <> Leaf a =-    Node b (fmap (Leaf a <>) t)-  Node b1 t1 <> Node b2 t2 =-    Node (b1 <> b2) (liftA2 (<>) t1 t2)--instance (Applicative f, Monoid a, Monoid b) => Monoid (Tree f a b) where-  mempty = Leaf mempty---- |------ >>> bimap (+1) (+2) (Leaf 10) :: TreeList' Int--- Leaf 12------ >>> bimap (+1) (+2) (Node 20 [Leaf 10]) :: TreeList' Int--- Node 21 [Leaf 12]------ >>> bimap (+1) (+2) (Node 20 [Node 30 [Leaf 10], Leaf 40]) :: TreeList' Int--- Node 21 [Node 31 [Leaf 12],Leaf 42] instance Functor f => Bifunctor (Tree f) where-  bimap _ g (Leaf b) =-    Leaf (g b)-  bimap f g (Node a t) =-    Node (f a) (fmap (bimap f g) t)+  bimap f g (Tree a t) =+    Tree (f a) (fmap (bimap g (bimap f g)) t) --- |------ >>> fmap (+1) (Leaf 10) :: TreeList' Int--- Leaf 11------ >>> fmap (+1) (Node 20 [Leaf 10]) :: TreeList' Int--- Node 20 [Leaf 11]------ >>> fmap (+1) (Node 20 [Node 30 [Leaf 10], Leaf 40]) :: TreeList' Int--- Node 20 [Node 30 [Leaf 11],Leaf 41] instance Functor f => Functor (Tree f a) where   fmap =     bimap id --- >>> Leaf (+1) <.> Leaf 10 :: TreeList' Int--- Leaf 11------ >>> Leaf (+1) <.> Node 10 [] :: TreeList' Int--- Node 10 []------ >>> Node 20 [] <.> Node 10 [] :: TreeList' Int--- Node 20 []------ >>> Node 20 [] <.> Leaf 10 :: TreeList' Int--- Node 20 []------ >>> Leaf (+1) <.> Node 20 [Leaf 10] :: TreeList' Int--- Node 20 [Leaf 11]------ >>> Node 10 [] <.> Node 20 [Leaf 10] :: TreeList' Int--- Node 10 []-instance Functor f => Apply (Tree f a) where-  Leaf f <.> t =-    fmap f t-  Node a fs <.> t =-    Node a (fmap (<*> t) fs)---- |------ >>> pure 10 :: TreeList' Int--- Leaf 10-instance Functor f => Applicative (Tree f a) where-  pure =-    Leaf-  (<*>) =-    (<.>)+instance (Apply f, Semigroup a) => Apply (Tree f a) where+  Tree a1 t1 <.> Tree a2 t2 =+    let combine (Left f) (Left x) =+          Left (f x)+        combine (Left f) (Right tx) =+          Right (fmap f tx)+        combine (Right tf) (Left x) =+          Right (fmap ($ x) tf)+        combine (Right tf) (Right tx) =+          Right (tf <.> tx)+    in  Tree (a1 <> a2) (liftF2 combine t1 t2)  -- | ----- >>> Leaf 10 >>- \n -> Leaf (n + 1) :: TreeList' Int--- Leaf 11------ >>> Leaf 10 >>- \n -> Node 20 [] :: TreeList' Int--- Node 20 []------ >>> Leaf 10 >>- \n -> Node 20 [Leaf 30] :: TreeList' Int--- Node 20 [Leaf 30]+-- >>> Tree "a" [] <*> Tree "b" [] :: TreeList String String+-- Tree "ab" [] ----- >>> Node 10 [] >>- Leaf--- Node 10 []+-- >>> Tree "a" [Left Prelude.reverse] <*> Tree "b" [Left "xyz"] :: TreeList String String+-- Tree "ab" [Left "zyx"] ----- >>> Node 10 [] >>- \n -> Node 20 [Leaf n] :: TreeList' Int--- Node 10 []-instance Functor f => Bind (Tree f a) where-  Leaf x >>- k =-    k x-  Node a ts >>- k =-    Node a (fmap (>>= k) ts)+-- >>> Tree "a" [Left Prelude.reverse] <*> Tree "b" [Left "xyz", makeChild "c" [Left "pqr"], makeChild "d" [Left "mno"]] :: TreeList String String+-- Tree "ab" [Left "zyx",Right (Tree "c" [Left "rqp"]),Right (Tree "d" [Left "onm"])]+instance (Applicative f, Monoid a) => Applicative (Tree f a) where+  pure b =+    Tree mempty (pure (Left b))+  Tree a1 t1 <*> Tree a2 t2 =+    let combine (Left f) (Left x) =+          Left (f x)+        combine (Left f) (Right tx) =+          Right (fmap f tx)+        combine (Right tf) (Left x) =+          Right (fmap ($ x) tf)+        combine (Right tf) (Right tx) =+          Right (tf <*> tx)+    in  Tree (a1 <> a2) (liftA2 combine t1 t2) -instance Functor f => Monad (Tree f a) where-  (>>=) =-    (>>-)+instance Foldable f => Bifoldable (Tree f) where+  bifoldMap f g (Tree a t) =+    f a <> foldMap (either g (bifoldMap f g)) t --- |------ >>> bifoldMap1 reverse (<> "DEF") (Leaf "ABC" :: Tree1' String)--- "ABCDEF"------ >>> bifoldMap1 reverse (<> "DEF") (node1 "ABC" (Leaf "DEF"))--- "CBADEFDEF"------ >>> bifoldMap1 reverse (<> "DEF") (node1 "ABC" (node1 "DEF" (Leaf "GHI")))--- "CBAFEDGHIDEF" instance Foldable1 f => Bifoldable1 (Tree f) where-  bifoldMap1 _ g (Leaf b) =-    g b-  bifoldMap1 f g (Node a t) =-    f a <> foldMap1 (bifoldMap1 f g) t+  bifoldMap1 f g (Tree a t) =+    f a <> foldMap1 (either g (bifoldMap1 f g)) t --- |------ >>> bifoldMap reverse (<> "DEF") (Leaf "ABC" :: TreeList' String)--- "ABCDEF"------ >>> bifoldMap reverse (<> "DEF") (Node "ABC" [Leaf "DEF"])--- "CBADEFDEF"------ >>> bifoldMap reverse (<> "DEF") (Node "ABC" [Node "DEF" [Leaf "GHI"]])--- "CBAFEDGHIDEF"-instance Foldable f => Bifoldable (Tree f) where-  bifoldMap _ g (Leaf b) =-    g b-  bifoldMap f g (Node a t) =-    f a <> foldMap (bifoldMap f g) t+instance Foldable f => Foldable (Tree f a) where+  foldMap f (Tree _ t) =+    foldMap (either f (foldMap f)) t --- |------ >>> foldMap1 reverse (Leaf "ABC" :: Tree1' String)--- "CBA"------ >>> foldMap1 reverse (node1 "ABC" (Leaf "DEF"))--- "FED"------ >>> foldMap1 reverse (node1 "ABC" (node1 "DEF" (Leaf "GHI")))--- "IHG" instance Foldable1 f => Foldable1 (Tree f a) where-  foldMap1 g (Leaf b) =-    g b-  foldMap1 g (Node _ ts) =-    foldMap1 (foldMap1 g) ts+  foldMap1 f (Tree _ t) =+    foldMap1 (either f (foldMap1 f)) t --- |------ >>> foldMap reverse (Leaf "ABC" :: Tree1' String)--- "CBA"------ >>> foldMap reverse (Node "ABC" [Leaf "DEF"])--- "FED"------ >>> foldMap reverse (Node "ABC" [Node "DEF" [Leaf "GHI"]])--- "IHG"-instance Foldable f => Foldable (Tree f a) where-  foldMap g (Leaf b) =-    g b-  foldMap g (Node _ ts) =-    foldMap (foldMap g) ts+instance Traversable f => Bitraversable (Tree f) where+  bitraverse f g (Tree a t) =+    Tree <$> f a <*> traverse (either (fmap Left . g) (fmap Right . bitraverse f g)) t --- |------ >>> bitraverse1 (\x -> [x, reverse x]) (\x -> [x, x <> "DEF"]) (Leaf "ABC" :: Tree1' String)--- [Leaf "ABC",Leaf "ABCDEF"]------ >>> bitraverse1 (\x -> [x, reverse x]) (\x -> [x, x <> "DEF"]) (Node "ABC" (Identity (Leaf "XYZ")) :: Tree1' String)--- [Node "ABC" (Identity (Leaf "XYZ")),Node "ABC" (Identity (Leaf "XYZDEF")),Node "CBA" (Identity (Leaf "XYZ")),Node "CBA" (Identity (Leaf "XYZDEF"))] instance Traversable1 f => Bitraversable1 (Tree f) where-  bitraverse1 _ g (Leaf b) =-    Leaf <$> g b-  bitraverse1 f g (Node a ts) =-    Node <$> f a <.> traverse1 (bitraverse1 f g) ts+  bitraverse1 f g (Tree a t) =+    Tree <$> f a <.> traverse1 (either (fmap Left . g) (fmap Right . bitraverse1 f g)) t --- |------ >>> bitraverse (\x -> [x, reverse x]) (\x -> [x, x <> "DEF"]) (Leaf "ABC" :: Tree1' String)--- [Leaf "ABC",Leaf "ABCDEF"]------ >>> bitraverse (\x -> [x, reverse x]) (\x -> [x, x <> "DEF"]) (Node "ABC" (Identity (Leaf "XYZ")) :: Tree1' String)--- [Node "ABC" (Identity (Leaf "XYZ")),Node "ABC" (Identity (Leaf "XYZDEF")),Node "CBA" (Identity (Leaf "XYZ")),Node "CBA" (Identity (Leaf "XYZDEF"))]-instance Traversable f => Bitraversable (Tree f) where-  bitraverse _ g (Leaf b) =-    Leaf <$> g b-  bitraverse f g (Node a ts) =-    Node <$> f a <*> traverse (bitraverse f g) ts+instance Traversable f => Traversable (Tree f a) where+  traverse f (Tree a t) =+    Tree a <$> traverse (either (fmap Left . f) (fmap Right . traverse f)) t --- |------ >>> traverse1 (\x -> [x, reverse x]) (Leaf "ABC" :: Tree1' String)--- [Leaf "ABC",Leaf "CBA"]------ >>> traverse1 (\x -> [x, reverse x]) (Node "ABC" (Identity (Leaf "XYZ")) :: Tree1' String)--- [Node "ABC" (Identity (Leaf "XYZ")),Node "ABC" (Identity (Leaf "ZYX"))] instance Traversable1 f => Traversable1 (Tree f a) where-  traverse1 f (Leaf b) =-    Leaf <$> f b-  traverse1 f (Node a ts) =-    Node a <$> traverse1 (traverse1 f) ts---- |------ >>> traverse (\x -> [x, reverse x]) (Leaf "ABC" :: Tree1' String)--- [Leaf "ABC",Leaf "CBA"]------ >>> traverse (\x -> [x, reverse x]) (Node "ABC" (Identity (Leaf "XYZ")) :: Tree1' String)--- [Node "ABC" (Identity (Leaf "XYZ")),Node "ABC" (Identity (Leaf "ZYX"))]-instance Traversable f => Traversable (Tree f a) where-  traverse f (Leaf b) =-    Leaf <$> f b-  traverse f (Node a ts) =-    Node a <$> traverse (traverse f) ts+  traverse1 f (Tree a t) =+    Tree a <$> traverse1 (either (fmap Left . f) (fmap Right . traverse1 f)) t --- |------ >>> toListOf plate (Leaf 1 :: TreeList' Int)--- [Leaf 1]------ >>> toListOf plate (Node 1 [] :: TreeList' Int)--- []------ >>> toListOf plate (Node 1 [Leaf 2] :: TreeList' Int)--- [Leaf 2]------ >>> toListOf plate (Node 1 [Leaf 2, Leaf 3, Node 4 []] :: TreeList' Int)--- [Leaf 2,Leaf 3,Node 4 []]------ >>> toListOf plate (Node 1 [Leaf 2, Leaf 3, Node 4 [Leaf 5]] :: TreeList' Int)--- [Leaf 2,Leaf 3,Node 4 [Leaf 5]] instance Traversable f => Plated (Tree f a b) where-  plate f (Leaf b) =-    f (Leaf b)-  plate f (Node a ts) =-    Node a <$> traverse f ts--matchTree ::-  (b -> x)-  -> (a -> f (Tree f a b) -> x)-  -> Tree f a b -> x-matchTree l _ (Leaf b) =-  l b-matchTree _ n (Node a t) =-  n a t--foldTree ::-  Functor f =>-  (b -> x)-  -> (a -> f x -> x)-  -> Tree f a b-  -> x-foldTree l _ (Leaf b) =-  l b-foldTree l n (Node a t) =-  n a (fmap (foldTree l n) t)---- |------ >>> foldTreeM (\b -> [b, b]) (:) (Leaf 1)--- [1,1]------ >>> foldTreeM (\b -> [b, b]) (:) (Leaf 1)--- [1,1]------ >>> foldTreeM (\b -> [b, b]) (:) (Node 1 [Leaf 2])--- [1,2,1,2]------ >>> foldTreeM (\b -> [b, b]) (:) (Node 1 [Leaf 2, Leaf 3])--- [1,2,3,1,2,3,1,2,3,1,2,3]------ >>> foldTreeM (\b -> [b, b]) (:) (Node 1 [Leaf 2, Leaf 3, Node 4 []])--- [1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4]------ >>> foldTreeM (\b -> [b, b * 10]) (:) (Leaf 1)--- [1,10]------ >>> foldTreeM (\b -> [b, b * 10]) (:) (Leaf 1)--- [1,10]------ >>> foldTreeM (\b -> [b, b * 10]) (:) (Node 1 [Leaf 2])--- [1,2,1,20]------ >>> foldTreeM (\b -> [b, b * 10]) (:) (Node 1 [Leaf 2, Leaf 3])--- [1,2,3,1,2,30,1,20,3,1,20,30]------ >>> foldTreeM (\b -> [b, b * 10]) (:) (Node 1 [Leaf 2, Leaf 3, Node 4 []])--- [1,2,3,4,1,2,30,4,1,20,3,4,1,20,30,4]-foldTreeM ::-  (Monad m, Traversable f) =>-  (b -> m x)-  -> (a -> f x -> m x)-  -> Tree f a b-  -> m x-foldTreeM l _ (Leaf b) =-  l b-foldTreeM l n (Node a t) =-  traverse (foldTreeM l n) t >>= n a--foldTreeM_ ::-  (Monad m, Traversable f) =>-  (b -> m x) ->-  (a -> f x -> m x)-  -> Tree f a b-  -> m ()-foldTreeM_ l n t =-  void (foldTreeM l n t)---- |------ >>> treeValue (Leaf 1 :: TreeList' Int)--- Right 1------ >>> treeValue (Node 1 [] :: TreeList' Int)--- Left 1------ >>> treeValue (Node 1 [Leaf 2] :: TreeList' Int)--- Left 1------ >>> treeValue (Node 1 [Node 2 []] :: TreeList' Int)--- Left 1-treeValue ::-  Tree f a b-  -> Either a b-treeValue =-  matchTree Right (pure . Left)---- |------ >>> treeChildren (Leaf 1 :: TreeList' Int)--- Left 1------ >>> treeChildren (Node 1 [] :: TreeList' Int)--- Right []------ >>> treeChildren (Node 1 [Leaf 2] :: TreeList' Int)--- Right [Leaf 2]------ >>> treeChildren (Node 1 [Leaf 2, Node 3 []] :: TreeList' Int)--- Right [Leaf 2,Node 3 []]-treeChildren ::-  Tree f a b-  -> Either b (f (Tree f a b))-treeChildren =-  matchTree Left (pure Right)+  plate f (Tree a t) =+    Tree a <$> traverse (either (pure . Left) (fmap Right . f)) t --- |------ >>> toListOf nodeValue (Leaf 1)--- []------ >>> toListOf nodeValue (Node 1 [] :: TreeList' Int)--- [1]------ >>> toListOf nodeValue (Node 1 [Leaf 2] :: TreeList' Int)--- [1]------ >>> toListOf nodeValue (Node 1 [Leaf 2, Node 3 []] :: TreeList' Int)--- [1]-nodeValue ::-  Traversal'+treeForest' ::+  Lens     (Tree f a b)-    a-nodeValue =-  _Node . _1+    (Tree f' a b')+    (TreeForest f a b)+    (TreeForest f' a b')+treeForest' f (Tree a t) =+  fmap (Tree a) (f t) --- |------ >>> toListOf nodeChildren (Leaf 1 :: TreeList' Int)--- []------ >>> toListOf nodeChildren (Node 1 [] :: TreeList' Int)--- [[]]------ >>> toListOf nodeChildren (Node 1 [Leaf 2] :: TreeList' Int)--- [[Leaf 2]]------ >>> toListOf nodeChildren (Node 1 [Leaf 2, Node 3 []] :: TreeList' Int)--- [[Leaf 2,Node 3 []]]-nodeChildren ::+treeSubForest ::+  Traversable f =>   Traversal     (Tree f a b)-    (Tree f' a b)-    (f (Tree f a b))-    (f' (Tree f' a b))-nodeChildren =-  _Node . _2---- | Depth-first search------ >>> dfs (Leaf 1) :: [Either String Int]--- [Right 1]------ >>> dfs (Node "A" []) :: [Either String Int]--- [Left "A"]------ >>> dfs (Node "A" [Leaf 1]) :: [Either String Int]--- [Left "A",Right 1]------ >>> dfs (Node "a" [Node "b" [Leaf 1], Leaf 88, Node "c" [Leaf 2], Leaf 99]) :: [Either String Int]--- [Left "a",Left "b",Right 1,Right 88,Left "c",Right 2,Right 99]-dfs ::-  (Semigroup (f (Either a b)), Monad f) =>-  Tree f a b-  -> f (Either a b)-dfs (Leaf b) =-  pure (Right b)-dfs (Node a ts) =-  pure (Left a) <> (ts >>= dfs)---- | Breadth-first search------ >>> bfs (Leaf 1) :: [Either String Int]--- [Right 1]------ >>> bfs (Node "A" []) :: [Either String Int]--- [Left "A"]------ >>> bfs (Node "A" [Leaf 1]) :: [Either String Int]--- [Left "A",Right 1]------ >>> bfs (Node "a" [Node "b" [Leaf 1], Leaf 88, Node "c" [Leaf 2], Leaf 99]) :: [Either String Int]--- [Left "a",Left "b",Right 88,Left "c",Right 99,Right 1,Right 2]-bfs ::-  (Monoid (f (Either a b)), Monad f, Foldable f) =>-  Tree f a b-  -> f (Either a b)-bfs (Leaf b) =-  pure (Right b)-bfs (Node a ts) =-  let go xs =-        foldMap-          (`foldMap` xs)-          [pure . treeValue, maybe mempty go . preview _Right . treeChildren]-  in  pure (Left a) <> go ts+    (Tree f a b')+    (Either b (Tree f a b))+    (Either b' (Tree f a b'))+treeSubForest =+  treeForest' . traverse -_Leaf ::-  Prism'+treeLeaves ::+  Traversable f =>+  Traversal'     (Tree f a b)     b-_Leaf =-  prism'-    Leaf-    (\case-        Leaf b ->-          Just b-        _ ->-          Nothing)+treeLeaves =+  treeSubForest . _Left -_Node ::-  Prism+treeForestChildren ::+  Traversable f =>+  Traversal'     (Tree f a b)-    (Tree f' a' b)-    (a, f (Tree f a b))-    (a', f' (Tree f' a' b))-_Node =-  prism-    (uncurry Node)-    (\case-        Node a t ->-          Right (a, t)-        Leaf b ->-          Left (Leaf b))---- |------ >>> toListOf _Node0 (Leaf "ABC" :: TreeList' String)--- []------ >>> toListOf _Node0 (Node "ABC" [] :: TreeList' String)--- []------ >>> toListOf _Node0 (Node "ABC" [Leaf "DEF"] :: TreeList' String)--- [("ABC",Leaf "DEF")]------ >>> toListOf _Node0 (Node "ABC" [Leaf "DEF", Leaf "GHI"] :: TreeList' String)--- [("ABC",Leaf "DEF"),("ABC",Leaf "GHI")]------ >>> toListOf _Node0 (Node "ABC" [Leaf "DEF", Node "GHI" []] :: TreeList' String)--- [("ABC",Leaf "DEF"),("ABC",Node "GHI" [])]-_Node0 ::-  Monoid a' =>-  Traversal-    (TreeList a b)-    (TreeList a' b)-    (a, TreeList a b)-    (a', TreeList a' b)-_Node0 _ (Leaf b) =-  pure (Leaf b)-_Node0 f (Node a t) =-  liftA2 Node (foldMap fst) (map snd) <$> traverse (\x -> f (a, x)) t---- |------ >>> preview _Node1 (Leaf 1 :: Tree1' Int)--- Nothing------ >>> preview _Node1 (Node 1 (Identity (Leaf 2)) :: Tree1' Int)--- Just (1,Leaf 2)-_Node1 ::-  Prism-    (Tree1 a b)-    (Tree1 a' b)-    (a, Tree1 a b)-    (a', Tree1 a' b)-_Node1 =-  prism-    (\(a, t) -> Node a (Identity t))-    (\case-        Node a t ->-          Right (a, runIdentity t)-        Leaf b ->-          Left (Leaf b)-    )+    (Tree f a b)+treeForestChildren =+  treeSubForest . _Right -nodeA ::-  Alternative f =>-  a-  -> Tree f a b-nodeA a =-  Node a empty+class HasTree x f a b | x -> f a b where+  tree ::+    Lens' x (Tree f a b)+  {-# INLINE treeLabel #-}+  treeLabel ::+    Lens' x a+  treeLabel =+    tree . treeLabel+  {-# INLINE treeForest #-}+  treeForest ::+    Lens' x (TreeForest f a b)+  treeForest =+    tree . treeForest -node ::-  a-  -> f (Tree f a b)-  -> Tree f a b-node =-  Node+instance HasTree (Tree f a b) f a b where+  tree =+    id+  {-# INLINE treeLabel #-}+  treeLabel f (Tree a t) =+    fmap (`Tree` t) (f a)+  {-# INLINE treeForest #-}+  treeForest f (Tree a t) =+    fmap (Tree a) (f t) -nodeList ::-  a-  -> [TreeList a b]-  -> TreeList a b-nodeList =-  Node+class AsTree x f a b | x -> f a b where+  _Tree ::+    Prism' x (Tree f a b) -node1 ::-  a-  -> Tree1 a b-  -> Tree1 a b-node1 a t =-  review _Node1 (a, t)+instance AsTree (Tree f a b) f a b where+  _Tree =+    id  -- | ----- >>> traverseNode (\(a, t) -> [(a, t)]) (Leaf 1 :: TreeList' Int)--- [Leaf 1]------ >>> traverseNode (\(a, t) -> [(a, t)]) (Node 1 [] :: TreeList' Int)--- [Node (1,[]) []]------ >>> traverseNode (\(a, t) -> [(a, t)]) (Node 1 [Leaf 2] :: TreeList' Int)--- [Node (1,[Leaf 2]) [Leaf 2]]+-- >>> dfs (Tree 1 [])+-- Left 1 :| [] ----- >>> traverseNode (\(a, t) -> [(a, t)]) (Node 1 [Leaf 2, Node 3 []] :: TreeList' Int)--- [Node (1,[Leaf 2,Node 3 []]) [Leaf 2,Node (3,[]) []]]-traverseNode ::-  Traversable f =>-  Traversal (Tree f a b) (Tree f a' b) (a, f (Tree f a b)) a'-traverseNode _ (Leaf b) =-  pure (Leaf b)-traverseNode f (Node a t) =-  Node <$> f (a, t) <*> traverse (traverseNode f) t--traverseNode_ ::-  Foldable f =>-  Traversal (Tree f a b) () (a, f (Tree f a b)) a'-traverseNode_ _ (Leaf b) =-  void (pure (Leaf b))-traverseNode_ f (Node a t) =-  f (a, t) *> traverse_ (traverseNode_ f) t--traverseNodeValues ::-  Traversable f =>-  Traversal (Tree f a x) (Tree f b x) a b-traverseNodeValues _ (Leaf b) =-  pure (Leaf b)-traverseNodeValues f (Node a t) =-  Node <$> f a <*> traverse (traverseNodeValues f) t--mapNodeValues ::-  Functor f =>-  (a -> b)-  -> Tree f a x-  -> Tree f b x-mapNodeValues _ (Leaf b) =-  Leaf b-mapNodeValues f (Node a t) =-  Node (f a) (fmap (mapNodeValues f) t)---- |+-- >>> dfs (Tree 1 [Left 2])+-- Left 1 :| [Right 2] ----- >>> view treeIso (Leaf 1 :: TreeList' Int)--- (1,Nothing)+-- >>> dfs (Tree 1 [Left 2, makeChild 3 []])+-- Left 1 :| [Right 2,Left 3] ----- >>> view treeIso (Node 1 [] :: TreeList' Int)--- (1,Just [])+-- >>> dfs (Tree 1 [Left 2, makeChild 3 [], Left 4])+-- Left 1 :| [Right 2,Left 3,Right 4] ----- >>> view treeIso (Node 1 [Leaf 2] :: TreeList' Int)--- (1,Just [Leaf 2])+-- >>> dfs (Tree 1 [Left 2, makeChild 3 [Left 5], Left 4])+-- Left 1 :| [Right 2,Left 3,Right 5,Right 4] ----- >>> view treeIso (Node 1 [Leaf 2, Node 3 []] :: TreeList' Int)--- (1,Just [Leaf 2,Node 3 []])-treeIso ::-  Iso-    (Tree' f a)-    (Tree' f' a')-    (a, Maybe (f (Tree' f a)))-    (a', Maybe (f' (Tree' f' a')))-treeIso =-  iso-    (matchTree (, Nothing) (\a t -> (a, Just t)))-    (\(a, t) -> maybe (Leaf a) (Node a) t)+-- >>> dfs (Tree 1 [Left 2, makeChild 3 [Left 5], Left 4, makeChild 6 []])+-- Left 1 :| [Right 2,Left 3,Right 5,Right 4,Left 6]+dfs ::+  Foldable f =>+  Tree f a b ->+  NonEmpty (Either a b)+dfs (Tree a t) =+  Left a :| foldMap (either (\b -> [Right b]) (toList . dfs)) t  -- | ----- >>> view treeValue' (Leaf 1 :: TreeList' Int)--- 1------ >>> view treeValue' (Node 1 [] :: TreeList' Int)--- 1------ >>> view treeValue' (Node 1 [Leaf 2] :: TreeList' Int)--- 1------ >>> view treeValue' (Node 1 [Leaf 2, Node 3 []] :: TreeList' Int)--- 1-treeValue' ::-  Lens'-    (Tree' f a)-    a-treeValue' =-  treeIso . _1---- |+-- >>> bfs (Tree 1 [])+-- Left 1 :| [] ----- >>> view treeChildren' (Leaf 1 :: TreeList' Int)--- Nothing+-- >>> bfs (Tree 1 [Left 2])+-- Left 1 :| [Right 2] ----- >>> view treeChildren' (Node 1 [] :: TreeList' Int)--- Just []+-- >>> bfs (Tree 1 [Left 2, makeChild 3 []])+-- Left 1 :| [Right 2,Left 3] ----- >>> view treeChildren' (Node 1 [Leaf 2, Leaf 3] :: TreeList' Int)--- Just [Leaf 2,Leaf 3]+-- >>> bfs (Tree 1 [Left 2, makeChild 3 [], Left 4])+-- Left 1 :| [Right 2,Right 4,Left 3] ----- >>> view treeChildren' (Node 1 [Leaf 2, Leaf 3, Node 4 []] :: TreeList' Int)--- Just [Leaf 2,Leaf 3,Node 4 []]+-- >>> bfs (Tree 1 [Left 2, makeChild 3 [Left 5], Left 4])+-- Left 1 :| [Right 2,Right 4,Left 3,Right 5] ----- >>> view treeChildren' (Node 1 [Leaf 2, Leaf 3, Node 4 [Node 5 []]] :: TreeList' Int)--- Just [Leaf 2,Leaf 3,Node 4 [Node 5 []]]-treeChildren' ::-  Lens-    (Tree' f a)-    (Tree' f' a)-    (Maybe (f (Tree' f a)))-    (Maybe (f' (Tree' f' a)))-treeChildren' =-  treeIso . _2+-- >>> bfs (Tree 1 [Left 2, makeChild 3 [Left 5], Left 4, makeChild 6 []])+-- Left 1 :| [Right 2,Right 4,Left 3,Right 5,Left 6]+bfs ::+  Foldable f =>+  Tree f a b+  -> NonEmpty (Either a b)+bfs root =+  let go (Tree a t :| rest) =+        let (leaves, c) =+              foldMap (either (\b -> ([Right b], [])) (\tr -> ([], [tr]))) t+        in  case nonEmpty (rest <> c) of+              Nothing -> Left a :| leaves+              Just q  -> Left a :| (leaves <> toList (go q))+  in  go (root :| []) -treeFree ::-  (Functor f, Functor f') =>-  Iso-    (Tree f a b)-    (Tree f' a' b')-    (Free (Compose ((,) a) f) b)-    (Free (Compose ((,) a') f') b')-treeFree =-  iso-    (foldTree Pure (\a t -> Free (Compose (a, t))))-    (-      let go (Pure b) =-            Leaf b-          go (Free x) =-            let (a, t) = getCompose x-            in  Node a (fmap go t)-      in  go-    )+makeChild ::+  a+  -> TreeForest f a b+  -> Either x (Tree f a b)+makeChild a t =+  Right (Tree a t) -treeFreeT ::-  (Functor f, Functor f') =>-  Iso-    (Tree f a b)-    (Tree f' a' b')-    (FreeT.Free (Compose ((,) a) f) b)-    (FreeT.Free (Compose ((,) a') f') b')-treeFreeT =-  iso-    (foldTree (FreeT.free . FreeT.Pure) (\a t -> FreeT.free (FreeT.Free (Compose (a, t)))))-    (-      let go (FreeT.Pure b) =-            Leaf b-          go (FreeT.Free x) =-            let (a, t) = getCompose x-            in  Node a (fmap (go . FreeT.runFree) t)-      in  go . FreeT.runFree-    )+makeLeaves ::+  Functor f =>+  a+  -> f b+  -> Tree f a b+makeLeaves a bs =+  Tree a (Left <$> bs) --- |------ >>> view baseTree (Node 1 [])--- Node {rootLabel = 1, subForest = []}------ >>> view baseTree (Node 1 [Node 2 []])--- Node {rootLabel = 1, subForest = [Node {rootLabel = 2, subForest = []}]}------ >>> view baseTree (Node 1 [Node 2 [], Node 3 [], Node 4 []])--- Node {rootLabel = 1, subForest = [Node {rootLabel = 2, subForest = []},Node {rootLabel = 3, subForest = []},Node {rootLabel = 4, subForest = []}]}------ >>> review baseTree (Tree.Node 1 [])--- Node 1 []------ >>> review baseTree (Tree.Node 1 [Tree.Node 2 []])--- Node 1 [Node 2 []]+makeChildren ::+  Functor f =>+  a+  -> f (Tree f a b)+  -> Tree f a b+makeChildren a cs =+  Tree a (Right <$> cs)+ baseTree ::-  Iso-    (TreeList a Void)-    (TreeList a' Void)-    (Tree.Tree a)-    (Tree.Tree a')+  Iso' (TreeList' a) (Tree.Tree a) baseTree =-  let mkTree h c =-        let go (Node a t) =-              Tree.Node a (fmap go t)-            go (Leaf b) =-              absurd b-        in  Tree.Node h (fmap go c)-      mkTreeList (Tree.Node h t) = Node h (fmap mkTreeList t)-  in  iso-        (matchTree absurd mkTree)-        (\(Tree.Node h t) -> Node h (fmap mkTreeList t))+  iso+    (+      let go (Tree a t) =+            Tree.Node a (fmap (either pure go) t)+      in  go)+    (+      let perNode (Tree.Node a []) =+            Left a+          perNode tr@(Tree.Node _ (_:_)) =+            Right tr+          go (Tree.Node a t) =+            Tree a (fmap (fmap go . perNode) t)+      in  go)