{-# OPTIONS_GHC -fno-warn-orphans #-}
module Pandora.Paradigm.Structure.Some.Stream where

import Pandora.Core.Functor (type (:=), type (:=>))
import Pandora.Pattern.Semigroupoid ((.))
import Pandora.Pattern.Category ((#))
import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))
import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))
import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))
import Pandora.Paradigm.Primary.Algebraic (extract)
import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity))
import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right))
import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct, (.-+))
import Pandora.Paradigm.Primary.Transformer.Reverse (Reverse (Reverse))
import Pandora.Paradigm.Primary (twosome)
import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Rotate), premorph, rotate)
import Pandora.Paradigm.Structure.Ability.Zipper (Zippable (Breadcrumbs), Tape)
import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>))
import Pandora.Paradigm.Primary.Algebraic (point)
import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!))

type Stream = Construction Identity

instance Zippable (Construction Identity) where
	type Breadcrumbs (Construction Identity) = Reverse Stream <:.:> Stream := (:*:)

instance Morphable (Rotate Left) (Tape Stream) where
	type Morphing (Rotate Left) (Tape Stream) = Tape Stream
	morphing :: (<::>) (Tagged ('Rotate 'Left)) (Tape (Construction Identity)) a
-> Morphing ('Rotate 'Left) (Tape (Construction Identity)) a
morphing (Tape (Construction Identity) a
-> Identity a
   :*: T_U
         Covariant
         Covariant
         (:*:)
         (Reverse (Construction Identity))
         (Construction Identity)
         a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
run (Tape (Construction Identity) a
 -> Identity a
    :*: T_U
          Covariant
          Covariant
          (:*:)
          (Reverse (Construction Identity))
          (Construction Identity)
          a)
-> ((<::>)
      (Tagged ('Rotate 'Left)) (Tape (Construction Identity)) a
    -> Tape (Construction Identity) a)
-> (<::>) (Tagged ('Rotate 'Left)) (Tape (Construction Identity)) a
-> Identity a
   :*: T_U
         Covariant
         Covariant
         (:*:)
         (Reverse (Construction Identity))
         (Construction Identity)
         a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Rotate 'Left)) (Tape (Construction Identity)) a
-> Tape (Construction Identity) a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Identity a
x :*: T_U (Reverse Construction Identity a
bs :*: Construction Identity a
fs)) = Identity a
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
-> Tape (Construction Identity) a
forall k (t :: k -> *) (a :: k) (u :: k -> *).
t a -> u a -> (<:.:>) t u (:*:) a
twosome (Identity a
 -> T_U
      Covariant
      Covariant
      (:*:)
      (Reverse (Construction Identity))
      (Construction Identity)
      a
 -> Tape (Construction Identity) a)
-> Identity a
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
-> Tape (Construction Identity) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# a -> Identity a
forall a. a -> Identity a
Identity (Construction Identity a -> a
forall (t :: * -> *) a. Extractable t => t a -> a
extract Construction Identity a
bs)
		(T_U
   Covariant
   Covariant
   (:*:)
   (Reverse (Construction Identity))
   (Construction Identity)
   a
 -> Tape (Construction Identity) a)
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
-> Tape (Construction Identity) a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! Reverse (Construction Identity) a
-> Construction Identity a
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
forall k (t :: k -> *) (a :: k) (u :: k -> *).
t a -> u a -> (<:.:>) t u (:*:) a
twosome (Reverse (Construction Identity) a
 -> Construction Identity a
 -> T_U
      Covariant
      Covariant
      (:*:)
      (Reverse (Construction Identity))
      (Construction Identity)
      a)
-> Reverse (Construction Identity) a
-> Construction Identity a
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# Construction Identity a -> Reverse (Construction Identity) a
forall k (t :: k -> *) (a :: k). t a -> Reverse t a
Reverse (Identity (Construction Identity a) -> Construction Identity a
forall (t :: * -> *) a. Extractable t => t a -> a
extract (Identity (Construction Identity a) -> Construction Identity a)
-> Identity (Construction Identity a) -> Construction Identity a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# Construction Identity a -> Identity (Construction Identity a)
forall (t :: * -> *) a.
Construction t a -> (t :. Construction t) := a
deconstruct Construction Identity a
bs) (Construction Identity a
 -> T_U
      Covariant
      Covariant
      (:*:)
      (Reverse (Construction Identity))
      (Construction Identity)
      a)
