{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}

-- |
-- Module      :  ELynx.Tree.Rooted
-- Description :  Rooted trees with labeled branches
-- Copyright   :  (c) Dominik Schrempf 2021
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Thu Jan 17 09:57:29 2019.
--
-- Rooted 'Tree's differs from a classical rose 'Data.Tree.Tree's in that they
-- have labeled branches.
--
-- For rooted topologies, please see 'ELynx.Topology.Rooted'.
--
-- A 'Tree' is defined as:
--
-- @
-- data Tree e a = Node
--   { branch :: e,
--     label :: a,
--     forest :: Forest e a
--   }
-- @
--
-- where
--
-- @
-- type Forest e a = [Tree e a]
-- @
--
-- This means, that the word 'Node' is reserved for the constructor of a tree,
-- and that a 'Node' has an attached 'branch', a 'label', and a sub-'forest'.
-- The terms /Node/ and /label/ referring to the value constructor 'Node' and
-- the record function 'label', respectively, are not to be confused. The
-- elements of the sub-forest are often called /children/.
--
-- In mathematical terms: A 'Tree' is a directed acyclic graph without loops,
-- with vertex labels, and with edge labels.
--
-- A short recap of recursive tree traversals:
--
-- - Pre-order: Root first, then sub trees from left to right. Also called depth
--   first.
--
-- - In-order: Only valid for bifurcating trees. Left sub tree first, then root,
--   then right sub tree.
--
-- - Post-order: Sub trees from left to right, then the root. Also called
--   breadth first.
--
-- Here, pre-order traversals are used exclusively, for example, by accessor
-- functions such as 'branches', or 'labels' which is the same as 'toList'.
-- Please let me know, if post-order algorithms are required.
module ELynx.Tree.Rooted
  ( -- * Tree with branch labels
    Tree (..),
    Forest,
    fromRoseTree,
    toTreeBranchLabels,
    toTreeNodeLabels,

    -- * Access leaves, branches and labels
    leaves,
    duplicateLeaves,
    setStem,
    modifyStem,
    branches,
    setBranches,
    setLabel,
    modifyLabel,
    labels,
    setLabels,
    identify,

    -- * Structure
    degree,
    depth,
    prune,
    dropNodesWith,
    dropLeavesWith,
    zipTreesWith,
    zipTrees,
    flipLabels,

    -- * Newtypes with specific instances
    ZipTree (..),
    BranchTree (..),
    ZipBranchTree (..),
  )
where

import Control.Applicative
import Control.Comonad
import Control.DeepSeq
import Control.Monad
import Data.Aeson
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.Data
import Data.Foldable
import Data.Functor
import Data.List
import Data.Maybe
import qualified Data.Set as S
import qualified Data.Tree as T
import GHC.Generics

-- | Rooted rose trees with branch labels.
--
-- Unary instances such as 'Functor' act on node labels, and not on branch
-- labels. Binary instances such as 'Bifunctor' act on both labels (`first` acts
-- on branches, `second` on node labels).
data Tree e a = Node
  { Tree e a -> e
branch :: e,
    Tree e a -> a
label :: a,
    Tree e a -> Forest e a
forest :: Forest e a
  }
  deriving (Tree e a -> Tree e a -> Bool
(Tree e a -> Tree e a -> Bool)
-> (Tree e a -> Tree e a -> Bool) -> Eq (Tree e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => Tree e a -> Tree e a -> Bool
/= :: Tree e a -> Tree e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => Tree e a -> Tree e a -> Bool
== :: Tree e a -> Tree e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => Tree e a -> Tree e a -> Bool
Eq, ReadPrec [Tree e a]
ReadPrec (Tree e a)
Int -> ReadS (Tree e a)
ReadS [Tree e a]
(Int -> ReadS (Tree e a))
-> ReadS [Tree e a]
-> ReadPrec (Tree e a)
-> ReadPrec [Tree e a]
-> Read (Tree e a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall e a. (Read e, Read a) => ReadPrec [Tree e a]
forall e a. (Read e, Read a) => ReadPrec (Tree e a)
forall e a. (Read e, Read a) => Int -> ReadS (Tree e a)
forall e a. (Read e, Read a) => ReadS [Tree e a]
readListPrec :: ReadPrec [Tree e a]
$creadListPrec :: forall e a. (Read e, Read a) => ReadPrec [Tree e a]
readPrec :: ReadPrec (Tree e a)
$creadPrec :: forall e a. (Read e, Read a) => ReadPrec (Tree e a)
readList :: ReadS [Tree e a]
$creadList :: forall e a. (Read e, Read a) => ReadS [Tree e a]
readsPrec :: Int -> ReadS (Tree e a)
$creadsPrec :: forall e a. (Read e, Read a) => Int -> ReadS (Tree e a)
Read, Int -> Tree e a -> ShowS
[Tree e a] -> ShowS
Tree e a -> String
(Int -> Tree e a -> ShowS)
-> (Tree e a -> String) -> ([Tree e a] -> ShowS) -> Show (Tree e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Tree e a -> ShowS
forall e a. (Show e, Show a) => [Tree e a] -> ShowS
forall e a. (Show e, Show a) => Tree e a -> String
showList :: [Tree e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [Tree e a] -> ShowS
show :: Tree e a -> String
$cshow :: forall e a. (Show e, Show a) => Tree e a -> String
showsPrec :: Int -> Tree e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Tree e a -> ShowS
Show, Typeable (Tree e a)
DataType
Constr
Typeable (Tree e a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Tree e a -> c (Tree e a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Tree e a))
-> (Tree e a -> Constr)
-> (Tree e a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Tree e a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Tree e a)))
-> ((forall b. Data b => b -> b) -> Tree e a -> Tree e a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Tree e a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Tree e a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Tree e a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Tree e a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a))
-> Data (Tree e a)
Tree e a -> DataType
Tree e a -> Constr
(forall b. Data b => b -> b) -> Tree e a -> Tree e a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree e a -> c (Tree e a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree e a)
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree e a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Tree e a -> u
forall u. (forall d. Data d => d -> u) -> Tree e a -> [u]
forall e a. (Data e, Data a) => Typeable (Tree e a)
forall e a. (Data e, Data a) => Tree e a -> DataType
forall e a. (Data e, Data a) => Tree e a -> Constr
forall e a.
(Data e, Data a) =>
(forall b. Data b => b -> b) -> Tree e a -> Tree e a
forall e a u.
(Data e, Data a) =>
Int -> (forall d. Data d => d -> u) -> Tree e a -> u
forall e a u.
(Data e, Data a) =>
(forall d. Data d => d -> u) -> Tree e a -> [u]
forall e a r r'.
(Data e, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Tree e a -> r
forall e a r r'.
(Data e, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Tree e a -> r
forall e a (m :: * -> *).
(Data e, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a)
forall e a (m :: * -> *).
(Data e, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a)
forall e a (c :: * -> *).
(Data e, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree e a)
forall e a (c :: * -> *).
(Data e, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree e a -> c (Tree e a)
forall e a (t :: * -> *) (c :: * -> *).
(Data e, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Tree e a))
forall e a (t :: * -> * -> *) (c :: * -> *).
(Data e, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree e a))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Tree e a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Tree e a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree e a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree e a -> c (Tree e a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Tree e a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree e a))
$cNode :: Constr
$tTree :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a)
$cgmapMo :: forall e a (m :: * -> *).
(Data e, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a)
gmapMp :: (forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a)
$cgmapMp :: forall e a (m :: * -> *).
(Data e, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a)
gmapM :: (forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a)
$cgmapM :: forall e a (m :: * -> *).
(Data e, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Tree e a -> m (Tree e a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Tree e a -> u
$cgmapQi :: forall e a u.
(Data e, Data a) =>
Int -> (forall d. Data d => d -> u) -> Tree e a -> u
gmapQ :: (forall d. Data d => d -> u) -> Tree e a -> [u]
$cgmapQ :: forall e a u.
(Data e, Data a) =>
(forall d. Data d => d -> u) -> Tree e a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Tree e a -> r
$cgmapQr :: forall e a r r'.
(Data e, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Tree e a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Tree e a -> r
$cgmapQl :: forall e a r r'.
(Data e, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Tree e a -> r
gmapT :: (forall b. Data b => b -> b) -> Tree e a -> Tree e a
$cgmapT :: forall e a.
(Data e, Data a) =>
(forall b. Data b => b -> b) -> Tree e a -> Tree e a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree e a))
$cdataCast2 :: forall e a (t :: * -> * -> *) (c :: * -> *).
(Data e, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree e a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Tree e a))
$cdataCast1 :: forall e a (t :: * -> *) (c :: * -> *).
(Data e, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Tree e a))
dataTypeOf :: Tree e a -> DataType
$cdataTypeOf :: forall e a. (Data e, Data a) => Tree e a -> DataType
toConstr :: Tree e a -> Constr
$ctoConstr :: forall e a. (Data e, Data a) => Tree e a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree e a)
$cgunfold :: forall e a (c :: * -> *).
(Data e, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree e a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree e a -> c (Tree e a)
$cgfoldl :: forall e a (c :: * -> *).
(Data e, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree e a -> c (Tree e a)
$cp1Data :: forall e a. (Data e, Data a) => Typeable (Tree e a)
Data, (forall x. Tree e a -> Rep (Tree e a) x)
-> (forall x. Rep (Tree e a) x -> Tree e a) -> Generic (Tree e a)
forall x. Rep (Tree e a) x -> Tree e a
forall x. Tree e a -> Rep (Tree e a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e a x. Rep (Tree e a) x -> Tree e a
forall e a x. Tree e a -> Rep (Tree e a) x
$cto :: forall e a x. Rep (Tree e a) x -> Tree e a
$cfrom :: forall e a x. Tree e a -> Rep (Tree e a) x
Generic)

-- | Shorthand.
type Forest e a = [Tree e a]

-- | Map over node labels.
instance Functor (Tree e) where
  fmap :: (a -> b) -> Tree e a -> Tree e b
fmap a -> b
f ~(Node e
br a
lb Forest e a
ts) = e -> b -> Forest e b -> Tree e b
forall e a. e -> a -> Forest e a -> Tree e a
Node e
br (a -> b
f a
lb) (Forest e b -> Tree e b) -> Forest e b -> Tree e b
forall a b. (a -> b) -> a -> b
$ (Tree e a -> Tree e b) -> Forest e a -> Forest e b
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Tree e a -> Tree e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Forest e a
ts
  a
lb <$ :: a -> Tree e b -> Tree e a
<$ ~(Node e
br b
_ Forest e b
ts) = e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb ((Tree e b -> Tree e a) -> Forest e b -> Forest e a
forall a b. (a -> b) -> [a] -> [b]
map (a
lb a -> Tree e b -> Tree e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) Forest e b
ts)

-- | The function 'first' acts on branch labels, 'second' on node labels.
instance Bifunctor Tree where
  bimap :: (a -> b) -> (c -> d) -> Tree a c -> Tree b d
bimap a -> b
f c -> d
g ~(Node a
br c
lb Forest a c
ts) = b -> d -> Forest b d -> Tree b d
forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b
f a
br) (c -> d
g c
lb) (Forest b d -> Tree b d) -> Forest b d -> Tree b d
forall a b. (a -> b) -> a -> b
$ (Tree a c -> Tree b d) -> Forest a c -> Forest b d
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> (c -> d) -> Tree a c -> Tree b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) Forest a c
ts
  first :: (a -> b) -> Tree a c -> Tree b c
first a -> b
f ~(Node a
br c
lb Forest a c
ts) = b -> c -> Forest b c -> Tree b c
forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b
f a
br) c
lb (Forest b c -> Tree b c) -> Forest b c -> Tree b c
forall a b. (a -> b) -> a -> b
$ (Tree a c -> Tree b c) -> Forest a c -> Forest b c
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Tree a c -> Tree b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) Forest a c
ts
  second :: (b -> c) -> Tree a b -> Tree a c
second b -> c
g ~(Node a
br b
lb Forest a b
ts) = a -> c -> Forest a c -> Tree a c
forall e a. e -> a -> Forest e a -> Tree e a
Node a
br (b -> c
g b
lb) (Forest a c -> Tree a c) -> Forest a c -> Tree a c
forall a b. (a -> b) -> a -> b
$ (Tree a b -> Tree a c) -> Forest a b -> Forest a c
forall a b. (a -> b) -> [a] -> [b]
map ((b -> c) -> Tree a b -> Tree a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second b -> c
g) Forest a b
ts

-- | Combine node labels in pre-order.
instance Foldable (Tree e) where
  foldMap :: (a -> m) -> Tree e a -> m
foldMap a -> m
f ~(Node e
_ a
lb Forest e a
ts) = a -> m
f a
lb m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Tree e a -> m) -> Forest e a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> Tree e a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) Forest e a
ts
  null :: Tree e a -> Bool
null Tree e a
_ = Bool
False
  {-# INLINE null #-}
  toList :: Tree e a -> [a]
toList = Tree e a -> [a]
forall e a. Tree e a -> [a]
labels
  {-# INLINE toList #-}

instance Bifoldable Tree where
  bifoldMap :: (a -> m) -> (b -> m) -> Tree a b -> m
bifoldMap a -> m
f b -> m
g ~(Node a
br b
lb Forest a b
ts) = a -> m
f a
br m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
lb m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Tree a b -> m) -> Forest a b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> Tree a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) Forest a b
ts

instance Traversable (Tree e) where
  traverse :: (a -> f b) -> Tree e a -> f (Tree e b)
