[Graph] missing files and default graph.

src/Gargantext/API/Auth.hs

@@ -34,7 +34,7 @@ import Data.Text (Text, reverse)
 import Database.PostgreSQL.Simple (Connection)
 import GHC.Generics (Generic)
 import Gargantext.Core.Utils.Prefix (unPrefix)
-import Gargantext.Database.Node (getRootUsername)
+import Gargantext.Database.Root (getRoot)
 import Gargantext.Database.Types.Node (NodePoly(_node_id))
 import Gargantext.Prelude hiding (reverse)
 import Test.QuickCheck (elements, oneof)
@@ -86,7 +86,7 @@ checkAuthRequest u p c
   | not (u `elem` arbitraryUsername) = pure InvalidUser
   | u /= reverse p = pure InvalidPassword
   | otherwise = do
-      muId <- getRootUsername u c
+      muId <- getRoot u c
       pure $ maybe InvalidUser (Valid "token" . _node_id) $ head muId
 
 auth' :: Connection -> AuthRequest -> IO AuthResponse

src/Gargantext/API/Node.hs

@@ -61,12 +61,12 @@ import Gargantext.Database.Facet (FacetDoc , runViewDocuments', OrderBy(..)
 import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
 import Gargantext.Database.NodeNode (nodesToFavorite, nodesToTrash)
 -- Graph
-import Gargantext.Text.Flow
-import Gargantext.Viz.Graph (Graph)
-import Gargantext.Core (Lang(..))
+--import Gargantext.Text.Flow
+import Gargantext.Viz.Graph (Graph,readGraphFromJson,defaultGraph)
+-- import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types (Offset, Limit)
 import Gargantext.Core.Types.Main (Tree, NodeTree, ListId)
-import Gargantext.Text.Terms (TermType(..))
+-- import Gargantext.Text.Terms (TermType(..))
 
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -238,7 +238,10 @@ type ChartApi = Summary " Chart API"
 ------------------------------------------------------------------------
 type GraphAPI   = Get '[JSON] Graph
 graphAPI :: Connection -> NodeId -> Server GraphAPI
-graphAPI _ _ = liftIO $ textFlow (Mono EN) (Contexts contextText)
+graphAPI _ _ = do
+  liftIO $ maybe defaultGraph identity <$> readGraphFromJson "purescript-gargantext/dist/examples/imtNew.json"
+  -- t <- textFlow (Mono EN) (Contexts contextText)
+  -- liftIO $ liftIO $ pure $  maybe t identity maybeGraph
   -- TODO what do we get about the node? to replace contextText
 
 -- TODO(orphan): There should be a proper APIError data type with a case TreeError.

src/Gargantext/Core/Types/Individu.hs

+{-|
+Module      : Gargantext.Core.Types.Individu
+Description : Short description
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Individu defintions
+-}
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
+module Gargantext.Core.Types.Individu
+  where
+
+import Data.Text (Text)
+
+type Username = Text

src/Gargantext/Database/Flow.hs

@@ -28,7 +28,8 @@ import Gargantext.Core.Types (NodePoly(..), ListType(..), listTypeId)
 import Gargantext.Database.Bashql (runCmd') -- , del)
 import Gargantext.Database.Config (userMaster, userArbitrary, corpusMasterName)
 import Gargantext.Database.Ngrams (insertNgrams, Ngrams(..), NgramsT(..), NgramsIndexed(..), indexNgramsT, ngramsTypeId, NgramsType(..), text2ngrams)
-import Gargantext.Database.Node (getRoot, mkRoot, mkCorpus, Cmd(..), mkList, mkGraph, mkDashboard, mkAnnuaire)
+import Gargantext.Database.Node (mkRoot, mkCorpus, Cmd(..), mkList, mkGraph, mkDashboard, mkAnnuaire)
+import Gargantext.Database.Root (getRootCmd)
 import Gargantext.Database.Types.Node (NodeType(..))
 import Gargantext.Database.Node.Document.Add    (add)
 import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
@@ -36,7 +37,8 @@ import Gargantext.Database.NodeNgram (NodeNgramPoly(..), insertNodeNgrams)
 import Gargantext.Database.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew)
 import Gargantext.Database.Types.Node (HyperdataDocument(..))
 --import Gargantext.Database.Node.Contact (HyperdataContact(..))
-import Gargantext.Database.User (getUser, UserLight(..), Username)
+import Gargantext.Database.User (getUser, UserLight(..))
+import Gargantext.Core.Types.Individu (Username)
 import Gargantext.Ext.IMT (toSchoolName)
 import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
 import Gargantext.Prelude
@@ -149,7 +151,7 @@ subFlowCorpus username cName = do
         -- mk NodeUser gargantua_id "Node Gargantua"
         Just user -> userLight_id user
 
-  rootId' <- map _node_id <$> runCmd' (getRoot userId)
+  rootId' <- map _node_id <$> runCmd' (getRootCmd username)
 
   rootId'' <- case rootId' of
         []  -> runCmd' (mkRoot username userId)
@@ -175,7 +177,7 @@ subFlowAnnuaire username _cName = do
         -- mk NodeUser gargantua_id "Node Gargantua"
         Just user -> userLight_id user
 
-  rootId' <- map _node_id <$> runCmd' (getRoot userId)
+  rootId' <- map _node_id <$> runCmd' (getRootCmd username)
 
   rootId'' <- case rootId' of
         []  -> runCmd' (mkRoot username userId)

src/Gargantext/Database/Ngrams.hs

@@ -40,7 +40,8 @@ import GHC.Generics (Generic)
 import Gargantext.Core.Types -- (fromListTypeId, ListType, NodePoly(Node))
 import Gargantext.Database.Config (nodeTypeId,userMaster)
 import Gargantext.Database.Types.Node (NodeType)
-import Gargantext.Database.Node (mkCmd, Cmd(..),getRootUsername)
+import Gargantext.Database.Node (mkCmd, Cmd(..))
+import Gargantext.Database.Root (getRoot)
 import Gargantext.Database.Tree (dbTree, toNodeTree)
 import Gargantext.Core.Types.Main (NodeTree(..))
 import Gargantext.Prelude
@@ -192,7 +193,7 @@ getNgramsTableDb :: DPS.Connection
                -> IO ([NgramsTableData], MapToParent, MapToChildren)
 getNgramsTableDb c nt ngrt ntp@(NgramsTableParam listIdUser _)  = do
   let lieu = "Garg.Db.Ngrams.getTableNgrams: "
-  maybeRoot <- head <$> getRootUsername userMaster c
+  maybeRoot <- head <$> getRoot userMaster c
   let masterRootId = maybe (panic $ lieu <> "no userMaster Tree") (view node_id) maybeRoot
   tree <- map toNodeTree <$> dbTree c masterRootId
   let maybeCorpus = head $ filter (\n -> _nt_type n == NodeCorpus) tree

src/Gargantext/Database/Node.hs

@@ -35,6 +35,7 @@ import Prelude hiding (null, id, map, sum)
 
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types
+import Gargantext.Core.Types.Individu (Username)
 import Gargantext.Database.Utils (fromField')
 import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
 import Gargantext.Database.Queries
@@ -205,26 +206,6 @@ runGetNodes :: Query NodeRead -> Cmd [NodeAny]
 runGetNodes q = mkCmd $ \conn -> runQuery conn q
 
 ------------------------------------------------------------------------
-selectRootUsername :: Username -> Query NodeRead
-selectRootUsername username = proc () -> do
-    row <- queryNodeTable -< ()
-    restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
-    restrict -< _node_name   row .== (pgStrictText username)
-    returnA -< row
-
-getRootUsername :: Username -> Connection -> IO [Node HyperdataUser]
-getRootUsername uname conn = runQuery conn (selectRootUsername uname)
-
-------------------------------------------------------------------------
-selectRootUser :: UserId -> Query NodeRead
-selectRootUser userId = proc () -> do
-    row <- queryNodeTable -< ()
-    restrict -< _node_userId   row .== (pgInt4 userId)
-    restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
-    returnA -< row
-
-getRoot :: UserId -> Cmd [Node HyperdataUser]
-getRoot userId = mkCmd $ \conn -> runQuery conn (selectRootUser userId)
 ------------------------------------------------------------------------
 
 -- | order by publication date
@@ -537,7 +518,6 @@ mk'' NodeUser _       _   _     = panic "NodeUser do not have any parent"
 mk'' _        Nothing _   _     = panic "NodeType does   have a   parent"
 mk'' nt       pId     uId name  = mkCmd $ \c -> mk' c nt uId pId name
 
-type Username = Text
 
 mkRoot :: Username -> UserId -> Cmd [Int]
 mkRoot uname uId = case uId > 0 of

src/Gargantext/Database/Root.hs

+{-|
+Module      : Gargantext.Database.Root
+Description : Main requests to get root of users
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-orphans        #-}
+
+{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE DeriveGeneric          #-}
+{-# LANGUAGE ConstraintKinds        #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE NoImplicitPrelude      #-}
+{-# LANGUAGE TemplateHaskell        #-}
+
+module Gargantext.Database.Root where
+
+import Database.PostgreSQL.Simple (Connection)
+import Opaleye (restrict, (.==), Query, runQuery)
+import Opaleye.PGTypes (pgStrictText, pgInt4)
+import Control.Arrow (returnA)
+import Gargantext.Prelude
+import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser), HyperdataUser)
+import Gargantext.Database.Queries (NodeRead)
+import Gargantext.Database.Node (queryNodeTable)
+import Gargantext.Database.User (queryUserTable, UserPoly(..))
+import Gargantext.Database.Config (nodeTypeId)
+import Gargantext.Core.Types.Individu (Username)
+import Gargantext.Database.Node (Cmd(..), mkCmd)
+
+getRootCmd :: Username -> Cmd [Node HyperdataUser]
+getRootCmd u = mkCmd $ \c -> getRoot u c
+
+getRoot :: Username -> Connection -> IO [Node HyperdataUser]
+getRoot uname conn = runQuery conn (selectRoot uname)
+
+selectRoot :: Username -> Query NodeRead
+selectRoot username = proc () -> do
+    row   <- queryNodeTable -< ()
+    users <- queryUserTable -< ()
+    restrict -< _node_typename   row .== (pgInt4 $ nodeTypeId NodeUser)
+    restrict -< user_username  users .== (pgStrictText username)
+    restrict -< _node_userId    row .== (user_id users)
+    returnA  -< row
+

src/Gargantext/Database/User.hs

@@ -32,6 +32,7 @@ import Data.Text (Text)
 import Data.Time (UTCTime)
 import GHC.Show(Show(..))
 import Gargantext.Database.Node (Cmd(..), mkCmd, runCmd)
+import Gargantext.Core.Types.Individu (Username)
 import Gargantext.Prelude
 import Opaleye
 
@@ -139,7 +140,6 @@ users = mkCmd $ \conn -> runQuery conn queryUserTable
 usersLight :: Cmd [UserLight]
 usersLight = mkCmd $ \conn -> map toUserLight <$> runQuery conn queryUserTable
 
-type Username = Text
 
 getUser :: Username -> Cmd (Maybe UserLight)
 getUser u = mkCmd $ \c -> userLightWithUsername u <$> runCmd c usersLight

src/Gargantext/Viz/Graph.hs

@@ -83,39 +83,42 @@ instance ToSchema Attributes
 instance ToSchema Edge
 instance ToSchema Graph
 
+defaultGraph :: Graph
+defaultGraph = Graph {graph_nodes = [Node {node_size = 4, node_type = Terms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}},Node {node_size = 3, node_type = Terms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}},Node {node_size = 2, node_type = Terms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}},Node {node_size = 4, node_type = Terms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}},Node {node_size = 3, node_type = Terms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}}], graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "0"},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "1"},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "2"},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_id = pack "3"},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "4"},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "5"},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "6"},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_id = pack "7"},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_id = pack "8"},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "9"},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "10"},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "11"},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "12"},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "13"},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "14"},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "15"},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_id = pack "16"}]}
+
 -- | Intances for the mack
 instance Arbitrary Graph where
