Add error reporting

Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>

src/Bergamot/Parser.elm

@@ -82,6 +82,9 @@ term = Parser.lazy (\() -> Parser.oneOf
     , Parser.succeed StringLit |= strLit
     ])
 
+topLevelTerm : Parser (Term Metavariable)
+topLevelTerm = term |. Parser.end
+
 rule : Parser Rule
 rule =
     let

src/Main.elm

@@ -122,10 +122,64 @@ viewRules renderProgs progs =
             (Just renderProg, Just prog) -> List.filterMap (viewRuleSection renderProg) prog.sections
             _ -> []
 
-proofGoal : EditMode -> String -> String -> Maybe (Term Metavariable)
+type Error
+    = BadQuery
+    | BadObjectTerm
+    | NoConversionResults
+    | BadInputProg
+    | BadProg
+    | BadRenderProg
+    | FailedRender
+    | Silent
+
+combineTwoResults : (a -> b -> Result Error c) -> Result Error a -> Result Error b -> Result Error c
+combineTwoResults f ra rb =
+    case ra of
+        Err _ -> Err Silent
+        Ok a ->
+            case rb of
+                Err _ -> Err Silent
+                Ok b -> f a b
+
+errorToString : Error -> String
+errorToString err =
+    case err of
+        BadQuery -> "Unable to parse input query"
+        BadObjectTerm -> "Unable to parse input object language term"
+        NoConversionResults -> "Failed to convert object language term to proof goal"
+        BadInputProg -> "Unable to parse conversion rules from object language to proof goals"
+        BadProg -> "Unable to parse rules"
+        BadRenderProg -> "Unable to parse rendering rules"
+        FailedRender -> "Unable to render terms using provided rendering rules"
+        Silent -> ""
+
+viewError : Error -> Html Msg
+viewError e = Html.div [ class "bergamot-error" ] [ Html.text <| errorToString e ]
+
+viewIfError : Result Error a -> List (Html Msg)
+viewIfError r =
+    case r of
+        Err Silent -> []
+        Err e -> [ viewError e ]
+        _ -> []
+
+viewOrError : Result Error (Html Msg) -> Html Msg
+viewOrError r =
+    case r of
+        Err Silent -> Html.div [] []
+        Err e -> Html.div [] [ viewError e ] -- The div wrapper is needed because Elm has a bug?
+        Ok html -> html
+
+proofGoal : EditMode -> String -> String -> Result Error (Term Metavariable)
 proofGoal editMode inputProgs querys =
+    if querys == ""
+    then Err Silent
+    else
         case editMode of
-        Query -> run term querys
+            Query ->
+                case run topLevelTerm querys of
+                    Nothing -> Err BadQuery
+                    Just query -> Ok query
             Syntax ->
                 case (run program inputProgs, run topLevelExpr querys) of
                     (Just inputProg, Just e) ->
@@ -137,51 +191,63 @@ proofGoal editMode inputProgs querys =
                             case single fullProgram (prove query |> Bergamot.Rules.andThen reifyProofTree) of
                                 Just (MkProofTree node) ->
                                     case node.conclusion of
-                                    Call "prompt" [t] -> Just <| Bergamot.Syntax.map (MkMetavariable << unUnificationVar) t
+                                        Call "prompt" [t] -> Ok <| Bergamot.Syntax.map (MkMetavariable << unUnificationVar) t
-                                    _ -> Nothing
+                                        _ -> Err NoConversionResults
-                            _ -> Nothing
+                                _ -> Err NoConversionResults
-                _ -> Nothing
+                    (_, Nothing) -> Err BadObjectTerm
+                    (Nothing, _) -> Err BadInputProg
 
