module Proof where

import TRS
import PCP
import SN
import Fork
import TA
import Labeling

data Status = Proved | Disproved | Subgoal TRS

data ProofStep =
    Emptiness
  | TCAP TRS Fork
  | TCAP2 TRS Peak
  | TA TRS Fork (TA Int) (TA Int)
  | TA2 TRS Peak (TA Int) (TA Int)
  | RL {
      _trsR :: TRS,
      _trsC :: TRS,
      _phi :: Labeling Int,
      _psi :: Labeling Int,
      _joinsRS :: [CritPairInfo],
      _joinsSR :: [CritPairInfo]
    }
  | CPS {
      _trsR :: TRS, 
      _trsS :: TRS,
      _trsP :: TRS,
      _joinSequencesForR :: [CritPairInfo],
      _joinSequencesForS :: [CritPairInfo],
      _relativeTerminationProof :: SNProof
    }
  | Redundancy {
      _trsR :: TRS,
      _trsS :: TRS
    }
  | KH12 {
      _trsR :: TRS,
      _trsS :: TRS,
      _relativeTerminationProof :: SNProof
    }

type Proof = ([ProofStep], Status)

indent :: String -> String
indent text = unlines [ "   " ++ s | s <- ss ]
  where ss = lines text

instance Show ProofStep where
  show Emptiness =
    unlines
      ["-- confluence by emptiness",
       "",
      "The empty TRS is trivially confluent."]
  show (TCAP trs fork@(_, s, _)) =
    unlines 
      ["-- non-confluence by TCAP unifiability:",
       "",
       "Consider the TRS:",
       "",
       show_trs trs,
       "The following peak is not joinable.",
       "",
       "  " ++ show t ++ " *<- " ++ show s ++ " ->* " ++ show u,
       "",
       "Hence, the TRS is not confluent."]
    where (t, u) = last_terms fork
  show (TCAP2 trs (t, s, u)) =
    unlines 
      ["-- non-confluence by TCAP unifiability:",
       "",
       "Consider the TRS:",
       "",
       show_trs trs,
       "The following peak is not joinable.",
       "",
       "  " ++ show t ++ " *<- " ++ show s ++ " ->* " ++ show u,
       "",
       "Hence, the TRS is not confluent."]
  show (Proof.TA2 trs (t, s, u) ta1 ta2) =
    unlines 
      ["-- non-confluence by tree automata techniques:",
       "",
       "Consider the TRS",
       "",
       show_trs trs,
       "the peak t *<- s ->* u with",
       "",
       "  s = " ++ show s,
       "  t = " ++ show t,
       "  u = " ++ show u,
       "",
       "and the state-compatible and state-coherent tree automata A and B:",
       "",
       "  A:",
       show ta1,
       "  B:",
       show ta2,
       "Their languages are closed under rewriting and disjoint.",
       "Because t and u are accepted by A and by B respectively, they are not joinable.",
       "Hence, the TRS is not confluent."]
  show (Proof.TA trs fork@(_, s, _) ta1 ta2) =
    unlines 
      ["-- non-confluence by tree automata techniques:",
       "",
       "Consider the TRS",
       "",
       show_trs trs,
       "the peak t *<- s ->* u with",
       "",
       "  s = " ++ show s,
       "  t = " ++ show t,
       "  u = " ++ show u,
       "",
       "and the state-compatible and state-coherent tree automata A and B:",
       "",
       "  A:",
       show ta1,
       "  B:",
       show ta2,
       "Their languages are closed under rewriting and disjoint.",
       "Because t and u are accepted by A and by B respectively, they are not joinable.",
       "Hence, the TRS is not confluent."]
    where (t, u) = last_terms fork
  show r@(RL {})  = 
    unlines
      ["-- rule removal by rule labeling (Shintani and Hirokawa 2024)",
       "",
       "Consider the left-linear TRS R:",
       "",
       show_trs (_trsR r),
       "Let S be the following subsystem of R:",
       "",
       show_trs (_trsC r),
       "The TRS R admits the following parallel critical pairs:",
       "",
       show_PCPs (_joinsRS r),
       "They are S-convertible, or (phi,psi)- and (psi,phi)-decreasing wrt labeling:",
       "",
       "  phi:",
       show_labeling ("phi", _phi r),
       "  psi:",
       show_labeling ("psi", _phi r),
       "Therefore, R and S are equi-confluent."
      ]
  show r@(CPS {}) =
    unlines
      ["-- rule removal by critical pair system (Shintani and Hirokawa 2024)",
       "",
       "Consider the left-linear TRS R:",
       "",
       show_trs (_trsR r),
       "Let S be the following subsystem of R:",
       "",
       show_trs (_trsS r),
       "All parallel critical pairs of R (below) are joinable:",
       "",
       show_PCPs (_joinSequencesForS r ++ _joinSequencesForR r),
       "The following TRS P is a superset of the parallel critical pair system PCPS(R,S):",
       "",
       show_trs (_trsP r),
       "Termination of P/R is shown as follows.",
       "",
       indent (show (_relativeTerminationProof r)),
       "Therefore, R and S are equi-confluent."]
  show r@(Redundancy {}) = 
    unlines 
      ["-- rule removal by redundant rule elimination (Nagele et al. 2015)",
       "",
       "Consider the TRS R:",
       "",
       show_trs (_trsR r),
       "All rules in R are convertible with respect to the subsystem S:",
       "",
       show_trs (_trsS r),
       "Therefore, the confluence of R follows from that of S."]
  show r@(KH12 {}) =
    unlines
      ["-- rule removal by generalization of Knuth and Bendix' criterion (Klein and Hirokawa 2012)",
       "",
       "Consider the TRSs R and S:",
       "",
       "  R:",
       show_trs (_trsR r),
       "  S:",
       show_trs (_trsS r),
       "SNO(R, S) holds and all S-critical pairs of R are joinable.",
       "Moreover, the termination of R/S is shown as follows.",
       "",
       indent (show (_relativeTerminationProof r)),
       "Therefore, R union S and S are equi-confluent."]

show_result :: Status -> String
show_result Proved      = "YES"
show_result Disproved   = "NO"
show_result (Subgoal _) = "MAYBE"

show_proof_steps :: [ProofStep] -> String
show_proof_steps proof_steps =
  unlines [ show proof_step | proof_step <- proof_steps ] 

conclusion :: Status -> String
conclusion Proved =
  unlines ["-- conclusion", "", "confluent"]
conclusion Disproved =
  unlines ["-- conclusion", "", "non-confluent"]
conclusion (Subgoal trs) =
  unlines 
    ["-- failure",
     "",
     "We failed to prove/disprove confluence of the system:",
     "",
     show_trs trs,
     "",
     "-- conclusion",
     "",
     "no conclusion"]

show_proof :: Proof -> String
show_proof (proof_steps, status) =
  show_result status ++ "\n\n" ++
  show_proof_steps proof_steps ++
  conclusion status
