defaultHyperdata returns a Maybe

src/Gargantext/API/Errors.hs

@@ -143,6 +143,8 @@ nodeErrorToFrontendError ne = case ne of
            -> mkFrontendErrShow $ FE_node_creation_failed_insert_node uId pId
          UserHasNegativeId uid
            -> mkFrontendErrShow $ FE_node_creation_failed_user_negative_id uid
+         NodeHasNoDefaultValue nt
+           -> mkFrontendErrShow $ FE_node_creation_failed_no_default_value nt
   NodeLookupFailed reason
     -> case reason of
          NodeDoesNotExist nid

src/Gargantext/API/Errors/Types.hs

@@ -209,6 +209,10 @@ newtype instance ToFrontendErrorData 'EC_400__node_creation_failed_user_negative
   FE_node_creation_failed_user_negative_id { neuni_user_id :: UserId }
   deriving (Show, Eq, Generic)
 
+newtype instance ToFrontendErrorData 'EC_400__node_creation_failed_no_default_value =
+  FE_node_creation_failed_no_default_value { ncfdv_nodetype :: NodeType }
+  deriving (Show, Eq, Generic)
+
 data instance ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_roots =
   FE_node_lookup_failed_user_too_many_roots { netmr_user_id :: UserId
                                             , netmr_roots   :: [NodeId]
@@ -432,6 +436,14 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_insert_node
     necin_parent_id <- o .: "parent_id"
     pure FE_node_creation_failed_insert_node{..}
 
+instance ToJSON (ToFrontendErrorData 'EC_400__node_creation_failed_no_default_value) where
+  toJSON FE_node_creation_failed_no_default_value{..} =
+    object [ "nodetype" .= toJSON ncfdv_nodetype ]
+instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_no_default_value) where
+  parseJSON = withObject "FE_node_creation_failed_no_default_value" $ \o -> do
+    ncfdv_nodetype <- o .: "nodetype"
+    pure FE_node_creation_failed_no_default_value{..}
+
 instance ToJSON (ToFrontendErrorData 'EC_500__node_generic_exception) where
   toJSON FE_node_generic_exception{..} =
     object [ "error" .= nege_error ]
@@ -634,6 +646,9 @@ instance FromJSON FrontendError where
       EC_400__node_creation_failed_user_negative_id -> do
         (fe_data :: ToFrontendErrorData 'EC_400__node_creation_failed_user_negative_id) <- o .: "data"
         pure FrontendError{..}
+      EC_400__node_creation_failed_no_default_value -> do
+        (fe_data :: ToFrontendErrorData 'EC_400__node_creation_failed_no_default_value) <- o .: "data"
+        pure FrontendError{..}
       EC_500__node_generic_exception -> do
         (fe_data :: ToFrontendErrorData 'EC_500__node_generic_exception) <- o .: "data"
         pure FrontendError{..}

src/Gargantext/API/Errors/Types/Backend.hs

@@ -30,6 +30,7 @@ data BackendErrorCode
   | EC_400__node_creation_failed_parent_exists
   | EC_400__node_creation_failed_insert_node
   | EC_400__node_creation_failed_user_negative_id
+  | EC_400__node_creation_failed_no_default_value
   | EC_500__node_generic_exception
   | EC_400__node_needs_configuration
   -- validation errors

src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs

@@ -28,7 +28,7 @@ data HyperdataCorpus =
                   -- 'defaultLanguage' if we don't know which language it is.
                   , _hc_lang           :: Maybe Lang
                   }
-    deriving (Generic, Show)
+    deriving (Generic, Eq, Show)
 
 defaultHyperdataCorpus :: HyperdataCorpus
 defaultHyperdataCorpus =

src/Gargantext/Database/Admin/Types/Hyperdata/CorpusField.hs

@@ -34,7 +34,7 @@ data CorpusField = MarkdownField { _cf_text    :: !Text }
                                  , _cf_authors :: !Text
                                  -- , _cf_resources :: ![Resource]
                                  }
-                  deriving (Show, Generic)
+                  deriving (Show, Eq, Generic)
 
 defaultCorpusField :: CorpusField
 defaultCorpusField = MarkdownField "# Title"
@@ -56,7 +56,7 @@ data HyperdataField a =
   HyperdataField { _hf_type :: !CodeType
                  , _hf_name :: !Text
                  , _hf_data :: !a
-                 } deriving (Generic, Show)
+                 } deriving (Generic, Eq, Show)
 defaultHyperdataField :: HyperdataField CorpusField
 defaultHyperdataField = HyperdataField Markdown "name" defaultCorpusField
 

src/Gargantext/Database/Admin/Types/Hyperdata/Default.hs

@@ -14,6 +14,7 @@ Portability : POSIX
 module Gargantext.Database.Admin.Types.Hyperdata.Default
   where
 
+import Prelude
 import Gargantext.Database.Admin.Types.Node (NodeType(..))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
@@ -49,7 +50,6 @@ data DefaultHyperdata =
   | DefaultFrameCode     HyperdataFrame
 
   | DefaultFile          HyperdataFile
-  | DefaultReadOnly      HyperdataReadOnly
 
 instance Hyperdata DefaultHyperdata
 
@@ -83,37 +83,38 @@ instance ToJSON DefaultHyperdata where
   toJSON (DefaultFrameCode  x) = toJSON x
 
   toJSON (DefaultFile x)     = toJSON x
-  toJSON (DefaultReadOnly x) = toJSON x
 
-
-defaultHyperdata :: NodeType -> DefaultHyperdata
-defaultHyperdata NodeUser           = DefaultUser    defaultHyperdataUser
-defaultHyperdata NodeContact        = DefaultContact defaultHyperdataContact
-
-defaultHyperdata NodeCorpus         = DefaultCorpus   defaultHyperdataCorpus
-defaultHyperdata NodeCorpusV3       = DefaultCorpusV3 defaultHyperdataCorpus
-defaultHyperdata NodeAnnuaire       = DefaultAnnuaire defaultHyperdataAnnuaire
-
-defaultHyperdata NodeDocument       = DefaultDocument defaultHyperdataDocument
-defaultHyperdata NodeTexts          = DefaultTexts    defaultHyperdataTexts
-defaultHyperdata NodeList           = DefaultList     defaultHyperdataList
-defaultHyperdata NodeListCooc       = DefaultListCooc defaultHyperdataListCooc
-defaultHyperdata NodeModel          = DefaultModel    defaultHyperdataModel
-
-defaultHyperdata NodeFolder         = DefaultFolder        defaultHyperdataFolder
-defaultHyperdata NodeFolderPrivate  = DefaultFolderPrivate defaultHyperdataFolderPrivate
-defaultHyperdata NodeFolderShared   = DefaultFolderShared  defaultHyperdataFolderShared
-defaultHyperdata NodeTeam           = DefaultTeam          defaultHyperdataFolder
-defaultHyperdata NodeFolderPublic   = DefaultFolderPublic  defaultHyperdataFolderPublic
-
-defaultHyperdata NodeGraph          = DefaultGraph     defaultHyperdataGraph
-defaultHyperdata NodePhylo          = DefaultPhylo     defaultHyperdataPhylo
-defaultHyperdata NodeDashboard      = DefaultDashboard defaultHyperdataDashboard
-
-defaultHyperdata Notes     = DefaultFrameWrite defaultHyperdataFrame
-defaultHyperdata Calc      = DefaultFrameCalc  defaultHyperdataFrame
-defaultHyperdata NodeFrameVisio     = DefaultFrameVisio defaultHyperdataFrame
-defaultHyperdata NodeFrameNotebook      = DefaultFrameCalc  defaultHyperdataFrame
-
-defaultHyperdata NodeFile           = DefaultFile defaultHyperdataFile
-defaultHyperdata NodeReadOnly       = DefaultReadOnly defaultHyperdataReadOnly
+-- | Gets the default value for the hyperdata given the input 'NodeType'. Note that not
+-- all the hyperdata type have a default. In particular, \"combinators\" type like the
+-- \"NodeReadOnly\" do not have a default.
+defaultHyperdata :: NodeType -> Maybe DefaultHyperdata
+defaultHyperdata NodeUser           = Just $ DefaultUser    defaultHyperdataUser
+defaultHyperdata NodeContact        = Just $ DefaultContact defaultHyperdataContact
+
+defaultHyperdata NodeCorpus         = Just $ DefaultCorpus   defaultHyperdataCorpus
+defaultHyperdata NodeCorpusV3       = Just $ DefaultCorpusV3 defaultHyperdataCorpus
+defaultHyperdata NodeAnnuaire       = Just $ DefaultAnnuaire defaultHyperdataAnnuaire
+
+defaultHyperdata NodeDocument       = Just $ DefaultDocument defaultHyperdataDocument
+defaultHyperdata NodeTexts          = Just $ DefaultTexts    defaultHyperdataTexts
+defaultHyperdata NodeList           = Just $ DefaultList     defaultHyperdataList
+defaultHyperdata NodeListCooc       = Just $ DefaultListCooc defaultHyperdataListCooc
+defaultHyperdata NodeModel          = Just $ DefaultModel    defaultHyperdataModel
+
+defaultHyperdata NodeFolder         = Just $ DefaultFolder        defaultHyperdataFolder
+defaultHyperdata NodeFolderPrivate  = Just $ DefaultFolderPrivate defaultHyperdataFolderPrivate
+defaultHyperdata NodeFolderShared   = Just $ DefaultFolderShared  defaultHyperdataFolderShared
+defaultHyperdata NodeTeam           = Just $ DefaultTeam          defaultHyperdataFolder
+defaultHyperdata NodeFolderPublic   = Just $ DefaultFolderPublic  defaultHyperdataFolderPublic
+
+defaultHyperdata NodeGraph          = Just $ DefaultGraph     defaultHyperdataGraph
+defaultHyperdata NodePhylo          = Just $ DefaultPhylo     defaultHyperdataPhylo
+defaultHyperdata NodeDashboard      = Just $ DefaultDashboard defaultHyperdataDashboard
+
+defaultHyperdata Notes     = Just $ DefaultFrameWrite defaultHyperdataFrame
+defaultHyperdata Calc      = Just $ DefaultFrameCalc  defaultHyperdataFrame
+defaultHyperdata NodeFrameVisio     = Just $ DefaultFrameVisio defaultHyperdataFrame
+defaultHyperdata NodeFrameNotebook  = Just $ DefaultFrameCalc  defaultHyperdataFrame
+
+defaultHyperdata NodeFile           = Just $ DefaultFile defaultHyperdataFile
+defaultHyperdata NodeReadOnly       = Nothing

src/Gargantext/Database/Admin/Types/Hyperdata/ReadOnly.hs

 {-# LANGUAGE TemplateHaskell #-}
 module Gargantext.Database.Admin.Types.Hyperdata.ReadOnly (
     HyperdataReadOnly(..)
-  , defaultHyperdataReadOnly
   ) where
 
 import Data.Aeson.TH
 
 import Prelude
 import GHC.Generics
-import Gargantext.Database.Admin.Types.Hyperdata.Any
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Test.QuickCheck
+import Gargantext.Database.Admin.Types.Node (NodeType)
 
-data HyperdataReadOnly =
-  HyperdataReadOnly { _hro_wrapped :: Maybe HyperdataAny }
+data HyperdataReadOnly wrapped =
+  HyperdataReadOnly { _hro_wrapped_type :: NodeType
+                    , _hro_wrapped :: Maybe wrapped
+                    }
     deriving (Generic, Show, Eq)
 
-defaultHyperdataReadOnly :: HyperdataReadOnly
-defaultHyperdataReadOnly =
-  HyperdataReadOnly
-    { _hro_wrapped = Nothing
-    }
-
 --
 -- Instances
 --
 
 $(deriveJSON (unPrefix "_hro_") ''HyperdataReadOnly)
 
-instance Arbitrary HyperdataReadOnly where
-    arbitrary = HyperdataReadOnly <$> arbitrary
+-- | NOTE(adn) This is not a sound instance, as there is no guarantee the
+-- inner type will be one of the wrapped node types, as well as that the
+-- 'NodeType' will match the inner wrapped value.
+instance Arbitrary wrapped => Arbitrary (HyperdataReadOnly wrapped) where
+    arbitrary = HyperdataReadOnly <$> arbitrary <*> arbitrary

src/Gargantext/Database/Query/Table/Node.hs

@@ -306,19 +306,31 @@ insertDefaultNodeIfNotExists nt p u = do
     xs -> pure xs
 
 insertNode :: (HasDBid NodeType, HasNodeError err)
-           => NodeType -> Maybe Name -> Maybe DefaultHyperdata -> ParentId -> UserId -> DBCmd err NodeId
-insertNode nt n h p u = do
-  res <- insertNodesR [nodeW nt n h p u]
-  case res of
-    [x] -> pure x
-    _   -> nodeError $ NodeCreationFailed $ InsertNodeFailed u p
+           => NodeType
+           -> Maybe Name
+           -> Maybe DefaultHyperdata
+           -> ParentId
+           -> UserId
+           -> DBCmd err NodeId
+insertNode nt mb_n mb_h p u = do
+  case mb_h <|> defaultHyperdata nt of
+    Nothing -> nodeError $ NodeCreationFailed $ NodeHasNoDefaultValue nt
+    Just h  -> do
+      res <- insertNodesR [nodeW nt n h p u]
+      case res of
+        [x] -> pure x
+        _   -> nodeError $ NodeCreationFailed $ InsertNodeFailed u p
+  where
+    n = fromMaybe (defaultName nt) mb_n
 
 nodeW ::  HasDBid NodeType
-       => NodeType -> Maybe Name -> Maybe DefaultHyperdata -> ParentId -> UserId -> NodeWrite
-nodeW nt n h p u = node nt n' h' (Just p) u
-  where
-    n' = fromMaybe (defaultName nt) n
-    h' = maybe     (defaultHyperdata nt) identity h
+       => NodeType
+       -> Name
+       -> DefaultHyperdata
+       -> ParentId
+       -> UserId
+       -> NodeWrite
+nodeW nt n h p u = node nt n h (Just p) u
 
 ------------------------------------------------------------------------
 node :: (ToJSON a, Hyperdata a, HasDBid NodeType)

src/Gargantext/Database/Query/Table/Node/Error.hs

@@ -30,6 +30,7 @@ import Control.Lens (Prism', (#), (^?))
 import Data.Aeson (object)
 import Data.Text qualified as T
 import Gargantext.Core.Types.Individu ( Username )
+import Gargantext.Core.Types (NodeType)
 import Gargantext.Database.Admin.Types.Node (ListId, NodeId(..), ContextId, UserId, ParentId)
 import Gargantext.Prelude hiding (sum, head)
 import Prelude hiding (null, id, map, sum, show)
@@ -40,6 +41,7 @@ data NodeCreationError
   | UserParentDoesNotExist  UserId
   | UserHasNegativeId       UserId
   | InsertNodeFailed        UserId ParentId
+  | NodeHasNoDefaultValue   NodeType
   deriving (Show, Eq, Generic)
 
 instance ToJSON NodeCreationError
@@ -50,6 +52,7 @@ renderNodeCreationFailed = \case
   UserParentDoesNotExist uid -> "user id " <> T.pack (show uid) <> " has no parent"
   UserHasNegativeId uid      -> "user id " <> T.pack (show uid) <> " is a negative id."
   InsertNodeFailed uid pid -> "couldn't create the list for user id " <> T.pack (show uid) <> " and parent id " <> T.pack (show pid)
+  NodeHasNoDefaultValue nt -> T.pack $ "node of type " <> show nt <> " could not be given a sensible default value."
 
 data NodeLookupError
   = NodeDoesNotExist     NodeId

test/Test/Instances.hs

@@ -16,7 +16,6 @@ module Test.Instances
 where
 
 import Data.List.NonEmpty qualified as NE
-import Data.Map.Strict qualified as Map
 import Data.Map.Strict.Patch qualified as PM
 import Data.Patch.Class (Replace(Keep), replace)
 import Data.Text qualified as T
@@ -26,13 +25,15 @@ import Gargantext.API.Errors.Types qualified as Errors
 import Gargantext.API.Ngrams.Types qualified as Ngrams
 import Gargantext.API.Node.Corpus.New (ApiInfo(..))
 import Gargantext.API.Node.Types (RenameNode(..), WithQuery(..))
+import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
+import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DET
+import Gargantext.Core.NodeStory.Types qualified as NS
 import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
 import Gargantext.Core.Notifications.Dispatcher.Types qualified as DET
-import Gargantext.Core.NodeStory.Types qualified as NS
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
 import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm))
-import Gargantext.Database.Admin.Types.Node (UserId(UnsafeMkUserId))
 import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata
+import Gargantext.Database.Admin.Types.Node (UserId(UnsafeMkUserId), NodeType(..))
 import Gargantext.Prelude hiding (replace, Location)
 import Servant.Job.Core qualified as SJ
 import Servant.Job.Types qualified as SJ
@@ -282,6 +283,8 @@ genFrontendErr be = do
             pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_creation_failed_insert_node parentId userId
     Errors.EC_400__node_creation_failed_user_negative_id
       ->    pure $ Errors.mkFrontendErr' txt (Errors.FE_node_creation_failed_user_negative_id (UnsafeMkUserId (-42)))
+    Errors.EC_400__node_creation_failed_no_default_value
+      ->    pure $ Errors.mkFrontendErr' txt (Errors.FE_node_creation_failed_no_default_value NodeReadOnly)
     Errors.EC_500__node_generic_exception
       -> do err <- arbitrary
             pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_generic_exception err

test/Test/Offline/JSON.hs

@@ -64,7 +64,7 @@ tests = testGroup "JSON" [
   , testProperty "ObjectData"    (jsonRoundtrip @ObjectData)
   , testProperty "PhyloData"     (jsonRoundtrip @PhyloData)
   , testProperty "LayerData"     (jsonRoundtrip @LayerData)
-  , testProperty "HyperdataReadOnly" (jsonRoundtrip @HyperdataReadOnly)
+  , testProperty "HyperdataReadOnly HyperdataCorpus" (jsonRoundtrip @(HyperdataReadOnly HyperdataCorpus))
   , testCase "can parse bpa_phylo_test.json" testParseBpaPhylo
   , testCase "can parse open_science.json" testOpenSciencePhylo
   ]