traverse a -> f b
g ~(Node e
br a
lb Forest e a
ts) = e -> b -> Forest e b -> Tree e b
forall e a. e -> a -> Forest e a -> Tree e a
Node e
br (b -> Forest e b -> Tree e b) -> f b -> f (Forest e b -> Tree e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
g a
lb f (Forest e b -> Tree e b) -> f (Forest e b) -> f (Tree e b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree e a -> f (Tree e b)) -> Forest e a -> f (Forest e b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> Tree e a -> f (Tree e b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
g) Forest e a
ts

instance Bitraversable Tree where
  bitraverse :: (a -> f c) -> (b -> f d) -> Tree a b -> f (Tree c d)
bitraverse a -> f c
f b -> f d
g ~(Node a
br b
lb Forest a b
ts) = c -> d -> Forest c d -> Tree c d
forall e a. e -> a -> Forest e a -> Tree e a
Node (c -> d -> Forest c d -> Tree c d)
-> f c -> f (d -> Forest c d -> Tree c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
br f (d -> Forest c d -> Tree c d)
-> f d -> f (Forest c d -> Tree c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
lb f (Forest c d -> Tree c d) -> f (Forest c d) -> f (Tree c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree a b -> f (Tree c d)) -> Forest a b -> f (Forest c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c) -> (b -> f d) -> Tree a b -> f (Tree c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) Forest a b
ts

-- | The 'Semigroup' instance of the branch labels determines how the
-- branches are combined. For example, distances can be summed using
-- 'Data.Semigroup.Sum'.
--
-- The 'Monoid' instance of the branch labels determines the default branch
-- label when using 'pure'.
--
-- This instance is similar to the one provided by 'Data.Tree.Tree'. For an
-- alternative, see 'ZipTree'.
instance (Semigroup e, Monoid e) => Applicative (Tree e) where
  pure :: a -> Tree e a
pure a
lb = e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
forall a. Monoid a => a
mempty a
lb []
  ~(Node e
brF a -> b
lbF Forest e (a -> b)
tsF) <*> :: Tree e (a -> b) -> Tree e a -> Tree e b
<*> ~tx :: Tree e a
tx@(Node e
brX a
lbX Forest e a
tsX) =
    e -> b -> Forest e b -> Tree e b
forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brF e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
brX) (a -> b
lbF a
lbX) ((Tree e a -> Tree e b) -> Forest e a -> Forest e b
forall a b. (a -> b) -> [a] -> [b]
map ((e -> e) -> (a -> b) -> Tree e a -> Tree e b
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (e
brF e -> e -> e
forall a. Semigroup a => a -> a -> a
<>) a -> b
lbF) Forest e a
tsX Forest e b -> Forest e b -> Forest e b
forall a. [a] -> [a] -> [a]
++ (Tree e (a -> b) -> Tree e b) -> Forest e (a -> b) -> Forest e b
forall a b. (a -> b) -> [a] -> [b]
map (Tree e (a -> b) -> Tree e a -> Tree e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tree e a
tx) Forest e (a -> b)
tsF)
  liftA2 :: (a -> b -> c) -> Tree e a -> Tree e b -> Tree e c
liftA2 a -> b -> c
f ~(Node e
brX a
lbX Forest e a
tsX) ~ty :: Tree e b
ty@(Node e
brY b
lbY Forest e b
tsY) =
    e -> c -> Forest e c -> Tree e c
forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
brY) (a -> b -> c
f a
lbX b
lbY) ((Tree e b -> Tree e c) -> Forest e b -> Forest e c
forall a b. (a -> b) -> [a] -> [b]
map ((e -> e) -> (b -> c) -> Tree e b -> Tree e c
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (e
brX e -> e -> e
forall a. Semigroup a => a -> a -> a
<>) (a -> b -> c
f a
lbX)) Forest e b
tsY Forest e c -> Forest e c -> Forest e c
forall a. [a] -> [a] -> [a]
++ (Tree e a -> Tree e c) -> Forest e a -> Forest e c
forall a b. (a -> b) -> [a] -> [b]
map (\Tree e a
tx -> (a -> b -> c) -> Tree e a -> Tree e b -> Tree e c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Tree e a
tx Tree e b
ty) Forest e a
tsX)
  ~(Node e
brX a
_ Forest e a
tsX) *> :: Tree e a -> Tree e b -> Tree e b
*> ~ty :: Tree e b
ty@(Node e
brY b
lbY Forest e b
tsY) =
    e -> b -> Forest e b -> Tree e b
forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
brY) b
lbY ((Tree e b -> Tree e b) -> Forest e b -> Forest e b
forall a b. (a -> b) -> [a] -> [b]
map ((e -> e) -> Tree e b -> Tree e b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (e
brX e -> e -> e
forall a. Semigroup a => a -> a -> a
<>)) Forest e b
tsY Forest e b -> Forest e b -> Forest e b
forall a. [a] -> [a] -> [a]
++ (Forest e a
tsX Forest e a -> (Tree e a -> Tree e b) -> Forest e b
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Tree e a -> Tree e b -> Tree e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tree e b
ty)))
  ~(Node e
brX a
lbX Forest e a
tsX) <* :: Tree e a -> Tree e b -> Tree e a
<* ~ty :: Tree e b
ty@(Node e
brY b
_ Forest e b
tsY) =
    e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
brY) a
lbX ((Tree e b -> Tree e a) -> Forest e b -> Forest e a
forall a b. (a -> b) -> [a] -> [b]
map ((e -> e) -> (b -> a) -> Tree e b -> Tree e a
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (e
brX e -> e -> e
forall a. Semigroup a => a -> a -> a
<>) (a -> b -> a
forall a b. a -> b -> a
const a
lbX)) Forest e b
tsY Forest e a -> Forest e a -> Forest e a
forall a. [a] -> [a] -> [a]
++ (Forest e a
tsX Forest e a -> (Tree e a -> Tree e a) -> Forest e a
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Tree e a -> Tree e b -> Tree e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tree e b
ty)))

-- | The 'Semigroup' instance of the branch labels determines how the branches
-- are combined. For example, distances can be summed using
-- 'Data.Semigroup.Sum'.
--
-- The 'Monoid' instance of the branch labels determines the default branch
-- label when using 'return'.
instance (Semigroup e, Monoid e) => Monad (Tree e) where
  ~(Node e
br a
lb Forest e a
ts) >>= :: Tree e a -> (a -> Tree e b) -> Tree e b
>>= a -> Tree e b
f = case a -> Tree e b
f a
lb of
    Node e
br' b
lb' Forest e b
ts' -> e -> b -> Forest e b -> Tree e b
forall e a. e -> a -> Forest e a -> Tree e a
Node (e
br e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
br') b
lb' ((Tree e b -> Tree e b) -> Forest e b -> Forest e b
forall a b. (a -> b) -> [a] -> [b]
map ((e -> e) -> Tree e b -> Tree e b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (e
br e -> e -> e
forall a. Semigroup a => a -> a -> a
<>)) Forest e b
ts' Forest e b -> Forest e b -> Forest e b
forall a. [a] -> [a] -> [a]
++ (Tree e a -> Tree e b) -> Forest e a -> Forest e b
forall a b. (a -> b) -> [a] -> [b]
map (Tree e a -> (a -> Tree e b) -> Tree e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Tree e b
f) Forest e a
ts)

-- -- NOTE: We cannot provide a MonadZip instance because branch labels cannot
-- -- be recovered from the combined label.
--
-- instance Monoid e => MonadZip (Tree e) where
--   mzipWith f (Node brL lbL tsL) (Node brR lbR tsR) =
--     Node (brL <> brR) (f lbL lbR) (mzipWith (mzipWith f) tsL tsR)
--
--   munzip (Node br (lbL, lbR) ts) = (Node ? lbL tsL, Node ? lbR tsR)
--     where
--       (tsL, tsR) = munzip (map munzip ts)

-- -- NOTE: I don't really know much about 'MonadFix', and so do not provide the
-- -- instance.
--
-- instance Monoid e => MonadFix (Tree e) where
--   mfix = mfixTree

-- mfixTree :: (a -> Tree e a) -> Tree e a
-- mfixTree f
--   | Node br lb ts <- fix (f . label) =
--     Node
--       br
--       lb
--       ( zipWith
--           (\i _ -> mfixTree ((!! i) . forest . f))
--           [0 ..]
--           ts
--       )

instance Comonad (Tree e) where
  duplicate :: Tree e a -> Tree e (Tree e a)
duplicate t :: Tree e a
t@(Node e
br a
_ Forest e a
ts) = e -> Tree e a -> Forest e (Tree e a) -> Tree e (Tree e a)
forall e a. e -> a -> Forest e a -> Tree e a
Node e
br Tree e a
t ((Tree e a -> Tree e (Tree e a))
-> Forest e a -> Forest e (Tree e a)
forall a b. (a -> b) -> [a] -> [b]
map Tree e a -> Tree e (Tree e a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate Forest e a
ts)
  extract :: Tree e a -> a
extract = Tree e a -> a
forall e a. Tree e a -> a
label
  {-# INLINE extract #-}

instance (NFData e, NFData a) => NFData (Tree e a) where
  rnf :: Tree e a -> ()
rnf (Node e
br a
lb Forest e a
ts) = e -> ()
forall a. NFData a => a -> ()
rnf e
br () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
lb () -> () -> ()
`seq` Forest e a -> ()
forall a. NFData a => a -> ()
rnf Forest e a
ts

instance (ToJSON e, ToJSON a) => ToJSON (Tree e a)

instance (FromJSON e, FromJSON a) => FromJSON (Tree e a)

-- | Conversion from 'T.Tree'.
fromRoseTree :: T.Tree a -> Tree () a
fromRoseTree :: Tree a -> Tree () a
fromRoseTree (T.Node a
l Forest a
ts) = () -> a -> Forest () a -> Tree () a
forall e a. e -> a -> Forest e a -> Tree e a
Node () a
l (Forest () a -> Tree () a) -> Forest () a -> Tree () a
forall a b. (a -> b) -> a -> b
$ (Tree a -> Tree () a) -> Forest a -> Forest () a
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> Tree () a
forall a. Tree a -> Tree () a
fromRoseTree Forest a
ts

-- | Conversion to 'T.Tree' using branch labels.
toTreeBranchLabels :: Tree e a -> T.Tree e
toTreeBranchLabels :: Tree e a -> Tree e
toTreeBranchLabels (Node e
br a
_ Forest e a
ts) = e -> Forest e -> Tree e
forall a. a -> Forest a -> Tree a
T.Node e
br ((Tree e a -> Tree e) -> Forest e a -> Forest e
forall a b. (a -> b) -> [a] -> [b]
map Tree e a -> Tree e
forall e a. Tree e a -> Tree e
toTreeBranchLabels Forest e a
ts)

-- | Conversion to 'T.Tree' using node labels.
toTreeNodeLabels :: Tree e a -> T.Tree a
toTreeNodeLabels :: Tree e a -> Tree a
toTreeNodeLabels (Node e
_ a
lb Forest e a
ts) = a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
T.Node a
lb ((Tree e a -> Tree a) -> Forest e a -> Forest a
forall a b. (a -> b) -> [a] -> [b]
map Tree e a -> Tree a
forall e a. Tree e a -> Tree a
toTreeNodeLabels Forest e a
ts)

-- | List of leaves.
leaves :: Tree e a -> [a]
leaves :: Tree e a -> [a]
leaves Tree e a
t = Tree e a -> [a] -> [a]
forall e a. Tree e a -> [a] -> [a]
squish Tree e a
t []
  where
    squish :: Tree e a -> [a] -> [a]
squish (Node e
_ a
lb []) [a]
xs = a
lb a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
    squish (Node e
_ a
_ [Tree e a]
ts) [a]
xs = (Tree e a -> [a] -> [a]) -> [a] -> [Tree e a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree e a -> [a] -> [a]
squish [a]
xs [Tree e a]
ts

duplicates :: Ord a => [a] -> Bool
duplicates :: [a] -> Bool
duplicates = Set a -> [a] -> Bool
forall a. Ord a => Set a -> [a] -> Bool
go Set a
forall a. Set a
S.empty
  where
    go :: Set a -> [a] -> Bool
go Set a
_ [] = Bool
False
    go Set a
seen (a
x : [a]
xs) = a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
seen Bool -> Bool -> Bool
|| Set a -> [a] -> Bool
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
x Set a
seen) [a]
xs

-- | Check if a tree has duplicate leaves.
duplicateLeaves :: Ord a => Tree e a -> Bool
duplicateLeaves :: Tree e a -> Bool
duplicateLeaves = [a] -> Bool
forall a. Ord a => [a] -> Bool
duplicates ([a] -> Bool) -> (Tree e a -> [a]) -> Tree e a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree e a -> [a]
forall e a. Tree e a -> [a]
leaves

-- | Set the stem to a given value.
setStem :: e -> Tree e a -> Tree e a
setStem :: e -> Tree e a -> Tree e a
setStem e
br (Node e
_ a
lb Forest e a
ts) = e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb Forest e a
ts

-- | Modify the stem of a tree.
modifyStem :: (e -> e) -> Tree e a -> Tree e a
modifyStem :: (e -> e) -> Tree e a -> Tree e a
modifyStem e -> e
f Tree e a
t = Tree e a
t {branch :: e
branch = e -> e
f (e -> e) -> e -> e
forall a b. (a -> b) -> a -> b
$ Tree e a -> e
forall e a. Tree e a -> e
branch Tree e a
t}

-- | Get branch labels in pre-order.
branches :: Tree e a -> [e]
branches :: Tree e a -> [e]
branches Tree e a
t = Tree e a -> [e] -> [e]
forall a a. Tree a a -> [a] -> [a]
squish Tree e a
t []
  where
    squish :: Tree a a -> [a] -> [a]
squish (Node a
br a
_ Forest a a
ts) [a]
xs = a
br a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Tree a a -> [a] -> [a]) -> [a] -> Forest a a -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree a a -> [a] -> [a]
squish [a]
xs Forest a a
ts

-- | Set branch labels in pre-order.
--
-- Return 'Nothing' if the provided list of branch labels is too short.
setBranches :: Bitraversable t => [f] -> t e a -> Maybe (t f a)
setBranches :: [f] -> t e a -> Maybe (t f a)
setBranches [f]
xs = t (Maybe f) (Maybe a) -> Maybe (t f a)
forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequenceA (t (Maybe f) (Maybe a) -> Maybe (t f a))
-> (t e a -> t (Maybe f) (Maybe a)) -> t e a -> Maybe (t f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([f], t (Maybe f) (Maybe a)) -> t (Maybe f) (Maybe a)
forall a b. (a, b) -> b
snd (([f], t (Maybe f) (Maybe a)) -> t (Maybe f) (Maybe a))
-> (t e a -> ([f], t (Maybe f) (Maybe a)))
-> t e a
-> t (Maybe f) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([f] -> e -> ([f], Maybe f))
-> ([f] -> a -> ([f], Maybe a))
-> [f]
-> t e a
-> ([f], t (Maybe f) (Maybe a))
forall (t :: * -> * -> *) a b c d e.
Bitraversable t =>
(a -> b -> (a, c))
-> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e)
bimapAccumL [f] -> e -> ([f], Maybe f)
forall a p. [a] -> p -> ([a], Maybe a)
setBranch [f] -> a -> ([f], Maybe a)
forall a a. a -> a -> (a, Maybe a)
noChange [f]
xs
  where
    setBranch :: [a] -> p -> ([a], Maybe a)
setBranch [] p
_ = ([], Maybe a
forall a. Maybe a
Nothing)
    setBranch (a
y : [a]
ys) p
_ = ([a]
ys, a -> Maybe a
forall a. a -> Maybe a
Just a
y)
    noChange :: a -> a -> (a, Maybe a)
noChange a
ys a
z = (a
ys, a -> Maybe a
forall a. a -> Maybe a
Just a
z)

-- | Set label.
setLabel :: a -> Tree e a -> Tree e a
setLabel :: a -> Tree e a -> Tree e a
setLabel a
lb (Node e
br a
_ Forest e a
ts) = e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb Forest e a
ts

-- | Modify the root label of a tree.
modifyLabel :: (a -> a) -> Tree e a -> Tree e a
modifyLabel :: (a -> a) -> Tree e a -> Tree e a
modifyLabel a -> a
f Tree e a
t = Tree e a
t {label :: a
label = a -> a
f (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Tree e a -> a
forall e a. Tree e a -> a
label Tree e a
t}

-- | Return node labels in pre-order.
labels :: Tree e a -> [a]
labels :: Tree e a -> [a]
labels Tree e a
t = Tree e a -> [a] -> [a]
forall e a. Tree e a -> [a] -> [a]
squish Tree e a
t []
  where
    squish :: Tree e a -> [a] -> [a]
squish (Node e
_ a
lb Forest e a
ts) [a]
xs = a
lb a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Tree e a -> [a] -> [a]) -> [a] -> Forest e a -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree e a -> [a] -> [a]
squish [a]
xs Forest e a
ts

-- | Set node labels in pre-order.
--
-- Return 'Nothing' if the provided list of node labels is too short.
setLabels :: Traversable t => [b] -> t a -> Maybe (t b)
setLabels :: [b] -> t a -> Maybe (t b)
setLabels [b]
xs = t (Maybe b) -> Maybe (t b)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (t (Maybe b) -> Maybe (t b))
-> (t a -> t (Maybe b)) -> t a -> Maybe (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b], t (Maybe b)) -> t (Maybe b)
forall a b. (a, b) -> b
snd (([b], t (Maybe b)) -> t (Maybe b))
-> (t a -> ([b], t (Maybe b))) -> t a -> t (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b] -> a -> ([b], Maybe b)) -> [b] -> t a -> ([b], t (Maybe b))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL [b] -> a -> ([b], Maybe b)
forall a p. [a] -> p -> ([a], Maybe a)
setLabelM [b]
xs
  where
    setLabelM :: [a] -> p -> ([a], Maybe a)
