[REFACTO] WIP

src/Gargantext/API/Node.hs

@@ -95,7 +95,7 @@ nodesAPI ids = deleteNodes ids
 -- TODO-EVENTS:
 --   PutNode ?
 -- TODO needs design discussion.
-type Roots =  Get    '[JSON] [NodeAny]
+type Roots =  Get    '[JSON] [Node HyperdataAny]
          :<|> Put    '[JSON] Int -- TODO
 
 -- | TODO: access by admin only

src/Gargantext/Core/Types/Main.hs

@@ -114,34 +114,11 @@ fromListTypeId i = lookup i $ fromList [ (listTypeId l, l) | l <- [minBound..max
 --              | TfidfCorpus | TfidfGlobal   | TirankLocal | TirankGlobal
 
 -- | Community Manager Use Case
-type Annuaire  = NodeCorpus
-
 -- | Favorites Node enable Swap Node with some synonyms for clarity
-type NodeSwap  = Node HyperdataResource
 
 -- | Then a Node can be a List which has some synonyms
-type List = Node HyperdataList
-type StopList   = List
-type MainList   = List
-type MapList    = List
-type GroupList  = List
 
 -- | Then a Node can be a Score which has some synonyms
-type Score = Node HyperdataScore
-type Occurrences   = Score
-type Cooccurrences = Score
-type Specclusion   = Score
-type Genclusion    = Score
-type Cvalue        = Score
-type Tficf         = Score
----- TODO All these Tfidf* will be replaced with TFICF
-type TfidfCorpus   = Tficf
-type TfidfGlobal   = Tficf
-type TirankLocal   = Tficf
-type TirankGlobal  = Tficf
---
--- Temporary types to be removed
-type ErrorMessage = Text
 
 -- Queries
 type Limit    = Int

src/Gargantext/Database/Bashql.hs

@@ -98,7 +98,7 @@ mv :: NodeId -> ParentId -> Cmd err [Int]
 mv n p = U.update $ U.Move n p
 
 -- | TODO get Children or Node
-get :: PWD -> Cmd err [NodeAny]
+get :: PWD -> Cmd err [Node HyperdataAny]
 get []  = pure []
 get pwd = runOpaQuery $ selectNodesWithParentID (last pwd)
 
@@ -107,10 +107,10 @@ home :: Cmd err PWD
 home = map _node_id <$> getNodesWithParentId 0 Nothing
 
 -- | ls == get Children
-ls :: PWD -> Cmd err [NodeAny]
+ls :: PWD -> Cmd err [Node HyperdataAny]
 ls = get
 
-tree :: PWD -> Cmd err [NodeAny]
+tree :: PWD -> Cmd err [Node HyperdataAny]
 tree p = do
   ns       <- get p
   children <- mapM (\n -> get [_node_id n]) ns

src/Gargantext/Database/Config.hs

@@ -61,6 +61,7 @@ nodeTypeId n =
     NodePhylo       -> 90
     NodeDashboard   -> 7
     NodeChart       -> 51
+    NodeNoteBook    -> 88
 
 --  Cooccurrences -> 9
 --

src/Gargantext/Database/Ngrams.hs

@@ -22,12 +22,12 @@ import Gargantext.Core.Types
 import Gargantext.Database.Utils (runOpaQuery, Cmd)
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.NodeNodeNgrams
-import Gargantext.Database.Schema.Node 
+import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
 import Opaleye
 import Control.Arrow (returnA)
 
-selectNgramsByDoc :: [CorpusId] -> DocumentId -> NgramsType -> Cmd err [Text]
+selectNgramsByDoc :: [CorpusId] -> DocId -> NgramsType -> Cmd err [Text]
 selectNgramsByDoc cIds dId nt = runOpaQuery (query cIds dId nt)
   where
     
@@ -44,6 +44,6 @@ selectNgramsByDoc cIds dId nt = runOpaQuery (query cIds dId nt)
       returnA -< ngrams_terms ng
 
 
-postNgrams :: CorpusId -> DocumentId -> [Text] -> Cmd err Int
+postNgrams :: CorpusId -> DocId -> [Text] -> Cmd err Int
 postNgrams = undefined
 

src/Gargantext/Database/Schema/Node.hs

@@ -40,7 +40,7 @@ import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu (Username)
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Queries.Filter (limit', offset')
-import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
+import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..))
 import Gargantext.Database.Utils
 import Gargantext.Prelude hiding (sum, head)
 
@@ -92,7 +92,7 @@ instance FromField HyperdataUser
   where
     fromField = fromField'
 
