[REFACTORING] Hyperdata Nodes (Texts for now).

src/Gargantext/Core/Types.hs

@@ -21,6 +21,7 @@ module Gargantext.Core.Types ( module Gargantext.Core.Types.Main
                              , TokenTag(..), POS(..), NER(..)
                              , Label, Stems
                              , HasInvalidError(..), assertValid
+                             , Name
                              ) where
 
 import Control.Lens (Prism', (#))
@@ -42,6 +43,7 @@ import Gargantext.Prelude
 import GHC.Generics
 ------------------------------------------------------------------------
 
+type Name = Text
 type Term  = Text
 type Stems = Set Text
 type Label = [Text]

src/Gargantext/Database/Flow.hs

@@ -186,7 +186,8 @@ flowCorpusUser l userName corpusName ctype ids = do
   (userId, _rootId, userCorpusId) <- getOrMkRootWithCorpus userName corpusName ctype
   -- TODO: check if present already, ignore
   _ <- Doc.add userCorpusId ids
-  tId <- mkTexts  userCorpusId userId
+  tId <- mkNode NodeTexts userCorpusId userId
+  
   printDebug "Node Text Id" tId
 
   -- User List Flow

src/Gargantext/Database/Node/Contact.hs

@@ -28,7 +28,8 @@ import Data.Time (UTCTime)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import GHC.Generics (Generic)
 import Gargantext.Core.Utils.Prefix (unPrefix)
-import Gargantext.Database.Schema.Node (NodeWrite, Name, node)
+import Gargantext.Core.Types (Name)
+import Gargantext.Database.Schema.Node (NodeWrite, node)
 import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..), UserId, AnnuaireId)
 import Gargantext.Database.Utils (fromField')
 import Gargantext.Prelude

src/Gargantext/Database/Node/Update.hs

@@ -21,9 +21,9 @@ import qualified Data.Text as DT
 import Database.PostgreSQL.Simple
 
 import Gargantext.Prelude
+import Gargantext.Core.Types (Name)
 import Gargantext.Database.Utils
 import Gargantext.Database.Types.Node (NodeId, ParentId)
-import Gargantext.Database.Schema.Node (Name)
 
 -- import Data.ByteString
 --rename :: NodeId -> Text -> IO ByteString

src/Gargantext/Database/Schema/Node.hs

@@ -173,10 +173,6 @@ instance QueryRunnerColumnDefault (Nullable PGInt4) NodeId
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
 
-------------------------------------------------------------------------
--- WIP
--- TODO Classe HasDefault where
--- default NodeType = Hyperdata
 ------------------------------------------------------------------------
 $(makeAdaptorAndInstance "pNode" ''NodePoly)
 $(makeLensesWith abbreviatedFields ''NodePoly)
@@ -292,7 +288,6 @@ runGetNodes = runOpaQuery
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
-
 -- | order by publication date
 -- Favorites (Bool), node_ngrams
 selectNodesWith :: ParentId     -> Maybe NodeType
@@ -381,7 +376,6 @@ getNodePhylo nId = do
              <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
 
 
-
 getNode' :: NodeId -> Cmd err (Node Value)
 getNode' nId = fromMaybe (error $ "Node does node exist: " <> show nId) . headMay
              <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
@@ -436,27 +430,34 @@ nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Jus
 
 
 ------------------------------------------------------------------------
-arbitraryTexts :: HyperdataTexts
-arbitraryTexts = HyperdataTexts (Just "Preferences")
+class HasDefault a where
+  hasDefaultData :: a -> HyperData
+  hasDefaultName :: a -> Text
+
+instance HasDefault NodeType where
+  hasDefaultData nt = case nt of
+      NodeTexts -> HyperdataTexts (Just "Preferences")
+      NodeList  -> HyperdataList'  (Just "Preferences")
+      _         -> undefined
+      --NodeAnnuaire -> HyperdataAnnuaire (Just "Title") (Just "Description")
+
+  hasDefaultName nt = case nt of
+      NodeTexts -> "Texts"
+      NodeList  -> "Lists"
+      _         -> undefined
 
-nodeTextsW :: Maybe Name -> Maybe HyperdataList -> ParentId -> UserId -> NodeWrite
-nodeTextsW maybeName maybeList pId = node NodeTexts name list (Just pId)
+
+------------------------------------------------------------------------
+nodeDefault :: NodeType -> ParentId -> UserId -> NodeWrite
+nodeDefault nt parent = node nt name hyper (Just parent)
   where
-    name = maybe "Texts" identity maybeName
-    list = maybe arbitraryList identity maybeList
+    name  = (hasDefaultName nt)
+    hyper = (hasDefaultData nt)
 
 ------------------------------------------------------------------------
 arbitraryList :: HyperdataList
 arbitraryList = HyperdataList (Just "Preferences")
 
-nodeListW :: Maybe Name -> Maybe HyperdataList -> ParentId -> UserId -> NodeWrite
-nodeListW maybeName maybeList pId = node NodeList name list (Just pId)
-  where
-    name = maybe "Lists" identity maybeName
-    list = maybe arbitraryList identity maybeList
-
-                --------------------
-
 arbitraryListModel :: HyperdataListModel
 arbitraryListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83)
 