setLabelM [] p
_ = ([], Maybe a
forall a. Maybe a
Nothing)
    setLabelM (a
y : [a]
ys) p
_ = ([a]
ys, a -> Maybe a
forall a. a -> Maybe a
Just a
y)

-- | Label the nodes in pre-order with unique indices starting at 0.
identify :: Traversable t => t a -> t Int
identify :: t a -> t Int
identify = (Int, t Int) -> t Int
forall a b. (a, b) -> b
snd ((Int, t Int) -> t Int) -> (t a -> (Int, t Int)) -> t a -> t Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> (Int, Int)) -> Int -> t a -> (Int, t Int)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\Int
i a
_ -> (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
i)) (Int
0 :: Int)

-- | Degree of the root node.
--
-- The degree of a node is the number of branches attached to the node.
degree :: Tree e a -> Int
degree :: Tree e a -> Int
degree = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> (Tree e a -> Int) -> Tree e a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree e a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Tree e a] -> Int) -> (Tree e a -> [Tree e a]) -> Tree e a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree e a -> [Tree e a]
forall e a. Tree e a -> Forest e a
forest

-- | Depth of a tree.
--
-- The [depth of a tree](https://en.wikipedia.org/wiki/Tree-depth) is the
-- largest number of nodes traversed on a path from the root to a leaf.
--
-- By convention, the depth is larger equal 1. That is, the depth of a leaf tree
-- is 1.
depth :: Tree e a -> Int
depth :: Tree e a -> Int
depth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (Tree e a -> [Int]) -> Tree e a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Tree e a -> [Int]
forall t e a. Num t => t -> Tree e a -> [t]
go Int
1
  where
    go :: t -> Tree e a -> [t]
go t
n (Node e
_ a
_ []) = [t
n]
    go t
n (Node e
_ a
_ [Tree e a]
xs) = (Tree e a -> [t]) -> [Tree e a] -> [t]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (t -> Tree e a -> [t]
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)) [Tree e a]
xs

-- | Prune degree two nodes.
--
-- The label of a pruned node is lost. The branches are combined according to
-- their 'Semigroup' instance of the form
--
-- @\daughterBranch parentBranch -> combinedBranch@.
prune :: Semigroup e => Tree e a -> Tree e a
prune :: Tree e a -> Tree e a
prune t :: Tree e a
t@(Node e
_ a
_ []) = Tree e a
t
prune (Node e
paBr a
_ [Node e
daBr a
daLb [Tree e a]
daTs]) = e -> a -> [Tree e a] -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node (e
daBr e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
paBr) a
daLb [Tree e a]
daTs
prune (Node e
paBr a
paLb [Tree e a]
paTs) = e -> a -> [Tree e a] -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
paBr a
paLb ([Tree e a] -> Tree e a) -> [Tree e a] -> Tree e a
forall a b. (a -> b) -> a -> b
$ (Tree e a -> Tree e a) -> [Tree e a] -> [Tree e a]
forall a b. (a -> b) -> [a] -> [b]
map Tree e a -> Tree e a
forall e a. Semigroup e => Tree e a -> Tree e a
prune [Tree e a]
paTs

-- | Drop nodes satisfying predicate.
--
-- Degree two nodes may arise.
--
-- Also drop nodes of which all daughter nodes are dropped.
--
-- Return 'Nothing' if
--
-- - The root node satisfies the predicate.
--
-- - All daughter nodes of the root are dropped.
dropNodesWith :: (a -> Bool) -> Tree e a -> Maybe (Tree e a)
dropNodesWith :: (a -> Bool) -> Tree e a -> Maybe (Tree e a)
dropNodesWith a -> Bool
p (Node e
br a
lb Forest e a
ts)
  | a -> Bool
p a
lb = Maybe (Tree e a)
forall a. Maybe a
Nothing
  | Bool
otherwise =
    if Forest e a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Forest e a
ts'
      then Maybe (Tree e a)
forall a. Maybe a
Nothing
      else Tree e a -> Maybe (Tree e a)
forall a. a -> Maybe a
Just (Tree e a -> Maybe (Tree e a)) -> Tree e a -> Maybe (Tree e a)
forall a b. (a -> b) -> a -> b
$ e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb Forest e a
ts'
  where
    ts' :: Forest e a
ts' = (Tree e a -> Maybe (Tree e a)) -> Forest e a -> Forest e a
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((a -> Bool) -> Tree e a -> Maybe (Tree e a)
forall a e. (a -> Bool) -> Tree e a -> Maybe (Tree e a)
dropNodesWith a -> Bool
p) Forest e a
ts

-- | Drop leaves satisfying predicate.
--
-- Degree two nodes may arise.
--
-- Also drop nodes of which all daughter nodes are dropped.
--
-- Return 'Nothing' if all leaves satisfy the predicate.
dropLeavesWith :: (a -> Bool) -> Tree e a -> Maybe (Tree e a)
dropLeavesWith :: (a -> Bool) -> Tree e a -> Maybe (Tree e a)
dropLeavesWith a -> Bool
p (Node e
br a
lb [])
  | a -> Bool
p a
lb = Maybe (Tree e a)
forall a. Maybe a
Nothing
  | Bool
otherwise = Tree e a -> Maybe (Tree e a)
forall a. a -> Maybe a
Just (Tree e a -> Maybe (Tree e a)) -> Tree e a -> Maybe (Tree e a)
forall a b. (a -> b) -> a -> b
$ e -> a -> [Tree e a] -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb []
dropLeavesWith a -> Bool
p (Node e
br a
lb [Tree e a]
ts) =
  if [Tree e a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree e a]
ts'
    then Maybe (Tree e a)
forall a. Maybe a
Nothing
    else Tree e a -> Maybe (Tree e a)
forall a. a -> Maybe a
Just (Tree e a -> Maybe (Tree e a)) -> Tree e a -> Maybe (Tree e a)
forall a b. (a -> b) -> a -> b
$ e -> a -> [Tree e a] -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb [Tree e a]
ts'
  where
    ts' :: [Tree e a]
ts' = (Tree e a -> Maybe (Tree e a)) -> [Tree e a] -> [Tree e a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((a -> Bool) -> Tree e a -> Maybe (Tree e a)
forall a e. (a -> Bool) -> Tree e a -> Maybe (Tree e a)
dropLeavesWith a -> Bool
p) [Tree e a]
ts

-- | Zip two trees with the same topology.
--
-- This function differs from the 'Applicative' instance of 'ZipTree' in that it
-- fails when the topologies don't match. Further, it allows specification of a
-- zipping function for the branches.
--
-- Return 'Nothing' if the topologies are different.
zipTreesWith ::
  (e1 -> e2 -> e) ->
  (a1 -> a2 -> a) ->
  Tree e1 a1 ->
  Tree e2 a2 ->
  Maybe (Tree e a)
zipTreesWith :: (e1 -> e2 -> e)
-> (a1 -> a2 -> a) -> Tree e1 a1 -> Tree e2 a2 -> Maybe (Tree e a)
zipTreesWith e1 -> e2 -> e
f a1 -> a2 -> a
g (Node e1
brL a1
lbL Forest e1 a1
tsL) (Node e2
brR a2
lbR Forest e2 a2
tsR) =
  if Forest e1 a1 -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest e1 a1
tsL Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Forest e2 a2 -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest e2 a2
tsR
    then -- I am proud of that :)).
      (Tree e1 a1 -> Tree e2 a2 -> Maybe (Tree e a))
