bergamot-elm/src/Bergamot/Latex.elm

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