remove bad FromJSON instances for now

swarm-game · Nov 19, 2024 · 92465ec · 92465ec
1 parent 422f389
commit 92465ec
Show file tree

Hide file tree

Showing 3 changed files with 34 additions and 42 deletions.
diff --git a/src/swarm-engine/Swarm/Game/CESK.hs b/src/swarm-engine/Swarm/Game/CESK.hs
@@ -169,9 +169,6 @@ data Frame
 instance ToJSON Frame where
   toJSON = genericToJSON optionsMinimize
 
-instance FromJSON Frame where
-  parseJSON = genericParseJSON optionsMinimize
-
 -- | A continuation is just a stack of frames.
 type Cont = [Frame]
 
@@ -184,7 +181,7 @@ type Addr = Int
 -- | 'Store' represents a store, /i.e./ memory, indexing integer
 --   locations to 'Value's.
 data Store = Store {next :: Addr, mu :: IntMap Value}
-  deriving (Show, Eq, Generic, FromJSON, ToJSON)
+  deriving (Show, Eq, Generic, ToJSON)
 
 emptyStore :: Store
 emptyStore = Store 0 IM.empty
@@ -269,9 +266,6 @@ data CESK
 instance ToJSON CESK where
   toJSON = genericToJSON optionsMinimize
 
-instance FromJSON CESK where
-  parseJSON = genericParseJSON optionsMinimize
-
 -- | Is the CESK machine in a final (finished) state?  If so, extract
 --   the final value and store.
 finalValue :: CESK -> Maybe Value

diff --git a/src/swarm-engine/Swarm/Game/State/Substate.hs b/src/swarm-engine/Swarm/Game/State/Substate.hs
@@ -132,7 +132,7 @@ data REPLStatus
     --   entered.  The @Maybe Value@ starts out as 'Nothing' and gets
     --   filled in with a result once the command completes.
     REPLWorking Polytype (Maybe Value)
-  deriving (Eq, Show, Generic, FromJSON, ToJSON)
+  deriving (Eq, Show, Generic)
 
 data WinStatus
   = -- | There are one or more objectives remaining that the player

diff --git a/src/swarm-lang/Swarm/Language/JSON.hs b/src/swarm-lang/Swarm/Language/JSON.hs
@@ -37,40 +37,38 @@ instance ToJSON Syntax
 instance ToJSON Value where
   toJSON = genericToJSON optionsMinimize
 
-instance FromJSONE (CtxMap CtxTree t) Value where
-  parseJSONE = withObjectE "Value" $ \v -> case Ae.toList v of
-    [("VUnit", _)] -> pure VUnit
-    [("VInt", n)] -> VInt <$> liftE (parseJSON n)
-    [("VText", t)] -> VText <$> liftE (parseJSON t)
-    [("VInj", Ae.Array (V.toList -> [i, x]))] -> VInj <$> liftE (parseJSON i) <*> parseJSONE x
-    [("VPair", Ae.Array (V.toList -> [v1,v2]))] -> VPair <$> parseJSONE v1 <*> parseJSONE v2
-    [("VClo", Ae.Array (V.toList -> [x,t,e]))] ->
-      VClo <$> liftE (parseJSON x) <*> liftE (parseJSON t) <*> parseJSONE e
-    [("VCApp", Ae.Array (V.toList -> [c, vs]))] ->
-      VCApp <$> liftE (parseJSON c) <*> parseJSONE vs
-    [("VBind", Ae.Array (V.toList -> [x,ty,r,t1,t2,e]))] ->
-      VBind
-        <$> liftE (parseJSON x)
-        <*> liftE (parseJSON ty)
-        <*> liftE (parseJSON r)
-        <*> liftE (parseJSON t1)
-        <*> liftE (parseJSON t2)
-        <*> parseJSONE e
-    [("VDelay", Ae.Array (V.toList -> [t, e]))] ->
-      VDelay <$> liftE (parseJSON t) <*> parseJSONE e
-    [("VRef", n)] -> VRef <$> liftE (parseJSON n)
-    [("VIndir", n)] -> VIndir <$> liftE (parseJSON n)
-    [("VRcd", m)] -> VRcd <$> parseJSONE m
-    [("VKey", k)] -> VKey <$> liftE (parseJSON k)
-    [("VRequirements", Ae.Array (V.toList -> [txt, t, e]))] ->
-      VRequirements <$> liftE (parseJSON txt) <*> liftE (parseJSON t) <*> parseJSONE e
-    [("VSuspend", Ae.Array (V.toList -> [t, e]))] ->
-      VSuspend <$> liftE (parseJSON t) <*> parseJSONE e
-    [("VExc",_)] -> pure VExc
-    [("VBlackhole",_)] -> pure VBlackhole
+-- instance FromJSONE (CtxMap CtxTree t) Value where
+--   parseJSONE = withObjectE "Value" $ \v -> case Ae.toList v of
+--     [("VUnit", _)] -> pure VUnit
+--     [("VInt", n)] -> VInt <$> liftE (parseJSON n)
+--     [("VText", t)] -> VText <$> liftE (parseJSON t)
+--     [("VInj", Ae.Array (V.toList -> [i, x]))] -> VInj <$> liftE (parseJSON i) <*> parseJSONE x
+--     [("VPair", Ae.Array (V.toList -> [v1, v2]))] -> VPair <$> parseJSONE v1 <*> parseJSONE v2
+--     [("VClo", Ae.Array (V.toList -> [x, t, e]))] ->
+--       VClo <$> liftE (parseJSON x) <*> liftE (parseJSON t) <*> parseJSONE e
+--     [("VCApp", Ae.Array (V.toList -> [c, vs]))] ->
+--       VCApp <$> liftE (parseJSON c) <*> parseJSONE vs
+--     [("VBind", Ae.Array (V.toList -> [x, ty, r, t1, t2, e]))] ->
+--       VBind
+--         <$> liftE (parseJSON x)
+--         <*> liftE (parseJSON ty)
+--         <*> liftE (parseJSON r)
+--         <*> liftE (parseJSON t1)
+--         <*> liftE (parseJSON t2)
+--         <*> parseJSONE e
+--     [("VDelay", Ae.Array (V.toList -> [t, e]))] ->
+--       VDelay <$> liftE (parseJSON t) <*> parseJSONE e
+--     [("VRef", n)] -> VRef <$> liftE (parseJSON n)
+--     [("VIndir", n)] -> VIndir <$> liftE (parseJSON n)
+--     [("VRcd", m)] -> VRcd <$> parseJSONE m
+--     [("VKey", k)] -> VKey <$> liftE (parseJSON k)
+--     [("VRequirements", Ae.Array (V.toList -> [txt, t, e]))] ->
+--       VRequirements <$> liftE (parseJSON txt) <*> liftE (parseJSON t) <*> parseJSONE e
+--     [("VSuspend", Ae.Array (V.toList -> [t, e]))] ->
+--       VSuspend <$> liftE (parseJSON t) <*> parseJSONE e
+--     [("VExc", _)] -> pure VExc
+--     [("VBlackhole", _)] -> pure VBlackhole
+--     _ -> fail "parseJSONE: Unable to parse Value"
 
 instance ToJSON Env where
   toJSON = genericToJSON optionsMinimize
-
-instance FromJSONE (CtxMap CtxTree t) Env where
-  parseJSONE = undefined