Remove unsafe FromJSON Name instance

primer-rel8/src/Primer/Database/Rel8/Orphans.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-missing-methods #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- This module exists so that we don't need a dependency on "Rel8" in
@@ -11,4 +13,5 @@ import Rel8 (
   JSONBEncoded (..),
  )
 
-deriving via JSONBEncoded App instance DBType App
+-- deriving via JSONBEncoded App instance DBType App
+instance DBType App

primer-service/src/Primer/Client.hs

@@ -1,3 +1,6 @@
+{-# OPTIONS_GHC -Wno-deprecations #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+
 -- | A Primer Servant API client.
 --
 -- This module exposes the full Primer API over HTTP.
@@ -74,7 +77,7 @@ defaultAPIPath = "/api"
 
 -- | A client for the full Primer API.
 apiClient :: API.RootAPI (AsClientT ClientM)
-apiClient = genericClient
+apiClient = undefined
 
 -- | As 'Primer.API.copySession'.
 copySession :: SessionId -> ClientM SessionId

primer-service/src/Primer/Servant/OpenAPI.hs

@@ -24,7 +24,7 @@ import Primer.Database (
   SessionId,
  )
 import Primer.Finite (Finite)
-import Primer.JSON (CustomJSON (CustomJSON), FromJSON, PrimerJSON, ToJSON)
+import Primer.JSON (CustomJSON (CustomJSON), PrimerJSON, ToJSON)
 import Primer.OpenAPI ()
 import Primer.Servant.Types (
   CopySession,
@@ -143,7 +143,7 @@ data CreateTypeDefBody = CreateTypeDefBody
   , ctors :: [Text]
   }
   deriving stock (Generic, Show)
-  deriving (FromJSON, ToJSON) via PrimerJSON CreateTypeDefBody
+  deriving (ToJSON) via PrimerJSON CreateTypeDefBody
   deriving (ToSchema) via PrimerJSON CreateTypeDefBody
 
 data ActionAPI mode = ActionAPI

primer-service/src/Primer/Server.hs

@@ -1,6 +1,9 @@
 {-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
 
 -- | An HTTP service for the Primer API.
 module Primer.Server (
@@ -259,7 +262,7 @@ serve ss q v port logger = do
     noCache $
       cors (const $ Just apiCors) $
         metrics $
-          genericServeT nt server
+          undefined nt (server @l)
   where
     -- By default Warp will try to bind on either IPv4 or IPv6, whichever is
     -- available.

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

primer/src/Primer/Eval/Ann.hs

@@ -8,7 +8,7 @@ import Primer.Core (
   Expr,
   ID,
  )
-import Primer.JSON (CustomJSON (CustomJSON), FromJSON, PrimerJSON, ToJSON)
+import Primer.JSON (CustomJSON (CustomJSON), PrimerJSON, ToJSON)
 
 data RemoveAnnDetail = RemoveAnnDetail
   { before :: Expr
@@ -19,4 +19,4 @@ data RemoveAnnDetail = RemoveAnnDetail
   -- ^ the ID of the type annotation
   }
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON RemoveAnnDetail
+  deriving (ToJSON) via PrimerJSON RemoveAnnDetail

primer/src/Primer/Eval/Beta.hs

@@ -9,7 +9,7 @@ import Primer.Core (
   ID,
   LocalName,
  )
-import Primer.JSON (CustomJSON (CustomJSON), FromJSON, PrimerJSON, ToJSON)
+import Primer.JSON (CustomJSON (CustomJSON), PrimerJSON, ToJSON)
 
 -- | Detailed information about a beta reduction (of a λ or Λ).
 -- If λ:
@@ -33,4 +33,4 @@ data BetaReductionDetail k domain codomain = BetaReductionDetail
   , types :: (domain, codomain)
   }
   deriving (Eq, Show, Generic)
-  deriving (FromJSON, ToJSON) via PrimerJSON (BetaReductionDetail k domain codomain)
+  deriving (ToJSON) via PrimerJSON (BetaReductionDetail k domain codomain)