diff --git a/primer/src/Primer/API.hs b/primer/src/Primer/API.hs index 5b3979a4f..455578e5b 100644 --- a/primer/src/Primer/API.hs +++ b/primer/src/Primer/API.hs @@ -59,7 +59,6 @@ import Control.Monad.Fix (MonadFix) import Control.Monad.Trans (MonadTrans) import Control.Monad.Writer (MonadWriter) import Control.Monad.Zip (MonadZip) -import Data.Aeson (ToJSON) import Data.Map qualified as Map import Data.Text qualified as T import ListT qualified (toList) @@ -139,6 +138,11 @@ import Primer.Database qualified as Database ( Success ), ) +import Primer.JSON ( + CustomJSON (..), + PrimerJSON, + ToJSON, + ) import Primer.Module (moduleDefsQualified, moduleName, moduleTypesQualified) import Primer.Name (Name, unName) import StmContainers.Map qualified as StmMap @@ -383,8 +387,7 @@ data Tree = Tree -- ^ a special subtree to be rendered to the right, rather than below - useful for `case` branches } deriving (Show, Eq, Generic) - -instance ToJSON Tree + deriving (ToJSON) via PrimerJSON Tree -- | The contents of a node. data NodeBody @@ -395,8 +398,7 @@ data NodeBody | -- | Some simple nodes, like function application, have no body. NoBody deriving (Show, Eq, Generic) - -instance ToJSON NodeBody + deriving (ToJSON) via PrimerJSON NodeBody -- | An indication of the meaning of a node, which frontend may use for labelling, colour etc. -- These mostly correspond to constructors of `Expr'` or `Type'`. @@ -425,8 +427,7 @@ data NodeFlavor | FlavorTForall | FlavorPattern deriving (Show, Eq, Generic) - -instance ToJSON NodeFlavor + deriving (ToJSON) via PrimerJSON NodeFlavor -- | This type is the API's view of a 'App.Prog' -- (this is expected to evolve as we flesh out the API) @@ -434,8 +435,7 @@ newtype Prog = Prog { modules :: [Module] } deriving (Generic) - -instance ToJSON Prog + deriving (ToJSON) via PrimerJSON Prog -- | This type is the API's view of a 'Module.Module' -- (this is expected to evolve as we flesh out the API) @@ -450,8 +450,7 @@ data Module = Module defs :: [Def] } deriving (Generic) - -instance ToJSON Module + deriving (ToJSON) via PrimerJSON Module -- | This type is the api's view of a 'Primer.Core.Def' -- (this is expected to evolve as we flesh out the API) @@ -462,8 +461,7 @@ data Def = Def -- ^ definitions with no associated tree are primitives } deriving (Generic) - -instance ToJSON Def + deriving (ToJSON) via PrimerJSON Def viewProg :: App.Prog -> Prog viewProg p = diff --git a/primer/src/Primer/App.hs b/primer/src/Primer/App.hs index b90af47c1..5331bbbee 100644 --- a/primer/src/Primer/App.hs +++ b/primer/src/Primer/App.hs @@ -54,11 +54,6 @@ module Primer.App ( import Foreword hiding (mod) import Control.Monad.Fresh (MonadFresh (..)) -import Data.Aeson ( - ToJSON (toEncoding), - defaultOptions, - genericToEncoding, - ) import Data.Bitraversable (bimapM) import Data.Data (Data) import Data.Generics.Uniplate.Operations (descendM, transform, transformM) @@ -354,7 +349,7 @@ data Selection = Selection , selectedNode :: Maybe NodeSelection } deriving (Eq, Show, Generic, Data) - deriving (ToJSON, FromJSON) via PrimerJSON Selection + deriving (FromJSON, 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@ @@ -364,11 +359,11 @@ data NodeSelection = NodeSelection , meta :: Either ExprMeta TypeMeta } deriving (Eq, Show, Generic, Data) - deriving (ToJSON, FromJSON) via PrimerJSON NodeSelection + deriving (FromJSON, ToJSON) via PrimerJSON NodeSelection data NodeType = BodyNode | SigNode deriving (Eq, Show, Generic, Data) - deriving (ToJSON, FromJSON) via PrimerJSON NodeType + deriving (FromJSON, ToJSON) via PrimerJSON NodeType -- | The type of requests which can mutate the application state. data MutationRequest @@ -1041,20 +1036,12 @@ runQueryAppM (QueryAppM m) appState = case runExcept (runReaderT m appState) of -- -- Building an 'App' can be tricky, so we don't export the -- constructor. See 'mkApp' and 'mkAppSafe'. --- --- Note that the 'ToJSON' and 'FromJSON' instances for this type are --- not used in the frontend, and therefore we can use "Data.Aeson"s --- generic instances for them. data App = App { currentState :: AppState , initialState :: AppState } deriving (Eq, Show, Generic) - -instance ToJSON App where - toEncoding = genericToEncoding defaultOptions - -instance FromJSON App + deriving (FromJSON, 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', @@ -1066,11 +1053,7 @@ data AppState = AppState , prog :: Prog } deriving (Eq, Show, Generic) - -instance ToJSON AppState where - toEncoding = genericToEncoding defaultOptions - -instance FromJSON AppState + deriving (FromJSON, ToJSON) via PrimerJSON AppState -- | Construct an 'App' from an 'ID' and a 'Prog'. -- diff --git a/primer/src/Primer/Core.hs b/primer/src/Primer/Core.hs index 80b5a9a0d..e59fbb5c8 100644 --- a/primer/src/Primer/Core.hs +++ b/primer/src/Primer/Core.hs @@ -192,9 +192,7 @@ data GlobalName (k :: GlobalNameKind) = GlobalName , baseName :: Name } deriving (Eq, Ord, Generic, Data, Show) - -instance FromJSON (GlobalName k) -instance ToJSON (GlobalName k) + deriving (FromJSON, ToJSON) via PrimerJSON (GlobalName k) -- | 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/src/Primer/Name.hs b/primer/src/Primer/Name.hs index e61771ed1..4152002fe 100644 --- a/primer/src/Primer/Name.hs +++ b/primer/src/Primer/Name.hs @@ -31,7 +31,8 @@ unsafeMkName :: Text -> Name unsafeMkName = Name newtype NameCounter = NC Natural - deriving (Eq, Enum, Show, ToJSON, FromJSON) + deriving (Eq, Enum, Show, Generic, Data) + deriving newtype (FromJSON, ToJSON) -- | Generate a new automatic name (distinct from all other names generated by -- this function, from the MonadFresh class), and avoiding the given set of diff --git a/primer/src/Primer/Typecheck.hs b/primer/src/Primer/Typecheck.hs index 7d1c6f9d2..174782b6b 100644 --- a/primer/src/Primer/Typecheck.hs +++ b/primer/src/Primer/Typecheck.hs @@ -178,7 +178,7 @@ assert b s = unless b $ throwError' (InternalError s) data SmartHoles = SmartHoles | NoSmartHoles deriving (Eq, Show, Generic) - deriving (ToJSON, FromJSON) via PrimerJSON SmartHoles + deriving (FromJSON, ToJSON) via PrimerJSON SmartHoles data KindOrType = K Kind | T Type deriving (Show, Eq)