fix: Remove unsafe FromJSON Name instance

Because it used `deriving newtype`, this instance constructed names without any validation, similarly to `unsafeMkName`. While we don't currently have any name validation, we expect that we will soon move to a "smart constructor" approach, ripping out most uses of `unsafeMkName`. We don't then want `fromJSON @Name` to remain as a validation-skipping backdoor.

An alternative would be to use our smart constructor (i.e. `safeMkName`) in a manual implementation of `fromJSON`. But given that the instance is unused (other than to define more unused instances for types which contain `Name`), we may as well just remove it.

N.B. This instance has been around since our old prototype frontend, and may have been useful back then.

Author: georgefst

primer/src/Primer/API.hs

@@ -1170,7 +1170,7 @@ data ApplyActionBody = ApplyActionBody
   , option :: Available.Option
   }
   deriving (Generic, Show)
-  deriving (FromJSON, ToJSON) via PrimerJSON ApplyActionBody
+  deriving (ToJSON) via PrimerJSON ApplyActionBody
 
 applyActions :: (MonadIO m, MonadThrow m, MonadAPILog l m) => ExprTreeOpts -> SessionId -> [ProgAction] -> PrimerM m Prog
 applyActions opts sid actions =
@@ -1185,7 +1185,7 @@ data Selection = Selection
   , node :: Maybe NodeSelection
   }
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON Selection
+  deriving (ToJSON) via PrimerJSON Selection
 
 viewSelection :: App.Selection -> Selection
 viewSelection App.Selection{..} = Selection{def = selectedDef, node = viewNodeSelection <$> selectedNode}

primer/src/Primer/Action/Actions.hs

@@ -6,7 +6,7 @@ module Primer.Action.Actions (
 
 import Foreword
 
-import Data.Aeson (FromJSON (..), ToJSON (..), Value)
+import Data.Aeson (ToJSON (..), Value)
 import Primer.Core (PrimCon)
 import Primer.Core.Meta (ID, TmVarRef, ValConName)
 import Primer.JSON (CustomJSON (..), PrimerJSON)
@@ -102,9 +102,9 @@ data Action
   | -- | Rename a case binding
     RenameCaseBinding Text
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON Action
+  deriving (ToJSON) via PrimerJSON Action
 
 -- | Core movements
 data Movement = Child1 | Child2 | Parent | Branch ValConName
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON Movement
+  deriving (ToJSON) via PrimerJSON Movement

primer/src/Primer/Action/Errors.hs

@@ -9,7 +9,7 @@ module Primer.Action.Errors (ActionError (..)) where
 
 import Foreword
 
-import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Aeson (ToJSON (..))
 import Primer.Action.Actions (Action)
 import Primer.Action.Available qualified as Available
 import Primer.Core (Expr, GVarName, ID, LVarName, ModuleName, Type)
@@ -63,4 +63,4 @@ data ActionError
   | NeedChar Available.Option
   | NoNodeSelection
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON ActionError
+  deriving (ToJSON) via PrimerJSON ActionError

primer/src/Primer/Action/ProgAction.hs

@@ -10,7 +10,7 @@ module Primer.Action.ProgAction (ProgAction (..)) where
 
 import Foreword
 
-import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Aeson (ToJSON (..))
 import Primer.Action.Actions (Action)
 import Primer.Core.Meta (GVarName, ID, ModuleName, TyConName, TyVarName, ValConName)
 import Primer.Core.Type (Type')
@@ -64,4 +64,4 @@ data ProgAction
   | -- | Renames an editable module (will return an error if asked to rename an imported module)
     RenameModule ModuleName (NonEmpty Text)
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON ProgAction
+  deriving (ToJSON) via PrimerJSON ProgAction

primer/src/Primer/Action/ProgError.hs

@@ -2,7 +2,7 @@ module Primer.Action.ProgError (ProgError (..)) where
 
 import Foreword
 
-import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Aeson (ToJSON (..))
 import Primer.Action.Errors (ActionError)
 import Primer.Core.Meta (GVarName, ModuleName, TyConName, TyVarName, ValConName)
 import Primer.Eval.EvalError (EvalError)
@@ -44,4 +44,4 @@ data ProgError
   | -- | Cannot edit an imported module
     ModuleReadonly ModuleName
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON ProgError
+  deriving (ToJSON) via PrimerJSON ProgError

primer/src/Primer/App.hs

@@ -230,7 +230,7 @@ data Prog = Prog
   , progLog :: Log -- The log of all actions
   }
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON Prog
+  deriving (ToJSON) via PrimerJSON Prog
 
 -- | The default 'Prog'. It has no imports, no definitions, no current
 -- 'Selection', and an empty 'Log'. Smart holes are enabled.
@@ -379,7 +379,7 @@ allDefs = fmap snd . progAllDefs
 --  Items are stored in reverse order so it's quick to add new ones.
 newtype Log = Log {unlog :: [[ProgAction]]}
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON Log
+  deriving (ToJSON) via PrimerJSON Log
 
 -- | The default (empty) 'Log'.
 defaultLog :: Log
@@ -393,7 +393,7 @@ data Selection = Selection
   , selectedNode :: Maybe NodeSelection
   }
   deriving (Eq, Show, Generic, Data)