-> Construction Identity a
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# a -> Identity (Construction Identity a) -> Construction Identity a
forall (t :: * -> *) a.
a -> ((t :. Construction t) := a) -> Construction t a
Construct a
x (Construction Identity a -> Identity (Construction Identity a)
forall (t :: * -> *) a. Pointable t => a -> t a
point Construction Identity a
fs)

instance Morphable (Rotate Right) (Tape Stream) where
	type Morphing (Rotate Right) (Tape Stream) = Tape Stream
	morphing :: (<::>) (Tagged ('Rotate 'Right)) (Tape (Construction Identity)) a
-> Morphing ('Rotate 'Right) (Tape (Construction Identity)) a
morphing (Tape (Construction Identity) a
-> Identity a
   :*: T_U
         Covariant
         Covariant
         (:*:)
         (Reverse (Construction Identity))
         (Construction Identity)
         a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
run (Tape (Construction Identity) a
 -> Identity a
    :*: T_U
          Covariant
          Covariant
          (:*:)
          (Reverse (Construction Identity))
          (Construction Identity)
          a)
-> ((<::>)
      (Tagged ('Rotate 'Right)) (Tape (Construction Identity)) a
    -> Tape (Construction Identity) a)
-> (<::>)
     (Tagged ('Rotate 'Right)) (Tape (Construction Identity)) a
-> Identity a
   :*: T_U
         Covariant
         Covariant
         (:*:)
         (Reverse (Construction Identity))
         (Construction Identity)
         a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Rotate 'Right)) (Tape (Construction Identity)) a
-> Tape (Construction Identity) a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Identity a
x :*: T_U (Reverse Construction Identity a
bs :*: Construction Identity a
fs)) = Identity a
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
-> Tape (Construction Identity) a
forall k (t :: k -> *) (a :: k) (u :: k -> *).
t a -> u a -> (<:.:>) t u (:*:) a
twosome (Identity a
 -> T_U
      Covariant
      Covariant
      (:*:)
      (Reverse (Construction Identity))
      (Construction Identity)
      a
 -> Tape (Construction Identity) a)
-> Identity a
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
-> Tape (Construction Identity) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# a -> Identity a
forall a. a -> Identity a
Identity (Construction Identity a -> a
forall (t :: * -> *) a. Extractable t => t a -> a
extract Construction Identity a
fs)
		(T_U
   Covariant
   Covariant
   (:*:)
   (Reverse (Construction Identity))
   (Construction Identity)
   a
 -> Tape (Construction Identity) a)
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
-> Tape (Construction Identity) a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! Reverse (Construction Identity) a
-> Construction Identity a
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
forall k (t :: k -> *) (a :: k) (u :: k -> *).
t a -> u a -> (<:.:>) t u (:*:) a
twosome (Reverse (Construction Identity) a
 -> Construction Identity a
 -> T_U
      Covariant
      Covariant
      (:*:)
      (Reverse (Construction Identity))
      (Construction Identity)
      a)
-> Reverse (Construction Identity) a
-> Construction Identity a
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# Construction Identity a -> Reverse (Construction Identity) a
forall k (t :: k -> *) (a :: k). t a -> Reverse t a
Reverse (a
-> ((Identity :. Construction Identity) := a)
-> Construction Identity a
forall (t :: * -> *) a.
a -> ((t :. Construction t) := a) -> Construction t a
Construct a
x (((Identity :. Construction Identity) := a)
 -> Construction Identity a)
-> ((Identity :. Construction Identity) := a)
-> Construction Identity a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# Construction Identity a -> (Identity :. Construction Identity) := a
forall (t :: * -> *) a. Pointable t => a -> t a
point Construction Identity a
bs) (Construction Identity a
 -> T_U
      Covariant
      Covariant
      (:*:)
      (Reverse (Construction Identity))
      (Construction Identity)
      a)
