From c484db38844d535d89294c8d91019d2c3f33f303 Mon Sep 17 00:00:00 2001 From: Ben Price Date: Wed, 20 Oct 2021 14:43:27 +0100 Subject: [PATCH] Change API to serialise IDs and Names plainly i.e. we now have '1' and '"foo"' instead of '{unID:1}' and '{unName:"foo"}' Almost all of this commit is testcase churn because of this change.` --- primer-service/src/Primer/OpenAPI.hs | 14 ++++- primer/src/Primer/API.hs | 2 +- primer/src/Primer/Core.hs | 2 +- primer/src/Primer/Name.hs | 2 +- primer/test/fixtures/action.json | 4 +- primer/test/fixtures/actionerror.json | 4 +- primer/test/fixtures/def.json | 16 ++--- primer/test/fixtures/edit_response_1.json | 4 +- primer/test/fixtures/edit_response_2.json | 72 ++++++----------------- primer/test/fixtures/expr.json | 4 +- primer/test/fixtures/id.json | 4 +- primer/test/fixtures/name.json | 4 +- primer/test/fixtures/prog.json | 72 ++++++----------------- primer/test/fixtures/progaction.json | 4 +- primer/test/fixtures/selection.json | 24 ++------ primer/test/fixtures/type.json | 4 +- primer/test/fixtures/typeDef.json | 28 +++------ 17 files changed, 75 insertions(+), 189 deletions(-) diff --git a/primer-service/src/Primer/OpenAPI.hs b/primer-service/src/Primer/OpenAPI.hs index 58c001a67..26359c723 100644 --- a/primer-service/src/Primer/OpenAPI.hs +++ b/primer-service/src/Primer/OpenAPI.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Primer.OpenAPI ( @@ -6,9 +7,10 @@ module Primer.OpenAPI ( ) where import Data.OpenApi (ToSchema) +import Data.Text (Text) import Primer.API (APIDef, APIProg, Tree) import Primer.App (InitialApp) -import Primer.Core (ID) +import Primer.Core (ID (..)) import Primer.Database (Session, SessionName) import Primer.Name (Name) @@ -22,8 +24,14 @@ import Primer.Name (Name) instance ToSchema SessionName instance ToSchema Session instance ToSchema InitialApp -instance ToSchema ID -instance ToSchema Name + +-- We need to GND the ID instance to matche its To/FromJSON instances +deriving newtype instance ToSchema ID + +-- We can't GND derive for Name as it is an opaque class +-- But the JSON instance is done by GND, so we must match here... +-- This instance works because the parameter has a phantom role! +deriving via Text instance (ToSchema Name) instance ToSchema Tree instance ToSchema APIDef instance ToSchema APIProg diff --git a/primer/src/Primer/API.hs b/primer/src/Primer/API.hs index 3631a8ae4..8967f3619 100644 --- a/primer/src/Primer/API.hs +++ b/primer/src/Primer/API.hs @@ -277,7 +277,7 @@ getProgram sid = withSession' sid $ QueryApp $ viewProg . handleGetProgramReques -- just enough information to render nicely. -- (NB: currently this is just a first draft, and is expected to evolve.) data Tree = Tree - { nodeId :: ID -- REVIEW: here, and in APIDef we maybe want a raw Int, as IDs serialise as '{unID: 5}' + { nodeId :: ID , label :: Text , children :: [Tree] } diff --git a/primer/src/Primer/Core.hs b/primer/src/Primer/Core.hs index 6e7859dcc..40e8f0a39 100644 --- a/primer/src/Primer/Core.hs +++ b/primer/src/Primer/Core.hs @@ -64,7 +64,7 @@ newtype ID = ID {unID :: Int} -- The Ord and Enum instances are useful for tests but we may remove them in -- future, so don't use them in app code. deriving newtype (Show, Num, Ord, Enum) - deriving (FromJSON, ToJSON) via VJSON ID + deriving newtype (FromJSON, ToJSON) instance ToJSONKey ID diff --git a/primer/src/Primer/Name.hs b/primer/src/Primer/Name.hs index 1c2ec2804..654a73af5 100644 --- a/primer/src/Primer/Name.hs +++ b/primer/src/Primer/Name.hs @@ -23,7 +23,7 @@ import Primer.JSON newtype Name = Name {unName :: Text} deriving (Eq, Ord, Generic, Data) deriving newtype (Show, IsString) - deriving (FromJSON, ToJSON) via VJSON Name + deriving newtype (FromJSON, ToJSON) -- | Construct a name from a Text. This is called unsafe because there are no -- guarantees about whether the name refers to anything that is in scope. diff --git a/primer/test/fixtures/action.json b/primer/test/fixtures/action.json index 0b8adf0e5..834c280fd 100644 --- a/primer/test/fixtures/action.json +++ b/primer/test/fixtures/action.json @@ -1,6 +1,4 @@ { - "contents": { - "unID": 0 - }, + "contents": 0, "tag": "SetCursor" } \ No newline at end of file diff --git a/primer/test/fixtures/actionerror.json b/primer/test/fixtures/actionerror.json index 610d019f0..26e8a96a3 100644 --- a/primer/test/fixtures/actionerror.json +++ b/primer/test/fixtures/actionerror.json @@ -1,6 +1,4 @@ { - "contents": { - "unID": 0 - }, + "contents": 0, "tag": "IDNotFound" } \ No newline at end of file diff --git a/primer/test/fixtures/def.json b/primer/test/fixtures/def.json index 26497389a..19c3eb0e4 100644 --- a/primer/test/fixtures/def.json +++ b/primer/test/fixtures/def.json @@ -1,9 +1,7 @@ { "defExpr": { "contents": [ - { - "unID": 0 - }, + 0, { "contents": { "contents": [], @@ -15,17 +13,11 @@ ], "tag": "EmptyHole" }, - "defID": { - "unID": 1 - }, - "defName": { - "unName": "main" - }, + "defID": 1, + "defName": "main", "defType": { "contents": [ - { - "unID": 0 - }, + 0, { "tag": "KType" }, diff --git a/primer/test/fixtures/edit_response_1.json b/primer/test/fixtures/edit_response_1.json index 8d5bee8ca..fc4a18aa6 100644 --- a/primer/test/fixtures/edit_response_1.json +++ b/primer/test/fixtures/edit_response_1.json @@ -1,8 +1,6 @@ { "contents": { - "contents": { - "unID": 0 - }, + "contents": 0, "tag": "IDNotFound" }, "tag": "Error" diff --git a/primer/test/fixtures/edit_response_2.json b/primer/test/fixtures/edit_response_2.json index 7b6fbdea0..ce3a01aa9 100644 --- a/primer/test/fixtures/edit_response_2.json +++ b/primer/test/fixtures/edit_response_2.json @@ -2,15 +2,11 @@ "contents": { "progDefs": [ [ - { - "unID": 1 - }, + 1, { "defExpr": { "contents": [ - { - "unID": 0 - }, + 0, { "contents": { "contents": [], @@ -22,17 +18,11 @@ ], "tag": "EmptyHole" }, - "defID": { - "unID": 1 - }, - "defName": { - "unName": "main" - }, + "defID": 1, + "defName": "main", "defType": { "contents": [ - { - "unID": 0 - }, + 0, { "tag": "KType" }, @@ -64,9 +54,7 @@ "selectedDef": { "defExpr": { "contents": [ - { - "unID": 0 - }, + 0, { "contents": { "contents": [], @@ -78,17 +66,11 @@ ], "tag": "EmptyHole" }, - "defID": { - "unID": 1 - }, - "defName": { - "unName": "main" - }, + "defID": 1, + "defName": "main", "defType": { "contents": [ - { - "unID": 0 - }, + 0, { "tag": "KType" }, @@ -100,9 +82,7 @@ "selectedNode": { "meta": { "Left": [ - { - "unID": 0 - }, + 0, { "contents": { "contents": [], @@ -113,9 +93,7 @@ null ] }, - "nodeId": { - "unID": 0 - }, + "nodeId": 0, "nodeType": { "tag": "BodyNode" } @@ -135,18 +113,14 @@ { "contents": [ [], - { - "unName": "b" - } + "b" ], "tag": "TCon" }, { "contents": [ [], - { - "unName": "a" - } + "a" ], "tag": "TCon" } @@ -156,35 +130,25 @@ { "contents": [ [], - { - "unName": "Nat" - } + "Nat" ], "tag": "TCon" } ], - "valConName": { - "unName": "C" - } + "valConName": "C" } ], - "typeDefName": { - "unName": "T" - }, + "typeDefName": "T", "typeDefNameHints": [], "typeDefParameters": [ [ - { - "unName": "a" - }, + "a", { "tag": "KType" } ], [ - { - "unName": "b" - }, + "b", { "contents": [ { diff --git a/primer/test/fixtures/expr.json b/primer/test/fixtures/expr.json index 19374dacb..69fa63969 100644 --- a/primer/test/fixtures/expr.json +++ b/primer/test/fixtures/expr.json @@ -1,8 +1,6 @@ { "contents": [ - { - "unID": 0 - }, + 0, { "contents": { "contents": [], diff --git a/primer/test/fixtures/id.json b/primer/test/fixtures/id.json index 8e5d1b35f..c22708346 100644 --- a/primer/test/fixtures/id.json +++ b/primer/test/fixtures/id.json @@ -1,3 +1 @@ -{ - "unID": 0 -} \ No newline at end of file +0 \ No newline at end of file diff --git a/primer/test/fixtures/name.json b/primer/test/fixtures/name.json index a6d6abbbd..3403a0c7f 100644 --- a/primer/test/fixtures/name.json +++ b/primer/test/fixtures/name.json @@ -1,3 +1 @@ -{ - "unName": "x" -} \ No newline at end of file +"x" \ No newline at end of file diff --git a/primer/test/fixtures/prog.json b/primer/test/fixtures/prog.json index 8a0d08f57..37ac24afe 100644 --- a/primer/test/fixtures/prog.json +++ b/primer/test/fixtures/prog.json @@ -1,15 +1,11 @@ { "progDefs": [ [ - { - "unID": 1 - }, + 1, { "defExpr": { "contents": [ - { - "unID": 0 - }, + 0, { "contents": { "contents": [], @@ -21,17 +17,11 @@ ], "tag": "EmptyHole" }, - "defID": { - "unID": 1 - }, - "defName": { - "unName": "main" - }, + "defID": 1, + "defName": "main", "defType": { "contents": [ - { - "unID": 0 - }, + 0, { "tag": "KType" }, @@ -63,9 +53,7 @@ "selectedDef": { "defExpr": { "contents": [ - { - "unID": 0 - }, + 0, { "contents": { "contents": [], @@ -77,17 +65,11 @@ ], "tag": "EmptyHole" }, - "defID": { - "unID": 1 - }, - "defName": { - "unName": "main" - }, + "defID": 1, + "defName": "main", "defType": { "contents": [ - { - "unID": 0 - }, + 0, { "tag": "KType" }, @@ -99,9 +81,7 @@ "selectedNode": { "meta": { "Left": [ - { - "unID": 0 - }, + 0, { "contents": { "contents": [], @@ -112,9 +92,7 @@ null ] }, - "nodeId": { - "unID": 0 - }, + "nodeId": 0, "nodeType": { "tag": "BodyNode" } @@ -134,18 +112,14 @@ { "contents": [ [], - { - "unName": "b" - } + "b" ], "tag": "TCon" }, { "contents": [ [], - { - "unName": "a" - } + "a" ], "tag": "TCon" } @@ -155,35 +129,25 @@ { "contents": [ [], - { - "unName": "Nat" - } + "Nat" ], "tag": "TCon" } ], - "valConName": { - "unName": "C" - } + "valConName": "C" } ], - "typeDefName": { - "unName": "T" - }, + "typeDefName": "T", "typeDefNameHints": [], "typeDefParameters": [ [ - { - "unName": "a" - }, + "a", { "tag": "KType" } ], [ - { - "unName": "b" - }, + "b", { "contents": [ { diff --git a/primer/test/fixtures/progaction.json b/primer/test/fixtures/progaction.json index 2e0e4dec5..6303f85fb 100644 --- a/primer/test/fixtures/progaction.json +++ b/primer/test/fixtures/progaction.json @@ -1,6 +1,4 @@ { - "contents": { - "unID": 0 - }, + "contents": 0, "tag": "MoveToDef" } \ No newline at end of file diff --git a/primer/test/fixtures/selection.json b/primer/test/fixtures/selection.json index 92480f322..798af6aef 100644 --- a/primer/test/fixtures/selection.json +++ b/primer/test/fixtures/selection.json @@ -2,9 +2,7 @@ "selectedDef": { "defExpr": { "contents": [ - { - "unID": 0 - }, + 0, { "contents": { "contents": [], @@ -16,17 +14,11 @@ ], "tag": "EmptyHole" }, - "defID": { - "unID": 1 - }, - "defName": { - "unName": "main" - }, + "defID": 1, + "defName": "main", "defType": { "contents": [ - { - "unID": 0 - }, + 0, { "tag": "KType" }, @@ -38,9 +30,7 @@ "selectedNode": { "meta": { "Left": [ - { - "unID": 0 - }, + 0, { "contents": { "contents": [], @@ -51,9 +41,7 @@ null ] }, - "nodeId": { - "unID": 0 - }, + "nodeId": 0, "nodeType": { "tag": "BodyNode" } diff --git a/primer/test/fixtures/type.json b/primer/test/fixtures/type.json index de8c0b92f..2596b3c9c 100644 --- a/primer/test/fixtures/type.json +++ b/primer/test/fixtures/type.json @@ -1,8 +1,6 @@ { "contents": [ - { - "unID": 0 - }, + 0, { "tag": "KType" }, diff --git a/primer/test/fixtures/typeDef.json b/primer/test/fixtures/typeDef.json index fbe1f3764..6b0fbd173 100644 --- a/primer/test/fixtures/typeDef.json +++ b/primer/test/fixtures/typeDef.json @@ -8,18 +8,14 @@ { "contents": [ [], - { - "unName": "b" - } + "b" ], "tag": "TCon" }, { "contents": [ [], - { - "unName": "a" - } + "a" ], "tag": "TCon" } @@ -29,35 +25,25 @@ { "contents": [ [], - { - "unName": "Nat" - } + "Nat" ], "tag": "TCon" } ], - "valConName": { - "unName": "C" - } + "valConName": "C" } ], - "typeDefName": { - "unName": "T" - }, + "typeDefName": "T", "typeDefNameHints": [], "typeDefParameters": [ [ - { - "unName": "a" - }, + "a", { "tag": "KType" } ], [ - { - "unName": "b" - }, + "b", { "contents": [ {