Revert "defaultHyperdata returns a Maybe"

This reverts commit a4e5b84d.

src/Gargantext/API/Errors.hs

@@ -143,8 +143,6 @@ 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,10 +209,6 @@ 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]
@@ -436,14 +432,6 @@ 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 ]
@@ -646,9 +634,6 @@ 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,7 +30,6 @@ 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, Eq, Show)
+    deriving (Generic, 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, Eq, Generic)
+                  deriving (Show, 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, Eq, Show)
+                 } deriving (Generic, Show)
 defaultHyperdataField :: HyperdataField CorpusField
 defaultHyperdataField = HyperdataField Markdown "name" defaultCorpusField
 

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

@@ -14,7 +14,6 @@ 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
@@ -50,6 +49,7 @@ data DefaultHyperdata =
   | DefaultFrameCode     HyperdataFrame
 
   | DefaultFile          HyperdataFile
+  | DefaultReadOnly      HyperdataReadOnly
 
 instance Hyperdata DefaultHyperdata
 
@@ -83,38 +83,37 @@ instance ToJSON DefaultHyperdata where
   toJSON (DefaultFrameCode  x) = toJSON x
 
   toJSON (DefaultFile x)     = toJSON x
+  toJSON (DefaultReadOnly x) = toJSON x
 
--- | 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
+
+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

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 wrapped =
-  HyperdataReadOnly { _hro_wrapped_type :: NodeType
-                    , _hro_wrapped :: Maybe wrapped
-                    }
+data HyperdataReadOnly =
+  HyperdataReadOnly { _hro_wrapped :: Maybe HyperdataAny }
     deriving (Generic, Show, Eq)
 
+defaultHyperdataReadOnly :: HyperdataReadOnly
+defaultHyperdataReadOnly =
+  HyperdataReadOnly
+    { _hro_wrapped = Nothing
+    }
+
 --
 -- Instances
 --
 
 $(deriveJSON (unPrefix "_hro_") ''HyperdataReadOnly)
 
--- | 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
+instance Arbitrary HyperdataReadOnly where
+    arbitrary = HyperdataReadOnly <$> arbitrary

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

@@ -306,31 +306,19 @@ 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 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
+           => 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
 
 nodeW ::  HasDBid NodeType
-       => NodeType
-       -> Name
-       -> DefaultHyperdata
-       -> ParentId
-       -> UserId
-       -> NodeWrite
-nodeW nt n h p u = node nt n h (Just p) u
+       => 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
 
 ------------------------------------------------------------------------
 node :: (ToJSON a, Hyperdata a, HasDBid NodeType)

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

@@ -30,7 +30,6 @@ 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)
@@ -41,7 +40,6 @@ data NodeCreationError
   | UserParentDoesNotExist  UserId
   | UserHasNegativeId       UserId
   | InsertNodeFailed        UserId ParentId
-  | NodeHasNoDefaultValue   NodeType
   deriving (Show, Eq, Generic)
 
 instance ToJSON NodeCreationError
@@ -52,7 +50,6 @@ 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,6 +16,7 @@ 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
@@ -27,8 +28,10 @@ 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.Text.Ngrams (NgramsType(..))
 import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm))
-import Gargantext.Database.Admin.Types.Node (UserId(UnsafeMkUserId), NodeType(..))
+import Gargantext.Database.Admin.Types.Node (UserId(UnsafeMkUserId))
 import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata
 import Gargantext.Prelude hiding (replace, Location)
 import Servant.Job.Core qualified as SJ
@@ -279,8 +282,6 @@ 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 HyperdataCorpus" (jsonRoundtrip @(HyperdataReadOnly HyperdataCorpus))
+  , testProperty "HyperdataReadOnly" (jsonRoundtrip @HyperdataReadOnly)
   , testCase "can parse bpa_phylo_test.json" testParseBpaPhylo
   , testCase "can parse open_science.json" testOpenSciencePhylo
   ]