-> Construction Identity a
-> T_U
     Covariant
     Covariant
     (:*:)
     (Reverse (Construction Identity))
     (Construction Identity)
     a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# ((Identity :. Construction Identity) := a)
-> Construction Identity a
forall (t :: * -> *) a. Extractable t => t a -> a
extract (Construction Identity a -> (Identity :. Construction Identity) := a
forall (t :: * -> *) a.
Construction t a -> (t :. Construction t) := a
deconstruct Construction Identity a
fs)

instance {-# OVERLAPS #-} Extendable (->) (Tape Stream) where
	Tape (Construction Identity) a -> b
f <<= :: (Tape (Construction Identity) a -> b)
-> Tape (Construction Identity) a -> Tape (Construction Identity) b
<<= Tape (Construction Identity) a
z = let move :: (Tape (Construction Identity) a -> Tape (Construction Identity) a)
-> Construction Identity (Tape (Construction Identity) a)
move Tape (Construction Identity) a -> Tape (Construction Identity) a
rtt = Identity (Construction Identity (Tape (Construction Identity) a))
-> Construction Identity (Tape (Construction Identity) a)
forall (t :: * -> *) a. Extractable t => t a -> a
extract (Identity (Construction Identity (Tape (Construction Identity) a))
 -> Construction Identity (Tape (Construction Identity) a))
-> (Construction Identity (Tape (Construction Identity) a)
    -> Identity
         (Construction Identity (Tape (Construction Identity) a)))
-> Construction Identity (Tape (Construction Identity) a)
-> Construction Identity (Tape (Construction Identity) a)
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Construction Identity (Tape (Construction Identity) a)
-> Identity
     (Construction Identity (Tape (Construction Identity) a))
forall (t :: * -> *) a.
Construction t a -> (t :. Construction t) := a
deconstruct (Construction Identity (Tape (Construction Identity) a)
 -> Construction Identity (Tape (Construction Identity) a))
-> Construction Identity (Tape (Construction Identity) a)
-> Construction Identity (Tape (Construction Identity) a)
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! Tape (Construction Identity) a
-> Identity (Tape (Construction Identity) a)
forall (t :: * -> *) a. Pointable t => a -> t a
point (Tape (Construction Identity) a
 -> Identity (Tape (Construction Identity) a))
-> (Tape (Construction Identity) a
    -> Tape (Construction Identity) a)
-> Tape (Construction Identity) a
-> Identity (Tape (Construction Identity) a)
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Tape (Construction Identity) a -> Tape (Construction Identity) a
rtt (Tape (Construction Identity) a
 -> Identity (Tape (Construction Identity) a))
-> Tape (Construction Identity) a :=> Construction Identity
forall (t :: * -> *) a.
Covariant (->) (->) t =>
(a :=> t) -> a :=> Construction t
.-+ Tape (Construction Identity) a
z
		in Tape (Construction Identity) a -> b
f (Tape (Construction Identity) a -> b)
-> T_U
     Covariant
     Covariant
     (:*:)
     Identity
     ((Reverse (Construction Identity) <:.:> Construction Identity)
      := (:*:))
     (Tape (Construction Identity) a)
-> Tape (Construction Identity) b
forall (source :: * -> * -> *) (target :: * -> * -> *)
       (t :: * -> *) a b.
Covariant source target t =>
source a b -> target (t a) (t b)
<-|- (Identity (Tape (Construction Identity) a)
 :*: (:=)
       (Reverse (Construction Identity) <:.:> Construction Identity)
       (:*:)
       (Tape (Construction Identity) a))
-> T_U
     Covariant
     Covariant
     (:*:)
     Identity
     ((Reverse (Construction Identity) <:.:> Construction Identity)
      := (:*:))
     (Tape (Construction Identity) a)
forall k k k k k (ct :: k) (cu :: k) (p :: k -> k -> *)
       (t :: k -> k) (u :: k -> k) (a :: k).
p (t a) (u a) -> T_U ct cu p t u a
T_U (Tape (Construction Identity) a
-> Identity (Tape (Construction Identity) a)
forall a. a -> Identity a
Identity Tape (Construction Identity) a
z Identity (Tape (Construction Identity) a)
-> (:=)
     (Reverse (Construction Identity) <:.:> Construction Identity)
     (:*:)
     (Tape (Construction Identity) a)
-> Identity (Tape (Construction Identity) a)
   :*: (:=)
         (Reverse (Construction Identity) <:.:> Construction Identity)
         (:*:)
         (Tape (Construction Identity) a)
forall s a. s -> a -> s :*: a
:*: Reverse (Construction Identity) (Tape (Construction Identity) a)
-> Construction Identity (Tape (Construction Identity) a)
-> (:=)
     (Reverse (Construction Identity) <:.:> Construction Identity)
     (:*:)
     (Tape (Construction Identity) a)
forall k (t :: k -> *) (a :: k) (u :: k -> *).
t a -> u a -> (<:.:>) t u (:*:) a
twosome (Reverse (Construction Identity) (Tape (Construction Identity) a)
 -> Construction Identity (Tape (Construction Identity) a)
 -> (:=)
      (Reverse (Construction Identity) <:.:> Construction Identity)
      (:*:)
      (Tape (Construction Identity) a))
-> Reverse (Construction Identity) (Tape (Construction Identity) a)
-> Construction Identity (Tape (Construction Identity) a)
-> (:=)
     (Reverse (Construction Identity) <:.:> Construction Identity)
     (:*:)
     (Tape (Construction Identity) a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# Construction Identity (Tape (Construction Identity) a)
-> Reverse (Construction Identity) (Tape (Construction Identity) a)
forall k (t :: k -> *) (a :: k). t a -> Reverse t a
Reverse ((Tape (Construction Identity) a -> Tape (Construction Identity) a)
-> Construction Identity (Tape (Construction Identity) a)
move (forall a (mod :: a) (struct :: * -> *).
Morphable ('Rotate mod) struct =>
struct ~> Morphing ('Rotate mod) struct
forall (struct :: * -> *).
Morphable ('Rotate 'Left) struct =>
struct ~> Morphing ('Rotate 'Left) struct
rotate @Left)) (Construction Identity (Tape (Construction Identity) a)
 -> (:=)
      (Reverse (Construction Identity) <:.:> Construction Identity)
      (:*:)
      (Tape (Construction Identity) a))
-> Construction Identity (Tape (Construction Identity) a)
-> (:=)
     (Reverse (Construction Identity) <:.:> Construction Identity)
     (:*:)
     (Tape (Construction Identity) a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# (Tape (Construction Identity) a -> Tape (Construction Identity) a)
-> Construction Identity (Tape (Construction Identity) a)
move (forall a (mod :: a) (struct :: * -> *).
Morphable ('Rotate mod) struct =>
struct ~> Morphing ('Rotate mod) struct
forall (struct :: * -> *).
Morphable ('Rotate 'Right) struct =>
struct ~> Morphing ('Rotate 'Right) struct
rotate @Right))

repeat :: a :=> Stream
repeat :: a :=> Construction Identity
repeat a
x = a
-> ((Identity :. Construction Identity) := a)
-> Construction Identity a
forall (t :: * -> *) a.
a -> ((t :. Construction t) := a) -> Construction t a
Construct a
x (((Identity :. Construction Identity) := a)
 -> Construction Identity a)
-> (Construction Identity a
    -> (Identity :. Construction Identity) := a)
-> Construction Identity a
-> Construction Identity a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Construction Identity a -> (Identity :. Construction Identity) := a
forall a. a -> Identity a
Identity (Construction Identity a -> Construction Identity a)
-> Construction Identity a -> Construction Identity a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! a :=> Construction Identity
forall a. a :=> Construction Identity
repeat a
x