polytree 0.0.3 → 0.0.4

raw patch · 3 files changed

+176/−50 lines, 3 filesdep +freePVP ok

version bump matches the API change (PVP)

Dependencies added: free

API changes (from Hackage documentation)

Files

• changelog.md +7/−0
• polytree.cabal +2/−1
• src/Data/PolyTree.hs +167/−49

@@ -1,3 +1,10 @@+0.0.4++* Add `nodeValue` and `nodeChildren`+* Add `node` and `node0` and `node1` constructor functions+* Add `foldTreeFix`+* Add isomorphisms to Free monad+ 0.0.3  * Add Semigroup and Monoid instance

@@ -1,5 +1,5 @@ name:                 polytree-version:              0.0.3+version:              0.0.4 synopsis:             A polymorphic rose-tree description:          A rose-tree which has different data in the nodes and leaves license:              BSD3@@ -26,6 +26,7 @@   build-depends:        base                 >= 4.9   && < 6                       , bifunctors           >= 5.6   && < 7                       , containers           >= 0.6.7 && < 1+                      , free                 >= 5.2   && < 6                       , lens                 >= 5     && < 6                       , semigroupoids        >= 6.0.1 && < 7 

@@ -4,13 +4,14 @@  module Data.PolyTree where -import Control.Applicative+import Control.Applicative ( Applicative(liftA2) ) import Control.Lens     ( preview,       iso,       _Right,       prism,       prism',+      review,       Plated(..),       Field1(_1),       Field2(_2),@@ -19,7 +20,10 @@       Lens',       Prism,       Prism',-      Traversal )+      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(..) )@@ -34,6 +38,7 @@       Ord2(..),       Show1(liftShowsPrec),       Show2(..) )+import Data.Functor.Compose ( Compose(..) ) import Data.Functor.Identity ( Identity(..) ) import Data.Semigroup.Bifoldable ( Bifoldable1(bifoldMap1) ) import Data.Semigroup.Bitraversable ( Bitraversable1(bitraverse1) )@@ -148,13 +153,13 @@  -- | ----- >>> bimap (+1) (+2) (Leaf 10) :: Tree' [] Int+-- >>> bimap (+1) (+2) (Leaf 10) :: Tree0' Int -- Leaf 12 ----- >>> bimap (+1) (+2) (Node 20 [Leaf 10]) :: Tree' [] Int+-- >>> bimap (+1) (+2) (Node 20 [Leaf 10]) :: Tree0' Int -- Node 21 [Leaf 12] ----- >>> bimap (+1) (+2) (Node 20 [Node 30 [Leaf 10], Leaf 40]) :: Tree' [] Int+-- >>> bimap (+1) (+2) (Node 20 [Node 30 [Leaf 10], Leaf 40]) :: Tree0' Int -- Node 21 [Node 31 [Leaf 12],Leaf 42] instance Functor f => Bifunctor (Tree f) where   bimap _ g (Leaf b) =@@ -164,34 +169,34 @@  -- | ----- >>> fmap (+1) (Leaf 10) :: Tree' [] Int+-- >>> fmap (+1) (Leaf 10) :: Tree0' Int -- Leaf 11 ----- >>> fmap (+1) (Node 20 [Leaf 10]) :: Tree' [] Int+-- >>> fmap (+1) (Node 20 [Leaf 10]) :: Tree0' Int -- Node 20 [Leaf 11] ----- >>> fmap (+1) (Node 20 [Node 30 [Leaf 10], Leaf 40]) :: Tree' [] Int+-- >>> fmap (+1) (Node 20 [Node 30 [Leaf 10], Leaf 40]) :: Tree0' Int -- Node 20 [Node 30 [Leaf 11],Leaf 41] instance Functor f => Functor (Tree f a) where   fmap =     bimap id --- >>> Leaf (+1) <.> Leaf 10 :: Tree' [] Int+-- >>> Leaf (+1) <.> Leaf 10 :: Tree0' Int -- Leaf 11 ----- >>> Leaf (+1) <.> Node 10 [] :: Tree' [] Int+-- >>> Leaf (+1) <.> Node 10 [] :: Tree0' Int -- Node 10 [] ----- >>> Node 20 [] <.> Node 10 [] :: Tree' [] Int+-- >>> Node 20 [] <.> Node 10 [] :: Tree0' Int -- Node 20 [] ----- >>> Node 20 [] <.> Leaf 10 :: Tree' [] Int+-- >>> Node 20 [] <.> Leaf 10 :: Tree0' Int -- Node 20 [] ----- >>> Leaf (+1) <.> Node 20 [Leaf 10] :: Tree' [] Int+-- >>> Leaf (+1) <.> Node 20 [Leaf 10] :: Tree0' Int -- Node 20 [Leaf 11] ----- >>> Node 10 [] <.> Node 20 [Leaf 10] :: Tree' [] Int+-- >>> Node 10 [] <.> Node 20 [Leaf 10] :: Tree0' Int -- Node 10 [] instance Functor f => Apply (Tree f a) where   Leaf f <.> t =@@ -201,7 +206,7 @@  -- | ----- >>> pure 10 :: Tree' [] Int+-- >>> pure 10 :: Tree0' Int -- Leaf 10 instance Functor f => Applicative (Tree f a) where   pure =@@ -211,19 +216,19 @@  -- | ----- >>> Leaf 10 >>- \n -> Leaf (n + 1) :: Tree' [] Int+-- >>> Leaf 10 >>- \n -> Leaf (n + 1) :: Tree0' Int -- Leaf 11 ----- >>> Leaf 10 >>- \n -> Node 20 [] :: Tree' [] Int+-- >>> Leaf 10 >>- \n -> Node 20 [] :: Tree0' Int -- Node 20 [] ----- >>> Leaf 10 >>- \n -> Node 20 [Leaf 30] :: Tree' [] Int+-- >>> Leaf 10 >>- \n -> Node 20 [Leaf 30] :: Tree0' Int -- Node 20 [Leaf 30] -- -- >>> Node 10 [] >>- Leaf -- Node 10 [] ----- >>> Node 10 [] >>- \n -> Node 20 [Leaf n] :: Tree' [] Int+-- >>> Node 10 [] >>- \n -> Node 20 [Leaf n] :: Tree0' Int -- Node 10 [] instance Functor f => Bind (Tree f a) where   Leaf x >>- k =@@ -240,10 +245,10 @@ -- >>> bifoldMap1 reverse (<> "DEF") (Leaf "ABC" :: Tree1' String) -- "ABCDEF" ----- >>> bifoldMap1 reverse (<> "DEF") (_Node1 # ("ABC", Leaf "DEF"))+-- >>> bifoldMap1 reverse (<> "DEF") (node1 "ABC" (Leaf "DEF")) -- "CBADEFDEF" ----- >>> bifoldMap1 reverse (<> "DEF") (_Node1 # ("ABC", _Node1 # ("DEF", Leaf "GHI")))+-- >>> bifoldMap1 reverse (<> "DEF") (node1 "ABC" (node1 "DEF" (Leaf "GHI"))) -- "CBAFEDGHIDEF" instance Foldable1 f => Bifoldable1 (Tree f) where   bifoldMap1 _ g (Leaf b) =@@ -272,10 +277,10 @@ -- >>> foldMap1 reverse (Leaf "ABC" :: Tree1' String) -- "CBA" ----- >>> foldMap1 reverse (_Node1 # ("ABC", Leaf "DEF"))+-- >>> foldMap1 reverse (node1 "ABC" (Leaf "DEF")) -- "FED" ----- >>> foldMap1 reverse (_Node1 # ("ABC", _Node1 # ("DEF", Leaf "GHI")))+-- >>> foldMap1 reverse (node1 "ABC" (node1 "DEF" (Leaf "GHI"))) -- "IHG" instance Foldable1 f => Foldable1 (Tree f a) where   foldMap1 g (Leaf b) =@@ -382,18 +387,29 @@ foldTree _ n (Node a t) =   n a t +foldTreeFix ::+  Functor f =>+  (b -> x)+  -> (a -> f x -> x)+  -> Tree f a b+  -> x+foldTreeFix l _ (Leaf b) =+  l b+foldTreeFix l n (Node a t) =+  n a (fmap (foldTreeFix l n) t)+ -- | ----- >>> treeValue (Leaf 1 :: Tree' [] Int)+-- >>> treeValue (Leaf 1 :: Tree0' Int) -- Right 1 ----- >>> treeValue (Node 1 [] :: Tree' [] Int)+-- >>> treeValue (Node 1 [] :: Tree0' Int) -- Left 1 ----- >>> treeValue (Node 1 [Leaf 2] :: Tree' [] Int)+-- >>> treeValue (Node 1 [Leaf 2] :: Tree0' Int) -- Left 1 ----- >>> treeValue (Node 1 [Node 2 []] :: Tree' [] Int)+-- >>> treeValue (Node 1 [Node 2 []] :: Tree0' Int) -- Left 1 treeValue ::   Tree f a b@@ -403,16 +419,16 @@  -- | ----- >>> treeChildren (Leaf 1 :: Tree' [] Int)+-- >>> treeChildren (Leaf 1 :: Tree0' Int) -- Left 1 ----- >>> treeChildren (Node 1 [] :: Tree' [] Int)+-- >>> treeChildren (Node 1 [] :: Tree0' Int) -- Right [] ----- >>> treeChildren (Node 1 [Leaf 2] :: Tree' [] Int)+-- >>> treeChildren (Node 1 [Leaf 2] :: Tree0' Int) -- Right [Leaf 2] ----- >>> treeChildren (Node 1 [Leaf 2, Node 3 []] :: Tree' [] Int)+-- >>> treeChildren (Node 1 [Leaf 2, Node 3 []] :: Tree0' Int) -- Right [Leaf 2,Node 3 []] treeChildren ::   Tree f a b@@ -420,6 +436,48 @@ treeChildren =   foldTree Left (pure Right) +-- |+--+-- >>> toListOf nodeValue (Leaf 1)+-- []+--+-- >>> toListOf nodeValue (Node 1 [] :: Tree0' Int)+-- [1]+--+-- >>> toListOf nodeValue (Node 1 [Leaf 2] :: Tree0' Int)+-- [1]+--+-- >>> toListOf nodeValue (Node 1 [Leaf 2, Node 3 []] :: Tree0' Int)+-- [1]+nodeValue ::+  Traversal'+    (Tree f a b)+    a+nodeValue =+  _Node . _1++-- |+--+-- >>> toListOf nodeChildren (Leaf 1 :: Tree0' Int)+-- []+--+-- >>> toListOf nodeChildren (Node 1 [] :: Tree0' Int)+-- [[]]+--+-- >>> toListOf nodeChildren (Node 1 [Leaf 2] :: Tree0' Int)+-- [[Leaf 2]]+--+-- >>> toListOf nodeChildren (Node 1 [Leaf 2, Node 3 []] :: Tree0' Int)+-- [[Leaf 2,Node 3 []]]+nodeChildren ::+  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]@@ -462,10 +520,11 @@ bfs (Leaf b) =   pure (Right b) bfs (Node a ts) =-  let go' xs =-        foldMap (pure . treeValue) xs <>-        foldMap (maybe mempty go' . preview _Right . treeChildren) xs-  in  pure (Left a) <> go' ts+  let go xs =+        foldMap+          (`foldMap` xs)+          [pure . treeValue, maybe mempty go . preview _Right . treeChildren]+  in  pure (Left a) <> go ts  _Leaf ::   Prism'@@ -521,7 +580,7 @@ _Node0 _ (Leaf b) =   pure (Leaf b) _Node0 f (Node a t) =-  (Node <$> (mconcat . map fst) <*> map snd) <$> traverse (\x -> f (a, x)) t+  liftA2 Node (foldMap fst) (map snd) <$> traverse (\x -> f (a, x)) t  -- | --@@ -546,18 +605,39 @@           Left (Leaf b)     ) +node ::+  a+  -> f (Tree f a b)+  -> Tree f a b+node =+  Node++node0 ::+  a+  -> [Tree0 a b]+  -> Tree0 a b+node0 =+  Node++node1 ::+  a+  -> Tree1 a b+  -> Tree1 a b+node1 a t =+  review _Node1 (a, t)+ -- | ----- >>> view treeIso (Leaf 1 :: Tree' [] Int)+-- >>> view treeIso (Leaf 1 :: Tree0' Int) -- (1,Nothing) ----- >>> view treeIso (Node 1 [] :: Tree' [] Int)+-- >>> view treeIso (Node 1 [] :: Tree0' Int) -- (1,Just []) ----- >>> view treeIso (Node 1 [Leaf 2] :: Tree' [] Int)+-- >>> view treeIso (Node 1 [Leaf 2] :: Tree0' Int) -- (1,Just [Leaf 2]) ----- >>> view treeIso (Node 1 [Leaf 2, Node 3 []] :: Tree' [] Int)+-- >>> view treeIso (Node 1 [Leaf 2, Node 3 []] :: Tree0' Int) -- (1,Just [Leaf 2,Node 3 []]) treeIso ::   Iso@@ -572,16 +652,16 @@  -- | ----- >>> view treeValue' (Leaf 1 :: Tree' [] Int)+-- >>> view treeValue' (Leaf 1 :: Tree0' Int) -- 1 ----- >>> view treeValue' (Node 1 [] :: Tree' [] Int)+-- >>> view treeValue' (Node 1 [] :: Tree0' Int) -- 1 ----- >>> view treeValue' (Node 1 [Leaf 2] :: Tree' [] Int)+-- >>> view treeValue' (Node 1 [Leaf 2] :: Tree0' Int) -- 1 ----- >>> view treeValue' (Node 1 [Leaf 2, Node 3 []] :: Tree' [] Int)+-- >>> view treeValue' (Node 1 [Leaf 2, Node 3 []] :: Tree0' Int) -- 1 treeValue' ::   Lens'@@ -592,19 +672,19 @@  -- | ----- >>> view treeChildren' (Leaf 1 :: Tree' [] Int)+-- >>> view treeChildren' (Leaf 1 :: Tree0' Int) -- Nothing ----- >>> view treeChildren' (Node 1 [] :: Tree' [] Int)+-- >>> view treeChildren' (Node 1 [] :: Tree0' Int) -- Just [] ----- >>> view treeChildren' (Node 1 [Leaf 2, Leaf 3] :: Tree' [] Int)+-- >>> view treeChildren' (Node 1 [Leaf 2, Leaf 3] :: Tree0' Int) -- Just [Leaf 2,Leaf 3] ----- >>> view treeChildren' (Node 1 [Leaf 2, Leaf 3, Node 4 []] :: Tree' [] Int)+-- >>> view treeChildren' (Node 1 [Leaf 2, Leaf 3, Node 4 []] :: Tree0' Int) -- Just [Leaf 2,Leaf 3,Node 4 []] ----- >>> view treeChildren' (Node 1 [Leaf 2, Leaf 3, Node 4 [Node 5 []]] :: Tree' [] Int)+-- >>> view treeChildren' (Node 1 [Leaf 2, Leaf 3, Node 4 [Node 5 []]] :: Tree0' Int) -- Just [Leaf 2,Leaf 3,Node 4 [Node 5 []]] treeChildren' ::   Lens@@ -614,6 +694,44 @@     (Maybe (f' (Tree' f' a))) treeChildren' =   treeIso . _2++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+    (foldTreeFix 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+    )++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+    (foldTreeFix (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+    )  -- | --