{-# 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