-tryProve : EditMode -> String -> String -> String -> Maybe ProofTree
+progAndRenderProg : String -> String -> Result Error (RuleEnv, RuleEnv)
-tryProve editMode inputProgs progs querys =
+progAndRenderProg progs renderProgs =
-    case (run program progs, proofGoal editMode inputProgs querys) of
+    case (run program progs, run program renderProgs) of
-        (Just prog, Just query) -> single prog (prove query |> Bergamot.Rules.andThen reifyProofTree)
+        (Just prog, Just renderProg) -> Ok (prog, renderProg)
-        _ -> Nothing
+        (Nothing, _) -> Err BadProg
+        (_, Nothing) -> Err BadRenderProg
 
-viewProofTree : EditMode -> ResultMode -> String -> String -> String -> String -> Html Msg
+renderProofTree : ResultMode -> ProofTree -> RuleEnv -> Result Error (Html Msg)
-viewProofTree editMode resultMode renderProgs inputProgs progs querys =
+renderProofTree resultMode (MkProofTree node) renderProg =
-    Html.div [ class "bergamot-proof-tree" ] <|
-        case tryProve editMode inputProgs progs querys of
-            Just (MkProofTree tree) ->
-                case run program renderProgs of
-                    Just renderProg ->
     let
         maybeLatexString =
             case resultMode of
-                                    Conclusion -> renderTermViaRules renderProg (quoteVariables tree.conclusion)
+                Conclusion -> renderTermViaRules renderProg (quoteVariables node.conclusion)
-                                    Tree -> renderTreeViaRules renderProg (MkProofTree tree)
+                Tree -> renderTreeViaRules renderProg (MkProofTree node)
-                        in List.filterMap (Maybe.map latex) [maybeLatexString]
+    in
-                    Nothing -> []
+        List.filterMap (Maybe.map latex) [maybeLatexString]
-            Nothing -> []
+        |> Html.div [ class "bergamot-proof-tree" ]
+        |> Ok
 
 
+viewProofTree : ResultMode -> Term Metavariable -> (RuleEnv, RuleEnv) -> Result Error (Html Msg)
+viewProofTree resultMode query (prog, renderProg) =
+    case single prog (prove query |> Bergamot.Rules.andThen reifyProofTree) of
+        Just proofTree -> renderProofTree resultMode proofTree renderProg
+        Nothing -> Ok <| Html.div [ class "bergamot-no-proofs" ] []
+
 view : Model -> Html Msg
-view m = Html.div [ class "bergamot-root" ]
+view m =
-    [ viewSection "Input" <| Html.div []
+    let
+        termOrErr = proofGoal m.editMode m.inputProgram m.query
+        progsOrErr = progAndRenderProg m.program m.renderProgram
+        proofTreeOrErr = combineTwoResults (viewProofTree m.resultMode) termOrErr progsOrErr
+    in
+        Html.div [ class "bergamot-root" ]
+        [ viewSection "Input" <| Html.div [] <|
             [ viewEditModeSelector m.editMode [(Query, "Query"), (Syntax, "Language Term")]
             , Html.input [ type_ "text", onInput SetQuery, value m.query ] []
-        ]
+            ] ++
+            viewIfError termOrErr
         , viewSection "Result" <| Html.div[]
             [ viewResultModeSelector m.resultMode [(Conclusion, "Conclusion Only"), (Tree, "Full Proof Tree")]
-        , viewProofTree m.editMode m.resultMode m.renderProgram m.inputProgram m.program m.query
+            , viewOrError proofTreeOrErr
             ]
-    , viewSection "Rules" <| Html.div []
+        , viewSection "Rules" <| Html.div [] <|
             [ viewTabSelector m.tab [(Rendered, "Rendered"), (Editor, "Editor"), (MetaEditor, "Presentation Rules")]
             , viewTab m.tab
                 (Html.textarea [ onInput SetProgram ] [ Html.text m.program ])
                 (Html.textarea [ onInput SetRenderProgram ] [ Html.text m.renderProgram ])
-            (Html.Lazy.lazy2 viewRules m.renderProgram m.program)
+                (viewRules m.renderProgram m.program)
-        ]
+            ] ++
+            viewIfError progsOrErr
         ]
 
 update : Msg -> Model -> (Model, Cmd Msg)