module Quox.OPE.Comp

import Quox.OPE.Basics
import Quox.OPE.Length
import Quox.OPE.Sub
import Data.DPair

%default total


public export
data Comp : ys `Sub` zs -> xs `Sub` ys -> xs `Sub` zs -> Type where
  CEE : Comp End End End
  CKK : Comp p q pq -> Comp (Keep p) (Keep q) (Keep pq)
  CKD : Comp p q pq -> Comp (Keep p) (Drop q) (Drop pq)
  CD0 : Comp p q pq -> Comp (Drop p) q        (Drop pq)

export
comp : (p : ys `Sub` zs) -> (q : xs `Sub` ys) -> Comp p q (p . q)
comp End      End      = CEE
comp (Keep p) (Keep q) = CKK (comp p q)
comp (Keep p) (Drop q) = CKD (comp p q)
comp (Drop p) q        = CD0 (comp p q)

export
0 compOk : Comp p q r -> r = (p . q)
compOk CEE     = Refl
compOk (CKK z) = cong Keep $ compOk z
compOk (CKD z) = cong Drop $ compOk z
compOk (CD0 z) = cong Drop $ compOk z

export
compZero : (sx : Length xs) => (sy : Length ys) =>
           (p : xs `Sub` ys) -> Comp p (Sub.zero @{sx}) (Sub.zero @{sy})
compZero {sx = Z,   sy = Z}   End      = CEE
compZero {sx = S _, sy = S _} (Keep p) = CKD (compZero p)
compZero           {sy = S _} (Drop p) = CD0 (compZero p)

export
compIdLeft : (sy : Length ys) =>
             (p : xs `Sub` ys) -> Comp (Sub.id @{sy}) p p
compIdLeft {sy = Z}   End      = CEE
compIdLeft {sy = S _} (Keep p) = CKK (compIdLeft p)
compIdLeft {sy = S _} (Drop p) = CKD (compIdLeft p)

export
compIdRight : (sx : Length xs) =>
              (p : xs `Sub` ys) -> Comp p (Sub.id @{sx}) p
compIdRight {sx = Z}   End      = CEE
compIdRight {sx = S _} (Keep p) = CKK (compIdRight p)
compIdRight            (Drop p) = CD0 (compIdRight p)


export
0 compAssoc : (p : ys `Sub` zs) -> (q : xs `Sub` ys) -> (r : ws `Sub` xs) ->
              p . (q . r) = (p . q) . r
compAssoc End      End      End      = Refl
compAssoc (Keep p) (Keep q) (Keep r) = cong Keep $ compAssoc p q r
compAssoc (Keep p) (Keep q) (Drop r) = cong Drop $ compAssoc p q r
compAssoc (Keep p) (Drop q) r        = cong Drop $ compAssoc p q r
compAssoc (Drop p) q        r        = cong Drop $ compAssoc p q r
compAssoc End (Drop _) _ impossible


public export
Subscope : Scope a -> Type
Subscope ys = Exists (`Sub` ys)

public export
record SubMap {a : Type} {xs, ys, zs : Scope a}
              (p : xs `Sub` zs) (q : ys `Sub` zs) where
  constructor SM
  thin : xs `Sub` ys
  0 comp : Comp q thin p

parameters (p : xs `Sub` ys)
  export
  subId : SubMap p p
  subId = SM id (compIdRight p)

  export
  subZero : SubMap Sub.zero p
  subZero = SM zero (compZero p)