From 8a6710c8a9c773c00a844c641665e3ef670d7395 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Fri, 3 Jan 2025 13:15:53 -0600 Subject: [PATCH] generalize read --- src/swarm-lang/Swarm/Language/Parser/Value.hs | 19 +++++++++++++++++-- test/unit/TestEval.hs | 10 ++++++++++ 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/src/swarm-lang/Swarm/Language/Parser/Value.hs b/src/swarm-lang/Swarm/Language/Parser/Value.hs index 107454208..07f320cee 100644 --- a/src/swarm-lang/Swarm/Language/Parser/Value.hs +++ b/src/swarm-lang/Swarm/Language/Parser/Value.hs @@ -8,7 +8,6 @@ -- of the proper type. module Swarm.Language.Parser.Value (readValue) where -import Control.Applicative ((<|>)) import Control.Lens ((^.)) import Data.Either.Extra (eitherToMaybe) import Data.Text (Text) @@ -24,7 +23,23 @@ import Text.Megaparsec qualified as MP readValue :: Type -> Text -> Maybe Value readValue ty txt = do - txt' <- T.stripPrefix "paper:" txt <|> pure txt + -- Try to strip off a prefix representing a printable entity. Look + -- for the first colon or double quote. We will ignore a colon if a + -- double quote comes before it, because a colon could legitimately + -- occur in a formatted Text value, e.g. "\"hi: there\"". Otherwise, + -- strip off anything occurring before the first colon. + -- + -- Note, this would break if we ever had a printable entity whose + -- name contains a colon; printing on such an entity would yield + -- entity names like "Magic: The Gathering: 6" for which `read`, as + -- implemented here, would not work correctly. However, that seems + -- unlikely. + let firstUnquotedColon = T.dropWhile (\c -> c /= ':' && c /= '"') txt + let txt' = case T.uncons firstUnquotedColon of + Nothing -> txt + Just ('"', _) -> txt + Just (':', t) -> t + _ -> txt s <- eitherToMaybe $ readNonemptyTerm txt' _ <- eitherToMaybe $ checkTop Ctx.empty Ctx.empty Ctx.empty s ty toValue $ s ^. sTerm diff --git a/test/unit/TestEval.hs b/test/unit/TestEval.hs index 0a4a94252..3ae51b058 100644 --- a/test/unit/TestEval.hs +++ b/test/unit/TestEval.hs @@ -391,6 +391,16 @@ testEval g = ( "read \"paper: (3, false, ())\" : Int * Bool * Unit" `evaluatesToV` (3 :: Integer, (False, ())) ) + , testCase + "read random entity with tuple" + ( "read \"foo: (3, false, ())\" : Int * Bool * Unit" + `evaluatesToV` (3 :: Integer, (False, ())) + ) + , testCase + "read Text value containing colon" + ( "read \"\\\"hi: there\\\"\" : Text" + `evaluatesToV` ("hi: there" :: Text) + ) ] , testGroup "records - #1093"