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

-- |
-- Module      :  ELynx.Tree.Rooted
-- Description :  Rooted trees with labeled branches
-- Copyright   :  2021 Dominik Schrempf
-- 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,
    duplicateLabels,
    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
  { forall e a. Tree e a -> e
branch :: e,
    forall e a. Tree e a -> a
label :: a,
    forall e a. Tree e a -> Forest e a
forest :: Forest e a
  }
  deriving (Tree e a -> Tree e a -> Bool
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)
ReadS [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
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, Tree e a -> DataType
Tree e a -> Constr
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 {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 (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 e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree e a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. 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 u. (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 :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data, 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 :: forall a b. (a -> b) -> Tree e a -> Tree e b
fmap a -> b
f ~(Node e
br a
lb Forest e a
ts) = forall e a. e -> a -> Forest e a -> Tree e a
Node e
br (a -> b
f a
lb) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Forest e a
ts
  a
lb <$ :: forall a b. a -> Tree e b -> Tree e a
<$ ~(Node e
br b
_ Forest e b
ts) = forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb (forall a b. (a -> b) -> [a] -> [b]
map (a
lb 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 :: forall a b c d. (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) = forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b
f a
br) (c -> d
g c
lb) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (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 :: forall a b c. (a -> b) -> Tree a c -> Tree b c
first a -> b
f ~(Node a
br c
lb Forest a c
ts) = forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b
f a
br) c
lb forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) Forest a c
ts
  second :: forall b c a. (b -> c) -> Tree a b -> Tree a c
second b -> c
g ~(Node a
br b
lb Forest a b
ts) = forall e a. e -> a -> Forest e a -> Tree e a
Node a
br (b -> c
g b
lb) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (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 :: forall m a. Monoid m => (a -> m) -> Tree e a -> m
foldMap a -> m
f ~(Node e
_ a
lb Forest e a
ts) = a -> m
f a
lb forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) Forest e a
ts
  null :: forall a. Tree e a -> Bool
null Tree e a
_ = Bool
False
  {-# INLINE null #-}
  toList :: forall a. Tree e a -> [a]
toList = forall e a. Tree e a -> [a]
labels
  {-# INLINE toList #-}

instance Bifoldable Tree where
  bifoldMap :: forall m a b. Monoid m => (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 forall a. Semigroup a => a -> a -> a
<> b -> m
g b
lb forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree e a -> f (Tree e b)
traverse a -> f b
g ~(Node e
br a
lb Forest e a
ts) = forall e a. e -> a -> Forest e a -> Tree e a
Node e
br forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
g a
lb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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 :: forall (f :: * -> *) a c b d.
Applicative f =>
(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) = forall e a. e -> a -> Forest e a -> Tree e a
Node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
br forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
lb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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 :: forall a. a -> Tree e a
pure a
lb = forall e a. e -> a -> Forest e a -> Tree e a
Node forall a. Monoid a => a
mempty a
lb []
  ~(Node e
brF a -> b
lbF Forest e (a -> b)
tsF) <*> :: forall a b. Tree e (a -> b) -> Tree e a -> Tree e b
<*> ~tx :: Tree e a
tx@(Node e
brX a
lbX Forest e a
tsX) =
    forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brF forall a. Semigroup a => a -> a -> a
<> e
brX) (a -> b
lbF a
lbX) (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (e
brF forall a. Semigroup a => a -> a -> a
<>) a -> b
lbF) Forest e a
tsX forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tree e a
tx) Forest e (a -> b)
tsF)
  liftA2 :: forall a b c. (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) =
    forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX forall a. Semigroup a => a -> a -> a
<> e
brY) (a -> b -> c
f a
lbX b
lbY) (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (e
brX forall a. Semigroup a => a -> a -> a
<>) (a -> b -> c
f a
lbX)) Forest e b
tsY forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\Tree e a
tx -> 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) *> :: forall a b. Tree e a -> Tree e b -> Tree e b
*> ~ty :: Tree e b
ty@(Node e
brY b
lbY Forest e b
tsY) =
    forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX forall a. Semigroup a => a -> a -> a
<> e
brY) b
lbY (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (e
brX forall a. Semigroup a => a -> a -> a
<>)) Forest e b
tsY forall a. [a] -> [a] -> [a]
++ (Forest e a
tsX forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f 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) <* :: forall a b. Tree e a -> Tree e b -> Tree e a
<* ~ty :: Tree e b
ty@(Node e
brY b
_ Forest e b
tsY) =
    forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX forall a. Semigroup a => a -> a -> a
<> e
brY) a
lbX (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (e
brX forall a. Semigroup a => a -> a -> a
<>) (forall a b. a -> b -> a
const a
lbX)) Forest e b
tsY forall a. [a] -> [a] -> [a]
++ (Forest e a
tsX forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (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) >>= :: forall a b. 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' -> forall e a. e -> a -> Forest e a -> Tree e a
Node (e
br forall a. Semigroup a => a -> a -> a
<> e
br') b
lb' (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (e
br forall a. Semigroup a => a -> a -> a
<>)) Forest e b
ts' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (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 :: forall a. Tree e a -> Tree e (Tree e a)
duplicate t :: Tree e a
t@(Node e
br a
_ Forest e a
ts) = forall e a. e -> a -> Forest e a -> Tree e a
Node e
br Tree e a
t (forall a b. (a -> b) -> [a] -> [b]
map forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate Forest e a
ts)
  extract :: forall a. Tree e a -> a