@@ -495,12 +496,6 @@ nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId)
 arbitraryDashboard :: HyperdataDashboard
 arbitraryDashboard = HyperdataDashboard (Just "Preferences")
 
-nodeDashboardW :: Maybe Name -> Maybe HyperdataDashboard -> ParentId -> UserId -> NodeWrite
-nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard (Just pId)
-  where
-    name = maybe "Dashboard" identity maybeName
-    dashboard = maybe arbitraryDashboard identity maybeDashboard
-
 ------------------------------------------------------------------------
 node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite
 node nodeType name hyperData parentId userId = Node Nothing (pgInt4 typeId) (pgInt4 userId) (pgNodeId <$> parentId) (pgStrictText name) Nothing (pgJSONB $ cs $ encode hyperData)
@@ -548,8 +543,8 @@ data Node' = Node' { _n_type :: NodeType
                    , _n_children :: [Node']
                    } deriving (Show)
 
-mkNode :: [NodeWrite] -> Cmd err Int64
-mkNode ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
+mkNodes :: [NodeWrite] -> Cmd err Int64
+mkNodes ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
 
 mkNodeR :: [NodeWrite] -> Cmd err [NodeId]
 mkNodeR ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable ns (_node_id)
@@ -584,8 +579,6 @@ childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Nod
 childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
 
 
-type Name = Text
-
 -- | TODO mk all others nodes
 mkNodeWithParent :: HasNodeError err => NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [NodeId]
 mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
@@ -632,17 +625,33 @@ defaultList :: HasNodeError err => CorpusId -> Cmd err ListId
 defaultList cId =
   maybe (nodeError NoListFound) (pure . view node_id) . headMay =<< getListsWithParentId cId
 
-mkTexts :: ParentId -> UserId -> Cmd err [NodeId]
-mkTexts p u = insertNodesR [nodeTextsW Nothing Nothing p u]
+mkNode :: NodeType -> ParentId -> UserId -> Cmd err [NodeId]
+mkNode nt p u = insertNodesR [nodeDefault nt p u]
+
 
 mkList :: HasNodeError err => ParentId -> UserId -> Cmd err [NodeId]
 mkList p u = insertNodesR [nodeListW Nothing Nothing p u]
+  where
+    nodeListW :: Maybe Name -> Maybe HyperdataList -> ParentId -> UserId -> NodeWrite
+    nodeListW maybeName maybeList pId = node NodeList name list (Just pId)
+      where
+        name = maybe "Lists" identity maybeName
+        list = maybe arbitraryList identity maybeList
+
 
 mkGraph :: ParentId -> UserId -> Cmd err [GraphId]
 mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
 
 mkDashboard :: ParentId -> UserId -> Cmd err [NodeId]
 mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u]
+  where
+    nodeDashboardW :: Maybe Name -> Maybe HyperdataDashboard -> ParentId -> UserId -> NodeWrite
+    nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard (Just pId)
+      where
+        name = maybe "Board" identity maybeName
+        dashboard = maybe arbitraryDashboard identity maybeDashboard
+
+
 
 mkPhylo :: ParentId -> UserId -> Cmd err [NodeId]
 mkPhylo p u = insertNodesR [nodePhyloW Nothing Nothing p u]