-  deriving (FromJSON, ToJSON) via PrimerJSON Selection
+  deriving (ToJSON) via PrimerJSON Selection
 
 -- | A selected node, in the body or type signature of some definition.
 -- We have the following invariant: @nodeType = SigNode ==> isRight meta@
@@ -402,7 +402,7 @@ data NodeSelection = NodeSelection
   , meta :: Either ExprMeta TypeMeta
   }
   deriving (Eq, Show, Generic, Data)
-  deriving (FromJSON, ToJSON) via PrimerJSON NodeSelection
+  deriving (ToJSON) via PrimerJSON NodeSelection
 
 instance HasID NodeSelection where
   _id =
@@ -415,37 +415,37 @@ data MutationRequest
   = Undo
   | Edit [ProgAction]
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON MutationRequest
+  deriving (ToJSON) via PrimerJSON MutationRequest
 
 data EvalReq = EvalReq
   { evalReqExpr :: Expr
   , evalReqRedex :: ID
   }
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON EvalReq
+  deriving (ToJSON) via PrimerJSON EvalReq
 
 data EvalResp = EvalResp
   { evalRespExpr :: Expr
   , evalRespRedexes :: [ID]
   , evalRespDetail :: EvalDetail
   }
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON EvalResp
+  deriving (ToJSON) via PrimerJSON EvalResp
 
 data EvalFullReq = EvalFullReq
   { evalFullReqExpr :: Expr
   , evalFullCxtDir :: Dir -- is this expression in a syn/chk context, so we can tell if is an embedding.
   , evalFullMaxSteps :: TerminationBound
   }
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON EvalFullReq
+  deriving (ToJSON) via PrimerJSON EvalFullReq
 
 -- If we time out, we still return however far we got
 data EvalFullResp
   = EvalFullRespTimedOut Expr
   | EvalFullRespNormal Expr
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON EvalFullResp
+  deriving (ToJSON) via PrimerJSON EvalFullResp
 
 -- * Request handlers
 
@@ -1049,7 +1049,7 @@ data App = App
   , initialState :: AppState
   }
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON App
+  deriving (ToJSON) via PrimerJSON App
 
 -- Internal app state. Note that this type is not exported, as we want
 -- to guarantee that the counters are kept in sync with the 'Prog',
@@ -1061,7 +1061,7 @@ data AppState = AppState
   , prog :: Prog
   }
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON AppState
+  deriving (ToJSON) via PrimerJSON AppState
 
 -- | Construct an 'App' from an 'ID' and a 'Prog'.
 --

primer/src/Primer/Core.hs

