[DB-FLOW] functions to create nodeTypes.

src/Gargantext/API/Node.hs

@@ -205,7 +205,7 @@ getNodesWith' conn id nodeType offset limit  = liftIO (getNodesWith conn id node
 
 getFacet :: Connection -> NodeId -> Maybe Int -> Maybe Int
                         -> Handler [FacetDoc]
-getFacet conn id offset limit = liftIO (putStrLn ( "/facet" :: Text)) >> liftIO (getDocFacet conn NodeCorpus id (Just Document) offset limit)
+getFacet conn id offset limit = liftIO (putStrLn ( "/facet" :: Text)) >> liftIO (getDocFacet conn NodeCorpus id (Just NodeDocument) offset limit)
 
 getChart :: Connection -> NodeId -> Maybe UTCTime -> Maybe UTCTime
                         -> Handler [FacetChart]

src/Gargantext/Core/Types/Main.hs

@@ -60,25 +60,21 @@ userTree = TreeN (NodeTree "user name" NodeUser 1) [annuaireTree, projectTree]
 
 -- | Project Tree
 projectTree :: Tree NodeTree
-projectTree = TreeN (NodeTree "Project CNRS/IMT" Folder 2) [corpusTree 10 "A", corpusTree 20 "B"]
-
-type Individu  = Document
+projectTree = TreeN (NodeTree "Project CNRS/IMT" NodeFolder 2) [corpusTree 10 "A", corpusTree 20 "B"]
 
 -- | Corpus Tree
 annuaireTree :: Tree NodeTree
-annuaireTree = (leafT $ NodeTree "Annuaire" Annuaire 41)
-
+annuaireTree = (leafT $ NodeTree "Annuaire" NodeAnnuaire 41)
 
 corpusTree :: NodeId -> Text -> Tree NodeTree