src/Gargantext/Database/Types/Node.hs

@@ -76,6 +76,36 @@ instance FromField NodeId where
 
 instance ToSchema NodeId
 
+-- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
+type NodeTypeId   = Int
+type NodeName     = Text
+type TSVector     = Text
+
+------------------------------------------------------------------------
+data NodePoly id        typename userId 
+              parentId  name     date 
+              hyperdata  = Node { _node_id        :: id
+                                , _node_typename  :: typename
+                                
+                                , _node_userId    :: userId
+                                , _node_parentId  :: parentId
+                                
+                                , _node_name      :: name
+                                , _node_date      :: date
+                                
+                                , _node_hyperdata :: hyperdata
+                                } deriving (Show, Generic)
+$(deriveJSON (unPrefix "_node_") ''NodePoly)
+$(makeLenses ''NodePoly)
+
+-- | NodePoly indicates that Node has a Polymorphism Type
+type Node json   = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
+
+
+
+------------------------------------------------------------------------
+
+
 instance FromHttpApiData NodeId where
   parseUrlPiece n = pure $ NodeId $ (read . cs) n
 
@@ -127,7 +157,6 @@ $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
 ------------------------------------------------------------------------
 
 -- Only Hyperdata types should be member of this type class.
-class Hyperdata a
 
 ------------------------------------------------------------------------
 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day    :: !(Maybe Int)
@@ -150,6 +179,7 @@ data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication
                                                } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
 
+class Hyperdata a
 instance Hyperdata HyperdataDocumentV3
 
 ------------------------------------------------------------------------
@@ -307,11 +337,6 @@ instance Arbitrary HyperdataCorpus where
     arbitrary = pure hyperdataCorpus -- TODO
 
 ------------------------------------------------------------------------
-data HyperdataTexts = HyperdataTexts { hyperdataTexts_desc    :: Maybe Text
-                                       } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataTexts_") ''HyperdataTexts)
-
-instance Hyperdata HyperdataTexts
 ------------------------------------------------------------------------
 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title        :: !(Maybe Text)
                                            , hyperdataAnnuaire_desc         :: !(Maybe Text)
@@ -406,21 +431,25 @@ $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 instance Hyperdata HyperdataNotebook
 
 
--- | NodePoly indicates that Node has a Polymorphism Type
-type Node json   = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
-
--- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
-type NodeTypeId   = Int
-type NodeName     = Text
-type TSVector     = Text
-
 
 -- | Then a Node can be either a Folder or a Corpus or a Document
 type NodeUser     = Node HyperdataUser
 type NodeFolder   = Node HyperdataFolder
 
 type NodeCorpus   = Node HyperdataCorpus
-type NodeTexts    = Node HyperdataTexts
+
+
+data HyperData = HyperdataTexts { hd_texts :: Maybe Text }
+               | HyperdataList' { hd_lists :: Maybe Text}
+  deriving (Show, Generic)
+
+$(deriveJSON (unPrefix "hd_") ''HyperData)
+
+instance Hyperdata HyperData
+
+
+type NodeTexts    = Node HyperData
+
 type NodeCorpusV3 = Node HyperdataCorpus
 type NodeDocument = Node HyperdataDocument
 
@@ -463,23 +492,6 @@ instance FromHttpApiData NodeType
 instance ToParamSchema NodeType
 instance ToSchema      NodeType
 
-------------------------------------------------------------------------
-data NodePoly id        typename userId 
-              parentId  name     date 
-              hyperdata  = Node { _node_id        :: id
-                                , _node_typename  :: typename
-                                
-                                , _node_userId    :: userId
-                                , _node_parentId  :: parentId
-                                
-                                , _node_name      :: name
-                                , _node_date      :: date
-                                
-                                , _node_hyperdata :: hyperdata
-                                } deriving (Show, Generic)
-$(deriveJSON (unPrefix "_node_") ''NodePoly)
-$(makeLenses ''NodePoly)
-
 
 data NodePolySearch id        typename userId 
               parentId  name     date