{-# LANGUAGE UndecidableInstances #-}

module Pandora.Paradigm.Structure.Splay where

import Pandora.Core.Functor (type (:.), type (:=))
import Pandora.Pattern.Category ((.), ($))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Extractable (extract)
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Paradigm.Primary.Functor (left, right, branches)
import Pandora.Paradigm.Primary.Functor.Function ((%))
import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just))
import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right))
import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag), type (:#))
import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct)
import Pandora.Paradigm.Inventory.Optics ((%~))
import Pandora.Paradigm.Structure.Ability.Rotatable (Rotatable (Rotational, rotation), rotate)
import Pandora.Paradigm.Structure.Ability.Substructure (sub)
import Pandora.Paradigm.Structure.Binary ()

data Splay a = Zig a | Zag a

instance Rotatable (Left Zig) (Construction Wye) where
	type Rotational (Left Zig) (Construction Wye) a = Maybe (Construction Wye a)
	rotation :: forall a . Left Zig :# Construction Wye a -> Maybe :. Construction Wye := a
	rotation :: ('Left 'Zig :# Construction Wye a)
-> (Maybe :. Construction Wye) := a
rotation (Construction Wye a <-| Tagged ('Left 'Zig)
forall (t :: * -> *) a. Extractable t => a <-| t
extract -> Construct a
parent (Wye :. Construction Wye) := a
st) = a -> ((Wye :. Construction Wye) := a) -> Construction Wye a
forall (t :: * -> *) a.
a -> ((t :. Construction t) := a) -> Construction t a
Construct (a -> ((Wye :. Construction Wye) := a) -> Construction Wye a)
-> ((Wye :. Construction Wye) := a) -> a -> Construction Wye a
forall a b c. (a -> b -> c) -> b -> a -> c
% (Wye :. Construction Wye) := a
subtree (a -> Construction Wye a)
-> Maybe a -> (Maybe :. Construction Wye) := a
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> Maybe a
found where

		found :: Maybe a
		found :: Maybe a
found = a <-| Construction Wye
forall (t :: * -> *) a. Extractable t => a <-| t
extract (a <-| Construction Wye)
-> ((Maybe :. Construction Wye) := a) -> Maybe a
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
left (Wye :. Construction Wye) := a
st

		subtree :: Wye :. Construction Wye := a
		subtree :: (Wye :. Construction Wye) := a
subtree = ((Maybe :. Construction Wye) := a)
-> ((Maybe :. Construction Wye) := a)
-> (Wye :. Construction Wye) := a
forall a. Maybe a -> Maybe a -> Wye a
branches (Construction Wye a -> (Wye :. Construction Wye) := a
forall (t :: * -> *) a.
Construction t a -> (t :. Construction t) := a
deconstruct (Construction Wye a -> (Wye :. Construction Wye) := a)
-> ((Maybe :. Construction Wye) := a)
-> Maybe ((Wye :. Construction Wye) := a)
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
left (Wye :. Construction Wye) := a
st Maybe ((Wye :. Construction Wye) := a)
-> (((Wye :. Construction Wye) := a)
    -> (Maybe :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
left)
			(((Maybe :. Construction Wye) := a)
 -> (Wye :. Construction Wye) := a)
-> (((Wye :. Construction Wye) := a)
    -> (Maybe :. Construction Wye) := a)
-> ((Wye :. Construction Wye) := a)
-> (Wye :. Construction Wye) := a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Construction Wye a -> (Maybe :. Construction Wye) := a
forall a. a -> Maybe a
Just (Construction Wye a -> (Maybe :. Construction Wye) := a)
-> (((Wye :. Construction Wye) := a) -> Construction Wye a)
-> ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> ((Wye :. Construction Wye) := a) -> Construction Wye a
forall (t :: * -> *) a.
a -> ((t :. Construction t) := a) -> Construction t a
Construct a
parent (((Wye :. Construction Wye) := a)
 -> (Wye :. Construction Wye) := a)
-> ((Wye :. Construction Wye) := a)
-> (Wye :. Construction Wye) := a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ ((Maybe :. Construction Wye) := a)
-> ((Maybe :. Construction Wye) := a)
-> (Wye :. Construction Wye) := a
forall a. Maybe a -> Maybe a -> Wye a
branches
				(Construction Wye a -> (Wye :. Construction Wye) := a
forall (t :: * -> *) a.
Construction t a -> (t :. Construction t) := a
deconstruct (Construction Wye a -> (Wye :. Construction Wye) := a)
-> ((Maybe :. Construction Wye) := a)
-> Maybe ((Wye :. Construction Wye) := a)
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
left (Wye :. Construction Wye) := a
st Maybe ((Wye :. Construction Wye) := a)
-> (((Wye :. Construction Wye) := a)
    -> (Maybe :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
right) (((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
right (Wye :. Construction Wye) := a
st)

instance Rotatable (Right Zig) (Construction Wye) where
	type Rotational (Right Zig) (Construction Wye) a = Maybe (Construction Wye a)
	rotation :: forall a . Right Zig :# Construction Wye a -> Maybe :. Construction Wye := a
	rotation :: ('Right 'Zig :# Construction Wye a)
-> (Maybe :. Construction Wye) := a
rotation (Construction Wye a <-| Tagged ('Right 'Zig)
forall (t :: * -> *) a. Extractable t => a <-| t
extract -> Construct a
parent (Wye :. Construction Wye) := a
st) = a -> ((Wye :. Construction Wye) := a) -> Construction Wye a
forall (t :: * -> *) a.
a -> ((t :. Construction t) := a) -> Construction t a
Construct (a -> ((Wye :. Construction Wye) := a) -> Construction Wye a)
-> ((Wye :. Construction Wye) := a) -> a -> Construction Wye a
forall a b c. (a -> b -> c) -> b -> a -> c
% (Wye :. Construction Wye) := a
subtree (a -> Construction Wye a)
-> Maybe a -> (Maybe :. Construction Wye) := a
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> Maybe a
found where

		found :: Maybe a
		found :: Maybe a
found = a <-| Construction Wye
forall (t :: * -> *) a. Extractable t => a <-| t
extract (a <-| Construction Wye)
-> ((Maybe :. Construction Wye) := a) -> Maybe a
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
right (Wye :. Construction Wye) := a
st

		subtree :: Wye :. Construction Wye := a
		subtree :: (Wye :. Construction Wye) := a
subtree = ((Maybe :. Construction Wye) := a)
-> ((Maybe :. Construction Wye) := a)
-> (Wye :. Construction Wye) := a
forall a. Maybe a -> Maybe a -> Wye a
branches (((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
left (Wye :. Construction Wye) := a
st)
			(((Maybe :. Construction Wye) := a)
 -> (Wye :. Construction Wye) := a)
-> (((Wye :. Construction Wye) := a)
    -> (Maybe :. Construction Wye) := a)
-> ((Wye :. Construction Wye) := a)
-> (Wye :. Construction Wye) := a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Construction Wye a -> (Maybe :. Construction Wye) := a
forall a. a -> Maybe a
Just (Construction Wye a -> (Maybe :. Construction Wye) := a)
-> (((Wye :. Construction Wye) := a) -> Construction Wye a)
-> ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> ((Wye :. Construction Wye) := a) -> Construction Wye a
forall (t :: * -> *) a.
a -> ((t :. Construction t) := a) -> Construction t a
Construct a
parent (((Wye :. Construction Wye) := a)
 -> (Wye :. Construction Wye) := a)
-> ((Wye :. Construction Wye) := a)
-> (Wye :. Construction Wye) := a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ ((Maybe :. Construction Wye) := a)
-> ((Maybe :. Construction Wye) := a)
-> (Wye :. Construction Wye) := a
forall a. Maybe a -> Maybe a -> Wye a
branches
				(Construction Wye a -> (Wye :. Construction Wye) := a
forall (t :: * -> *) a.
Construction t a -> (t :. Construction t) := a
deconstruct (Construction Wye a -> (Wye :. Construction Wye) := a)
-> ((Maybe :. Construction Wye) := a)
-> Maybe ((Wye :. Construction Wye) := a)
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
right (Wye :. Construction Wye) := a
st Maybe ((Wye :. Construction Wye) := a)
-> (((Wye :. Construction Wye) := a)
    -> (Maybe :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
left)
				(Construction Wye a -> (Wye :. Construction Wye) := a
forall (t :: * -> *) a.
Construction t a -> (t :. Construction t) := a
deconstruct (Construction Wye a -> (Wye :. Construction Wye) := a)
-> ((Maybe :. Construction Wye) := a)
-> Maybe ((Wye :. Construction Wye) := a)
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
right (Wye :. Construction Wye) := a
st Maybe ((Wye :. Construction Wye) := a)
-> (((Wye :. Construction Wye) := a)
    -> (Maybe :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= ((Wye :. Construction Wye) := a)
-> (Maybe :. Construction Wye) := a
Wye ~> Maybe
right)

instance Rotatable (Left (Zig Zig)) (Construction Wye) where
	type Rotational (Left (Zig Zig)) (Construction Wye) a = Maybe (Construction Wye a)
	rotation :: Tagged ('Left ('Zig 'Zig)) (Construction Wye a)
-> Rotational ('Left ('Zig 'Zig)) (Construction Wye) a
rotation (Tag Construction Wye a
tree) = Construction Wye a -> Rotational ('Left 'Zig) (Construction Wye) a
forall k (f :: k) (t :: * -> *) a.
Rotatable f t =>
t a -> Rotational f t a
rotate @(Left Zig) Construction Wye a
tree Maybe (Construction Wye a)
-> (Construction Wye a -> Maybe (Construction Wye a))
-> Maybe (Construction Wye a)
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= forall k (f :: k) (t :: * -> *) a.
Rotatable f t =>
t a -> Rotational f t a
forall (t :: * -> *) a.
Rotatable ('Left 'Zig) t =>
t a -> Rotational ('Left 'Zig) t a
rotate @(Left Zig)

instance Rotatable (Right (Zig Zig)) (Construction Wye) where
	type Rotational (Right (Zig Zig)) (Construction Wye) a = Maybe (Construction Wye a)
	rotation :: Tagged ('Right ('Zig 'Zig)) (Construction Wye a)
-> Rotational ('Right ('Zig 'Zig)) (Construction Wye) a
rotation (Tag Construction Wye a
tree) = Construction Wye a -> Rotational ('Right 'Zig) (Construction Wye) a
forall k (f :: k) (t :: * -> *) a.
Rotatable f t =>
t a -> Rotational f t a
rotate @(Right Zig) Construction Wye a
tree Maybe (Construction Wye a)
-> (Construction Wye a -> Maybe (Construction Wye a))
-> Maybe (Construction Wye a)
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= forall k (f :: k) (t :: * -> *) a.
Rotatable f t =>
t a -> Rotational f t a
forall (t :: * -> *) a.
Rotatable ('Right 'Zig) t =>
t a -> Rotational ('Right 'Zig) t a
rotate @(Right Zig)

instance Rotatable (Left (Zig Zag)) (Construction Wye) where
	type Rotational (Left (Zig Zag)) (Construction Wye) a = Maybe (Construction Wye a)
	rotation :: Tagged ('Left ('Zig 'Zag)) (Construction Wye a)
-> Rotational ('Left ('Zig 'Zag)) (Construction Wye) a
rotation (Tag Construction Wye a
tree) = forall k (f :: k) (t :: * -> *) a.
Rotatable f t =>
t a -> Rotational f t a
forall (t :: * -> *) a.
Rotatable ('Left 'Zig) t =>
t a -> Rotational ('Left 'Zig) t a
rotate @(Left Zig) (Construction Wye a -> Maybe (Construction Wye a))
-> Construction Wye a -> Maybe (Construction Wye a)
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ forall k (f :: k) (t :: * -> *) a.
Substructure f t a =>
t a :-. Substructural f t a
forall (t :: * -> *) a.
Substructure 'Left t a =>
t a :-. Substructural 'Left t a
sub @Left (Construction Wye a
 -> Store (Maybe (Construction Wye a)) (Construction Wye a))
-> (Maybe (Construction Wye a) -> Maybe (Construction Wye a))
-> Construction Wye a
-> Construction Wye a
forall src tgt. Lens src tgt -> (tgt -> tgt) -> src -> src
%~ (Maybe (Construction Wye a)
-> (Construction Wye a -> Maybe (Construction Wye a))
-> Maybe (Construction Wye a)
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= forall k (f :: k) (t :: * -> *) a.
Rotatable f t =>
t a -> Rotational f t a
forall (t :: * -> *) a.
Rotatable ('Right 'Zig) t =>
t a -> Rotational ('Right 'Zig) t a
rotate @(Right Zig)) (Construction Wye a -> Construction Wye a)
-> Construction Wye a -> Construction Wye a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ Construction Wye a
tree

instance Rotatable (Right (Zig Zag)) (Construction Wye) where
	type Rotational (Right (Zig Zag)) (Construction Wye) a = Maybe (Construction Wye a)
	rotation :: Tagged ('Right ('Zig 'Zag)) (Construction Wye a)
-> Rotational ('Right ('Zig 'Zag)) (Construction Wye) a
rotation (Tag Construction Wye a
tree) = forall k (f :: k) (t :: * -> *) a.
Rotatable f t =>
t a -> Rotational f t a
forall (t :: * -> *) a.
Rotatable ('Right 'Zig) t =>
t a -> Rotational ('Right 'Zig) t a
rotate @(Right Zig) (Construction Wye a -> Maybe (Construction Wye a))
-> Construction Wye a -> Maybe (Construction Wye a)
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ forall k (f :: k) (t :: * -> *) a.
Substructure f t a =>
t a :-. Substructural f t a
forall (t :: * -> *) a.
Substructure 'Right t a =>
t a :-. Substructural 'Right t a
sub @Right (Construction Wye a
 -> Store (Maybe (Construction Wye a)) (Construction Wye a))
-> (Maybe (Construction Wye a) -> Maybe (Construction Wye a))
-> Construction Wye a
-> Construction Wye a
forall src tgt. Lens src tgt -> (tgt -> tgt) -> src -> src
%~ (Maybe (Construction Wye a)
-> (Construction Wye a -> Maybe (Construction Wye a))
-> Maybe (Construction Wye a)
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= forall k (f :: k) (t :: * -> *) a.
Rotatable f t =>
t a -> Rotational f t a
forall (t :: * -> *) a.
Rotatable ('Left 'Zig) t =>
t a -> Rotational ('Left 'Zig) t a
rotate @(Left Zig)) (Construction Wye a -> Construction Wye a)
-> Construction Wye a -> Construction Wye a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ Construction Wye a
tree