generalize read

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

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"