-corpusTree nId t  = TreeN (NodeTree ("Corpus " <> t)  NodeCorpus nId) (  [ leafT $ NodeTree "Dashboard" Dashboard (nId +1)
-                                                                         , leafT $ NodeTree "Graph" Graph (nId +2)
+corpusTree nId t  = TreeN (NodeTree ("Corpus " <> t)  NodeCorpus nId) (  [ leafT $ NodeTree "Dashboard" NodeDashboard (nId +1)
+                                                                         , leafT $ NodeTree "Graph" NodeGraph (nId +2)
                                                                          ]
 --                                                      <> [ leafT $ NodeTree "My lists"  Lists    5]
 --                          <> [ leafT (NodeTree "Metrics A" Metrics 6)  ]
 --                          <> [ leafT (NodeTree "Class A" Classification 7)]
                           )
 
-data Parent = NodeType NodeId
 
 --data Classification = Favorites | MyClassifcation
 

src/Gargantext/Database/Bashql.hs

@@ -125,7 +125,7 @@ tree p = do
 post :: PWD -> [NodeWrite'] -> Cmd Int64
 post [] _   = pure 0
 post _ []   = pure 0
-post pth ns = Cmd . ReaderT $ mkNode (Just $ last pth) ns
+post pth ns = Cmd . ReaderT $ insertNode (Just $ last pth) ns
 
 --postR :: PWD -> [NodeWrite'] -> Cmd [Int]
 --postR [] _ _ = pure [0]

src/Gargantext/Database/Config.hs

@@ -31,14 +31,13 @@ import Gargantext.Prelude
 nodeTypeId :: NodeType -> NodeTypeId
 nodeTypeId n =
   case n of
-    NodeUser   -> 1
-    Folder     -> 2
-    --NodeCorpus -> 3
-    NodeCorpusV3 -> 3
-    NodeCorpus -> 30
-    Annuaire   -> 31
-    Document   -> 4
-    UserPage   -> 41
+    NodeUser      -> 1
+    NodeFolder    -> 2
+    NodeCorpusV3  -> 3
+    NodeCorpus    -> 30
+    NodeAnnuaire  -> 31
+    NodeDocument  -> 4
+    NodeContact   -> 41
   --NodeSwap   -> 19
 
 ----  Lists
@@ -48,10 +47,10 @@ nodeTypeId n =
 --  MapList    -> 8
 
 ----  Scores
-    Occurrences -> 10
-    Graph       -> 9
-    Dashboard   -> 5
-    Chart       -> 51
+    NodeOccurrences -> 10
+    NodeGraph       -> 9
+    NodeDashboard   -> 5
+    NodeChart       -> 51
 
 --  Cooccurrences -> 9
 --
@@ -65,14 +64,9 @@ nodeTypeId n =
 --  TirankLocal  -> 16
 --  TirankGlobal -> 17
 
-----  Node management
-    Favorites    -> 15
+--  Node management
+--  NodeFavorites    -> 15
 
---  Project -> TODO
---  Individu -> TODO
---  Classification -> TODO
---  Lists -> TODO
---  Metrics -> TODO
 
 --
 -- | Nodes are typed in the database according to a specific ID

src/Gargantext/Database/Facet.hs

@@ -221,13 +221,13 @@ selectDocFacet' :: NodeType -> ParentId -> Maybe NodeType -> Query FacetDocRead
 selectDocFacet' _ pId _ = proc () -> do
         (n1,(nn,n2)) <- leftJoin3''' -< ()
         restrict -< (.&&) (node_parentId n1 .== (toNullable $ pgInt4 pId))
-                          (node_typename n1 .== (pgInt4 $ nodeTypeId Document))
+                          (node_typename n1 .== (pgInt4 $ nodeTypeId NodeDocument))
 
-        restrict -< (.||) (node_typename n2 .== (toNullable $ pgInt4 $ nodeTypeId Favorites))
-                          (isNull $ node_typename n2)
-
-        restrict -< (.||) (node_parentId n2 .== (toNullable $ pgInt4 $ nodeTypeId Favorites))
-                          (isNull $ node_parentId n2)
+--        restrict -< (.||) (node_typename n2 .== (toNullable $ pgInt4 $ nodeTypeId Favorites))
+--                          (isNull $ node_typename n2)
+--
+--        restrict -< (.||) (node_parentId n2 .== (toNullable $ pgInt4 $ nodeTypeId Favorites))
+--                          (isNull $ node_parentId n2)
 
         let isFav = ifThenElse (isNull $ nodeNode_score nn) (pgBool False) (pgBool True)
 

src/Gargantext/Database/Flow.hs

@@ -45,7 +45,7 @@ flow = do
   masterUser <- runCmd' (getUser "gargantua")
   
   let masterUserId = case masterUser of
-        Nothing   -> panic "no user"
+        Nothing   -> panic "Error: User does not exist (yet)" -- mk NodeUser gargantua_id "Node Gargantua"
         Just user -> userLight_id user
         
   root <- map node_id <$> runCmd' (getRoot masterUserId)
@@ -60,7 +60,6 @@ flow = do
   
   pure ()
 {-
-  rootId       <- mk NodeUser gargantua_id "Node Gargantua"
 
   --folderId <- mk Folder parentId (Name "Data") (Descr "All corpora DATA here")
   folderId <- mk Folder rootId "Data"

src/Gargantext/Database/Node.hs

@@ -89,7 +89,6 @@ type CorpusId = Int
 type UserId = NodeId
 type TypeId = Int
 ------------------------------------------------------------------------
-
 instance FromField HyperdataCorpus where
     fromField = fromField'
 
@@ -99,13 +98,9 @@ instance FromField HyperdataDocument where
 instance FromField HyperdataDocumentV3 where
     fromField = fromField'
 
-instance FromField HyperdataProject where
-    fromField = fromField'
-
 instance FromField HyperdataUser where
     fromField = fromField'
-
-
+------------------------------------------------------------------------
 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
@@ -115,13 +110,9 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataDocumentV3 where
 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus   where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataProject  where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
-
 instance QueryRunnerColumnDefault PGJsonb HyperdataUser     where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-
+------------------------------------------------------------------------
 
 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DB.ByteString -> Conversion b
 fromField' field mb = do
@@ -261,10 +252,10 @@ getNodesWithParentId' n _ conn = runQuery conn $ selectNodesWithParentID n
 
 ------------------------------------------------------------------------
 getDocumentsV3WithParentId :: Connection -> Int -> IO [Node HyperdataDocumentV3]
-getDocumentsV3WithParentId conn n = runQuery conn $ selectNodesWith' n (Just Document)
+getDocumentsV3WithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeDocument)
 
 getDocumentsWithParentId :: Connection -> Int -> IO [Node HyperdataDocument]
-getDocumentsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just Document)
+getDocumentsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeDocument)
 
 ------------------------------------------------------------------------
 
@@ -298,15 +289,58 @@ getNodesWithType conn type_id = do
 
 
 ------------------------------------------------------------------------
--- Quick and dirty
+-- WIP
 ------------------------------------------------------------------------
+
 type NodeWrite' = NodePoly (Maybe Int) Int Int (Maybe ParentId) Text (Maybe UTCTime) ByteString
+------------------------------------------------------------------------
+defaultUser :: HyperdataUser
+defaultUser = HyperdataUser (Just $ (pack . show) EN)
 
-node :: ToJSON a => UserId -> Maybe ParentId -> NodeType -> Text -> Hyperdata a -> NodeWrite'
-node userId parentId nodeType name nodeData = Node Nothing typeId userId parentId name Nothing byteData
+nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite'
+nodeUserW maybeName maybeHyperdata = node NodeUser name (Hyperdata user) Nothing
+  where
+    name = maybe "User" identity maybeName
+    user = maybe defaultUser identity maybeHyperdata
+------------------------------------------------------------------------
+defaultFolder :: HyperdataFolder
+defaultFolder = HyperdataFolder (Just "Markdown Description")
+
+nodeFolderW :: Maybe Name -> Maybe HyperdataFolder -> ParentId -> UserId -> NodeWrite'
+nodeFolderW maybeName maybeFolder pid = node NodeFolder name (Hyperdata folder) (Just pid)
+  where
+    name   = maybe "Folder" identity maybeName
+    folder = maybe defaultFolder identity maybeFolder
+------------------------------------------------------------------------
+defaultCorpus :: HyperdataCorpus
+defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
+
+nodeCorpusW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite'
+nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name (Hyperdata corpus) (Just pId)
+  where
+    name   = maybe "Corpus" identity maybeName
+    corpus = maybe defaultCorpus identity maybeCorpus
+------------------------------------------------------------------------
+defaultDocument :: HyperdataDocument
+defaultDocument = hyperdataDocument
+
+nodeDocumentW :: Maybe Name -> Maybe HyperdataDocument -> CorpusId -> UserId -> NodeWrite'
+nodeDocumentW maybeName maybeDocument cId = node NodeDocument name (Hyperdata doc) (Just cId)
+  where
+    name = maybe "Document" identity maybeName
+    doc  = maybe defaultDocument identity maybeDocument
+------------------------------------------------------------------------
+--defaultAnnuaire :: HyperdataAnnuaire
+--defaultAnnuaire = HyperdataAnnuaire 
+--nodeAnnuaireW
+--nodeContactW
+
+------------------------------------------------------------------------
+node :: ToJSON a => NodeType -> Name -> Hyperdata a -> Maybe ParentId -> UserId -> NodeWrite'
+node nodeType name hyperData parentId userId = Node Nothing typeId userId parentId name Nothing byteData
   where
     typeId = nodeTypeId nodeType
-    byteData = DB.pack $ DBL.unpack $ encode $ unHyperdata nodeData
+    byteData = DB.pack $ DBL.unpack $ encode $ unHyperdata hyperData
 
 
 node2write :: (Functor maybe1, Functor maybe2, Functor maybe3) =>
@@ -315,30 +349,27 @@ node2write :: (Functor maybe1, Functor maybe2, Functor maybe3) =>
                   maybe1 (Column PGInt4), Column PGText, maybe3 (Column PGTimestamptz),
                   Column PGJsonb)
 node2write pid (Node id tn ud _ nm dt hp) = ((pgInt4    <$> id)
-                                         ,(pgInt4        tn)
+                                        ,(pgInt4        tn)
                                          ,(pgInt4        ud)
                                          ,(pgInt4   <$> pid)
                                          ,(pgStrictText  nm)
                                          ,(pgUTCTime <$> dt)
                                          ,(pgStrictJSONB hp)
                                          )
+------------------------------------------------------------------------
+insertNode :: Maybe ParentId -> [NodeWrite'] -> Connection -> IO Int64
+insertNode pid ns conn = runInsertMany conn nodeTable' $ map (node2write pid) ns
 
-
-mkNode :: Maybe ParentId -> [NodeWrite'] -> Connection -> IO Int64
-mkNode pid ns conn = runInsertMany conn nodeTable' $ map (node2write pid) ns
-
-mkNodeR :: Maybe ParentId -> [NodeWrite'] -> Connection -> IO [Int]
-mkNodeR pid ns conn = runInsertManyReturning conn nodeTable' (map (node2write pid) ns) (\(i,_,_,_,_,_,_) -> i)
-
-
+insertNodeR :: Maybe ParentId -> [NodeWrite'] -> Connection -> IO [Int]
+insertNodeR pid ns conn = runInsertManyReturning conn nodeTable' (map (node2write pid) ns) (\(i,_,_,_,_,_,_) -> i)
 ------------------------------------------------------------------------
 -- TODO Hierachy of Nodes
 -- post and get same types Node' and update if changes
 
 {- TODO semantic to achieve
-post c uid pid [ Node' Corpus "name" "{}" []
-               , Node' Folder "name" "{}" [Node' Corpus "test 2" "" [ Node' Document "title" "metaData" []
-                                                                    , Node' Document "title" "jsonData" []
+post c uid pid [ Node' NodeCorpus "name" "{}" []
+               , Node' NodeFolder "name" "{}" [Node' NodeCorpus "test 2" "" [ Node' NodeDocument "title" "metaData" []
+                                                                    , Node' NodeDocument "title" "jsonData" []
                                                                     ]
                                           ]
                ]
@@ -377,6 +408,9 @@ mkNode' ns = mkCmd $ \conn -> runInsertMany conn nodeTable' ns
 mkNodeR' :: [NodeWriteT] -> Cmd [Int]
 mkNodeR' ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable' ns (\(i,_,_,_,_,_,_) -> i)
 
+
+------------------------------------------------------------------------
+
 data NewNode = NewNode { _newNodeId :: Int
                        , _newNodeChildren :: [Int] }
 
@@ -393,26 +427,28 @@ postNode uid pid (Node' NodeCorpus txt v ns) = do
   pids  <- mkNodeR' (concat $ map (\n -> [childWith uid pid' n]) ns)
   pure $ NewNode pid' pids
 
-postNode uid pid (Node' Annuaire txt v ns) = do
-  NewNode pid' _ <- postNode uid pid (Node' Annuaire txt v [])
+postNode uid pid (Node' NodeAnnuaire txt v ns) = do
+  NewNode pid' _ <- postNode uid pid (Node' NodeAnnuaire txt v [])
   pids  <- mkNodeR' (concat $ map (\n -> [childWith uid pid' n]) ns)
   pure $ NewNode pid' pids
 postNode _ _ (Node' _ _ _ _) = panic "TODO: postNode for this type not implemented yet"
 
 
 childWith :: UserId -> ParentId -> Node' -> NodeWriteT
-childWith uId pId (Node' Document txt v []) = node2table uId (Just pId) (Node' Document txt v [])
-childWith uId pId (Node' UserPage txt v []) = node2table uId (Just pId) (Node' UserPage txt v [])
+childWith uId pId (Node' NodeDocument txt v []) = node2table uId (Just pId) (Node' NodeDocument txt v [])
+childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Node' NodeContact txt v [])
 childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
 
 
 -- TODO: remove hardcoded userId (with Reader)
 -- TODO: user Reader in the API and adapt this function
+userId = 1
+
 mk :: Connection -> NodeType -> Maybe ParentId -> Text -> IO [Int]
-mk c nt pId name  = mk' c nt 1 pId name
+mk c nt pId name  = mk' c nt userId pId name
 
 mk' :: Connection -> NodeType -> UserId -> Maybe ParentId -> Text -> IO [Int]
-mk' c nt uId pId name  = map fromIntegral <$> mkNodeR pId [node uId pId nt name hd] c
+mk' c nt uId pId name  = map fromIntegral <$> insertNodeR pId [node nt name hd pId uId] c
   where
     hd = Hyperdata (HyperdataUser (Just $ (pack . show) EN))
 

src/Gargantext/Database/Node/Document/Import.hs

@@ -149,7 +149,7 @@ queryInsert = [sql|
 prepare :: UserId -> ParentId -> [HyperdataDocument] -> [InputData]
 prepare uId pId = map (\h -> InputData tId uId pId (DT.pack "Doc") (toJSON $ addUniqId h))
   where
-    tId = nodeTypeId Document
+    tId = nodeTypeId NodeDocument
 
 ------------------------------------------------------------------------
 -- * Main Types used

src/Gargantext/Database/Types/Node.hs

@@ -191,10 +191,14 @@ instance Arbitrary Resource where
 
 ------------------------------------------------------------------------
 
-data Hyperdata a = Hyperdata { unHyperdata :: a} 
+data Hyperdata a = Hyperdata { unHyperdata :: a}
 $(deriveJSON (unPrefix "") ''Hyperdata)
 
-data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_resources    :: [Resource]
+data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: Maybe Text
+                                       , hyperdataCorpus_descr        :: Maybe Text
+                                       , hyperdataCorpus_query        :: Maybe Text
+                                       , hyperdataCorpus_authors      :: Maybe Text
+                                       , hyperdataCorpus_resources    :: Maybe [Resource]
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 
@@ -205,17 +209,11 @@ $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 
 -- Preferences ?
 
-data HyperdataFolder = HyperdataFolder { hyperdataFolder_preferences   :: Maybe Text
+data HyperdataFolder = HyperdataFolder { hyperdataFolder_descr   :: Maybe Text
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 
 
-data HyperdataProject = HyperdataProject { hyperdataProject_preferences   :: Maybe Text
-                                       } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataProject_") ''HyperdataProject)
-
-
-
 data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
@@ -225,7 +223,6 @@ data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Tex
 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 
 
-
 data HyperdataFavorites = HyperdataFavorites { hyperdataFavorites_preferences   :: Maybe Text
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataFavorites_") ''HyperdataFavorites)
@@ -268,25 +265,23 @@ type NodeName     = Text
 --type NodeUser    = Node HyperdataUser
 
 -- | Then a Node can be either a Folder or a Corpus or a Document
-type NodeUser   = Node HyperdataUser
-type Folder     = Node HyperdataFolder
-type Project    = Node HyperdataProject
-type NodeCorpus = Node HyperdataCorpus
+type NodeUser     = Node HyperdataUser
+type NodeFolder   = Node HyperdataFolder
+type NodeCorpus   = Node HyperdataCorpus
 type NodeCorpusV3 = Node HyperdataCorpus
-type Document   = Node HyperdataDocument
+type NodeDocument = Node HyperdataDocument
 
 ------------------------------------------------------------------------
 data NodeType = NodeUser 
-              -- | Project
-              | Folder
-              | NodeCorpus | NodeCorpusV3 | Annuaire 
-              | Document -- | Individu
-              | UserPage | Favorites
-              | Graph    | Dashboard | Chart
+              | NodeFolder
+              | NodeCorpus     | NodeCorpusV3 | NodeDocument
+              | NodeAnnuaire   | NodeContact
+              | NodeOccurrences
+              | NodeGraph
+              | NodeDashboard  | NodeChart
               -- | Classification
               -- | Lists
               -- | Metrics
-              | Occurrences
               deriving (Show, Read, Eq, Generic, Bounded, Enum)
 
 allNodeTypes :: [NodeType]