-instance FromField HyperdataList
+instance FromField HyperData
   where
     fromField = fromField'
 
@@ -112,6 +112,10 @@ instance FromField HyperdataAnnuaire
   where
     fromField = fromField'
 
+instance FromField HyperdataList
+  where
+    fromField = fromField'
+
 instance FromField (NodeId, Text)
   where
     fromField = fromField'
@@ -120,6 +124,15 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataAny
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+instance QueryRunnerColumnDefault PGJsonb HyperdataList
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGJsonb HyperData
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+
 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
@@ -136,10 +149,6 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataUser
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataList
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
 instance QueryRunnerColumnDefault PGJsonb HyperdataListModel
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
@@ -283,7 +292,7 @@ selectNode id = proc () -> do
 
 
 
-runGetNodes :: Query NodeRead -> Cmd err [NodeAny]
+runGetNodes :: Query NodeRead -> Cmd err [Node HyperdataAny]
 runGetNodes = runOpaQuery
 
 ------------------------------------------------------------------------
@@ -330,7 +339,7 @@ getNodesWith parentId _ nodeType maybeOffset maybeLimit =
 
 -- TODO: Why is the second parameter ignored?
 -- TODO: Why not use getNodesWith?
-getNodesWithParentId :: NodeId -> Maybe Text -> Cmd err [NodeAny]
+getNodesWithParentId :: NodeId -> Maybe Text -> Cmd err [Node HyperdataAny]
 getNodesWithParentId n _ = runOpaQuery $ selectNodesWithParentID n
 
 ------------------------------------------------------------------------
@@ -341,9 +350,6 @@ getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocume
 getDocumentsWithParentId :: NodeId -> Cmd err [Node HyperdataDocument]
 getDocumentsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
 
-getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
-getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
-
 getListsModelWithParentId :: NodeId -> Cmd err [Node HyperdataListModel]
 getListsModelWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeListModel)
 
@@ -370,7 +376,7 @@ getNode nId _ = do
     fromMaybe (error $ "Node does node exist: " <> show nId) . headMay
              <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
 
-getNodePhylo :: NodeId -> Cmd err (NodePhylo)
+getNodePhylo :: NodeId -> Cmd err (Node HyperdataPhylo)
 getNodePhylo nId = do
     fromMaybe (error $ "Node does node exist: " <> show nId) . headMay
              <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
@@ -384,7 +390,6 @@ getNode' nId = fromMaybe (error $ "Node does node exist: " <> show nId) . headMa
 getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument]
 getNodesWithType = runOpaQuery . selectNodesWithType
 
-------------------------------------------------------------------------
 ------------------------------------------------------------------------
 defaultUser :: HyperdataUser
 defaultUser = HyperdataUser (Just $ (pack . show) EN)
@@ -437,7 +442,7 @@ class HasDefault a where
 instance HasDefault NodeType where
   hasDefaultData nt = case nt of
       NodeTexts -> HyperdataTexts (Just "Preferences")
-      NodeList  -> HyperdataList'  (Just "Preferences")
+      NodeList  -> HyperdataList' (Just "Preferences")
       _         -> undefined
       --NodeAnnuaire -> HyperdataAnnuaire (Just "Title") (Just "Description")
 
@@ -446,7 +451,6 @@ instance HasDefault NodeType where
       NodeList  -> "Lists"
       _         -> undefined
 
-
 ------------------------------------------------------------------------
 nodeDefault :: NodeType -> ParentId -> UserId -> NodeWrite
 nodeDefault nt parent = node nt name hyper (Just parent)
@@ -455,8 +459,6 @@ nodeDefault nt parent = node nt name hyper (Just parent)
     hyper = (hasDefaultData nt)
 
 ------------------------------------------------------------------------
-arbitraryList :: HyperdataList
-arbitraryList = HyperdataList (Just "Preferences")
 
 arbitraryListModel :: HyperdataListModel
 arbitraryListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83)
@@ -618,7 +620,7 @@ getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err ListId
 getOrMkList pId uId =
   maybe (mkList' pId uId) (pure . view node_id) . headMay =<< getListsWithParentId pId
     where
-      mkList' pId uId = maybe (nodeError MkNode) pure . headMay =<< mkList pId uId
+      mkList' pId uId = maybe (nodeError MkNode) pure . headMay =<< mkNode NodeList pId uId
 
 -- | TODO remove defaultList
 defaultList :: HasNodeError err => CorpusId -> Cmd err ListId
@@ -629,16 +631,6 @@ 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]
 