-  arbitrary = elements $ [Graph {graph_nodes = [Node {node_size = 4, node_type = Terms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}},Node {node_size = 3, node_type = Terms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}},Node {node_size = 2, node_type = Terms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}},Node {node_size = 4, node_type = Terms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}},Node {node_size = 3, node_type = Terms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}}], graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "0"},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "1"},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "2"},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_id = pack "3"},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "4"},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "5"},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "6"},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_id = pack "7"},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_id = pack "8"},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "9"},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "10"},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "11"},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "12"},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "13"},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "14"},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "15"},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_id = pack "16"}]}]
+  arbitrary = elements $ [defaultGraph]
 
 
 -----------------------------------------------------------
--- Old Gargantext Version
+-- V3 Gargantext Version
 
-data AttributesOld = AttributesOld { cl :: Int }
+data AttributesV3 = AttributesV3 { cl :: Int }
   deriving (Show, Generic)
-$(deriveJSON (unPrefix "") ''AttributesOld)
+$(deriveJSON (unPrefix "") ''AttributesV3)
 
-data NodeOld = NodeOld { no_id :: Int
-                   , no_at :: AttributesOld
+data NodeV3 = NodeV3 { no_id :: Int
+                   , no_at :: AttributesV3
                    , no_s :: Int
                    , no_lb :: Text
                    }
   deriving (Show, Generic)
-$(deriveJSON (unPrefix "no_") ''NodeOld)
+$(deriveJSON (unPrefix "no_") ''NodeV3)
 
-data EdgeOld = EdgeOld { eo_s :: Int
+data EdgeV3 = EdgeV3 { eo_s :: Int
                  , eo_t :: Int
                  , eo_w :: Text
                  }
   deriving (Show, Generic)
-$(deriveJSON (unPrefix "eo_") ''EdgeOld)
+$(deriveJSON (unPrefix "eo_") ''EdgeV3)
 
-data GraphOld = GraphOld { 
-                           go_links :: [EdgeOld]
-                         , go_nodes :: [NodeOld]
+data GraphV3 = GraphV3 { 
+                           go_links :: [EdgeV3]
+                         , go_nodes :: [NodeV3]
                    }
   deriving (Show, Generic)
-$(deriveJSON (unPrefix "go_") ''GraphOld)
+$(deriveJSON (unPrefix "go_") ''GraphV3)
 
 ----------------------------------------------------------
 -- | From data to Graph
@@ -143,25 +146,28 @@ data2graph labels coocs distance partitions = Graph nodes edges
 -----------------------------------------------------------
 -----------------------------------------------------------
 
-graphOld2graph :: GraphOld -> Graph
-graphOld2graph (GraphOld links nodes) = Graph (map nodeOld2node nodes) (zipWith linkOld2edge [1..] links)
+graphV3ToGraph :: GraphV3 -> Graph
+graphV3ToGraph (GraphV3 links nodes) = Graph (map nodeV32node nodes) (zipWith linkV32edge [1..] links)
   where
-    nodeOld2node :: NodeOld -> Node
-    nodeOld2node (NodeOld no_id' (AttributesOld cl') no_s' no_lb')
+    nodeV32node :: NodeV3 -> Node
+    nodeV32node (NodeV3 no_id' (AttributesV3 cl') no_s' no_lb')
                 = Node no_s' Terms (cs $ show no_id') no_lb' (Attributes cl')
     
