{-# LANGUAGE UndecidableInstances #-}

module Pandora.Paradigm.Structure.Splay where

import Pandora.Core.Morphism ((%))
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)
import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing))
import Pandora.Paradigm.Primary.Functor.Wye (Wye (End, Left, Right, Both))
import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))
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 :: Tagged ('Left 'Zig) (Construction Wye a)
-> Rotational ('Left 'Zig) (Construction Wye) a
rotation (Tag (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

		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
maybe_subtree Maybe (Construction Wye a)
a (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
maybe_subtree Maybe (Construction Wye a)
b Maybe (Construction Wye a)
c
		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
		a :: Maybe (Construction Wye a)
a = 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
		b :: Maybe (Construction Wye a)
b = 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
		c :: Maybe (Construction Wye a)
c = ((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 :: Tagged ('Right 'Zig) (Construction Wye a)
-> Rotational ('Right 'Zig) (Construction Wye) a
rotation (Tag (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 = 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 = Maybe (Construction Wye a)
-> Maybe (Construction Wye a) -> (Wye :. Construction Wye) := a
forall a. Maybe a -> Maybe a -> Wye a
maybe_subtree Maybe (Construction Wye a)
a (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
maybe_subtree Maybe (Construction Wye a)
b Maybe (Construction Wye a)
c
		a :: Maybe (Construction Wye a)
a = ((Wye :. Construction Wye) := a) -> Maybe (Construction Wye a)
Wye ~> Maybe
left (Wye :. Construction Wye) := a
st
		b :: Maybe (Construction Wye a)
b = 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
		c :: Maybe (Construction Wye a)
c = 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 =>
t a :-. Substructural f t a
forall (t :: * -> *) a.
Substructure 'Left t =>
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 =>
t a :-. Substructural f t a
forall (t :: * -> *) a.
Substructure 'Right t =>
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

maybe_subtree :: Maybe a -> Maybe a -> Wye a
maybe_subtree :: Maybe a -> Maybe a -> Wye a
maybe_subtree (Just a
x) (Just a
y) = a -> a -> Wye a
forall a. a -> a -> Wye a
Both a
x a
y
maybe_subtree Maybe a
Nothing (Just a
y) = a -> Wye a
forall a. a -> Wye a
Right a
y
maybe_subtree (Just a
x) Maybe a
Nothing = a -> Wye a
forall a. a -> Wye a
Left a
x
maybe_subtree Maybe a
Nothing Maybe a
Nothing = Wye a
forall a. Wye a
End