extract = 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) = forall a. NFData a => a -> ()
rnf e
br seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
lb seq :: forall a b. a -> b -> b
`seq` 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 :: forall a. Tree a -> Tree () a
fromRoseTree (T.Node a
l [Tree a]
ts) = forall e a. e -> a -> Forest e a -> Tree e a
Node () a
l forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Tree a -> Tree () a
fromRoseTree [Tree a]
ts

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

-- | List of leaves.
leaves :: Tree e a -> [a]
leaves :: forall e a. Tree e a -> [a]
leaves Tree e a
t = 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 forall a. a -> [a] -> [a]
: [a]
xs
    squish (Node e
_ a
_ [Tree e a]
ts) [a]
xs = 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 :: forall a. Ord a => [a] -> Bool
duplicates = forall {a}. Ord a => Set a -> [a] -> Bool
go 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 forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
seen Bool -> Bool -> Bool
|| Set a -> [a] -> Bool
go (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 :: forall a e. Ord a => Tree e a -> Bool
duplicateLeaves = forall a. Ord a => [a] -> Bool
duplicates forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Tree e a -> [a]
leaves

-- | Set the stem to a given value.
setStem :: e -> Tree e a -> Tree e a
setStem :: forall e a. e -> Tree e a -> Tree e a
setStem e
br (Node e
_ a
lb Forest e a
ts) = 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 :: forall e a. (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 forall a b. (a -> b) -> a -> b
$ forall e a. Tree e a -> e
branch Tree e a
t}

-- | Get branch labels in pre-order.
branches :: Tree e a -> [e]
branches :: forall e a. Tree e a -> [e]
branches Tree e a
t = 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 forall a. 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 :: forall (t :: * -> * -> *) f e a.
Bitraversable t =>
[f] -> t e a -> Maybe (t f a)
setBranches [f]
xs = forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequenceA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall {a} {p}. [a] -> p -> ([a], Maybe a)
setBranch forall {a} {a}. a -> a -> (a, Maybe a)
noChange [f]
xs
  where
    setBranch :: [a] -> p -> ([a], Maybe a)
setBranch [] p
_ = ([], forall a. Maybe a
Nothing)
    setBranch (a
y : [a]
ys) p
_ = ([a]
ys, forall a. a -> Maybe a
Just a
y)
    noChange :: a -> a -> (a, Maybe a)
noChange a
ys a
z = (a
ys, forall a. a -> Maybe a
Just a
z)

-- | Set label.
setLabel :: a -> Tree e a -> Tree e a
setLabel :: forall a e. a -> Tree e a -> Tree e a
setLabel a
lb (Node e
br a
_ Forest e a
ts) = 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 :: forall a e. (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 forall a b. (a -> b) -> a -> b
$ forall e a. Tree e a -> a
label Tree e a
t}

-- | Return node labels in pre-order.
labels :: Tree e a -> [a]
labels :: forall e a. Tree e a -> [a]
labels Tree e a
t = 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 forall a. a -> [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

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

-- | 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 :: forall (t :: * -> *) b a.
Traversable t =>
[b] -> t a -> Maybe (t b)
setLabels [b]
xs = forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL forall {a} {p}. [a] -> p -> ([a], Maybe a)
setLabelM [b]
xs
  where
    setLabelM :: [a] -> p -> ([a], Maybe a)
setLabelM [] p
_ = ([], forall a. Maybe a
Nothing)
    setLabelM (a
y : [a]
ys) p
_ = ([a]
ys, 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 :: forall (t :: * -> *) a. Traversable t => t a -> t Int
identify = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\Int
i a
_ -> (Int
i 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 :: forall e a. Tree e a -> Int
degree = (forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall e a. Tree e a -> Int
depth = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (t -> Tree e a -> [t]
go (t
n 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 :: forall e a. Semigroup e => 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]) = forall e a. e -> a -> Forest e a -> Tree e a
Node (e
daBr 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) = forall e a. e -> a -> Forest e a -> Tree e a
Node e
paBr a
paLb forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 :: forall a e. (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 = forall a. Maybe a
Nothing
  | Bool
otherwise =
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Forest e a
ts'
        then forall a. Maybe a
Nothing
        else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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' = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (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 :: forall a e. (a -> Bool) -> Tree e a -> Maybe (Tree e a)
dropLeavesWith a -> Bool
p (Node e
br a
lb [])
  | a -> Bool
p a
lb = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree e a]
ts'
    then forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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' = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (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 :: 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 (Node e1
brL a1
lbL Forest e1 a1
tsL) (Node e2
brR a2
lbR Forest e2 a2
tsR) =
  if forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest e1 a1
tsL forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest e2 a2
tsR
    then -- I am proud of that :)).
      forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Maybe a
Nothing

-- | See 'zipTreesWith'.
zipTrees :: Tree e1 a1 -> Tree e2 a2 -> Maybe (Tree (e1, e2) (a1, a2))
zipTrees :: forall e1 a1 e2 a2.
Tree e1 a1 -> Tree e2 a2 -> Maybe (Tree (e1, e2) (a1, a2))
zipTrees = 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 :: forall e a. Tree e a -> Tree a e
flipLabels (Node e
x a
y Forest e a
zs) = forall e a. e -> a -> Forest e a -> Tree e a
Node a
y e
x forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 {forall a e. BranchTree a e -> Tree e a
getBranchTree :: Tree e a}
  deriving (BranchTree a e -> BranchTree a e -> Bool
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)
ReadS [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
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, BranchTree a e -> DataType
BranchTree a e -> Constr
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 {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 (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 e. (Data d, Data e) => c (t d e))
-> Maybe (c (BranchTree a e))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
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 u. (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 :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data, 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 :: forall a b. (a -> b) -> BranchTree a a -> BranchTree a b
fmap a -> b
f ~(BranchTree (Node a
br a
lb Forest a a
ts)) =
    forall a e. Tree e a -> BranchTree a e
BranchTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b
f a
br) a
lb forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a e. BranchTree a e -> Tree e a
getBranchTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Tree e a -> BranchTree a e
BranchTree) Forest a a
ts
  a
br <$ :: forall a b. a -> BranchTree a b -> BranchTree a a
<$ ~(BranchTree (Node b
_ a
lb Forest b a
ts)) =
    forall a e. Tree e a -> BranchTree a e
BranchTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node a
br a
lb (forall a b. (a -> b) -> [a] -> [b]
map (forall a e. BranchTree a e -> Tree e a
getBranchTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
br forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall m a. Monoid m => (a -> m) -> BranchTree a a -> m
foldMap a -> m
f ~(BranchTree (Node a
br a
_ Forest a a
ts)) =
    a -> m
f a
br forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Tree e a -> BranchTree a e
BranchTree) Forest a a
ts
  null :: forall a. BranchTree a a -> Bool
null BranchTree a a
_ = Bool
False
  {-# INLINE null #-}
  toList :: forall a. BranchTree a a -> [a]
toList = forall e a. Tree e a -> [e]
branches forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. BranchTree a e -> Tree e a
getBranchTree
  {-# INLINE toList #-}

instance Traversable (BranchTree a) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(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)) =
    forall {a} {e}. a -> e -> Forest e a -> BranchTree a e
assemble a
lb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
fbr' 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' = forall a e. Tree e a -> BranchTree a e
BranchTree forall a b. (a -> b) -> a -> b
$ 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' = forall a b. (a -> b) -> [a] -> [b]
map forall a e. BranchTree a e -> Tree e a
getBranchTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Tree e a -> BranchTree a e
BranchTree) Forest a a
ts

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

instance Monoid a => Applicative (BranchTree a) where
  -- Infinite layers with infinite subtrees.
  pure :: forall a. a -> BranchTree a a
pure a
br = forall a e. Tree e a -> BranchTree a e
BranchTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node a
br forall a. Monoid a => a
mempty []
  (BranchTree ~(Node a -> b
brF a
lbF Forest (a -> b) a
tsF)) <*> :: forall a b.
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)) =
    forall a e. Tree e a -> BranchTree a e
BranchTree forall a b. (a -> b) -> a -> b
$
      forall e a. e -> a -> Forest e a -> Tree e a
Node
        (a -> b
brF a
brX)
        (a
lbF forall a. Semigroup a => a -> a -> a
<> a
lbX)
        ( forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
brF (a
lbF forall a. Semigroup a => a -> a -> a
<>)) Forest a a
tsX
            forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a e. BranchTree a e -> Tree e a
getBranchTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BranchTree a a
tx) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Tree e a -> BranchTree a e
BranchTree) Forest (a -> b) a
tsF
        )
  liftA2 :: forall a b c.
