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