diff --git a/src/Gargantext/API/Node.hs b/src/Gargantext/API/Node.hs index 77679ef29b9c06304ab2981d58a94ab07ca5218e..ed7226eb38f42e33833c077877c377e333dbe686 100644 --- a/src/Gargantext/API/Node.hs +++ b/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 diff --git a/src/Gargantext/Core/Types/Main.hs b/src/Gargantext/Core/Types/Main.hs index bf48099bfef4076c8f5e22082662ac3dc73ae8b5..7b9f4f745186e3bbec0dbdeda5eb62611c84d003 100644 --- a/src/Gargantext/Core/Types/Main.hs +++ b/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 diff --git a/src/Gargantext/Database/Bashql.hs b/src/Gargantext/Database/Bashql.hs index 94c9e73d83f0d774ba7c1ad37d730760d0b1d64f..d85d40beea04969a61a9f03e0f596b2f0a4454ef 100644 --- a/src/Gargantext/Database/Bashql.hs +++ b/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 diff --git a/src/Gargantext/Database/Config.hs b/src/Gargantext/Database/Config.hs index d793b3d7866483dee30b630342461dd83d11bb3d..76d36fd2896fc039edad11f2c3b7af5f8b285646 100644 --- a/src/Gargantext/Database/Config.hs +++ b/src/Gargantext/Database/Config.hs @@ -61,6 +61,7 @@ nodeTypeId n = NodePhylo -> 90 NodeDashboard -> 7 NodeChart -> 51 + NodeNoteBook -> 88 -- Cooccurrences -> 9 -- diff --git a/src/Gargantext/Database/Ngrams.hs b/src/Gargantext/Database/Ngrams.hs index 27a0535c134e8aea72c94b0d963aa5d129857912..3f6a5a63b917c4268f433263d86db4e7454efb93 100644 --- a/src/Gargantext/Database/Ngrams.hs +++ b/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 diff --git a/src/Gargantext/Database/Schema/Node.hs b/src/Gargantext/Database/Schema/Node.hs index bfa4ecdc3d26f946cd2869a49659ddd30d6d763e..c739ab8427a221ccaba9cf9cd6f633b666954cb4 100644 --- a/src/Gargantext/Database/Schema/Node.hs +++ b/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) + + diff --git a/src/Gargantext/Database/Schema/NodeNode.hs b/src/Gargantext/Database/Schema/NodeNode.hs index 05c01d572fcc41a5698d271b92dc34a10f98d0d6..5fcf88d3229561269b855ca837d1f13a06b007fa 100644 --- a/src/Gargantext/Database/Schema/NodeNode.hs +++ b/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 diff --git a/src/Gargantext/Database/Types/Node.hs b/src/Gargantext/Database/Types/Node.hs index ebd1517c31ff3ac0c32513cec1942b68fcb1b67b..54313428a6aacc53e699b052cfe38f53c1ffa731 100644 --- a/src/Gargantext/Database/Types/Node.hs +++ b/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) {-