(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)) =
    forall a e. Tree e a -> BranchTree a e
BranchTree forall a b. (a -> b) -> a -> b
$
      forall e a. e -> a -> Forest e a -> Tree e a
Node
        (a -> b -> c
f a
brX b
brY)
        (a
lbX forall a. Semigroup a => a -> a -> a
<> a
lbY)
        ( forall a b. (a -> b) -> [a] -> [b]
map (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 forall a. Semigroup a => a -> a -> a
<>)) Forest b a
tsY
            forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\Tree a a
tx -> forall a e. BranchTree a e -> Tree e a
getBranchTree forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (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)) *> :: forall a b. BranchTree a a -> BranchTree a b -> BranchTree a b
*> ty :: BranchTree a b
ty@(BranchTree ~(Node b
brY a
lbY Forest b a
tsY)) =
    forall a e. Tree e a -> BranchTree a e
BranchTree forall a b. (a -> b) -> a -> b
$
      forall e a. e -> a -> Forest e a -> Tree e a
Node
        b
brY
        (a
lbX forall a. Semigroup a => a -> a -> a
<> a
lbY)
        ( forall a e. BranchTree a e -> Tree e a
getBranchTree
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall a b. (a -> b) -> [a] -> [b]
map (forall a e. Tree e a -> BranchTree a e
BranchTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (a
lbX forall a. Semigroup a => a -> a -> a
<>)) Forest b a
tsY
                    forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ((forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BranchTree a b
ty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Tree e a -> BranchTree a e
BranchTree) Forest a a
tsX
                )
        )
  (BranchTree ~(Node a
brX a
lbX Forest a a
tsX)) <* :: forall a b. BranchTree a a -> BranchTree a b -> BranchTree a a
<* ty :: BranchTree a b
ty@(BranchTree ~(Node b
_ a
lbY Forest b a
tsY)) =
    forall a e. Tree e a -> BranchTree a e
