Manually-rolled NodeType JSON instances

This commit moves away from generic-derive JSON istances for `NodeType`,
as we know that the frontend will be relying on this in the GraphQL API,
and we don't want them to silently break the frontend during
refactoring.

src/Gargantext/Database/Admin/Types/Node.hs

@@ -16,6 +16,7 @@ Portability : POSIX
 {-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE LambdaCase #-}
 
 -- {-# LANGUAGE DuplicateRecordFields #-}
 
@@ -23,14 +24,17 @@ module Gargantext.Database.Admin.Types.Node
   where
 
 import Codec.Serialise (Serialise())
-import Data.Aeson
+import Data.Aeson as JSON
+import Data.Aeson.Types
 import Data.Aeson.TH (deriveJSON)
+import Data.Bifunctor
+import Data.ByteString.Lazy qualified as BL
 import Data.Csv qualified as Csv
-import Data.Either
 import Data.Morpheus.Kind (SCALAR)
 import Data.Morpheus.Types
 import Data.Swagger
-import Data.Text (unpack, pack)
+import Data.Text (pack)
+import Data.Text.Encoding qualified as TE
 import Data.Time (UTCTime)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField, fromJSONField)
 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
@@ -400,45 +404,147 @@ instance ToSchema Resource where
 
 ------------------------------------------------------------------------
 -- | Then a Node can be either a Folder or a Corpus or a Document
-data NodeType = NodeUser
-              | NodeFolderPrivate
-              | NodeFolderShared | NodeTeam
-              | NodeFolderPublic
-              | NodeFolder
-
-              -- | NodeAnalysis | NodeCommunity
-
-              | NodeCorpus     | NodeCorpusV3 | NodeTexts | NodeDocument
-              | NodeAnnuaire   | NodeContact
-              | NodeGraph      | NodePhylo
-              | NodeDashboard  -- | NodeChart    | NodeNoteBook
-              | NodeList       | NodeModel
-              | NodeListCooc
-
-{-
-              -- | Metrics
-              -- | NodeOccurrences
-              -- | Classification
--}
-
-              -- Optional Nodes
-              | Notes | Calc | NodeFrameVisio | NodeFrameNotebook
-              | NodeFile
-
+data NodeType
+  = NodeUser
+  | NodeFolderPrivate
+  | NodeFolderShared
+  | NodeTeam
+  | NodeFolderPublic
+  | NodeFolder
+  | NodeCorpus
+  | NodeCorpusV3
+  | NodeTexts
+  | NodeDocument
+  | NodeAnnuaire
+  | NodeContact
+  | NodeGraph
+  | NodePhylo
+  | NodeDashboard
+  | NodeList
+  | NodeModel
+  | NodeListCooc
+  -- Optional Nodes
+  | Notes
+  | Calc
+  | NodeFrameVisio
+  | NodeFrameNotebook
+  | NodeFile
   deriving (Show, Read, Eq, Ord, Generic, Bounded, Enum)
 
-
 instance GQLType NodeType
-instance FromJSON NodeType
-instance ToJSON NodeType
+
+-- /NOTE/ (adn) For backward-compatibility reasons, we keep the format for ToJSON/FromJSON similar
+-- to what 'Show/Read' would generate, but we otherwise generate \"by hand\" the mapping between a
+-- NodeType and its JSON representation, because this way we reduce the odds of /breaking the frontend/
+-- in case we change the Show/Read instances in the future.
+instance ToJSON NodeType where
+  toJSON = JSON.String . \case
+    NodeUser
+      -> "NodeUser"
+    NodeFolderPrivate
+      -> "NodeFolderPrivate"
+    NodeFolderShared
+      -> "NodeFolderShared"
+    NodeTeam
+      -> "NodeTeam"
+    NodeFolderPublic
+      -> "NodeFolderPublic"
+    NodeFolder
+      -> "NodeFolder"
+    NodeCorpus
+      -> "NodeCorpus"
+    NodeCorpusV3
+      -> "NodeCorpusV3"
+    NodeTexts
+      -> "NodeTexts"
+    NodeDocument
+      -> "NodeDocument"
+    NodeAnnuaire
+      -> "NodeAnnuaire"
+    NodeContact
+      -> "NodeContact"
+    NodeGraph
+      -> "NodeGraph"
+    NodePhylo
+      -> "NodePhylo"
+    NodeDashboard
+      -> "NodeDashboard"
+    NodeList
+      -> "NodeList"
+    NodeModel
+      -> "NodeModel"
+    NodeListCooc
+      -> "NodeListCooc"
+    Notes
+      -> "Notes"
+    Calc
+      -> "Calc"
+    NodeFrameVisio
+      -> "NodeFrameVisio"
+    NodeFrameNotebook
+      -> "NodeFrameNotebook"
+    NodeFile
+      -> "NodeFile"
+
+instance FromJSON NodeType where
+  parseJSON = withText "NodeType" $ \t -> case t of
+    "NodeUser"
+      -> pure NodeUser
+    "NodeFolderPrivate"
+      -> pure NodeFolderPrivate
+    "NodeFolderShared"
+      -> pure NodeFolderShared
+    "NodeTeam"
+      -> pure NodeTeam
+    "NodeFolderPublic"
+      -> pure NodeFolderPublic
+    "NodeFolder"
+      -> pure NodeFolder
+    "NodeCorpus"
+      -> pure NodeCorpus
+    "NodeCorpusV3"
+      -> pure NodeCorpusV3
+    "NodeTexts"
+      -> pure NodeTexts
+    "NodeDocument"
+      -> pure NodeDocument
+    "NodeAnnuaire"
+      -> pure NodeAnnuaire
+    "NodeContact"
+      -> pure NodeContact
+    "NodeGraph"
+      -> pure NodeGraph
+    "NodePhylo"
+      -> pure NodePhylo
+    "NodeDashboard"
+      -> pure NodeDashboard
+    "NodeList"
+      -> pure NodeList
+    "NodeModel"
+      -> pure NodeModel
+    "NodeListCooc"
+      -> pure NodeListCooc
+    "Notes"
+      -> pure Notes
+    "Calc"
+      -> pure Calc
+    "NodeFrameVisio"
+      -> pure NodeFrameVisio
+    "NodeFrameNotebook"
+      -> pure NodeFrameNotebook
+    "NodeFile"
+      -> pure NodeFile
+    unhandled
+      -> typeMismatch "NodeType" (JSON.String unhandled)
+
 instance FromHttpApiData NodeType where
-  parseUrlPiece = Right . read . unpack
+  parseUrlPiece = first pack . eitherDecode . BL.fromStrict . TE.encodeUtf8
 instance ToHttpApiData NodeType where
-  toUrlPiece = pack . show
+  toUrlPiece = TE.decodeUtf8 . BL.toStrict . JSON.encode
 instance ToParamSchema NodeType
 instance ToSchema      NodeType
 instance Arbitrary NodeType where
-  arbitrary = elements allNodeTypes
+  arbitrary = arbitraryBoundedEnum
 instance FromField NodeType where
   fromField = fromJSONField
 instance ToField NodeType where

test/Test/Offline/JSON.hs

@@ -30,6 +30,7 @@ jsonRoundtrip a =
 
 class (Show a, FromJSON a, ToJSON a, Eq a, Enum a, Bounded a) => EnumBoundedJSON a
 instance EnumBoundedJSON BackendErrorCode
+instance EnumBoundedJSON NodeType
 
 jsonEnumRoundtrip :: forall a. Dict EnumBoundedJSON a -> Property
 jsonEnumRoundtrip d = case d of
@@ -54,6 +55,7 @@ tests = testGroup "JSON" [
   , testProperty "WithQuery roundtrips"     (jsonRoundtrip @WithQuery)
   , testProperty "FrontendError roundtrips" jsonFrontendErrorRoundtrip
   , testProperty "BackendErrorCode roundtrips" (jsonEnumRoundtrip (Dict @_ @BackendErrorCode))
+  , testProperty "NodeType roundtrips"      (jsonEnumRoundtrip (Dict @_ @NodeType))
   , testCase "WithQuery frontend compliance" testWithQueryFrontend
   , testGroup "Phylo" [
     testProperty "PeriodToNode"  (jsonRoundtrip @PeriodToNodeData)