-    linkOld2edge :: Int -> EdgeOld -> Edge
-    linkOld2edge n (EdgeOld eo_s' eo_t' eo_w') = Edge (cs $ show eo_s') (cs $ show eo_t') ((T.read $ T.unpack eo_w') :: Double) (cs $ show n)
+    linkV32edge :: Int -> EdgeV3 -> Edge
+    linkV32edge n (EdgeV3 eo_s' eo_t' eo_w') = Edge (cs $ show eo_s') (cs $ show eo_t') ((T.read $ T.unpack eo_w') :: Double) (cs $ show n)
 
 
-graphOld2graphWithFiles :: FilePath -> FilePath -> IO ()
-graphOld2graphWithFiles g1 g2 = do
-  -- GraphOld <- IO Fichier
+graphV3ToGraphWithFiles :: FilePath -> FilePath -> IO ()
+graphV3ToGraphWithFiles g1 g2 = do
+  -- GraphV3 <- IO Fichier
   graph <- DBL.readFile g1
-  let newGraph = case DA.decode graph :: Maybe GraphOld of
+  let newGraph = case DA.decode graph :: Maybe GraphV3 of
         Nothing -> panic (T.pack "no graph")
         Just new -> new
 
-  DBL.writeFile g2 (DA.encode $ graphOld2graph newGraph)
-
+  DBL.writeFile g2 (DA.encode $ graphV3ToGraph newGraph)
 
+readGraphFromJson :: FilePath -> IO (Maybe Graph)
+readGraphFromJson fp = do
+  graph <- DBL.readFile fp
+  pure $ DA.decode graph