content: {-# LANGUAGE AllowAmbiguousTypes #-}
  module Ya.Program.Patterns where
  
  import Ya.Algebra
  
  pattern Same :: i `AR_` i
  pattern Same e = e
  
  type Once = I
  
  pattern Once :: e -> Once e
  pattern Once e = Identity e
  
  type Alone = I
  
  pattern Alone :: e -> Alone e
  pattern Alone e = Identity e
  
  type Singular = I
  
  pattern Singular :: e -> Singular e
  pattern Singular e = Identity e
  
  type Apparently = I
  
  pattern Apparently :: e -> Apparently e
  pattern Apparently e = Identity e
  
  type Boolean = S'I'II Unit Unit
  
  pattern Boolean :: Unit `S` Unit `AR_` Boolean
  pattern Boolean e = T'I'II e
  
  pattern False x = T'I'II (This x) :: Boolean
  pattern True x = T'I'II (That x) :: Boolean
  
  pattern Selfsame x = T'I'II (That x)
  
  type Given = T'I'II (AR)
  
  pattern Given :: e `AR` e `AR__` Given e e
  pattern Given e = T'I'II e
  
  type Supplied = T'II'I P
  
  type Along = T'II'I P
  
  pattern Along :: forall e ee . e `P` ee -> Along ee e
  pattern Along x = T'II'I x
  
  type Optional = S'I'II Unit
  
  pattern Empty :: Unit -> Maybe i
  pattern Empty x = T'I'II (This x)
  
  pattern Exist :: i -> Maybe i
  pattern Exist x = T'I'II (That x)
  
  pattern Optionally x = T'I'II x
  
  type Halts = S'I'II Unit
  
  type Maybe = S'I'II Unit
  
  pattern Maybe :: Unit `S` e `AR_` Maybe e
  pattern Maybe x = T'I'II @(S) @Unit x
  
  type Progress = T'I'II (S)
  
  pattern Progress x = T'I'II @(S) x
  
  pattern Interrupt :: e -> Progress e ee
  pattern Interrupt x = T'I'II @(S) (This x)
  
  pattern Continue :: ee -> Progress e ee
  pattern Continue x = T'I'II @(S) (That x)
  
  pattern Erase :: e -> Progress e ee
  pattern Erase x = T'I'II (This x)
  
  pattern Store :: ee -> Progress e ee
  pattern Store x = T'I'II (That x)
  
  pattern Allot :: ee -> Progress e ee
  pattern Allot x = T'I'II (That x)
  
  type Stops = T'I'II (S)
  
  pattern Stops x = T'I'II @(S) x
  
  pattern Error :: i -> Stops i ii
  pattern Error x = T'I'II (This x)
  
  pattern Break :: i -> Stops i ii
  pattern Break x = T'I'II (This x)
  
  type Catch = T'I'II (S)
  
  pattern Catch :: i -> Stops i ii
  pattern Catch x = T'I'II (This x)
  
  type Reach = T'I'II (S)
  
  pattern Reach :: i -> Stops i ii
  pattern Reach x = T'I'II (This x)
  
  pattern Wrong :: i -> Stops i ii
  pattern Wrong x = T'I'II (This x)
  
  pattern Valid, Going, Ok :: ii -> Stops i ii
  pattern Valid x = T'I'II (That x)
  pattern Going x = T'I'II (That x)
  pattern Ok x = T'I'II (That x)
  
  type Probably = T'I'II (S)
  
  pattern Probably x = T'I'II @(S) x
  
  type Perhaps = T'I'II (S)
  
  pattern Perhaps x = T'I'II @(S) x
  
  type Reference u i ii iii = i `AR_` u ii (iii `AR_` i)
  
  type Attribute = T'I'TT'II'T'II'I (AR) P
  
  pattern Attribute :: forall ee e . (e `AR_` (P) ee (ee -> e)) -> Attribute e ee
  pattern Attribute x = T'I'TT'II'T'II'I @(AR) @(P) x
  
  type Scope = T'I'TT'II'T'II'I (AR) P
  
  pattern Scope :: forall ee e . (e `AR_` (P) ee (ee -> e)) -> Scope e ee
  pattern Scope x = T'I'TT'II'T'II'I @(AR) @(P) x
  
  type Automation e ee eee = e `AR_` ee `P` eee
  
  type Transition = T'I'TT'II'I (AR) (P)
  
  pattern Transition :: Automation e ee e `AR__` Transition e ee
  pattern Transition x = T'I'TT'II'I @(AR) @(P) x
  
  type Event = T'I'TT'II'I (AR) P
  
  pattern Event :: Automation e ee e `AR__` Event e ee
  pattern Event x = T'I'TT'II'I @(AR) @(P) x
  
  type State = T'I'II Transition
  
  pattern State :: forall e o . Transition e o -> State e o
  pattern State x = T'I'II @Transition x
  
  type Branching t tt i = t i `T'TT'I` tt
  
  type Construction = F'T'I'TT'I Along
  
  pattern Construct xs = F'T'I'TT'I xs
  
  pattern Root x xs = F'T'I'TT'I (Recursive (T'TT'I (T'II'I (These xs x))))
  
  pattern Node x xs = Recursive (T'TT'I (T'II'I (These xs x)))
  
  -- pattern Yet x xs = Recursive (T'I'TT'II (These x xs))
  
  type Instruction = F'T'I'TT'I Stops
  
  -- x `kyokl` Level `ha` ...
  
  -- TODO: t `C'AR___` Instruction t
  
  -- pattern Value x = F'T'I'TT'I (Recursive (T'I'TT'II (This x)))
  -- pattern Impel x = F'T'I'TT'I (Recursive (T'I'TT'II (That x)))
  
  pattern Impel :: t (Recursive (T'I'II (S) i `T'TT'I` t)) `AR____` Instruction t i
  pattern Impel xs = F'T'I'TT'I (Recursive (T'TT'I (T'I'II (That xs))))
  
  pattern Value :: i `AR____` Instruction t i
  pattern Value x = F'T'I'TT'I (Recursive (T'TT'I (T'I'II (This x))))
  
  type List = Optional `T'TT'I` Construction Optional
  
  pattern List xs = T'TT'I @Optional @(Construction Optional) (Exist (F'T'I'TT'I xs))
  
  type Quest = List
  
  pattern Item :: i -> t (Recursive (Along i `T'TT'I` t)) -> Recursive (Along i `T'TT'I` t)
  pattern Item x xs = Recursive (T'TT'I (T'II'I (These xs x)))
  
  pattern Next :: forall ee e . ee `AR_` Progress e ee
  pattern Next x = T'I'II (That x)
  
  pattern Last :: forall e ee . e `AR_` Progress e ee
  pattern Last x = T'I'II (This x)
  
  type family Brancher datastructure where
   Brancher (T'TT'I t (Construction t)) = t
  
  type family Nonempty datastructure where
   Nonempty (Maybe `T'TT'I` Construction Maybe) = Construction Maybe
   Nonempty (List `T'TT'I` Construction t) = Construction Maybe `T'TT'I` Construction t
  
  pattern Nonempty :: forall t i . Recursive (Along i `T'TT'I` Brancher t) -> Construction (Brancher t) i
  pattern Nonempty xs = F'T'I'TT'I xs
  
  type Tree = Construction List
  
  -- TODO: fix it, it shouldn't be too complicated
  pattern Tree x xs = F'T'I'TT'I (Recursive (T'TT'I (T'II'I (These (T'TT'I (Exist (Construct xs))) x))))
  
  type family Binary t where
   Binary Tree = Construction (T'I'I (P) `T'TT'I` Optional)
  
  pattern Binary xs = T'TT'I (T'I'I xs)
  
  type family Forest tree where
   Forest (Construction t) = List `T'TT'I` Construction t
  
  type family Prefix t k where
   Prefix Tree k = List `T'TT'I` Construction List `T'TT'I` Along k
   Prefix List k = List `T'TT'I` Along k
   Prefix (Construction Maybe) k = Construction Maybe `T'TT'I` Along k
  
  type Stream = Construction Alone
  
  pattern Stream :: Stream i -> Stream i
  pattern Stream xs = xs
  
  type Way = Unit `S` Unit
  
  pattern Back :: forall r e ee . (r ~ e `S` ee) => e -> r
  pattern Back x = This x
  
  pattern Fore :: forall r ee e . (r ~ e `S` ee) => ee -> r
  pattern Fore x = That x
  
  pattern Passed x = This x
  pattern Future x = That x
  
  type Decision = (S) Unit Unit
  
  pattern No x = This x
  pattern Yes x = That x
  
  type Side = (S) Unit Unit
  
  pattern Left x = This x
  pattern Right x = That x
  
  type Vertical = (S) Unit Unit
  
  type Match = T'II'I Arrow Boolean
  
  pattern Match :: e `AR` Boolean `AR_` Match e
  pattern Match e = T'II'I e
  
  pattern Junction :: t e `P` tt e `AR__` (t `P'T'I'TT'I` tt) e
  pattern Junction x = T'TT'I'TTT'I  x
  