Merge pull request #5706 from unisonweb/topic/json-replacement

Add builtin replacements for some Json functions

Author: pchiusano

parser-typechecker/src/Unison/Builtin/Decls.hs

@@ -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"
@@ -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)
 
@@ -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
@@ -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

parser-typechecker/src/Unison/Util/Text.hs

@@ -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
 

unison-runtime/src/Unison/Runtime/Builtin.hs

@@ -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 =