-> Forest e1 a1 -> Forest e2 a2 -> Maybe [Tree e a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ((e1 -> e2 -> e)
-> (a1 -> a2 -> a) -> Tree e1 a1 -> Tree e2 a2 -> Maybe (Tree e a)
forall e1 e2 e a1 a2 a.
(e1 -> e2 -> e)
-> (a1 -> a2 -> a) -> Tree e1 a1 -> Tree e2 a2 -> Maybe (Tree e a)
zipTreesWith e1 -> e2 -> e
f a1 -> a2 -> a
g) Forest e1 a1
tsL Forest e2 a2
tsR Maybe [Tree e a]
-> ([Tree e a] -> Maybe (Tree e a)) -> Maybe (Tree e a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tree e a -> Maybe (Tree e a)
forall a. a -> Maybe a
Just (Tree e a -> Maybe (Tree e a))
-> ([Tree e a] -> Tree e a) -> [Tree e a] -> Maybe (Tree e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> a -> [Tree e a] -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node (e1 -> e2 -> e
f e1
brL e2
brR) (a1 -> a2 -> a
g a1
lbL a2
lbR)
    else Maybe (Tree e a)
forall a. Maybe a
Nothing

-- | See 'zipTreesWith'.
zipTrees :: Tree e1 a1 -> Tree e2 a2 -> Maybe (Tree (e1, e2) (a1, a2))
zipTrees :: Tree e1 a1 -> Tree e2 a2 -> Maybe (Tree (e1, e2) (a1, a2))
zipTrees = (e1 -> e2 -> (e1, e2))
-> (a1 -> a2 -> (a1, a2))
-> Tree e1 a1
-> Tree e2 a2
-> Maybe (Tree (e1, e2) (a1, a2))
forall e1 e2 e a1 a2 a.
(e1 -> e2 -> e)
-> (a1 -> a2 -> a) -> Tree e1 a1 -> Tree e2 a2 -> Maybe (Tree e a)
zipTreesWith (,) (,)

-- | Flip the branch and node lables.
flipLabels :: Tree e a -> Tree a e
flipLabels :: Tree e a -> Tree a e
flipLabels (Node e
x a
y Forest e a
zs) = a -> e -> Forest a e -> Tree a e
forall e a. e -> a -> Forest e a -> Tree e a
Node a
y e
x (Forest a e -> Tree a e) -> Forest a e -> Tree a e
forall a b. (a -> b) -> a -> b
$ (Tree e a -> Tree a e) -> Forest e a -> Forest a e
forall a b. (a -> b) -> [a] -> [b]
map Tree e a -> Tree a e
forall e a. Tree e a -> Tree a e
flipLabels Forest e a
zs

-- | This newtype provides instances acting on the branch labels, and not on the
-- node labels as it is the case in 'Tree'.
newtype BranchTree a e = BranchTree {BranchTree a e -> Tree e a
getBranchTree :: Tree e a}
  deriving (BranchTree a e -> BranchTree a e -> Bool
(BranchTree a e -> BranchTree a e -> Bool)
-> (BranchTree a e -> BranchTree a e -> Bool)
-> Eq (BranchTree a e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a e.
(Eq e, Eq a) =>
BranchTree a e -> BranchTree a e -> Bool
/= :: BranchTree a e -> BranchTree a e -> Bool
$c/= :: forall a e.
(Eq e, Eq a) =>
BranchTree a e -> BranchTree a e -> Bool
== :: BranchTree a e -> BranchTree a e -> Bool
$c== :: forall a e.
(Eq e, Eq a) =>
BranchTree a e -> BranchTree a e -> Bool
Eq, ReadPrec [BranchTree a e]
ReadPrec (BranchTree a e)
Int -> ReadS (BranchTree a e)
ReadS [BranchTree a e]
(Int -> ReadS (BranchTree a e))
-> ReadS [BranchTree a e]
-> ReadPrec (BranchTree a e)
-> ReadPrec [BranchTree a e]
-> Read (BranchTree a e)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a e. (Read e, Read a) => ReadPrec [BranchTree a e]
forall a e. (Read e, Read a) => ReadPrec (BranchTree a e)
forall a e. (Read e, Read a) => Int -> ReadS (BranchTree a e)
forall a e. (Read e, Read a) => ReadS [BranchTree a e]
readListPrec :: ReadPrec [BranchTree a e]
$creadListPrec :: forall a e. (Read e, Read a) => ReadPrec [BranchTree a e]
readPrec :: ReadPrec (BranchTree a e)
$creadPrec :: forall a e. (Read e, Read a) => ReadPrec (BranchTree a e)
readList :: ReadS [BranchTree a e]
$creadList :: forall a e. (Read e, Read a) => ReadS [BranchTree a e]
readsPrec :: Int -> ReadS (BranchTree a e)
$creadsPrec :: forall a e. (Read e, Read a) => Int -> ReadS (BranchTree a e)
Read, Int -> BranchTree a e -> ShowS
[BranchTree a e] -> ShowS
BranchTree a e -> String
(Int -> BranchTree a e -> ShowS)
-> (BranchTree a e -> String)
-> ([BranchTree a e] -> ShowS)
-> Show (BranchTree a e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a e. (Show e, Show a) => Int -> BranchTree a e -> ShowS
forall a e. (Show e, Show a) => [BranchTree a e] -> ShowS
forall a e. (Show e, Show a) => BranchTree a e -> String
showList :: [BranchTree a e] -> ShowS
$cshowList :: forall a e. (Show e, Show a) => [BranchTree a e] -> ShowS
show :: BranchTree a e -> String
$cshow :: forall a e. (Show e, Show a) => BranchTree a e -> String
showsPrec :: Int -> BranchTree a e -> ShowS
$cshowsPrec :: forall a e. (Show e, Show a) => Int -> BranchTree a e -> ShowS
Show, Typeable (BranchTree a e)
DataType
Constr
Typeable (BranchTree a e)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BranchTree a e -> c (BranchTree a e))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (BranchTree a e))
-> (BranchTree a e -> Constr)
-> (BranchTree a e -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (BranchTree a e)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (BranchTree a e)))
-> ((forall b. Data b => b -> b)
    -> BranchTree a e -> BranchTree a e)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BranchTree a e -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BranchTree a e -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> BranchTree a e -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BranchTree a e -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> BranchTree a e -> m (BranchTree a e))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> BranchTree a e -> m (BranchTree a e))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> BranchTree a e -> m (BranchTree a e))
-> Data (BranchTree a e)
BranchTree a e -> DataType
BranchTree a e -> Constr
(forall b. Data b => b -> b) -> BranchTree a e -> BranchTree a e
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BranchTree a e -> c (BranchTree a e)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BranchTree a e)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BranchTree a e))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> BranchTree a e -> u
forall u. (forall d. Data d => d -> u) -> BranchTree a e -> [u]
forall a e. (Data a, Data e) => Typeable (BranchTree a e)
forall a e. (Data a, Data e) => BranchTree a e -> DataType
forall a e. (Data a, Data e) => BranchTree a e -> Constr
forall a e.
(Data a, Data e) =>
(forall b. Data b => b -> b) -> BranchTree a e -> BranchTree a e
forall a e u.
(Data a, Data e) =>
Int -> (forall d. Data d => d -> u) -> BranchTree a e -> u
forall a e u.
(Data a, Data e) =>
(forall d. Data d => d -> u) -> BranchTree a e -> [u]
forall a e r r'.
(Data a, Data e) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BranchTree a e -> r
forall a e r r'.
(Data a, Data e) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BranchTree a e -> r
forall a e (m :: * -> *).
(Data a, Data e, Monad m) =>
(forall d. Data d => d -> m d)
-> BranchTree a e -> m (BranchTree a e)
forall a e (m :: * -> *).
(Data a, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> BranchTree a e -> m (BranchTree a e)
forall a e (c :: * -> *).
(Data a, Data e) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BranchTree a e)
forall a e (c :: * -> *).
(Data a, Data e) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BranchTree a e -> c (BranchTree a e)
forall a e (t :: * -> *) (c :: * -> *).
(Data a, Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (BranchTree a e))
forall a e (t :: * -> * -> *) (c :: * -> *).
(Data a, Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BranchTree a e))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BranchTree a e -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BranchTree a e -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BranchTree a e -> m (BranchTree a e)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BranchTree a e -> m (BranchTree a e)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BranchTree a e)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BranchTree a e -> c (BranchTree a e)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (BranchTree a e))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BranchTree a e))
$cBranchTree :: Constr
$tBranchTree :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> BranchTree a e -> m (BranchTree a e)
$cgmapMo :: forall a e (m :: * -> *).
(Data a, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> BranchTree a e -> m (BranchTree a e)
gmapMp :: (forall d. Data d => d -> m d)
-> BranchTree a e -> m (BranchTree a e)
$cgmapMp :: forall a e (m :: * -> *).
(Data a, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> BranchTree a e -> m (BranchTree a e)
gmapM :: (forall d. Data d => d -> m d)
-> BranchTree a e -> m (BranchTree a e)
$cgmapM :: forall a e (m :: * -> *).
(Data a, Data e, Monad m) =>
(forall d. Data d => d -> m d)
-> BranchTree a e -> m (BranchTree a e)
gmapQi :: Int -> (forall d. Data d => d -> u) -> BranchTree a e -> u
$cgmapQi :: forall a e u.
(Data a, Data e) =>
Int -> (forall d. Data d => d -> u) -> BranchTree a e -> u
gmapQ :: (forall d. Data d => d -> u) -> BranchTree a e -> [u]
$cgmapQ :: forall a e u.
(Data a, Data e) =>
(forall d. Data d => d -> u) -> BranchTree a e -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BranchTree a e -> r
$cgmapQr :: forall a e r r'.
(Data a, Data e) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BranchTree a e -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BranchTree a e -> r
$cgmapQl :: forall a e r r'.
(Data a, Data e) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BranchTree a e -> r
gmapT :: (forall b. Data b => b -> b) -> BranchTree a e -> BranchTree a e
$cgmapT :: forall a e.
(Data a, Data e) =>
(forall b. Data b => b -> b) -> BranchTree a e -> BranchTree a e
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BranchTree a e))
$cdataCast2 :: forall a e (t :: * -> * -> *) (c :: * -> *).
(Data a, Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BranchTree a e))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (BranchTree a e))
$cdataCast1 :: forall a e (t :: * -> *) (c :: * -> *).
(Data a, Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (BranchTree a e))
dataTypeOf :: BranchTree a e -> DataType
$cdataTypeOf :: forall a e. (Data a, Data e) => BranchTree a e -> DataType
toConstr :: BranchTree a e -> Constr
$ctoConstr :: forall a e. (Data a, Data e) => BranchTree a e -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BranchTree a e)
$cgunfold :: forall a e (c :: * -> *).
(Data a, Data e) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BranchTree a e)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BranchTree a e -> c (BranchTree a e)
$cgfoldl :: forall a e (c :: * -> *).
(Data a, Data e) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BranchTree a e -> c (BranchTree a e)
$cp1Data :: forall a e. (Data a, Data e) => Typeable (BranchTree a e)
Data, (forall x. BranchTree a e -> Rep (BranchTree a e) x)
-> (forall x. Rep (BranchTree a e) x -> BranchTree a e)
-> Generic (BranchTree a e)
forall x. Rep (BranchTree a e) x -> BranchTree a e
forall x. BranchTree a e -> Rep (BranchTree a e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a e x. Rep (BranchTree a e) x -> BranchTree a e
forall a e x. BranchTree a e -> Rep (BranchTree a e) x
$cto :: forall a e x. Rep (BranchTree a e) x -> BranchTree a e
$cfrom :: forall a e x. BranchTree a e -> Rep (BranchTree a e) x
Generic)

-- | Map over branch labels.
instance Functor (BranchTree a) where
  fmap :: (a -> b) -> BranchTree a a -> BranchTree a b
fmap a -> b
f ~(BranchTree (Node a
br a
lb Forest a a
ts)) =
    Tree b a -> BranchTree a b
forall a e. Tree e a -> BranchTree a e
BranchTree (Tree b a -> BranchTree a b) -> Tree b a -> BranchTree a b
forall a b. (a -> b) -> a -> b
$ b -> a -> Forest b a -> Tree b a
forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b
f a
br) a
lb (Forest b a -> Tree b a) -> Forest b a -> Tree b a
forall a b. (a -> b) -> a -> b
$ (Tree a a -> Tree b a) -> Forest a a -> Forest b a
forall a b. (a -> b) -> [a] -> [b]
map (BranchTree a b -> Tree b a
forall a e. BranchTree a e -> Tree e a
getBranchTree (BranchTree a b -> Tree b a)
-> (Tree a a -> BranchTree a b) -> Tree a a -> Tree b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> BranchTree a a -> BranchTree a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (BranchTree a a -> BranchTree a b)
-> (Tree a a -> BranchTree a a) -> Tree a a -> BranchTree a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a a -> BranchTree a a
forall a e. Tree e a -> BranchTree a e
BranchTree) Forest a a
ts
  a
br <$ :: a -> BranchTree a b -> BranchTree a a
<$ ~(BranchTree (Node b
_ a
lb Forest b a
ts)) =
    Tree a a -> BranchTree a a
forall a e. Tree e a -> BranchTree a e
BranchTree (Tree a a -> BranchTree a a) -> Tree a a -> BranchTree a a
forall a b. (a -> b) -> a -> b
$ a -> a -> Forest a a -> Tree a a
forall e a. e -> a -> Forest e a -> Tree e a
Node a
br a
lb ((Tree b a -> Tree a a) -> Forest b a -> Forest a a
forall a b. (a -> b) -> [a] -> [b]
map (BranchTree a a -> Tree a a
forall a e. BranchTree a e -> Tree e a
getBranchTree (BranchTree a a -> Tree a a)
-> (Tree b a -> BranchTree a a) -> Tree b a -> Tree a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
br a -> BranchTree a b -> BranchTree a a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (BranchTree a b -> BranchTree a a)
-> (Tree b a -> BranchTree a b) -> Tree b a -> BranchTree a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree b a -> BranchTree a b
forall a e. Tree e a -> BranchTree a e
BranchTree) Forest b a
ts)

-- | Combine branch labels in pre-order.
instance Foldable (BranchTree a) where
  foldMap :: (a -> m) -> BranchTree a a -> m
foldMap a -> m
f ~(BranchTree (Node a
br a
_ Forest a a
ts)) =
    a -> m
f a
br m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Tree a a -> m) -> Forest a a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> BranchTree a a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (BranchTree a a -> m)
-> (Tree a a -> BranchTree a a) -> Tree a a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a a -> BranchTree a a
forall a e. Tree e a -> BranchTree a e
BranchTree) Forest a a
ts
  null :: BranchTree a a -> Bool