@@ -95,7 +95,7 @@ data TypeCache
   | TCChkedAt (Type' ())
   | TCEmb TypeCacheBoth
   deriving (Eq, Show, Generic, Data)
-  deriving (FromJSON, ToJSON) via PrimerJSON TypeCache
+  deriving (ToJSON) via PrimerJSON TypeCache
   deriving anyclass (NFData)
 
 -- We were checking at the first, but term was synthesisable and synth'd the
@@ -104,7 +104,7 @@ data TypeCache
 -- though, to make it clear what each one is!
 data TypeCacheBoth = TCBoth {tcChkedAt :: Type' (), tcSynthed :: Type' ()}
   deriving (Eq, Show, Generic, Data)
-  deriving (FromJSON, ToJSON) via PrimerJSON TypeCacheBoth
+  deriving (ToJSON) via PrimerJSON TypeCacheBoth
   deriving anyclass (NFData)
 
 -- TODO `_chkedAt` and `_synthed` should be `AffineTraversal`s,
@@ -182,7 +182,7 @@ data Expr' a b
   | Case a (Expr' a b) [CaseBranch' a b] -- See Note [Case]
   | PrimCon a PrimCon
   deriving (Eq, Show, Data, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON (Expr' a b)
+  deriving (ToJSON) via PrimerJSON (Expr' a b)
   deriving anyclass (NFData)
 
 -- Note [Synthesisable constructors]
@@ -257,7 +257,7 @@ data CaseBranch' a b
       (Expr' a b)
       -- ^ right hand side
   deriving (Eq, Show, Data, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON (CaseBranch' a b)
+  deriving (ToJSON) via PrimerJSON (CaseBranch' a b)
   deriving anyclass (NFData)
 
 -- | Variable bindings
@@ -267,7 +267,7 @@ type Bind = Bind' ExprMeta
 
 data Bind' a = Bind a LVarName
   deriving (Eq, Show, Data, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON (Bind' a)
+  deriving (ToJSON) via PrimerJSON (Bind' a)
   deriving anyclass (NFData)
 
 bindName :: Bind' a -> LVarName

primer/src/Primer/Core/Meta.hs

@@ -77,7 +77,7 @@ trivialMeta id = Meta id Nothing Nothing
 
 newtype ModuleName = ModuleName {unModuleName :: NonEmpty Name}
   deriving (Eq, Ord, Show, Data, Generic)
-  deriving (FromJSON, ToJSON) via NonEmpty Name
+  deriving (ToJSON) via NonEmpty Name
   deriving anyclass (NFData)
 
 -- | Helper function for simple (non-hierarchical) module names.
@@ -103,7 +103,7 @@ data GlobalName (k :: GlobalNameKind) = GlobalName
   , baseName :: Name
   }
   deriving (Eq, Ord, Generic, Data, Show)
-  deriving (FromJSON, ToJSON) via PrimerJSON (GlobalName k)
+  deriving (ToJSON) via PrimerJSON (GlobalName k)
   deriving anyclass (NFData)
 
 -- | Construct a name from a Text. This is called unsafe because there are no
@@ -129,7 +129,7 @@ data LocalNameKind
 newtype LocalName (k :: LocalNameKind) = LocalName {unLocalName :: Name}
   deriving (Eq, Ord, Show, Data, Generic)
   deriving (IsString) via Name
-  deriving (FromJSON, ToJSON) via Name
+  deriving (ToJSON) via Name
   deriving anyclass (NFData)
 
 unsafeMkLocalName :: Text -> LocalName k
@@ -143,7 +143,7 @@ data TmVarRef
   = GlobalVarRef GVarName
   | LocalVarRef LVarName
   deriving (Eq, Show, Data, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON TmVarRef
+  deriving (ToJSON) via PrimerJSON TmVarRef
   deriving anyclass (NFData)
 
 -- | A class for types which have an ID.

primer/src/Primer/Core/Type.hs

@@ -59,7 +59,7 @@ data Type' a
       (Type' a)
       -- ^ body of the let; binding scopes over this
   deriving (Eq, Show, Data, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON (Type' a)
+  deriving (ToJSON) via PrimerJSON (Type' a)
   deriving anyclass (NFData)
 
 -- | A traversal over the metadata of a type

primer/src/Primer/Def.hs

@@ -21,7 +21,6 @@ import Primer.Core (
 import Primer.Core.Utils (forgetTypeMetadata)
 import Primer.JSON (
   CustomJSON (CustomJSON),
-  FromJSON,
   PrimerJSON,
   ToJSON,
  )
@@ -31,7 +30,7 @@ data Def
   = DefPrim PrimDef
   | DefAST ASTDef
   deriving (Eq, Show, Data, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON Def
+  deriving (ToJSON) via PrimerJSON Def
   deriving anyclass (NFData)
 
 defType :: Def -> Type' ()
@@ -48,7 +47,7 @@ data ASTDef = ASTDef
   , astDefType :: Type
   }
   deriving (Eq, Show, Data, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON ASTDef
+  deriving (ToJSON) via PrimerJSON ASTDef
   deriving anyclass (NFData)
 
 defAST :: Def -> Maybe ASTDef