@@ -660,3 +652,9 @@ mkPhylo p u = insertNodesR [nodePhyloW Nothing Nothing p u]
 
 pgNodeId :: NodeId -> Column PGInt4
 pgNodeId = pgInt4 . id2int
+
+
+getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
+getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
+
+

src/Gargantext/Database/Schema/NodeNode.hs

@@ -144,7 +144,7 @@ queryDocs cId = proc () -> do
   returnA -< view (node_hyperdata) n
 
 
-selectDocNodes :: CorpusId -> Cmd err [NodeDocument]
+selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 
 queryDocNodes :: CorpusId -> O.Query NodeRead
@@ -156,7 +156,6 @@ queryDocNodes cId = proc () -> do
   returnA -<  n
 
 
-
 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
   where

src/Gargantext/Database/Types/Node.hs

@@ -19,6 +19,7 @@ Portability : POSIX
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 -- {-# LANGUAGE DuplicateRecordFields #-}
 
 module Gargantext.Database.Types.Node
@@ -76,7 +77,6 @@ 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
@@ -117,7 +117,7 @@ type ParentId = NodeId
 type CorpusId = NodeId
 type ListId   = NodeId
 type DocumentId = NodeId
-type DocId      = DocumentId -- todo: remove this
+type DocId      = NodeId
 type RootId   = NodeId
 type MasterCorpusId = CorpusId
 type UserCorpusId   = CorpusId
@@ -337,6 +337,13 @@ instance Arbitrary HyperdataCorpus where
     arbitrary = pure hyperdataCorpus -- TODO
 
 ------------------------------------------------------------------------
+
+data HyperdataList = HyperdataList {hd_list         :: !(Maybe Text)
+                                           } deriving (Show, Generic)
+$(deriveJSON (unPrefix "hd_") ''HyperdataList)
+
+instance Hyperdata HyperdataList
+
 ------------------------------------------------------------------------
 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title        :: !(Maybe Text)
                                            , hyperdataAnnuaire_desc         :: !(Maybe Text)
@@ -361,14 +368,10 @@ instance Arbitrary HyperdataAny where
     arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
 ------------------------------------------------------------------------
 
-data HyperdataList = HyperdataList { hyperdataList_preferences   :: !(Maybe Text)
-                                   } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
-
-instance Hyperdata HyperdataList
-
-instance Arbitrary HyperdataList where
-  arbitrary = elements [HyperdataList (Just "from list A")]
+{-
+instance Arbitrary HyperdataList' where
+  arbitrary = elements [HyperdataList' (Just "from list A")]
+-}
 
                       ----
 data HyperdataListModel = HyperdataListModel { _hlm_params  :: !(Int, Int)
@@ -432,15 +435,8 @@ instance Hyperdata HyperdataNotebook
 
 
 
--- | 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
-
-
 data HyperData = HyperdataTexts { hd_texts :: Maybe Text }
-               | HyperdataList' { hd_lists :: Maybe Text}
+               | HyperdataList'  { hd_lists :: Maybe Text}
   deriving (Show, Generic)
 
 $(deriveJSON (unPrefix "hd_") ''HyperData)
@@ -448,29 +444,16 @@ $(deriveJSON (unPrefix "hd_") ''HyperData)
 instance Hyperdata HyperData
 
 
-type NodeTexts    = Node HyperData
-
-type NodeCorpusV3 = Node HyperdataCorpus
-type NodeDocument = Node HyperdataDocument
-
-type NodeAnnuaire = Node HyperdataAnnuaire
-
--- | Any others nodes
-type NodeAny      = Node HyperdataAny
-
----- | Then a Node can be either a Graph or a Phylo or a Notebook
-type NodeList     = Node HyperdataList
-type NodeGraph    = Node HyperdataGraph
-type NodePhylo    = Node HyperdataPhylo
-type NodeNotebook = Node HyperdataNotebook
 ------------------------------------------------------------------------
+-- | Then a Node can be either a Folder or a Corpus or a Document
 data NodeType = NodeUser
               | NodeFolder
               | NodeCorpus     | NodeCorpusV3 | NodeTexts | NodeDocument
               | NodeAnnuaire   | NodeContact
               | NodeGraph      | NodePhylo
-              | NodeDashboard  | NodeChart
-              | NodeList       | NodeListModel deriving (Show, Read, Eq, Generic, Bounded, Enum)
+              | NodeDashboard  | NodeChart    | NodeNoteBook
+              | NodeList       | NodeListModel
+  deriving (Show, Read, Eq, Generic, Bounded, Enum)
 
 
 {-