null BranchTree a a
_ = Bool
False
  {-# INLINE null #-}
  toList :: BranchTree a a -> [a]
toList = Tree a a -> [a]
forall e a. Tree e a -> [e]
branches (Tree a a -> [a])
-> (BranchTree a a -> Tree a a) -> BranchTree a a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchTree a a -> Tree a a
forall a e. BranchTree a e -> Tree e a
getBranchTree
  {-# INLINE toList #-}

instance Traversable (BranchTree a) where
  traverse :: (a -> f b) -> BranchTree a a -> f (BranchTree a b)
traverse a -> f b
g ~(BranchTree (Node a
br a
lb Forest a a
ts)) =
    a -> b -> Forest b a -> BranchTree a b
forall a e. a -> e -> Forest e a -> BranchTree a e
assemble a
lb (b -> Forest b a -> BranchTree a b)
-> f b -> f (Forest b a -> BranchTree a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
fbr' f (Forest b a -> BranchTree a b)
-> f (Forest b a) -> f (BranchTree a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Forest b a)
fts'
    where
      assemble :: a -> e -> Forest e a -> BranchTree a e
assemble a
lb' e
br' Forest e a
ts' = Tree e a -> BranchTree a e
forall a e. Tree e a -> BranchTree a e
BranchTree (Tree e a -> BranchTree a e) -> Tree e a -> BranchTree a e
forall a b. (a -> b) -> a -> b
$ e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
br' a
lb' Forest e a
ts'
      fbr' :: f b
fbr' = a -> f b
g a
br
      fts' :: f (Forest b a)
fts' = (BranchTree a b -> Tree b a) -> [BranchTree a b] -> Forest b a
forall a b. (a -> b) -> [a] -> [b]
map BranchTree a b -> Tree b a
forall a e. BranchTree a e -> Tree e a
getBranchTree ([BranchTree a b] -> Forest b a)
-> f [BranchTree a b] -> f (Forest b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree a a -> f (BranchTree a b))
-> Forest a a -> f [BranchTree a b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> BranchTree a a -> f (BranchTree a b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
g (BranchTree a a -> f (BranchTree a b))
-> (Tree a a -> BranchTree a a) -> Tree a a -> f (BranchTree a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a a -> BranchTree a a
forall a e. Tree e a -> BranchTree a e
BranchTree) Forest a a
ts

instance Comonad (BranchTree a) where
  duplicate :: BranchTree a a -> BranchTree a (BranchTree a a)
duplicate (BranchTree t :: Tree a a
t@(Node a
_ a
lb Forest a a
ts)) =
    Tree (BranchTree a a) a -> BranchTree a (BranchTree a a)
forall a e. Tree e a -> BranchTree a e
BranchTree (Tree (BranchTree a a) a -> BranchTree a (BranchTree a a))
-> Tree (BranchTree a a) a -> BranchTree a (BranchTree a a)
forall a b. (a -> b) -> a -> b
$
      BranchTree a a
-> a -> Forest (BranchTree a a) a -> Tree (BranchTree a a) a
forall e a. e -> a -> Forest e a -> Tree e a
Node (Tree a a -> BranchTree a a
forall a e. Tree e a -> BranchTree a e
BranchTree Tree a a
t) a
lb (Forest (BranchTree a a) a -> Tree (BranchTree a a) a)
-> Forest (BranchTree a a) a -> Tree (BranchTree a a) a
forall a b. (a -> b) -> a -> b
$
        (Tree a a -> Tree (BranchTree a a) a)
-> Forest a a -> Forest (BranchTree a a) a
forall a b. (a -> b) -> [a] -> [b]
map (BranchTree a (BranchTree a a) -> Tree (BranchTree a a) a
forall a e. BranchTree a e -> Tree e a
getBranchTree (BranchTree a (BranchTree a a) -> Tree (BranchTree a a) a)
-> (Tree a a -> BranchTree a (BranchTree a a))
-> Tree a a
-> Tree (BranchTree a a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchTree a a -> BranchTree a (BranchTree a a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate (BranchTree a a -> BranchTree a (BranchTree a a))
-> (Tree a a -> BranchTree a a)
-> Tree a a
-> BranchTree a (BranchTree a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a a -> BranchTree a a
forall a e. Tree e a -> BranchTree a e
BranchTree) Forest a a
ts
  extract :: BranchTree a a -> a
extract = Tree a a -> a
forall e a. Tree e a -> e
branch (Tree a a -> a)
-> (BranchTree a a -> Tree a a) -> BranchTree a a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchTree a a -> Tree a a
forall a e. BranchTree a e -> Tree e a
getBranchTree

instance Monoid a => Applicative (BranchTree a) where
  -- Infinite layers with infinite subtrees.
  pure :: a -> BranchTree a a
pure a
br = Tree a a -> BranchTree a a
forall a e. Tree e a -> BranchTree a e
BranchTree (Tree a a -> BranchTree a a) -> Tree a a -> BranchTree a a
forall a b. (a -> b) -> a -> b
$ a -> a -> Forest a a -> Tree a a
forall e a. e -> a -> Forest e a -> Tree e a
Node a
br a
forall a. Monoid a => a
mempty []
  (BranchTree ~(Node a -> b
brF a
lbF Forest (a -> b) a
tsF)) <*> :: BranchTree a (a -> b) -> BranchTree a a -> BranchTree a b
<*> tx :: BranchTree a a
tx@(BranchTree ~(Node a
brX a
lbX Forest a a
tsX)) =
    Tree b a -> BranchTree a b
forall a e. Tree e a -> BranchTree a e
BranchTree (Tree b a -> BranchTree a b) -> Tree b a -> BranchTree a b
forall a b. (a -> b) -> a -> b
$
      b -> a -> Forest b a -> Tree b a
forall e a. e -> a -> Forest e a -> Tree e a
Node
        (a -> b
brF a
brX)
        (a
lbF a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
lbX)
        ( (Tree a a -> Tree b a) -> Forest a a -> Forest b a
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> (a -> a) -> Tree a a -> Tree b a
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
brF (a
lbF a -> a -> a
forall a. Semigroup a => a -> a -> a
<>)) Forest a a
tsX
            Forest b a -> Forest b a -> Forest b a
forall a. [a] -> [a] -> [a]
++ (Tree (a -> b) a -> Tree b a) -> Forest (a -> b) a -> Forest b a
forall a b. (a -> b) -> [a] -> [b]
map (BranchTree a b -> Tree b a
forall a e. BranchTree a e -> Tree e a
getBranchTree (BranchTree a b -> Tree b a)
-> (Tree (a -> b) a -> BranchTree a b)
-> Tree (a -> b) a
-> Tree b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BranchTree a (a -> b) -> BranchTree a a -> BranchTree a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BranchTree a a
tx) (BranchTree a (a -> b) -> BranchTree a b)
-> (Tree (a -> b) a -> BranchTree a (a -> b))
-> Tree (a -> b) a
-> BranchTree a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (a -> b) a -> BranchTree a (a -> b)
forall a e. Tree e a -> BranchTree a e
BranchTree) Forest (a -> b) a
tsF
        )
  liftA2 :: (a -> b -> c) -> BranchTree a a -> BranchTree a b -> BranchTree a c
liftA2 a -> b -> c
f (BranchTree ~(Node a
brX a
lbX Forest a a
tsX)) ty :: BranchTree a b
ty@(BranchTree ~(Node b
brY a
lbY Forest b a
tsY)) =
    Tree c a -> BranchTree a c
forall a e. Tree e a -> BranchTree a e
BranchTree (Tree c a -> BranchTree a c) -> Tree c a -> BranchTree a c
forall a b. (a -> b) -> a -> b
$
      c -> a -> Forest c a -> Tree c a
forall e a. e -> a -> Forest e a -> Tree e a
Node
        (a -> b -> c
f a
brX b
brY)
        (a
lbX a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
lbY)
        ( (Tree b a -> Tree c a) -> Forest b a -> Forest c a
forall a b. (a -> b) -> [a] -> [b]
map ((b -> c) -> (a -> a) -> Tree b a -> Tree c a
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (a -> b -> c
f a
brX) (a
lbX a -> a -> a
forall a. Semigroup a => a -> a -> a
<>)) Forest b a
tsY
            Forest c a -> Forest c a -> Forest c a
forall a. [a] -> [a] -> [a]
++ (Tree a a -> Tree c a) -> Forest a a -> Forest c a
forall a b. (a -> b) -> [a] -> [b]
map (\Tree a a
tx -> BranchTree a c -> Tree c a
forall a e. BranchTree a e -> Tree e a
getBranchTree (BranchTree a c -> Tree c a) -> BranchTree a c -> Tree c a
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> BranchTree a a -> BranchTree a b -> BranchTree a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (Tree a a -> BranchTree a a
forall a e. Tree e a -> BranchTree a e
BranchTree Tree a a
tx) BranchTree a b
ty) Forest a a
tsX
        )
  (BranchTree ~(Node a
_ a
lbX Forest a a
tsX)) *> :: BranchTree a a -> BranchTree a b -> BranchTree a b
*> ty :: BranchTree a b
ty@(BranchTree ~(Node b
brY a
lbY Forest b a
tsY)) =
    Tree b a -> BranchTree a b
forall a e. Tree e a -> BranchTree a e
BranchTree (Tree b a -> BranchTree a b) -> Tree b a -> BranchTree a b
forall a b. (a -> b) -> a -> b
$
      b -> a -> Forest b a -> Tree b a
forall e a. e -> a -> Forest e a -> Tree e a
Node
        b
brY
        (a
lbX a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
lbY)
        ( BranchTree a b -> Tree b a
forall a e. BranchTree a e -> Tree e a
getBranchTree
            (BranchTree a b -> Tree b a) -> [BranchTree a b] -> Forest b a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (Tree b a -> BranchTree a b) -> Forest b a -> [BranchTree a b]
forall a b. (a -> b) -> [a] -> [b]
map (Tree b a -> BranchTree a b
forall a e. Tree e a -> BranchTree a e
BranchTree (Tree b a -> BranchTree a b)
-> (Tree b a -> Tree b a) -> Tree b a -> BranchTree a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> Tree b a -> Tree b a
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (a
lbX a -> a -> a
forall a. Semigroup a => a -> a -> a
<>)) Forest b a
tsY
                    [BranchTree a b] -> [BranchTree a b] -> [BranchTree a b]
forall a. [a] -> [a] -> [a]
++ (Tree a a -> BranchTree a b) -> Forest a a -> [BranchTree a b]
forall a b. (a -> b) -> [a] -> [b]
map ((BranchTree a a -> BranchTree a b -> BranchTree a b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BranchTree a b
ty) (BranchTree a a -> BranchTree a b)
-> (Tree a a -> BranchTree a a) -> Tree a a -> BranchTree a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a a -> BranchTree a a
forall a e. Tree e a -> BranchTree a e
BranchTree) Forest a a
tsX
                )
        )
  (BranchTree ~(Node a
brX a
lbX Forest a a
tsX)) <* :: BranchTree a a -> BranchTree a b -> BranchTree a a
<* ty :: BranchTree a b
ty@(BranchTree ~(Node b
_ a
lbY Forest b a
tsY)) =
    Tree a a -> BranchTree a a
forall a e. Tree e a -> BranchTree a e
BranchTree (Tree a a -> BranchTree a a) -> Tree a a -> BranchTree a a
forall a b. (a -> b) -> a -> b
$
      a -> a -> Forest a a -> Tree a a
forall e a. e -> a -> Forest e a -> Tree e a
Node
        a
brX
        (a
lbX a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
lbY)
        ( (Tree b a -> Tree a a) -> Forest b a -> Forest a a
forall a b. (a -> b) -> [a] -> [b]
map ((b -> a) -> (a -> a) -> Tree b a -> Tree a a
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (a -> b -> a
forall a b. a -> b -> a
const a
brX) (a
lbX a -> a -> a
forall a. Semigroup a => a -> a -> a
<>)) Forest b a
tsY
            Forest a a -> Forest a a -> Forest a a
forall a. [a] -> [a] -> [a]
++ (Tree a a -> Tree a a) -> Forest a a -> Forest a a
forall a b. (a -> b) -> [a] -> [b]
map (BranchTree a a -> Tree a a
forall a e. BranchTree a e -> Tree e a
getBranchTree (BranchTree a a -> Tree a a)
-> (Tree a a -> BranchTree a a) -> Tree a a -> Tree a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BranchTree a a -> BranchTree a b -> BranchTree a a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* BranchTree a b
ty) (BranchTree a a -> BranchTree a a)
-> (Tree a a -> BranchTree a a) -> Tree a a -> BranchTree a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a a -> BranchTree a a
forall a e. Tree e a -> BranchTree a e
BranchTree) Forest a a
tsX
        )

-- | This newtype provides a zip-like applicative instance, similar to
-- 'Control.Applicative.ZipList'.
--
-- The default applicative instance of 'Tree' is not zip-like, because the
-- zip-like instance makes the Monad instance meaningless (similar to the
-- behavior observed with lists).
newtype ZipTree e a = ZipTree {ZipTree e a -> Tree e a
getZipTree :: Tree e a}
  deriving (ZipTree e a -> ZipTree e a -> Bool
(ZipTree e a -> ZipTree e a -> Bool)
-> (ZipTree e a -> ZipTree e a -> Bool) -> Eq (ZipTree e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => ZipTree e a -> ZipTree e a -> Bool
/= :: ZipTree e a -> ZipTree e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => ZipTree e a -> ZipTree e a -> Bool
== :: ZipTree e a -> ZipTree e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => ZipTree e a -> ZipTree e a -> Bool
Eq, ReadPrec [ZipTree e a]
ReadPrec (ZipTree e a)
Int -> ReadS (ZipTree e a)
ReadS [ZipTree e a]
(Int -> ReadS (ZipTree e a))
-> ReadS [ZipTree e a]
-> ReadPrec (ZipTree e a)
-> ReadPrec [ZipTree e a]
-> Read (ZipTree e a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall e a. (Read e, Read a) => ReadPrec [ZipTree e a]
forall e a. (Read e, Read a) => ReadPrec (ZipTree e a)
forall e a. (Read e, Read a) => Int -> ReadS (ZipTree e a)
forall e a. (Read e, Read a) => ReadS [ZipTree e a]
readListPrec :: ReadPrec [ZipTree e a]
$creadListPrec :: forall e a. (Read e, Read a) => ReadPrec [ZipTree e a]
readPrec :: ReadPrec (ZipTree e a)
$creadPrec :: forall e a. (Read e, Read a) => ReadPrec (ZipTree e a)
readList :: ReadS [ZipTree e a]
$creadList :: forall e a. (Read e, Read a) => ReadS [ZipTree e a]
readsPrec :: Int -> ReadS (ZipTree e a)
$creadsPrec :: forall e a. (Read e, Read a) => Int -> ReadS (ZipTree e a)
Read, Int -> ZipTree e a -> ShowS
[ZipTree e a] -> ShowS
ZipTree e a -> String
(Int -> ZipTree e a -> ShowS)
-> (ZipTree e a -> String)
-> ([ZipTree e a] -> ShowS)
-> Show (ZipTree e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> ZipTree e a -> ShowS
forall e a. (Show e, Show a) => [ZipTree e a] -> ShowS
forall e a. (Show e, Show a) => ZipTree e a -> String
showList :: [ZipTree e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [ZipTree e a] -> ShowS
show :: ZipTree e a -> String
$cshow :: forall e a. (Show e, Show a) => ZipTree e a -> String
showsPrec :: Int -> ZipTree e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> ZipTree e a -> ShowS
Show, Typeable (ZipTree e a)
DataType
Constr
Typeable (ZipTree e a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ZipTree e a -> c (ZipTree e a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ZipTree e a))
-> (ZipTree e a -> Constr)
-> (ZipTree e a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ZipTree e a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ZipTree e a)))
-> ((forall b. Data b => b -> b) -> ZipTree e a -> ZipTree e a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ZipTree e a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ZipTree e a -> r)
-> (forall u. (forall d. Data d => d -> u) -> ZipTree e a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ZipTree e a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a))
-> Data (ZipTree e a)
ZipTree e a -> DataType
ZipTree e a -> Constr
(forall b. Data b => b -> b) -> ZipTree e a -> ZipTree e a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipTree e a -> c (ZipTree e a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ZipTree e a)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipTree e a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ZipTree e a -> u
forall u. (forall d. Data d => d -> u) -> ZipTree e a -> [u]
forall e a. (Data e, Data a) => Typeable (ZipTree e a)
forall e a. (Data e, Data a) => ZipTree e a -> DataType
forall e a. (Data e, Data a) => ZipTree e a -> Constr
forall e a.
(Data e, Data a) =>
(forall b. Data b => b -> b) -> ZipTree e a -> ZipTree e a
forall e a u.
(Data e, Data a) =>
Int -> (forall d. Data d => d -> u) -> ZipTree e a -> u
forall e a u.
(Data e, Data a) =>
(forall d. Data d => d -> u) -> ZipTree e a -> [u]
forall e a r r'.
(Data e, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipTree e a -> r
forall e a r r'.
(Data e, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipTree e a -> r
forall e a (m :: * -> *).
(Data e, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a)
forall e a (m :: * -> *).
(Data e, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a)
forall e a (c :: * -> *).
(Data e, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ZipTree e a)
forall e a (c :: * -> *).
(Data e, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipTree e a -> c (ZipTree e a)
forall e a (t :: * -> *) (c :: * -> *).
(Data e, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ZipTree e a))
forall e a (t :: * -> * -> *) (c :: * -> *).
(Data e, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipTree e a))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipTree e a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipTree e a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ZipTree e a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipTree e a -> c (ZipTree e a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ZipTree e a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipTree e a))
$cZipTree :: Constr
$tZipTree :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a)
$cgmapMo :: forall e a (m :: * -> *).
(Data e, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a)
gmapMp :: (forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a)
$cgmapMp :: forall e a (m :: * -> *).
(Data e, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a)
gmapM :: (forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a)
$cgmapM :: forall e a (m :: * -> *).
(Data e, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> ZipTree e a -> m (ZipTree e a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> ZipTree e a -> u
$cgmapQi :: forall e a u.
(Data e, Data a) =>
Int -> (forall d. Data d => d -> u) -> ZipTree e a -> u
gmapQ :: (forall d. Data d => d -> u) -> ZipTree e a -> [u]
$cgmapQ :: forall e a u.
(Data e, Data a) =>
(forall d. Data d => d -> u) -> ZipTree e a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipTree e a -> r
$cgmapQr :: forall e a r r'.
(Data e, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipTree e a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipTree e a -> r
$cgmapQl :: forall e a r r'.
(Data e, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipTree e a -> r
gmapT :: (forall b. Data b => b -> b) -> ZipTree e a -> ZipTree e a
$cgmapT :: forall e a.
(Data e, Data a) =>
(forall b. Data b => b -> b) -> ZipTree e a -> ZipTree e a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipTree e a))
$cdataCast2 :: forall e a (t :: * -> * -> *) (c :: * -> *).
(Data e, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipTree e a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (ZipTree e a))
$cdataCast1 :: forall e a (t :: * -> *) (c :: * -> *).
(Data e, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ZipTree e a))
dataTypeOf :: ZipTree e a -> DataType
$cdataTypeOf :: forall e a. (Data e, Data a) => ZipTree e a -> DataType
toConstr :: ZipTree e a -> Constr
$ctoConstr :: forall e a. (Data e, Data a) => ZipTree e a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ZipTree e a)
$cgunfold :: forall e a (c :: * -> *).
(Data e, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ZipTree e a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipTree e a -> c (ZipTree e a)
$cgfoldl :: forall e a (c :: * -> *).
(Data e, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipTree e a -> c (ZipTree e a)
$cp1Data :: forall e a. (Data e, Data a) => Typeable (ZipTree e a)
Data, (forall x. ZipTree e a -> Rep (ZipTree e a) x)
-> (forall x. Rep (ZipTree e a) x -> ZipTree e a)
-> Generic (ZipTree e a)
forall x. Rep (ZipTree e a) x -> ZipTree e a
forall x. ZipTree e a -> Rep (ZipTree e a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e a x. Rep (ZipTree e a) x -> ZipTree e a
forall e a x. ZipTree e a -> Rep (ZipTree e a) x
$cto :: forall e a x. Rep (ZipTree e a) x -> ZipTree e a
$cfrom :: forall e a x. ZipTree e a -> Rep (ZipTree e a) x
Generic)

deriving instance Functor (ZipTree e)

deriving instance Foldable (ZipTree e)

instance Traversable (ZipTree e) where
  traverse :: (a -> f b) -> ZipTree e a -> f (ZipTree e b)
traverse a -> f b
f (ZipTree Tree e a
t) = Tree e b -> ZipTree e b
forall e a. Tree e a -> ZipTree e a
ZipTree (Tree e b -> ZipTree e b) -> f (Tree e b) -> f (ZipTree e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Tree e a -> f (Tree e b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Tree e a
t

instance Comonad (ZipTree e) where
  duplicate :: ZipTree e a -> ZipTree e (ZipTree e a)
duplicate (ZipTree Tree e a
t) = Tree e (ZipTree e a) -> ZipTree e (ZipTree e a)
forall e a. Tree e a -> ZipTree e a
ZipTree (Tree e (ZipTree e a) -> ZipTree e (ZipTree e a))
-> Tree e (ZipTree e a) -> ZipTree e (ZipTree e a)
forall a b. (a -> b) -> a -> b
$ (Tree e a -> ZipTree e a)
-> Tree e (Tree e a) -> Tree e (ZipTree e a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Tree e a -> ZipTree e a
forall e a. Tree e a -> ZipTree e a
ZipTree (Tree e (Tree e a) -> Tree e (ZipTree e a))
-> Tree e (Tree e a) -> Tree e (ZipTree e a)
forall a b. (a -> b) -> a -> b
$ Tree e a -> Tree e (Tree e a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate Tree e a
t
  extract :: ZipTree e a -> a
extract = Tree e a -> a
forall e a. Tree e a -> a
label (Tree e a -> a) -> (ZipTree e a -> Tree e a) -> ZipTree e a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipTree e a -> Tree e a
forall e a. ZipTree e a -> Tree e a
getZipTree

-- | The 'Monoid' instance of the branch labels determines the default branch
-- label, and how the branches are combined. For example, distances can be
-- summed using the 'Data.Monoid.Sum' monoid.
--
-- >>> let t = ZipTree $ Node "" 0 [Node "" 1 [], Node "" 2 []] :: ZipTree String Int
-- >>> let f = ZipTree $ Node "+3" (+3) [Node "*5" (*5) [], Node "+10" (+10) []] :: ZipTree String (Int -> Int)
-- >>> f <*> t
--
-- ZipTree {getZipTree = Node {branch = "+3", label = 3, forest = [Node {branch = "*5", label = 5, forest = []},Node {branch = "+10", label = 12, forest = []}]}}
instance Monoid e => Applicative (ZipTree e) where
  -- Infinite layers with infinite subtrees.
  pure :: a -> ZipTree e a
pure a
lb = Tree e a -> ZipTree e a
forall e a. Tree e a -> ZipTree e a
ZipTree (Tree e a -> ZipTree e a) -> Tree e a -> ZipTree e a
forall a b. (a -> b) -> a -> b
$ e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
forall a. Monoid a => a
mempty a
lb (Forest e a -> Tree e a) -> Forest e a -> Tree e a
forall a b. (a -> b) -> a -> b
$ Tree e a -> Forest e a
forall a. a -> [a]
repeat (ZipTree e a -> Tree e a
forall e a. ZipTree e a -> Tree e a
getZipTree (ZipTree e a -> Tree e a) -> ZipTree e a -> Tree e a
forall a b. (a -> b) -> a -> b
$ a -> ZipTree e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
lb)
  (ZipTree ~(Node e
brF a -> b
lbF Forest e (a -> b)
tsF)) <*> :: ZipTree e (a -> b) -> ZipTree e a -> ZipTree e b
<*> (ZipTree ~(Node e
brX a
lbX Forest e a
tsX)) =
    Tree e b -> ZipTree e b
forall e a. Tree e a -> ZipTree e a
ZipTree (Tree e b -> ZipTree e b) -> Tree e b -> ZipTree e b
forall a b. (a -> b) -> a -> b
$ e -> b -> Forest e b -> Tree e b
forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brF e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
brX) (a -> b
lbF a
lbX) ((Tree e (a -> b) -> Tree e a -> Tree e b)
-> Forest e (a -> b) -> Forest e a -> Forest e b
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Tree e (a -> b) -> Tree e a -> Tree e b
forall e a a. Monoid e => Tree e (a -> a) -> Tree e a -> Tree e a
f Forest e (a -> b)
tsF Forest e a
tsX)
    where
      f :: Tree e (a -> a) -> Tree e a -> Tree e a
f Tree e (a -> a)
x Tree e a
y = ZipTree e a -> Tree e a
forall e a. ZipTree e a -> Tree e a
getZipTree (ZipTree e a -> Tree e a) -> ZipTree e a -> Tree e a
forall a b. (a -> b) -> a -> b
$ Tree e (a -> a) -> ZipTree e (a -> a)
forall e a. Tree e a -> ZipTree e a
ZipTree Tree e (a -> a)
x ZipTree e (a -> a) -> ZipTree e a -> ZipTree e a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tree e a -> ZipTree e a
forall e a. Tree e a -> ZipTree e a
ZipTree Tree e a
y
  liftA2 :: (a -> b -> c) -> ZipTree e a -> ZipTree e b -> ZipTree e c
liftA2 a -> b -> c
f (ZipTree ~(Node e
brX a
lbX Forest e a
tsX)) (ZipTree ~(Node e
brY b
lbY Forest e b
tsY)) =
    Tree e c -> ZipTree e c
forall e a. Tree e a -> ZipTree e a
ZipTree (Tree e c -> ZipTree e c) -> Tree e c -> ZipTree e c
forall a b. (a -> b) -> a -> b
$ e -> c -> Forest e c -> Tree e c
forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
brY) (a -> b -> c
f a
lbX b
lbY) ((Tree e a -> Tree e b -> Tree e c)
-> Forest e a -> Forest e b -> Forest e c
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Tree e a -> Tree e b -> Tree e c
forall e. Monoid e => Tree e a -> Tree e b -> Tree e c
g Forest e a
tsX Forest e b
tsY)
    where
      g :: Tree e a -> Tree e b -> Tree e c
g Tree e a
x Tree e b
y = ZipTree e c -> Tree e c
forall e a. ZipTree e a -> Tree e a
getZipTree (ZipTree e c -> Tree e c) -> ZipTree e c -> Tree e c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> ZipTree e a -> ZipTree e b -> ZipTree e c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (Tree e a -> ZipTree e a
forall e a. Tree e a -> ZipTree e a
ZipTree Tree e a
x) (Tree e b -> ZipTree e b
forall e a. Tree e a -> ZipTree e a
ZipTree Tree e b
y)
  (ZipTree ~(Node e
brX a
_ Forest e a
tsX)) *> :: ZipTree e a -> ZipTree e b -> ZipTree e b
*> (ZipTree ~(Node e
brY b
lbY Forest e b
tsY)) =
    Tree e b -> ZipTree e b
forall e a. Tree e a -> ZipTree e a
ZipTree (Tree e b -> ZipTree e b) -> Tree e b -> ZipTree e b
forall a b. (a -> b) -> a -> b
$ e -> b -> Forest e b -> Tree e b
forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
brY) b
lbY ((Tree e a -> Tree e b -> Tree e b)
-> Forest e a -> Forest e b -> Forest e b
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Tree e a -> Tree e b -> Tree e b
forall e a a. Monoid e => Tree e a -> Tree e a -> Tree e a
f Forest e a
tsX Forest e b
tsY)
    where
      f :: Tree e a -> Tree e a -> Tree e a
f Tree e a
x Tree e a
y = ZipTree e a -> Tree e a
forall e a. ZipTree e a -> Tree e a
getZipTree (ZipTree e a -> Tree e a) -> ZipTree e a -> Tree e a
forall a b. (a -> b) -> a -> b
$ Tree e a -> ZipTree e a
forall e a. Tree e a -> ZipTree e a
ZipTree Tree e a
x ZipTree e a -> ZipTree e a -> ZipTree e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tree e a -> ZipTree e a
forall e a. Tree e a -> ZipTree e a
ZipTree Tree e a
y
  (ZipTree ~(Node e
brX a
lbX Forest e a
tsX)) <* :: ZipTree e a -> ZipTree e b -> ZipTree e a
<* (ZipTree ~(Node e
brY b
_ Forest e b
tsY)) =
    Tree e a -> ZipTree e a
forall e a. Tree e a -> ZipTree e a
ZipTree (Tree e a -> ZipTree e a) -> Tree e a -> ZipTree e a
forall a b. (a -> b) -> a -> b
$ e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
brY) a
lbX ((Tree e a -> Tree e b -> Tree e a)
-> Forest e a -> Forest e b -> Forest e a
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Tree e a -> Tree e b -> Tree e a
forall e a b. Monoid e => Tree e a -> Tree e b -> Tree e a
f Forest e a
tsX Forest e b
tsY)
    where
      f :: Tree e a -> Tree e b -> Tree e a
f Tree e a
x Tree e b
y = ZipTree e a -> Tree e a
forall e a. ZipTree e a -> Tree e a
getZipTree (ZipTree e a -> Tree e a) -> ZipTree e a -> Tree e a
forall a b. (a -> b) -> a -> b
$ Tree e a -> ZipTree e a
forall e a. Tree e a -> ZipTree e a
ZipTree Tree e a
x ZipTree e a -> ZipTree e b -> ZipTree e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tree e b -> ZipTree e b
forall e a. Tree e a -> ZipTree e a
ZipTree Tree e b
y

-- | Like 'ZipTree' but act on branch labels; see 'BranchTree'.
newtype ZipBranchTree a e = ZipBranchTree {ZipBranchTree a e -> Tree e a
getZipBranchTree :: Tree e a}
  deriving (ZipBranchTree a e -> ZipBranchTree a e -> Bool
(ZipBranchTree a e -> ZipBranchTree a e -> Bool)
-> (ZipBranchTree a e -> ZipBranchTree a e -> Bool)
-> Eq (ZipBranchTree a e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a e.
(Eq e, Eq a) =>
ZipBranchTree a e -> ZipBranchTree a e -> Bool
/= :: ZipBranchTree a e -> ZipBranchTree a e -> Bool
$c/= :: forall a e.
(Eq e, Eq a) =>
ZipBranchTree a e -> ZipBranchTree a e -> Bool
== :: ZipBranchTree a e -> ZipBranchTree a e -> Bool
$c== :: forall a e.
(Eq e, Eq a) =>
ZipBranchTree a e -> ZipBranchTree a e -> Bool
Eq, ReadPrec [ZipBranchTree a e]
ReadPrec (ZipBranchTree a e)
Int -> ReadS (ZipBranchTree a e)
ReadS [ZipBranchTree a e]
(Int -> ReadS (ZipBranchTree a e))
-> ReadS [ZipBranchTree a e]
-> ReadPrec (ZipBranchTree a e)
-> ReadPrec [ZipBranchTree a e]
-> Read (ZipBranchTree a e)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a e. (Read e, Read a) => ReadPrec [ZipBranchTree a e]
forall a e. (Read e, Read a) => ReadPrec (ZipBranchTree a e)
forall a e. (Read e, Read a) => Int -> ReadS (ZipBranchTree a e)
forall a e. (Read e, Read a) => ReadS [ZipBranchTree a e]
readListPrec :: ReadPrec [ZipBranchTree a e]
$creadListPrec :: forall a e. (Read e, Read a) => ReadPrec [ZipBranchTree a e]
readPrec :: ReadPrec (ZipBranchTree a e)
$creadPrec :: forall a e. (Read e, Read a) => ReadPrec (ZipBranchTree a e)
readList :: ReadS [ZipBranchTree a e]
$creadList :: forall a e. (Read e, Read a) => ReadS [ZipBranchTree a e]
readsPrec :: Int -> ReadS (ZipBranchTree a e)
$creadsPrec :: forall a e. (Read e, Read a) => Int -> ReadS (ZipBranchTree a e)
Read, Int -> ZipBranchTree a e -> ShowS
[ZipBranchTree a e] -> ShowS
ZipBranchTree a e -> String
(Int -> ZipBranchTree a e -> ShowS)
-> (ZipBranchTree a e -> String)
-> ([ZipBranchTree a e] -> ShowS)
-> Show (ZipBranchTree a e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a e. (Show e, Show a) => Int -> ZipBranchTree a e -> ShowS
forall a e. (Show e, Show a) => [ZipBranchTree a e] -> ShowS
forall a e. (Show e, Show a) => ZipBranchTree a e -> String
showList :: [ZipBranchTree a e] -> ShowS
$cshowList :: forall a e. (Show e, Show a) => [ZipBranchTree a e] -> ShowS
show :: ZipBranchTree a e -> String
$cshow :: forall a e. (Show e, Show a) => ZipBranchTree a e -> String
showsPrec :: Int -> ZipBranchTree a e -> ShowS
$cshowsPrec :: forall a e. (Show e, Show a) => Int -> ZipBranchTree a e -> ShowS
Show, Typeable (ZipBranchTree a e)
DataType
Constr
Typeable (ZipBranchTree a e)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ZipBranchTree a e
    -> c (ZipBranchTree a e))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ZipBranchTree a e))
-> (ZipBranchTree a e -> Constr)
-> (ZipBranchTree a e -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ZipBranchTree a e)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ZipBranchTree a e)))
-> ((forall b. Data b => b -> b)
    -> ZipBranchTree a e -> ZipBranchTree a e)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ZipBranchTree a e -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ZipBranchTree a e -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ZipBranchTree a e -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ZipBranchTree a e -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ZipBranchTree a e -> m (ZipBranchTree a e))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ZipBranchTree a e -> m (ZipBranchTree a e))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ZipBranchTree a e -> m (ZipBranchTree a e))
-> Data (ZipBranchTree a e)
ZipBranchTree a e -> DataType
ZipBranchTree a e -> Constr
(forall b. Data b => b -> b)
-> ZipBranchTree a e -> ZipBranchTree a e
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ZipBranchTree a e
-> c (ZipBranchTree a e)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ZipBranchTree a e)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipBranchTree a e))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ZipBranchTree a e -> u
forall u. (forall d. Data d => d -> u) -> ZipBranchTree a e -> [u]
forall a e. (Data a, Data e) => Typeable (ZipBranchTree a e)
forall a e. (Data a, Data e) => ZipBranchTree a e -> DataType
forall a e. (Data a, Data e) => ZipBranchTree a e -> Constr
forall a e.
(Data a, Data e) =>
(forall b. Data b => b -> b)
-> ZipBranchTree a e -> ZipBranchTree a e
forall a e u.
(Data a, Data e) =>
Int -> (forall d. Data d => d -> u) -> ZipBranchTree a e -> u
forall a e u.
(Data a, Data e) =>
(forall d. Data d => d -> u) -> ZipBranchTree a e -> [u]
forall a e r r'.
(Data a, Data e) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipBranchTree a e -> r
forall a e r r'.
(Data a, Data e) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipBranchTree a e -> r
forall a e (m :: * -> *).
(Data a, Data e, Monad m) =>
(forall d. Data d => d -> m d)
-> ZipBranchTree a e -> m (ZipBranchTree a e)
forall a e (m :: * -> *).
(Data a, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ZipBranchTree a e -> m (ZipBranchTree a e)
forall a e (c :: * -> *).
(Data a, Data e) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ZipBranchTree a e)
forall a e (c :: * -> *).
(Data a, Data e) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ZipBranchTree a e
-> c (ZipBranchTree a e)
forall a e (t :: * -> *) (c :: * -> *).
(Data a, Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ZipBranchTree a e))
forall a e (t :: * -> * -> *) (c :: * -> *).
(Data a, Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipBranchTree a e))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipBranchTree a e -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipBranchTree a e -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ZipBranchTree a e -> m (ZipBranchTree a e)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ZipBranchTree a e -> m (ZipBranchTree a e)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ZipBranchTree a e)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ZipBranchTree a e
-> c (ZipBranchTree a e)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ZipBranchTree a e))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipBranchTree a e))
$cZipBranchTree :: Constr
$tZipBranchTree :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ZipBranchTree a e -> m (ZipBranchTree a e)
$cgmapMo :: forall a e (m :: * -> *).
(Data a, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ZipBranchTree a e -> m (ZipBranchTree a e)
gmapMp :: (forall d. Data d => d -> m d)
-> ZipBranchTree a e -> m (ZipBranchTree a e)
$cgmapMp :: forall a e (m :: * -> *).
(Data a, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ZipBranchTree a e -> m (ZipBranchTree a e)
gmapM :: (forall d. Data d => d -> m d)
-> ZipBranchTree a e -> m (ZipBranchTree a e)
$cgmapM :: forall a e (m :: * -> *).
(Data a, Data e, Monad m) =>
(forall d. Data d => d -> m d)
-> ZipBranchTree a e -> m (ZipBranchTree a e)
gmapQi :: Int -> (forall d. Data d => d -> u) -> ZipBranchTree a e -> u
$cgmapQi :: forall a e u.
(Data a, Data e) =>
Int -> (forall d. Data d => d -> u) -> ZipBranchTree a e -> u
gmapQ :: (forall d. Data d => d -> u) -> ZipBranchTree a e -> [u]
$cgmapQ :: forall a e u.
(Data a, Data e) =>
(forall d. Data d => d -> u) -> ZipBranchTree a e -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipBranchTree a e -> r
$cgmapQr :: forall a e r r'.
(Data a, Data e) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipBranchTree a e -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipBranchTree a e -> r
$cgmapQl :: forall a e r r'.
(Data a, Data e) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipBranchTree a e -> r
gmapT :: (forall b. Data b => b -> b)
-> ZipBranchTree a e -> ZipBranchTree a e
$cgmapT :: forall a e.
(Data a, Data e) =>
(forall b. Data b => b -> b)
-> ZipBranchTree a e -> ZipBranchTree a e
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipBranchTree a e))
$cdataCast2 :: forall a e (t :: * -> * -> *) (c :: * -> *).
(Data a, Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipBranchTree a e))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (ZipBranchTree a e))
$cdataCast1 :: forall a e (t :: * -> *) (c :: * -> *).
(Data a, Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ZipBranchTree a e))
dataTypeOf :: ZipBranchTree a e -> DataType
$cdataTypeOf :: forall a e. (Data a, Data e) => ZipBranchTree a e -> DataType
toConstr :: ZipBranchTree a e -> Constr
$ctoConstr :: forall a e. (Data a, Data e) => ZipBranchTree a e -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ZipBranchTree a e)
$cgunfold :: forall a e (c :: * -> *).
(Data a, Data e) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ZipBranchTree a e)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ZipBranchTree a e
-> c (ZipBranchTree a e)
$cgfoldl :: forall a e (c :: * -> *).
(Data a, Data e) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ZipBranchTree a e
-> c (ZipBranchTree a e)
$cp1Data :: forall a e. (Data a, Data e) => Typeable (ZipBranchTree a e)
Data, (forall x. ZipBranchTree a e -> Rep (ZipBranchTree a e) x)
-> (forall x. Rep (ZipBranchTree a e) x -> ZipBranchTree a e)
-> Generic (ZipBranchTree a e)
forall x. Rep (ZipBranchTree a e) x -> ZipBranchTree a e
forall x. ZipBranchTree a e -> Rep (ZipBranchTree a e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a e x. Rep (ZipBranchTree a e) x -> ZipBranchTree a e
forall a e x. ZipBranchTree a e -> Rep (ZipBranchTree a e) x
$cto :: forall a e x. Rep (ZipBranchTree a e) x -> ZipBranchTree a e
$cfrom :: forall a e x. ZipBranchTree a e -> Rep (ZipBranchTree a e) x
Generic)

