{-# LANGUAGE DeriveFunctor, Rank2Types #-}
module Data.Magma 
       ( Magma(..)
       , BinaryTree(..)
       , cataBinaryTree
       , anaBinaryTree
       , foldMap
       , _Leaf
       , _Node
       , nodeLeft
       , nodeRight
       ) where

import Prelude hiding (foldMap, (<>))
import qualified Data.Foldable as F
import qualified Data.Monoid as M hiding ((<>))
import Data.Profunctor
import qualified Data.Semigroup as S hiding ((<>))
import Control.DeepSeq
import Control.Applicative
import Data.Traversable

class Magma a where
  (<>) :: a -> a -> a
  

instance Magma () where
  _ <> :: () -> () -> ()
<> _ = ()

instance (Magma a, Magma b) => Magma (a, b) where
  (a :: a
a, b :: b
b) <> :: (a, b) -> (a, b) -> (a, b)
<> (a' :: a
a', b' :: b
b') = (a
a a -> a -> a
forall a. Magma a => a -> a -> a
<> a
a', b
b b -> b -> b
forall a. Magma a => a -> a -> a
<> b
b')

instance Magma a => Magma (M.Dual a) where
  M.Dual a :: a
a <> :: Dual a -> Dual a -> Dual a
<> M.Dual b :: a
b = a -> Dual a
forall a. a -> Dual a
M.Dual (a
b a -> a -> a
forall a. Magma a => a -> a -> a
<> a
a)

instance Magma (M.Endo a) where
  M.Endo f :: a -> a
f <> :: Endo a -> Endo a -> Endo a
<> M.Endo g :: a -> a
g = (a -> a) -> Endo a
forall a. (a -> a) -> Endo a
M.Endo (a -> a
f (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
g)

instance Magma M.All where
  M.All a :: Bool
a <> :: All -> All -> All
<> M.All b :: Bool
b = Bool -> All
M.All (Bool
a Bool -> Bool -> Bool
&& Bool
b)

instance Magma M.Any where
  M.Any a :: Bool
a <> :: Any -> Any -> Any
<> M.Any b :: Bool
b = Bool -> Any
M.Any (Bool
a Bool -> Bool -> Bool
|| Bool
b)

instance Num a => Magma (M.Sum a) where
  M.Sum a :: a
a <> :: Sum a -> Sum a -> Sum a
<> M.Sum b :: a
b = a -> Sum a
forall a. a -> Sum a
M.Sum (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b)

instance Num a => Magma (M.Product a) where
  M.Product a :: a
a <> :: Product a -> Product a -> Product a
<> M.Product b :: a
b = a -> Product a
forall a. a -> Product a
M.Product (a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
b)

instance Magma (M.First a) where
  r :: First a
r@(M.First (Just _)) <> :: First a -> First a -> First a
<> _ = First a
r
  M.First Nothing <> r :: First a
r = First a
r

instance Magma (M.Last a) where
  _ <> :: Last a -> Last a -> Last a
<> r :: Last a
r@(M.Last (Just _)) = Last a
r
  r :: Last a
r <> M.Last Nothing = Last a
r

instance Ord a => Magma (S.Min a) where
  S.Min a :: a
a <> :: Min a -> Min a -> Min a
<> S.Min b :: a
b = a -> Min a
forall a. a -> Min a
S.Min (a -> a -> a
forall a. Ord a => a -> a -> a
min a
a a
b)

instance Ord a => Magma (S.Max a) where
  S.Max a :: a
a <> :: Max a -> Max a -> Max a
<> S.Max b :: a
b = a -> Max a
forall a. a -> Max a
S.Max (a -> a -> a
forall a. Ord a => a -> a -> a
max a
a a
b)

instance M.Monoid m => Magma (S.WrappedMonoid m) where
  S.WrapMonoid a :: m
a <> :: WrappedMonoid m -> WrappedMonoid m -> WrappedMonoid m
<> S.WrapMonoid b :: m
b = m -> WrappedMonoid m
forall m. m -> WrappedMonoid m
S.WrapMonoid (m -> m -> m
forall a. Monoid a => a -> a -> a
M.mappend m
a m
b)

data BinaryTree a = Leaf a 
                  | Node (BinaryTree a) (BinaryTree a)
                  deriving (Int -> BinaryTree a -> ShowS
[BinaryTree a] -> ShowS
BinaryTree a -> String
(Int -> BinaryTree a -> ShowS)
-> (BinaryTree a -> String)
-> ([BinaryTree a] -> ShowS)
-> Show (BinaryTree a)
forall a. Show a => Int -> BinaryTree a -> ShowS
forall a. Show a => [BinaryTree a] -> ShowS
forall a. Show a => BinaryTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryTree a] -> ShowS
$cshowList :: forall a. Show a => [BinaryTree a] -> ShowS
show :: BinaryTree a -> String
$cshow :: forall a. Show a => BinaryTree a -> String
showsPrec :: Int -> BinaryTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BinaryTree a -> ShowS
Show, ReadPrec [BinaryTree a]
ReadPrec (BinaryTree a)
Int -> ReadS (BinaryTree a)
ReadS [BinaryTree a]
(Int -> ReadS (BinaryTree a))
-> ReadS [BinaryTree a]
-> ReadPrec (BinaryTree a)
-> ReadPrec [BinaryTree a]
-> Read (BinaryTree a)
forall a. Read a => ReadPrec [BinaryTree a]
forall a. Read a => ReadPrec (BinaryTree a)
forall a. Read a => Int -> ReadS (BinaryTree a)
forall a. Read a => ReadS [BinaryTree a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinaryTree a]
$creadListPrec :: forall a. Read a => ReadPrec [BinaryTree a]
readPrec :: ReadPrec (BinaryTree a)
$creadPrec :: forall a. Read a => ReadPrec (BinaryTree a)
readList :: ReadS [BinaryTree a]
$creadList :: forall a. Read a => ReadS [BinaryTree a]
readsPrec :: Int -> ReadS (BinaryTree a)
$creadsPrec :: forall a. Read a => Int -> ReadS (BinaryTree a)
Read, BinaryTree a -> BinaryTree a -> Bool
(BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool) -> Eq (BinaryTree a)
forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinaryTree a -> BinaryTree a -> Bool
$c/= :: forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
== :: BinaryTree a -> BinaryTree a -> Bool
$c== :: forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
Eq, Eq (BinaryTree a)
Eq (BinaryTree a) =>
(BinaryTree a -> BinaryTree a -> Ordering)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> BinaryTree a)
-> (BinaryTree a -> BinaryTree a -> BinaryTree a)
-> Ord (BinaryTree a)
BinaryTree a -> BinaryTree a -> Bool
BinaryTree a -> BinaryTree a -> Ordering
BinaryTree a -> BinaryTree a -> BinaryTree a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (BinaryTree a)
forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
forall a. Ord a => BinaryTree a -> BinaryTree a -> Ordering
forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
min :: BinaryTree a -> BinaryTree a -> BinaryTree a
$cmin :: forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
max :: BinaryTree a -> BinaryTree a -> BinaryTree a
$cmax :: forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
>= :: BinaryTree a -> BinaryTree a -> Bool
$c>= :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
> :: BinaryTree a -> BinaryTree a -> Bool
$c> :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
<= :: BinaryTree a -> BinaryTree a -> Bool
$c<= :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
< :: BinaryTree a -> BinaryTree a -> Bool
$c< :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
compare :: BinaryTree a -> BinaryTree a -> Ordering
$ccompare :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (BinaryTree a)
Ord, a -> BinaryTree b -> BinaryTree a
(a -> b) -> BinaryTree a -> BinaryTree b
(forall a b. (a -> b) -> BinaryTree a -> BinaryTree b)
-> (forall a b. a -> BinaryTree b -> BinaryTree a)
-> Functor BinaryTree
forall a b. a -> BinaryTree b -> BinaryTree a
forall a b. (a -> b) -> BinaryTree a -> BinaryTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BinaryTree b -> BinaryTree a
$c<$ :: forall a b. a -> BinaryTree b -> BinaryTree a
fmap :: (a -> b) -> BinaryTree a -> BinaryTree b
$cfmap :: forall a b. (a -> b) -> BinaryTree a -> BinaryTree b
Functor)

cataBinaryTree :: (a -> r) -> (r -> r -> r) -> BinaryTree a -> r
cataBinaryTree :: (a -> r) -> (r -> r -> r) -> BinaryTree a -> r
cataBinaryTree f :: a -> r
f _ (Leaf a :: a
a) = a -> r
f a
a
cataBinaryTree f :: a -> r
f g :: r -> r -> r
g (Node l :: BinaryTree a
l r :: BinaryTree a
r) = r -> r -> r
g ((a -> r) -> (r -> r -> r) -> BinaryTree a -> r
forall a r. (a -> r) -> (r -> r -> r) -> BinaryTree a -> r
cataBinaryTree a -> r
f r -> r -> r
g BinaryTree a
l) ((a -> r) -> (r -> r -> r) -> BinaryTree a -> r
forall a r. (a -> r) -> (r -> r -> r) -> BinaryTree a -> r
cataBinaryTree a -> r
f r -> r -> r
g BinaryTree a
r)

anaBinaryTree :: (b -> Either a (b, b)) -> b -> BinaryTree a
anaBinaryTree :: (b -> Either a (b, b)) -> b -> BinaryTree a
anaBinaryTree f :: b -> Either a (b, b)
f = b -> BinaryTree a
go where
  go :: b -> BinaryTree a
go b :: b
b = case b -> Either a (b, b)
f b
b of
    Left a :: a
a -> a -> BinaryTree a
forall a. a -> BinaryTree a
Leaf a
a
    Right (c :: b
c, d :: b
d) -> BinaryTree a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> BinaryTree a -> BinaryTree a
Node (b -> BinaryTree a
go b
c) (b -> BinaryTree a
go b
d)

foldMap :: Magma m => (a -> m) -> BinaryTree a -> m
foldMap :: (a -> m) -> BinaryTree a -> m
foldMap f :: a -> m
f (Leaf x :: a
x) = a -> m
f a
x
foldMap f :: a -> m
f (Node l :: BinaryTree a
l r :: BinaryTree a
r) = (a -> m) -> BinaryTree a -> m
forall m a. Magma m => (a -> m) -> BinaryTree a -> m
foldMap a -> m
f BinaryTree a
l m -> m -> m
forall a. Magma a => a -> a -> a
<> (a -> m) -> BinaryTree a -> m
forall m a. Magma m => (a -> m) -> BinaryTree a -> m
foldMap a -> m
f BinaryTree a
r

instance F.Foldable BinaryTree where
  foldMap :: (a -> m) -> BinaryTree a -> m
foldMap f :: a -> m
f (Leaf x :: a
x) = a -> m
f a
x
  foldMap f :: a -> m
f (Node l :: BinaryTree a
l r :: BinaryTree a
r) = (a -> m) -> BinaryTree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f BinaryTree a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`M.mappend` (a -> m) -> BinaryTree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f BinaryTree a
r

instance Magma (BinaryTree a) where
  <> :: BinaryTree a -> BinaryTree a -> BinaryTree a
(<>) = BinaryTree a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> BinaryTree a -> BinaryTree a
Node

instance Traversable BinaryTree where
  traverse :: (a -> f b) -> BinaryTree a -> f (BinaryTree b)
traverse f :: a -> f b
f (Leaf x :: a
x) = b -> BinaryTree b
forall a. a -> BinaryTree a
Leaf (b -> BinaryTree b) -> f b -> f (BinaryTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
  traverse f :: a -> f b
f (Node l :: BinaryTree a
l r :: BinaryTree a
r) = BinaryTree b -> BinaryTree b -> BinaryTree b
forall a. BinaryTree a -> BinaryTree a -> BinaryTree a
Node (BinaryTree b -> BinaryTree b -> BinaryTree b)
-> f (BinaryTree b) -> f (BinaryTree b -> BinaryTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> BinaryTree a -> f (BinaryTree b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f BinaryTree a
l f (BinaryTree b -> BinaryTree b)
-> f (BinaryTree b) -> f (BinaryTree b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> BinaryTree a -> f (BinaryTree b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f BinaryTree a
r

instance Applicative BinaryTree where
  pure :: a -> BinaryTree a
pure = a -> BinaryTree a
forall a. a -> BinaryTree a
Leaf
  {-# INLINE pure #-}
  Leaf f :: a -> b
f <*> :: BinaryTree (a -> b) -> BinaryTree a -> BinaryTree b
<*> Leaf x :: a
x = b -> BinaryTree b
forall a. a -> BinaryTree a
Leaf (a -> b
f a
x)
  Leaf f :: a -> b
f <*> Node l :: BinaryTree a
l r :: BinaryTree a
r = BinaryTree b -> BinaryTree b -> BinaryTree b
forall a. BinaryTree a -> BinaryTree a -> BinaryTree a
Node (a -> b
f (a -> b) -> BinaryTree a -> BinaryTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinaryTree a
l) (a -> b
f (a -> b) -> BinaryTree a -> BinaryTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinaryTree a
r)
  Node l :: BinaryTree (a -> b)
l r :: BinaryTree (a -> b)
r <*> t :: BinaryTree a
t = BinaryTree b -> BinaryTree b -> BinaryTree b
forall a. BinaryTree a -> BinaryTree a -> BinaryTree a
Node (BinaryTree (a -> b)
l BinaryTree (a -> b) -> BinaryTree a -> BinaryTree b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinaryTree a
t) (BinaryTree (a -> b)
r BinaryTree (a -> b) -> BinaryTree a -> BinaryTree b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinaryTree a
t)

instance Monad BinaryTree where
  return :: a -> BinaryTree a
return = a -> BinaryTree a
forall a. a -> BinaryTree a
Leaf
  {-# INLINE return #-}
  Leaf a :: a
a >>= :: BinaryTree a -> (a -> BinaryTree b) -> BinaryTree b
>>= k :: a -> BinaryTree b
k = a -> BinaryTree b
k a
a
  Node l :: BinaryTree a
l r :: BinaryTree a
r >>= k :: a -> BinaryTree b
k = BinaryTree b -> BinaryTree b -> BinaryTree b
forall a. BinaryTree a -> BinaryTree a -> BinaryTree a
Node (BinaryTree a
l BinaryTree a -> (a -> BinaryTree b) -> BinaryTree b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> BinaryTree b
k) (BinaryTree a
r BinaryTree a -> (a -> BinaryTree b) -> BinaryTree b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> BinaryTree b
k)

instance NFData a => NFData (BinaryTree a) where
  rnf :: BinaryTree a -> ()
rnf (Leaf a :: a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (Node l :: BinaryTree a
l r :: BinaryTree a
r) = BinaryTree a -> ()
forall a. NFData a => a -> ()
rnf BinaryTree a
l () -> () -> ()
forall a b. a -> b -> b
`seq` BinaryTree a -> ()
forall a. NFData a => a -> ()
rnf BinaryTree a
r

-- | @'_Leaf' :: Prism' ('BinaryTree' a) a@
_Leaf :: forall p f a. (Choice p, Applicative f) => p a (f a) -> p (BinaryTree a) (f (BinaryTree a))
_Leaf :: p a (f a) -> p (BinaryTree a) (f (BinaryTree a))
_Leaf = (BinaryTree a -> Either (BinaryTree a) a)
-> (Either (BinaryTree a) (f a) -> f (BinaryTree a))
-> p (Either (BinaryTree a) a) (Either (BinaryTree a) (f a))
-> p (BinaryTree a) (f (BinaryTree a))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap BinaryTree a -> Either (BinaryTree a) a
forall b. BinaryTree b -> Either (BinaryTree b) b
go ((BinaryTree a -> f (BinaryTree a))
-> (f a -> f (BinaryTree a))
-> Either (BinaryTree a) (f a)
-> f (BinaryTree a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either BinaryTree a -> f (BinaryTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a -> BinaryTree a) -> f a -> f (BinaryTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> BinaryTree a
forall a. a -> BinaryTree a
Leaf)) (p (Either (BinaryTree a) a) (Either (BinaryTree a) (f a))
 -> p (BinaryTree a) (f (BinaryTree a)))
-> (p a (f a)
    -> p (Either (BinaryTree a) a) (Either (BinaryTree a) (f a)))
-> p a (f a)
-> p (BinaryTree a) (f (BinaryTree a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f a)
-> p (Either (BinaryTree a) a) (Either (BinaryTree a) (f a))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' where
  go :: BinaryTree b -> Either (BinaryTree b) b
go (Leaf a :: b
a) = b -> Either (BinaryTree b) b
forall a b. b -> Either a b
Right b
a
  go t :: BinaryTree b
t = BinaryTree b -> Either (BinaryTree b) b
forall a b. a -> Either a b
Left BinaryTree b
t

-- | @'_Node' :: Prism' ('BinaryTree' a) ('BinaryTree' a, 'BinaryTree' a)@
_Node :: forall p f a. (Choice p, Applicative f) => p (BinaryTree a, BinaryTree a) (f (BinaryTree a, BinaryTree a)) -> p (BinaryTree a) (f (BinaryTree a))
_Node :: p (BinaryTree a, BinaryTree a) (f (BinaryTree a, BinaryTree a))
-> p (BinaryTree a) (f (BinaryTree a))
_Node = (BinaryTree a
 -> Either (BinaryTree a) (BinaryTree a, BinaryTree a))
-> (Either (BinaryTree a) (f (BinaryTree a, BinaryTree a))
    -> f (BinaryTree a))
-> p (Either (BinaryTree a) (BinaryTree a, BinaryTree a))
     (Either (BinaryTree a) (f (BinaryTree a, BinaryTree a)))
-> p (BinaryTree a) (f (BinaryTree a))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap BinaryTree a -> Either (BinaryTree a) (BinaryTree a, BinaryTree a)
forall a.
BinaryTree a -> Either (BinaryTree a) (BinaryTree a, BinaryTree a)
go ((BinaryTree a -> f (BinaryTree a))
-> (f (BinaryTree a, BinaryTree a) -> f (BinaryTree a))
-> Either (BinaryTree a) (f (BinaryTree a, BinaryTree a))
-> f (BinaryTree a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either BinaryTree a -> f (BinaryTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((BinaryTree a, BinaryTree a) -> BinaryTree a)
-> f (BinaryTree a, BinaryTree a) -> f (BinaryTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((BinaryTree a -> BinaryTree a -> BinaryTree a)
-> (BinaryTree a, BinaryTree a) -> BinaryTree a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BinaryTree a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> BinaryTree a -> BinaryTree a
Node))) (p (Either (BinaryTree a) (BinaryTree a, BinaryTree a))
   (Either (BinaryTree a) (f (BinaryTree a, BinaryTree a)))
 -> p (BinaryTree a) (f (BinaryTree a)))
-> (p (BinaryTree a, BinaryTree a) (f (BinaryTree a, BinaryTree a))
    -> p (Either (BinaryTree a) (BinaryTree a, BinaryTree a))
         (Either (BinaryTree a) (f (BinaryTree a, BinaryTree a))))
-> p (BinaryTree a, BinaryTree a) (f (BinaryTree a, BinaryTree a))
-> p (BinaryTree a) (f (BinaryTree a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (BinaryTree a, BinaryTree a) (f (BinaryTree a, BinaryTree a))
-> p (Either (BinaryTree a) (BinaryTree a, BinaryTree a))
     (Either (BinaryTree a) (f (BinaryTree a, BinaryTree a)))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' where
  go :: BinaryTree a -> Either (BinaryTree a) (BinaryTree a, BinaryTree a)
go (Node l :: BinaryTree a
l r :: BinaryTree a
r) = (BinaryTree a, BinaryTree a)
-> Either (BinaryTree a) (BinaryTree a, BinaryTree a)
forall a b. b -> Either a b
Right (BinaryTree a
l, BinaryTree a
r)
  go t :: BinaryTree a
t = BinaryTree a -> Either (BinaryTree a) (BinaryTree a, BinaryTree a)
forall a b. a -> Either a b
Left BinaryTree a
t

-- | @'nodeLeft' :: Traversal' ('BinaryTree' a) ('BinaryTree' a)@
nodeLeft :: Applicative f => (BinaryTree a -> f (BinaryTree a)) -> BinaryTree a -> f (BinaryTree a)
nodeLeft :: (BinaryTree a -> f (BinaryTree a))
-> BinaryTree a -> f (BinaryTree a)
nodeLeft f :: BinaryTree a -> f (BinaryTree a)
f (Node l :: BinaryTree a
l r :: BinaryTree a
r) = (\l' :: BinaryTree a
l' -> BinaryTree a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> BinaryTree a -> BinaryTree a
Node BinaryTree a
l' BinaryTree a
r) (BinaryTree a -> BinaryTree a)
-> f (BinaryTree a) -> f (BinaryTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinaryTree a -> f (BinaryTree a)
f BinaryTree a
l
nodeLeft _ t :: BinaryTree a
t = BinaryTree a -> f (BinaryTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryTree a
t

-- | @'nodeRight' :: Traversal' ('BinaryTree' a) ('BinaryTree' a)@
nodeRight :: Applicative f => (BinaryTree a -> f (BinaryTree a)) -> BinaryTree a -> f (BinaryTree a)
nodeRight :: (BinaryTree a -> f (BinaryTree a))
-> BinaryTree a -> f (BinaryTree a)
nodeRight f :: BinaryTree a -> f (BinaryTree a)
f (Node l :: BinaryTree a
l r :: BinaryTree a
r) = (\r' :: BinaryTree a
r' -> BinaryTree a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> BinaryTree a -> BinaryTree a
Node BinaryTree a
l BinaryTree a
r') (BinaryTree a -> BinaryTree a)
-> f (BinaryTree a) -> f (BinaryTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinaryTree a -> f (BinaryTree a)
f BinaryTree a
r
nodeRight _ t :: BinaryTree a
t = BinaryTree a -> f (BinaryTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryTree a
t