2023-11-26 11:43:38 -08:00
|
|
|
module Main exposing (main)
|
|
|
|
|
|
|
|
import Browser
|
|
|
|
import Html exposing (Html)
|
2023-11-26 11:58:20 -08:00
|
|
|
import Html.Events exposing (onInput)
|
2023-11-26 17:17:10 -08:00
|
|
|
import Html.Attributes exposing (type_, class, value)
|
2023-11-26 11:43:38 -08:00
|
|
|
import Bergamot.Syntax exposing (..)
|
|
|
|
import Bergamot.Search exposing (..)
|
|
|
|
import Bergamot.Rules exposing (..)
|
|
|
|
import Bergamot.Parser exposing (..)
|
2023-11-26 14:34:52 -08:00
|
|
|
import Bergamot.Latex exposing (..)
|
2023-11-26 15:54:01 -08:00
|
|
|
import Json.Encode
|
2023-11-26 11:43:38 -08:00
|
|
|
import Maybe
|
|
|
|
import Tuple
|
|
|
|
import Debug
|
|
|
|
|
2023-11-26 12:47:05 -08:00
|
|
|
type alias Model =
|
|
|
|
{ program : String
|
|
|
|
, query : String
|
|
|
|
}
|
2023-11-26 20:53:31 -08:00
|
|
|
type alias Flags = { rules: String, query: String }
|
2023-11-26 11:58:20 -08:00
|
|
|
type Msg
|
|
|
|
= SetProgram String
|
2023-11-26 12:47:05 -08:00
|
|
|
| SetQuery String
|
2023-11-26 11:43:38 -08:00
|
|
|
|
|
|
|
init : Flags -> (Model, Cmd Msg)
|
2023-11-26 20:53:31 -08:00
|
|
|
init fs = ({ program = fs.rules, query = fs.query }, Cmd.none)
|
2023-11-26 12:47:05 -08:00
|
|
|
|
2023-11-26 16:25:23 -08:00
|
|
|
viewSection : String -> Html Msg -> Html Msg
|
|
|
|
viewSection name content =
|
2023-11-29 22:20:55 -08:00
|
|
|
Html.div [ class "bergamot-section" ] [ Html.em [ class "bergamot-section-heading" ] [ Html.text name ], content ]
|
2023-11-26 14:34:52 -08:00
|
|
|
|
2023-11-26 16:25:23 -08:00
|
|
|
viewRule : Rule -> Html Msg
|
|
|
|
viewRule = latex << ruleToLatex
|
|
|
|
|
|
|
|
viewRules : String -> Html Msg
|
|
|
|
viewRules progs = viewSection "Rendered Rules" <|
|
2023-11-29 22:20:55 -08:00
|
|
|
Html.div [ class "bergamot-rule-list" ] <|
|
2023-11-26 16:25:23 -08:00
|
|
|
case run program progs of
|
|
|
|
Just prog -> List.map viewRule prog.rules
|
|
|
|
Nothing -> []
|
|
|
|
|
|
|
|
tryProve : String -> String -> Maybe ProofTree
|
|
|
|
tryProve progs querys =
|
2023-11-26 12:47:05 -08:00
|
|
|
case (run program progs, run term querys) of
|
2023-11-26 13:14:44 -08:00
|
|
|
(Just prog, Just query) -> single prog (prove query |> Bergamot.Rules.andThen reifyProofTree)
|
2023-11-26 12:47:05 -08:00
|
|
|
_ -> Nothing
|
2023-11-26 11:43:38 -08:00
|
|
|
|
2023-11-26 16:25:23 -08:00
|
|
|
viewProofTree : String -> String -> Html Msg
|
|
|
|
viewProofTree progs querys = viewSection "Proof Tree" <|
|
2023-11-29 22:20:55 -08:00
|
|
|
Html.div [ class "bergamot-proof-tree" ] <|
|
2023-11-26 16:25:23 -08:00
|
|
|
case tryProve progs querys of
|
|
|
|
Just tree -> [ latex (proofTreeToLatex tree) ]
|
|
|
|
Nothing -> []
|
|
|
|
|
|
|
|
|
2023-11-26 11:43:38 -08:00
|
|
|
view : Model -> Html Msg
|
2023-11-29 22:20:55 -08:00
|
|
|
view m = Html.div [ class "bergamot-root" ]
|
2023-11-26 20:53:31 -08:00
|
|
|
[ viewSection "Rules" <| Html.textarea [ onInput SetProgram ] [ Html.text m.program ]
|
2023-11-26 17:17:10 -08:00
|
|
|
, viewSection "Query" <| Html.input [ type_ "text", onInput SetQuery, value m.query ] []
|
2023-11-26 16:25:23 -08:00
|
|
|
, viewRules m.program
|
|
|
|
, viewProofTree m.program m.query
|
2023-11-26 11:58:20 -08:00
|
|
|
]
|
2023-11-26 11:43:38 -08:00
|
|
|
|
|
|
|
update : Msg -> Model -> (Model, Cmd Msg)
|
|
|
|
update msg m =
|
|
|
|
case msg of
|
2023-11-26 11:58:20 -08:00
|
|
|
SetProgram prog -> ({ m | program = prog }, Cmd.none)
|
2023-11-26 12:47:05 -08:00
|
|
|
SetQuery query -> ({ m | query = query }, Cmd.none)
|
2023-11-26 11:43:38 -08:00
|
|
|
|
|
|
|
subscriptions : Model -> Sub Msg
|
|
|
|
subscriptions _ = Sub.none
|
|
|
|
|
|
|
|
main =
|
|
|
|
Browser.element
|
|
|
|
{ init = init
|
|
|
|
, view = view
|
|
|
|
, update = update
|
|
|
|
, subscriptions = subscriptions
|
|
|
|
}
|
2023-11-26 15:54:01 -08:00
|
|
|
|
|
|
|
-- Latex support:
|
|
|
|
-- Based on https://stackoverflow.com/questions/75492820/embedding-mathematical-equations-in-an-elm-spa
|
|
|
|
|
|
|
|
latex : String -> Html Msg
|
|
|
|
latex expr =
|
|
|
|
Html.node "katex-expression"
|
|
|
|
[ Html.Attributes.attribute "expression" expr
|
|
|
|
, Html.Attributes.attribute "katex-options" (Json.Encode.encode 0 options)
|
|
|
|
]
|
|
|
|
[]
|
|
|
|
|
|
|
|
|
|
|
|
options : Json.Encode.Value
|
|
|
|
options =
|
|
|
|
Json.Encode.object
|
|
|
|
[ ( "displayMode", Json.Encode.bool True )
|
|
|
|
]
|