From a66c7c8cc4e461083bd4181e96dc0369841e2d5b Mon Sep 17 00:00:00 2001 From: Noah Yorgey Date: Mon, 17 Jun 2024 15:27:54 -0500 Subject: [PATCH 1/2] Stop printing context after a definition. (#1936) Fixes #1336. --- src/swarm-lang/Swarm/Language/Pretty.hs | 10 +++++++++- test/unit/TestLanguagePipeline.hs | 14 ++++++++++++-- 2 files changed, 21 insertions(+), 3 deletions(-) diff --git a/src/swarm-lang/Swarm/Language/Pretty.hs b/src/swarm-lang/Swarm/Language/Pretty.hs index 357d8b57f..3a612a14e 100644 --- a/src/swarm-lang/Swarm/Language/Pretty.hs +++ b/src/swarm-lang/Swarm/Language/Pretty.hs @@ -396,7 +396,7 @@ prettyTypeErr :: Text -> ContextualTypeErr -> Doc ann prettyTypeErr code (CTE l tcStack te) = vcat [ teLoc <> ppr te - , ppr (BulletList "" tcStack) + , ppr (BulletList "" (filterTCStack tcStack)) ] where teLoc = case l of @@ -404,6 +404,14 @@ prettyTypeErr code (CTE l tcStack te) = NoLoc -> emptyDoc showLoc (r, c) = pretty r <> ":" <> pretty c +-- | Filter the TCStack of extravagant Binds. +filterTCStack :: TCStack -> TCStack +filterTCStack tcStack = case tcStack of + [] -> [] + t@(LocatedTCFrame _ (TCDef _)) : _ -> [t] + t@(LocatedTCFrame _ TCBindR) : xs -> t : filterTCStack xs + t@(LocatedTCFrame _ TCBindL) : xs -> t : filterTCStack xs + instance PrettyPrec TypeErr where prettyPrec _ = \case UnificationErr ue -> ppr ue diff --git a/test/unit/TestLanguagePipeline.hs b/test/unit/TestLanguagePipeline.hs index 7cf476bf4..cc7b61dba 100644 --- a/test/unit/TestLanguagePipeline.hs +++ b/test/unit/TestLanguagePipeline.hs @@ -630,14 +630,24 @@ testLanguagePipeline = "1:1: Undefined type U" ) ] + , testCase + "Stop printing context after a definition. - #1336" + ( processCompare + (==) + "move; def x = move; say 3 end; move;" + "1:25: Type mismatch:\n From context, expected `3` to have type `Text`,\n but it actually has type `Int`\n\n - While checking the right-hand side of a semicolon\n - While checking the definition of x" + ) ] where valid = flip process "" process :: Text -> Text -> Assertion - process code expect = case processTerm code of + process = processCompare T.isPrefixOf + + processCompare :: (Text -> Text -> Bool) -> Text -> Text -> Assertion + processCompare cmp code expect = case processTerm code of Left e - | not (T.null expect) && expect `T.isPrefixOf` e -> pure () + | not (T.null expect) && cmp expect e -> pure () | otherwise -> error $ "Unexpected failure:\n\n " <> show e <> "\n\nExpected:\n\n " <> show expect <> "\n" From de12501a563389b96381dbe7f5785657d8d13644 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Tue, 18 Jun 2024 09:27:31 -0500 Subject: [PATCH 2/2] Automatically insert matching close brackets at REPL (#1953) Closes #1952. Whenever you type `(`, `[`, or `{` at the REPL, a matching close bracket is automatically inserted. I suppose the next level would be to have it delete both brackets if you hit backspace immediately after inserting an open bracket, but I'll leave that for another PR. Doesn't seem that important anyway. --- src/swarm-tui/Swarm/TUI/Controller.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/src/swarm-tui/Swarm/TUI/Controller.hs b/src/swarm-tui/Swarm/TUI/Controller.hs index 379fbc666..b7214f913 100644 --- a/src/swarm-tui/Swarm/TUI/Controller.hs +++ b/src/swarm-tui/Swarm/TUI/Controller.hs @@ -40,12 +40,13 @@ module Swarm.TUI.Controller ( import Brick hiding (Direction, Location) import Brick.Focus import Brick.Widgets.Dialog -import Brick.Widgets.Edit (applyEdit, handleEditorEvent) +import Brick.Widgets.Edit (Editor, applyEdit, handleEditorEvent) import Brick.Widgets.List (handleListEvent) import Brick.Widgets.List qualified as BL import Control.Applicative (liftA2, pure) import Control.Carrier.Lift qualified as Fused import Control.Carrier.State.Lazy qualified as Fused +import Control.Category ((>>>)) import Control.Lens as Lens import Control.Lens.Extras as Lens (is) import Control.Monad (forM_, unless, void, when) @@ -66,6 +67,7 @@ import Data.String (fromString) import Data.Text (Text) import Data.Text qualified as T import Data.Text.IO qualified as T +import Data.Text.Zipper qualified as TZ import Data.Text.Zipper.Generic.Words qualified as TZ import Data.Time (getZonedTime) import Data.Vector qualified as V @@ -1206,12 +1208,23 @@ handleREPLEventTyping = \case uiState . uiGameplay . uiREPL . replPromptEditor %= applyEdit TZ.deletePrevWord -- finally if none match pass the event to the editor ev -> do - Brick.zoom (uiState . uiGameplay . uiREPL . replPromptEditor) (handleEditorEvent ev) + Brick.zoom (uiState . uiGameplay . uiREPL . replPromptEditor) $ case ev of + CharKey c | c `elem` ("([{" :: String) -> insertMatchingPair c + _ -> handleEditorEvent ev uiState . uiGameplay . uiREPL . replPromptType %= \case CmdPrompt _ -> CmdPrompt [] -- reset completions on any event passed to editor SearchPrompt a -> SearchPrompt a modify validateREPLForm +insertMatchingPair :: Char -> EventM Name (Editor Text Name) () +insertMatchingPair c = modify . applyEdit $ TZ.insertChar c >>> TZ.insertChar (close c) >>> TZ.moveLeft + where + close = \case + '(' -> ')' + '[' -> ']' + '{' -> '}' + _ -> c + data CompletionType = FunctionName | EntityName