Add an interactive 'can this query be satisfied' interface

src/Bergamot/Rules.elm

@@ -90,16 +90,19 @@ provePremises l =
     case l of
         t :: ts ->
             pure (::)
-            |> apply (prove t)
+            |> apply (proveTerm t)
             |> apply (provePremises ts)
         [] -> pure []
 
+proveTerm : Term UnificationVar -> Prover ProofTree
+proveTerm t =
+    getEnv
+    |> andThen (\env -> List.foldl (\r -> interleave (rule t r)) fail env.rules)
+
 prove : Term Metavariable -> Prover ProofTree
 prove mt =
-    pure (\t env -> List.foldl (\r -> interleave (rule t r)) fail env.rules)
-    |> apply (liftInstantiation instantiate mt)
-    |> apply getEnv
-    |> join
+    liftInstantiation instantiate mt
+    |> andThen proveTerm
 
 single : RuleEnv -> Prover a -> Maybe a
 single env p =

src/Main.elm

@@ -3,6 +3,7 @@ module Main exposing (main)
 import Browser
 import Html exposing (Html)
 import Html.Events exposing (onInput)
+import Html.Attributes exposing (type_)
 import Bergamot.Syntax exposing (..)
 import Bergamot.Search exposing (..)
 import Bergamot.Rules exposing (..)
@@ -11,24 +12,37 @@ import Maybe
 import Tuple
 import Debug
 
-type alias Model = { program : String }
+type alias Model =
+    { program : String
+    , query : String
+    }
 type alias Flags = ()
 type Msg
     = SetProgram String
+    | SetQuery String
 
 init : Flags -> (Model, Cmd Msg)
-init () = ({ program = "" }, Cmd.none)
+init () = ({ program = "", query = "" }, Cmd.none)
+
+proveQuery : String -> String -> Maybe ProofTree
+proveQuery progs querys =
+    case (run program progs, run term querys) of
+        (Just prog, Just query) -> single prog (prove query)
+        _ -> Nothing
 
 view : Model -> Html Msg
 view m = Html.div []
     [ Html.textarea [ onInput SetProgram ] []
-    , Html.p [] [ Html.text (Debug.toString (run program m.program)) ]
+    , Html.br [] []
+    , Html.input [ type_ "text", onInput SetQuery ] []
+    , Html.p [] [ Html.text (Debug.toString (proveQuery m.program m.query)) ]
     ]
 
 update : Msg -> Model -> (Model, Cmd Msg)
 update msg m =
     case msg of
         SetProgram prog -> ({ m | program = prog }, Cmd.none)
+        SetQuery query -> ({ m | query = query }, Cmd.none)
 
 subscriptions : Model -> Sub Msg
 subscriptions _ = Sub.none