Skip to content

Add builtin replacements for some Json functions #5706

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 9 commits into from
May 18, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
57 changes: 56 additions & 1 deletion parser-typechecker/src/Unison/Builtin/Decls.hs
Original file line number Diff line number Diff line change
Expand Up @@ -125,6 +125,19 @@ mapBin = Maybe.fromJust $ constructorId mapRef "Map.Bin"
setWrap :: ConstructorId
setWrap = Maybe.fromJust $ constructorId setRef "Set.Set"

jsonNull, jsonBool, jsonObj, jsonNum, jsonText, jsonArr :: ConstructorId
jsonNull = Maybe.fromJust $ constructorId jsonRef "Json.Null"
jsonBool = Maybe.fromJust $ constructorId jsonRef "Json.Boolean"
jsonObj = Maybe.fromJust $ constructorId jsonRef "Json.Object"
jsonNum = Maybe.fromJust $ constructorId jsonRef "Json.Number.Unparsed"
jsonText = Maybe.fromJust $ constructorId jsonRef "Json.Text"
jsonArr = Maybe.fromJust $ constructorId jsonRef "Json.Array"

jsonParseError :: ConstructorId
jsonParseError =
Maybe.fromJust $
constructorId parseErrorRef "Json.ParseError.ParseError"

isPropagatedConstructorId = Maybe.fromJust $ constructorId isPropagatedRef "IsPropagated.IsPropagated"

isTestConstructorId = Maybe.fromJust $ constructorId isTestRef "IsTest.IsTest"
Expand Down Expand Up @@ -260,6 +273,12 @@ mapRef = lookupDeclRef "Map"
setRef :: Reference
setRef = lookupDeclRef "Set"

jsonRef :: Reference
jsonRef = lookupDeclRef "Json"

parseErrorRef :: Reference
parseErrorRef = lookupDeclRef "Json.ParseError"

pattern Rewrites' :: [Term2 vt at ap v a] -> Term2 vt at ap v a
pattern Rewrites' ts <- (unRewrites -> Just ts)

Expand Down Expand Up @@ -316,7 +335,9 @@ builtinDataDecls = rs1 ++ rs
(v "RewriteCase", rewriteCase),
(v "Rewrites", rewrites),
(v "Map", map),
(v "Set", set)
(v "Set", set),
(v "Json", json),
(v "Json.ParseError", jsonParseError)
] of
Right a -> a
Left e -> error $ "builtinDataDecls: " <> show e
Expand Down Expand Up @@ -649,6 +670,40 @@ builtinDataDecls = rs1 ++ rs
)
]

json =
DataDeclaration
(Unique "oml0j9g6bb2tij2s75k4v7n1nftj199i")
()
[]
let json = var "Json"
tup x y = Type.apps' (var "Tuple") [x, y]
pair x y = tup x (tup y (var "Unit"))
in [ ((), v "Json.Null", var "Json"),
((), v "Json.Boolean", Type.boolean () `arr` json),
( (),
v "Json.Object",
Type.app () (Type.list ()) (pair (Type.text ()) json)
`arr` json
),
((), v "Json.Number.Unparsed", Type.text () `arr` json),
((), v "Json.Text", Type.text () `arr` json),
( (),
v "Json.Array",
Type.app () (Type.list ()) json `arr` json
)
]
jsonParseError =
DataDeclaration
(Unique "u3j6g9j6daejijc5e0rcujjj3sd6j3gq")
()
[]
let jpe = var "Json.ParseError"
in [ ( (),
v "Json.ParseError.ParseError",
Type.text () `arr` Type.nat () `arr` Type.text () `arr` jpe
)
]

builtinEffectDecls :: [(Symbol, Reference.Id, DD.EffectDeclaration Symbol ())]
builtinEffectDecls =
case hashDataDecls $ Map.fromList [(v "Exception", exception)] of
Expand Down
4 changes: 4 additions & 0 deletions parser-typechecker/src/Unison/Util/Text.hs
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,10 @@ replicate n t =
toLazyText :: Text -> TL.Text
toLazyText (Text t) = TL.fromChunks (chunkToText <$> toList t)

fromLazyText :: TL.Text -> Text
fromLazyText =
Text . foldl' (\t -> R.snoc t . chunk) mempty . TL.toChunks

chunkToText :: Chunk -> T.Text
chunkToText (Chunk _ t) = t

Expand Down
3 changes: 3 additions & 0 deletions unison-runtime/src/Unison/Runtime/Builtin.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1296,6 +1296,9 @@ declareForeigns = do
declareForeign Untracked 2 Set_union
declareForeign Untracked 2 Set_intersect
declareForeign Untracked 1 Set_toList
declareForeign Untracked 1 Json_toText
declareForeign Untracked 1 Json_unconsText
declareForeign Untracked 1 Json_tryUnconsText

foreignDeclResults :: (Map ForeignFunc (Sandbox, SuperNormal Symbol))
foreignDeclResults =
Expand Down
Loading