BranchTree forall a b. (a -> b) -> a -> b
$
      forall e a. e -> a -> Forest e a -> Tree e a
Node
        a
brX
        (a
lbX forall a. Semigroup a => a -> a -> a
<> a
lbY)
        ( forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a b. a -> b -> a
const a
brX) (a
lbX forall a. Semigroup a => a -> a -> a
<>)) Forest b a
tsY
            forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a e. BranchTree a e -> Tree e a
getBranchTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* BranchTree a b
ty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 {forall e a. ZipTree e a -> Tree e a
getZipTree :: Tree e a}
  deriving (ZipTree e a -> ZipTree e a -> Bool
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)
ReadS [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
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, ZipTree e a -> DataType
ZipTree e a -> Constr
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 {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 (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 e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipTree e a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. 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 u. (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 :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data, 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ZipTree e a -> f (ZipTree e b)
traverse a -> f b
f (ZipTree Tree e a
t) = forall e a. Tree e a -> ZipTree e a
ZipTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 :: forall a. ZipTree e a -> ZipTree e (ZipTree e a)
duplicate (ZipTree Tree e a
t) = forall e a. Tree e a -> ZipTree e a
ZipTree forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall e a. Tree e a -> ZipTree e a
ZipTree forall a b. (a -> b) -> a -> b
$ forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate Tree e a
t
  extract :: forall a. ZipTree e a -> a
extract = forall e a. Tree e a -> a
label forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. a -> ZipTree e a
pure a
lb = forall e a. Tree e a -> ZipTree e a
ZipTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node forall a. Monoid a => a
mempty a
lb forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat (forall e a. ZipTree e a -> Tree e a
getZipTree forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
lb)
  (ZipTree ~(Node e
brF a -> b
lbF Forest e (a -> b)
tsF)) <*> :: forall a b. ZipTree e (a -> b) -> ZipTree e a -> ZipTree e b
<*> (ZipTree ~(Node e
brX a
lbX Forest e a
tsX)) =
    forall e a. Tree e a -> ZipTree e a
ZipTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brF forall a. Semigroup a => a -> a -> a
<> e
brX) (a -> b
lbF a
lbX) (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall e a. ZipTree e a -> Tree e a
getZipTree forall a b. (a -> b) -> a -> b
$ forall e a. Tree e a -> ZipTree e a
ZipTree Tree e (a -> a)
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a. Tree e a -> ZipTree e a
ZipTree Tree e a
y
  liftA2 :: forall a b c.
(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)) =
    forall e a. Tree e a -> ZipTree e a
ZipTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX forall a. Semigroup a => a -> a -> a
<> e
brY) (a -> b -> c
f a
lbX b
lbY) (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall e a. ZipTree e a -> Tree e a
getZipTree forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (forall e a. Tree e a -> ZipTree e a
ZipTree Tree e a
x) (forall e a. Tree e a -> ZipTree e a
ZipTree Tree e b
y)
  (ZipTree ~(Node e
brX a
_ Forest e a
tsX)) *> :: forall a b. ZipTree e a -> ZipTree e b -> ZipTree e b
*> (ZipTree ~(Node e
brY b
lbY Forest e b
tsY)) =
    forall e a. Tree e a -> ZipTree e a
ZipTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX forall a. Semigroup a => a -> a -> a
<> e
brY) b
lbY (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall e a. ZipTree e a -> Tree e a
getZipTree forall a b. (a -> b) -> a -> b
$ forall e a. Tree e a -> ZipTree e a
ZipTree Tree e a
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e a. Tree e a -> ZipTree e a
ZipTree Tree e a
y
  (ZipTree ~(Node e
brX a
lbX Forest e a
tsX)) <* :: forall a b. ZipTree e a -> ZipTree e b -> ZipTree e a
<* (ZipTree ~(Node e
brY b
_ Forest e b
tsY)) =
    forall e a. Tree e a -> ZipTree e a
ZipTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node (e
brX forall a. Semigroup a => a -> a -> a
<> e
brY) a
lbX (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall e a. ZipTree e a -> Tree e a
getZipTree forall a b. (a -> b) -> a -> b
$ forall e a. Tree e a -> ZipTree e a
ZipTree Tree e a
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 {forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree :: Tree e a}
  deriving (ZipBranchTree a e -> ZipBranchTree a e -> Bool
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)
ReadS [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
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, ZipBranchTree a e -> DataType
ZipBranchTree a e -> Constr
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 {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 (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 e. (Data d, Data e) => c (t d e))
-> Maybe (c (ZipBranchTree a e))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
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 u. (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 :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data, 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 :: forall a b. (a -> b) -> ZipBranchTree a a -> ZipBranchTree a b
fmap a -> b
f ~(ZipBranchTree (Node a
br a
lb Forest a a
ts)) =
    forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b
f a
br) a
lb forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Tree a a -> Tree b a
g Forest a a
ts
    where
      g :: Tree a a -> Tree b a
g = forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree
  a
br <$ :: forall a b. a -> ZipBranchTree a b -> ZipBranchTree a a
<$ ~(ZipBranchTree (Node b
_ a
lb Forest b a
ts)) =
    forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node a
br a
lb (forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. Tree b a -> Tree a a
f Forest b a
ts)
    where
      f :: Tree b a -> Tree a a
f = forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
br forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree

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

instance Traversable (ZipBranchTree a) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(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)) =
    forall {a} {e}. a -> e -> Forest e a -> ZipBranchTree a e
assemble a
lb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
fbr' 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' = forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree forall a b. (a -> b) -> a -> b
$ 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' = forall a b. (a -> b) -> [a] -> [b]
map forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree) Forest a a
ts

instance Comonad (ZipBranchTree a) where
  duplicate :: forall a. ZipBranchTree a a -> ZipBranchTree a (ZipBranchTree a a)
duplicate (ZipBranchTree t :: Tree a a
t@(Node a
_ a
lb Forest a a
ts)) =
    forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree forall a b. (a -> b) -> a -> b
$
      forall e a. e -> a -> Forest e a -> Tree e a
Node (forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree a a
t) a
lb forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree) Forest a a
ts
  extract :: forall a. ZipBranchTree a a -> a
extract = forall e a. Tree e a -> e
branch forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. a -> ZipBranchTree a a
pure a
br = forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node a
br forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat (forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
br)
  (ZipBranchTree ~(Node a -> b
brF a
lbF Forest (a -> b) a
tsF)) <*> :: forall a b.
ZipBranchTree a (a -> b) -> ZipBranchTree a a -> ZipBranchTree a b
<*> (ZipBranchTree ~(Node a
brX a
lbX Forest a a
tsX)) =
    forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b
brF a
brX) (a
lbF forall a. Semigroup a => a -> a -> a
<> a
lbX) (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree forall a b. (a -> b) -> a -> b
$ forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree (a -> e) a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree a a
y
  liftA2 :: forall a b c.
(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)) =
    forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node (a -> b -> c
f a
brX b
brY) (a
lbX forall a. Semigroup a => a -> a -> a
<> a
lbY) (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree a a
x) (forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree b a
y)
  (ZipBranchTree ~(Node a
_ a
lbX Forest a a
tsX)) *> :: forall a b.
ZipBranchTree a a -> ZipBranchTree a b -> ZipBranchTree a b
*> (ZipBranchTree ~(Node b
brY a
lbY Forest b a
tsY)) =
    forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node b
brY (a
lbX forall a. Semigroup a => a -> a -> a
<> a
lbY) (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree forall a b. (a -> b) -> a -> b
$ forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree a a
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree e a
y
  (ZipBranchTree ~(Node a
brX a
lbX Forest a a
tsX)) <* :: forall a b.
ZipBranchTree a a -> ZipBranchTree a b -> ZipBranchTree a a
<* (ZipBranchTree ~(Node b
_ a
lbY Forest b a
tsY)) =
    forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree forall a b. (a -> b) -> a -> b
$ forall e a. e -> a -> Forest e a -> Tree e a
Node a
brX (a
lbX forall a. Semigroup a => a -> a -> a
<> a
lbY) (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall a e. ZipBranchTree a e -> Tree e a
getZipBranchTree forall a b. (a -> b) -> a -> b
$ forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree e a
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree Tree b a
y