module Tree.Append where

import Data.Functor
import Data.Tree (Tree (..))

-- TODO: Come up with better names

appendLeaf :: (a -> b) -> ([a] -> b) -> [a] -> Tree a -> Tree b
appendLeaf :: forall a b. (a -> b) -> ([a] -> b) -> [a] -> Tree a -> Tree b
appendLeaf a -> b
f [a] -> b
g [a]
acc (Node a
label []) = b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node (a -> b
f a
label) [b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node ([a] -> b
g (a
label a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)) []]
appendLeaf a -> b
f [a] -> b
g [a]
acc (Node a
label [Tree a]
xs) = b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node (a -> b
f a
label) ([Tree b] -> Tree b) -> [Tree b] -> Tree b
forall a b. (a -> b) -> a -> b
$ (Tree a -> Tree b) -> [Tree a] -> [Tree b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> ([a] -> b) -> [a] -> Tree a -> Tree b
forall a b. (a -> b) -> ([a] -> b) -> [a] -> Tree a -> Tree b
appendLeaf a -> b
f [a] -> b
g (a
label a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)) [Tree a]
xs

mayAppendLeaf :: (a -> b) -> ([a] -> Maybe b) -> [a] -> Tree a -> Tree b
mayAppendLeaf :: forall a b. (a -> b) -> ([a] -> Maybe b) -> [a] -> Tree a -> Tree b
mayAppendLeaf a -> b
f [a] -> Maybe b
g [a]
acc (Node a
label []) =
  case [a] -> Maybe b
g (a
label a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc) of
    Just b
leaf -> b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node (a -> b
f a
label) [b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node b
leaf []]
    Maybe b
Nothing -> b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node (a -> b
f a
label) []
mayAppendLeaf a -> b
f [a] -> Maybe b
g [a]
acc (Node a
label [Tree a]
xs) = b -> [Tree b] -> Tree b
forall a. a -> [Tree a] -> Tree a
Node (a -> b
f a
label) ([Tree b] -> Tree b) -> [Tree b] -> Tree b
forall a b. (a -> b) -> a -> b
$ (Tree a -> Tree b) -> [Tree a] -> [Tree b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> ([a] -> Maybe b) -> [a] -> Tree a -> Tree b
forall a b. (a -> b) -> ([a] -> Maybe b) -> [a] -> Tree a -> Tree b
mayAppendLeaf a -> b
f [a] -> Maybe b
g (a
label a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)) [Tree a]
xs

appendLeafA :: (Applicative f) => ([a] -> f a) -> [a] -> Tree a -> Tree (f a)
appendLeafA :: forall (f :: * -> *) a.
Applicative f =>
([a] -> f a) -> [a] -> Tree a -> Tree (f a)
appendLeafA [a] -> f a
f [a]
acc = (a -> f a) -> ([a] -> f a) -> [a] -> Tree a -> Tree (f a)
forall a b. (a -> b) -> ([a] -> b) -> [a] -> Tree a -> Tree b
appendLeaf a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a] -> f a
f [a]
acc

mayAppendLeafA :: (Applicative f) => ([a] -> Maybe (f a)) -> [a] -> Tree a -> Tree (f a)
mayAppendLeafA :: forall (f :: * -> *) a.
Applicative f =>
([a] -> Maybe (f a)) -> [a] -> Tree a -> Tree (f a)
mayAppendLeafA [a] -> Maybe (f a)
f [a]
acc = (a -> f a) -> ([a] -> Maybe (f a)) -> [a] -> Tree a -> Tree (f a)
forall a b. (a -> b) -> ([a] -> Maybe b) -> [a] -> Tree a -> Tree b
mayAppendLeaf a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a] -> Maybe (f a)
f [a]
acc

mayAppendLeafA' :: (Applicative f) => ([a] -> f (Maybe a)) -> [a] -> Tree a -> f (Tree a)
mayAppendLeafA' :: forall (f :: * -> *) a.
Applicative f =>
([a] -> f (Maybe a)) -> [a] -> Tree a -> f (Tree a)
mayAppendLeafA' [a] -> f (Maybe a)
f [a]
acc (Node a
label []) =
  [a] -> f (Maybe a)
f (a
label a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)
    f (Maybe a) -> (Maybe a -> Tree a) -> f (Tree a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Just a
leaf -> a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
label [a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
leaf []]
      Maybe a
Nothing -> a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
label []
mayAppendLeafA' [a] -> f (Maybe a)
f [a]
acc (Node a
label [Tree a]
xs) =
  let
    trees :: f [Tree a]
trees = (Tree a -> f (Tree a)) -> [Tree a] -> f [Tree a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (([a] -> f (Maybe a)) -> [a] -> Tree a -> f (Tree a)
forall (f :: * -> *) a.
Applicative f =>
([a] -> f (Maybe a)) -> [a] -> Tree a -> f (Tree a)
mayAppendLeafA' [a] -> f (Maybe a)
f (a
label a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)) [Tree a]
xs
  in
    a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
label ([Tree a] -> Tree a) -> f [Tree a] -> f (Tree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Tree a]
trees

travAppendLeafA :: (Applicative f) => ([a] -> f a) -> [a] -> Tree a -> f (Tree a)
travAppendLeafA :: forall (f :: * -> *) a.
Applicative f =>
([a] -> f a) -> [a] -> Tree a -> f (Tree a)
travAppendLeafA [a] -> f a
f [a]
acc = Tree (f a) -> f (Tree a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => Tree (f a) -> f (Tree a)
sequenceA (Tree (f a) -> f (Tree a))
-> (Tree a -> Tree (f a)) -> Tree a -> f (Tree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> ([a] -> f a) -> [a] -> Tree a -> Tree (f a)
forall a b. (a -> b) -> ([a] -> b) -> [a] -> Tree a -> Tree b
appendLeaf a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a] -> f a
f [a]
acc

travMayAppendLeafA :: (Traversable f, Applicative f) => ([a] -> f (Maybe a)) -> [a] -> Tree a -> f (Tree a)
travMayAppendLeafA :: forall (f :: * -> *) a.
(Traversable f, Applicative f) =>
([a] -> f (Maybe a)) -> [a] -> Tree a -> f (Tree a)
travMayAppendLeafA [a] -> f (Maybe a)
f [a]
acc = Tree (f a) -> f (Tree a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => Tree (f a) -> f (Tree a)
sequenceA (Tree (f a) -> f (Tree a))
-> (Tree a -> Tree (f a)) -> Tree a -> f (Tree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> ([a] -> Maybe (f a)) -> [a] -> Tree a -> Tree (f a)
forall a b. (a -> b) -> ([a] -> Maybe b) -> [a] -> Tree a -> Tree b
mayAppendLeaf a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f (Maybe a) -> Maybe (f a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => f (f a) -> f (f a)
sequenceA (f (Maybe a) -> Maybe (f a))
-> ([a] -> f (Maybe a)) -> [a] -> Maybe (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> f (Maybe a)
f) [a]
acc