module Bergamot.Latex exposing (..) import Bergamot.Syntax as Syntax exposing (..) import Bergamot.Rules as Rules exposing (..) import Bergamot.Utils exposing (..) import Debug type Void = Void Void absurd : Void -> a absurd (Void v) = absurd v renderTermViaRules : RuleEnv -> Term Void -> Maybe String renderTermViaRules env t = Call "latex" [Syntax.map absurd t, Var (MkMetavariable "s")] |> prove |> Rules.andThen reifyProofTree |> single env |> Maybe.andThen (\(MkProofTree node) -> case node.conclusion of Call "latex" [_, StringLit s] -> Just s _ -> Nothing) buildInferenceRuleFrac : List String -> String -> String -> String buildInferenceRuleFrac prems conc name = String.concat [ "\\cfrac{" , String.join "\\quad " prems , "}{" , conc , "}\\ \\texttt{" , name , "}" ] renderRuleViaRules : RuleEnv -> Rule -> Maybe String renderRuleViaRules env r = let quotedPrems = List.map quoteMetavariables r.premises quotedConc = quoteMetavariables r.conclusion in renderTermViaRules env quotedConc |> Maybe.andThen (\conc -> sequenceMaybes (List.map (renderTermViaRules env) quotedPrems) |> Maybe.map (\prems -> buildInferenceRuleFrac prems conc r.name)) renderTreeViaRules : RuleEnv -> ProofTree -> Maybe String renderTreeViaRules env (MkProofTree node) = renderTermViaRules env (quoteVariables node.conclusion) |> Maybe.andThen (\conc -> sequenceMaybes (List.map (renderTreeViaRules env) node.premises) |> Maybe.map (\prems -> buildInferenceRuleFrac prems conc node.name)) quote : String -> (a -> String) -> Term a -> Term Void quote s f = let helper a = Call s [StringLit <| f a] in Syntax.andThen helper quoteMetavariables : Term Metavariable -> Term Void quoteMetavariables = quote "metavariable" metavariableToLatex quoteVariables : Term UnificationVar -> Term Void quoteVariables = quote "variable" (\(MkUnificationVar v) -> v) metavariableToLatex : Metavariable -> String metavariableToLatex (MkMetavariable s) = let noQuestion = String.dropLeft 1 s in if String.startsWith "tau" noQuestion then "\\" ++ noQuestion else if String.startsWith "Gamma" noQuestion then "\\" ++ noQuestion else noQuestion