-- | Map over branch labels.
instance Functor (ZipBranchTree a) where
  fmap :: (a -> b) -> ZipBranchTree a a -> ZipBranchTree a b
fmap a -> b
f ~(ZipBranchTree (Node a
br a
lb Forest a a
ts)) =
    Tree b a -> ZipBranchTree a b
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree (Tree b a -> ZipBranchTree a b) -> Tree b a -> ZipBranchTree a b
forall a b. (a -> b) -> a -> b
$ b -> a -> Forest b a -> Tree b a
forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b
f a
br) a
lb (Forest b a -> Tree b a) -> Forest b a -> Tree b a
forall a b. (a -> b) -> a -> b
$ (Tree a a -> Tree b a) -> Forest a a -> Forest b a
forall a b. (a -> b) -> [a] -> [b]
map Tree a a -> Tree b a
forall a. Tree a a -> Tree b a
g Forest a a
ts
    where
      g :: Tree a a -> Tree b a
g = ZipBranchTree a b -> Tree b a
forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree (ZipBranchTree a b -> Tree b a)
-> (Tree a a -> ZipBranchTree a b) -> Tree a a -> Tree b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> ZipBranchTree a a -> ZipBranchTree a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ZipBranchTree a a -> ZipBranchTree a b)
-> (Tree a a -> ZipBranchTree a a) -> Tree a a -> ZipBranchTree a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a a -> ZipBranchTree a a
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree
  a
br <$ :: a -> ZipBranchTree a b -> ZipBranchTree a a
<$ ~(ZipBranchTree (Node b
_ a
lb Forest b a
ts)) =
    Tree a a -> ZipBranchTree a a
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree (Tree a a -> ZipBranchTree a a) -> Tree a a -> ZipBranchTree a a
forall a b. (a -> b) -> a -> b
$ a -> a -> Forest a a -> Tree a a
forall e a. e -> a -> Forest e a -> Tree e a
Node a
br a
lb ((Tree b a -> Tree a a) -> Forest b a -> Forest a a
forall a b. (a -> b) -> [a] -> [b]
map Tree b a -> Tree a a
forall b a. Tree b a -> Tree a a
f Forest b a
ts)
    where
      f :: Tree b a -> Tree a a
f = ZipBranchTree a a -> Tree a a
forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree (ZipBranchTree a a -> Tree a a)
-> (Tree b a -> ZipBranchTree a a) -> Tree b a -> Tree a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
br a -> ZipBranchTree a b -> ZipBranchTree a a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (ZipBranchTree a b -> ZipBranchTree a a)
-> (Tree b a -> ZipBranchTree a b) -> Tree b a -> ZipBranchTree a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree b a -> ZipBranchTree a b
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree

-- | Combine branch labels in pre-order.
instance Foldable (ZipBranchTree a) where
  foldMap :: (a -> m) -> ZipBranchTree a a -> m
foldMap a -> m
f ~(ZipBranchTree (Node a
br a
_ Forest a a
ts)) =
    a -> m
f a
br m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Tree a a -> m) -> Forest a a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Tree a a -> m
forall a. Tree a a -> m
g Forest a a
ts
    where
      g :: Tree a a -> m
g = (a -> m) -> ZipBranchTree a a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (ZipBranchTree a a -> m)
-> (Tree a a -> ZipBranchTree a a) -> Tree a a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a a -> ZipBranchTree a a
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree
  null :: ZipBranchTree a a -> Bool
null ZipBranchTree a a
_ = Bool
False
  {-# INLINE null #-}
  toList :: ZipBranchTree a a -> [a]
toList = Tree a a -> [a]
forall e a. Tree e a -> [e]
branches (Tree a a -> [a])
-> (ZipBranchTree a a -> Tree a a) -> ZipBranchTree a a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipBranchTree a a -> Tree a a
forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree
  {-# INLINE toList #-}

instance Traversable (ZipBranchTree a) where
  traverse :: (a -> f b) -> ZipBranchTree a a -> f (ZipBranchTree a b)
traverse a -> f b
g ~(ZipBranchTree (Node a
br a
lb Forest a a
ts)) =
    a -> b -> Forest b a -> ZipBranchTree a b
forall a e. a -> e -> Forest e a -> ZipBranchTree a e
assemble a
lb (b -> Forest b a -> ZipBranchTree a b)
-> f b -> f (Forest b a -> ZipBranchTree a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
fbr' f (Forest b a -> ZipBranchTree a b)
-> f (Forest b a) -> f (ZipBranchTree a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Forest b a)
fts'
    where
      assemble :: a -> e -> Forest e a -> ZipBranchTree a e
assemble a
lb' e
br' Forest e a
ts' = Tree e a -> ZipBranchTree a e
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree (Tree e a -> ZipBranchTree a e) -> Tree e a -> ZipBranchTree a e
forall a b. (a -> b) -> a -> b
$ e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
br' a
lb' Forest e a
ts'
      fbr' :: f b
fbr' = a -> f b
g a
br
      fts' :: f (Forest b a)
fts' = (ZipBranchTree a b -> Tree b a)
-> [ZipBranchTree a b] -> Forest b a
forall a b. (a -> b) -> [a] -> [b]
map ZipBranchTree a b -> Tree b a
forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree ([ZipBranchTree a b] -> Forest b a)
-> f [ZipBranchTree a b] -> f (Forest b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree a a -> f (ZipBranchTree a b))
-> Forest a a -> f [ZipBranchTree a b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> ZipBranchTree a a -> f (ZipBranchTree a b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
g (ZipBranchTree a a -> f (ZipBranchTree a b))
-> (Tree a a -> ZipBranchTree a a)
-> Tree a a
-> f (ZipBranchTree a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a a -> ZipBranchTree a a
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree) Forest a a
ts

instance Comonad (ZipBranchTree a) where
  duplicate :: ZipBranchTree a a -> ZipBranchTree a (ZipBranchTree a a)
duplicate (ZipBranchTree t :: Tree a a
t@(Node a
_ a
lb Forest a a
ts)) =
    Tree (ZipBranchTree a a) a -> ZipBranchTree a (ZipBranchTree a a)
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree (Tree (ZipBranchTree a a) a -> ZipBranchTree a (ZipBranchTree a a))
-> Tree (ZipBranchTree a a) a
-> ZipBranchTree a (ZipBranchTree a a)
forall a b. (a -> b) -> a -> b
$
      ZipBranchTree a a
-> a -> Forest (ZipBranchTree a a) a -> Tree (ZipBranchTree a a) a
forall e a. e -> a -> Forest e a -> Tree e a
Node (Tree a a -> ZipBranchTree a a
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree a a
t) a
lb (Forest (ZipBranchTree a a) a -> Tree (ZipBranchTree a a) a)
-> Forest (ZipBranchTree a a) a -> Tree (ZipBranchTree a a) a
forall a b. (a -> b) -> a -> b
$
        (Tree a a -> Tree (ZipBranchTree a a) a)
-> Forest a a -> Forest (ZipBranchTree a a) a
forall a b. (a -> b) -> [a] -> [b]
map (ZipBranchTree a (ZipBranchTree a a) -> Tree (ZipBranchTree a a) a
forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree (ZipBranchTree a (ZipBranchTree a a) -> Tree (ZipBranchTree a a) a)
-> (Tree a a -> ZipBranchTree a (ZipBranchTree a a))
-> Tree a a
-> Tree (ZipBranchTree a a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipBranchTree a a -> ZipBranchTree a (ZipBranchTree a a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate (ZipBranchTree a a -> ZipBranchTree a (ZipBranchTree a a))
-> (Tree a a -> ZipBranchTree a a)
-> Tree a a
-> ZipBranchTree a (ZipBranchTree a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a a -> ZipBranchTree a a
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree) Forest a a
ts
  extract :: ZipBranchTree a a -> a
extract = Tree a a -> a
forall e a. Tree e a -> e
branch (Tree a a -> a)
-> (ZipBranchTree a a -> Tree a a) -> ZipBranchTree a a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipBranchTree a a -> Tree a a
forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree

-- | See the 'Applicative' instance of 'ZipTree'.
instance Monoid a => Applicative (ZipBranchTree a) where
  -- Infinite layers with infinite subtrees.
  pure :: a -> ZipBranchTree a a
pure a
br = Tree a a -> ZipBranchTree a a
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree (Tree a a -> ZipBranchTree a a) -> Tree a a -> ZipBranchTree a a
forall a b. (a -> b) -> a -> b
$ a -> a -> Forest a a -> Tree a a
forall e a. e -> a -> Forest e a -> Tree e a
Node a
br a
forall a. Monoid a => a
mempty (Forest a a -> Tree a a) -> Forest a a -> Tree a a
forall a b. (a -> b) -> a -> b
$ Tree a a -> Forest a a
forall a. a -> [a]
repeat (ZipBranchTree a a -> Tree a a
forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree (ZipBranchTree a a -> Tree a a) -> ZipBranchTree a a -> Tree a a
forall a b. (a -> b) -> a -> b
$ a -> ZipBranchTree a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
br)
  (ZipBranchTree ~(Node a -> b
brF a
lbF Forest (a -> b) a
tsF)) <*> :: ZipBranchTree a (a -> b) -> ZipBranchTree a a -> ZipBranchTree a b
<*> (ZipBranchTree ~(Node a
brX a
lbX Forest a a
tsX)) =
    Tree b a -> ZipBranchTree a b
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree (Tree b a -> ZipBranchTree a b) -> Tree b a -> ZipBranchTree a b
forall a b. (a -> b) -> a -> b
$ b -> a -> Forest b a -> Tree b a
forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b
brF a
brX) (a
lbF a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
lbX) ((Tree (a -> b) a -> Tree a a -> Tree b a)
-> Forest (a -> b) a -> Forest a a -> Forest b a
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Tree (a -> b) a -> Tree a a -> Tree b a
forall a a e. Monoid a => Tree (a -> e) a -> Tree a a -> Tree e a
f Forest (a -> b) a
tsF Forest a a
tsX)
    where
      f :: Tree (a -> e) a -> Tree a a -> Tree e a
f Tree (a -> e) a
x Tree a a
y = ZipBranchTree a e -> Tree e a
forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree (ZipBranchTree a e -> Tree e a) -> ZipBranchTree a e -> Tree e a
forall a b. (a -> b) -> a -> b
$ Tree (a -> e) a -> ZipBranchTree a (a -> e)
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree (a -> e) a
x ZipBranchTree a (a -> e) -> ZipBranchTree a a -> ZipBranchTree a e
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tree a a -> ZipBranchTree a a
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree a a
y
  liftA2 :: (a -> b -> c)
-> ZipBranchTree a a -> ZipBranchTree a b -> ZipBranchTree a c
liftA2 a -> b -> c
f (ZipBranchTree ~(Node a
brX a
lbX Forest a a
tsX)) (ZipBranchTree ~(Node b
brY a
lbY Forest b a
tsY)) =
    Tree c a -> ZipBranchTree a c
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree (Tree c a -> ZipBranchTree a c) -> Tree c a -> ZipBranchTree a c
forall a b. (a -> b) -> a -> b
$ c -> a -> Forest c a -> Tree c a
forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b -> c
f a
brX b
brY) (a
lbX a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
lbY) ((Tree a a -> Tree b a -> Tree c a)
-> Forest a a -> Forest b a -> Forest c a
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Tree a a -> Tree b a -> Tree c a
forall a. Monoid a => Tree a a -> Tree b a -> Tree c a
g Forest a a
tsX Forest b a
tsY)
    where
      g :: Tree a a -> Tree b a -> Tree c a
g Tree a a
x Tree b a
y = ZipBranchTree a c -> Tree c a
forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree (ZipBranchTree a c -> Tree c a) -> ZipBranchTree a c -> Tree c a
forall a b. (a -> b) -> a -> b
$ (a -> b -> c)
-> ZipBranchTree a a -> ZipBranchTree a b -> ZipBranchTree a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (Tree a a -> ZipBranchTree a a
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree a a
x) (Tree b a -> ZipBranchTree a b
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree b a
y)
  (ZipBranchTree ~(Node a
_ a
lbX Forest a a
tsX)) *> :: ZipBranchTree a a -> ZipBranchTree a b -> ZipBranchTree a b
*> (ZipBranchTree ~(Node b
brY a
lbY Forest b a
tsY)) =
    Tree b a -> ZipBranchTree a b
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree (Tree b a -> ZipBranchTree a b) -> Tree b a -> ZipBranchTree a b
forall a b. (a -> b) -> a -> b
$ b -> a -> Forest b a -> Tree b a
forall e a. e -> a -> Forest e a -> Tree e a
Node b
brY (a
lbX a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
lbY) ((Tree a a -> Tree b a -> Tree b a)
-> Forest a a -> Forest b a -> Forest b a
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Tree a a -> Tree b a -> Tree b a
forall a a e. Monoid a => Tree a a -> Tree e a -> Tree e a
f Forest a a
tsX Forest b a
tsY)
    where
      f :: Tree a a -> Tree e a -> Tree e a
f Tree a a
x Tree e a
y = ZipBranchTree a e -> Tree e a
forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree (ZipBranchTree a e -> Tree e a) -> ZipBranchTree a e -> Tree e a
forall a b. (a -> b) -> a -> b
$ Tree a a -> ZipBranchTree a a
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree a a
x ZipBranchTree a a -> ZipBranchTree a e -> ZipBranchTree a e
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tree e a -> ZipBranchTree a e
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree e a
y
  (ZipBranchTree ~(Node a
brX a
lbX Forest a a
tsX)) <* :: ZipBranchTree a a -> ZipBranchTree a b -> ZipBranchTree a a
<* (ZipBranchTree ~(Node b
_ a
lbY Forest b a
tsY)) =
    Tree a a -> ZipBranchTree a a
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree (Tree a a -> ZipBranchTree a a) -> Tree a a -> ZipBranchTree a a
forall a b. (a -> b) -> a -> b
$ a -> a -> Forest a a -> Tree a a
forall e a. e -> a -> Forest e a -> Tree e a
Node a
brX (a
lbX a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
lbY) ((Tree a a -> Tree b a -> Tree a a)
-> Forest a a -> Forest b a -> Forest a a
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Tree a a -> Tree b a -> Tree a a
forall a e b. Monoid a => Tree e a -> Tree b a -> Tree e a
f Forest a a
tsX Forest b a
tsY)
    where
      f :: Tree e a -> Tree b a -> Tree e a
f Tree e a
x Tree b a
y = ZipBranchTree a e -> Tree e a
forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree (ZipBranchTree a e -> Tree e a) -> ZipBranchTree a e -> Tree e a
forall a b. (a -> b) -> a -> b
$ Tree e a -> ZipBranchTree a e
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree e a
x ZipBranchTree a e -> ZipBranchTree a b -> ZipBranchTree a e
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tree b a -> ZipBranchTree a b
forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree b a
y