2 Module : Gargantext.Viz.Phylo.Tools
3 Description : Phylomemy Tools to build/manage it
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
13 {-# OPTIONS_GHC -fno-warn-orphans #-}
15 {-# LANGUAGE FlexibleContexts #-}
16 {-# LANGUAGE FlexibleInstances #-}
17 {-# LANGUAGE RankNTypes #-}
18 {-# LANGUAGE NoImplicitPrelude #-}
19 {-# LANGUAGE OverloadedStrings #-} -- allows to write Text literals
20 {-# LANGUAGE OverloadedLists #-} -- allows to write Map and HashMap as lists
21 {-# LANGUAGE DataKinds #-}
22 {-# LANGUAGE TypeOperators #-}
24 module Gargantext.Viz.Graph.API
27 import Control.Lens -- (set, (^.), (_Just), (^?))
28 import Control.Monad.IO.Class (liftIO)
29 import Data.Maybe (Maybe(..))
30 import Gargantext.API.Ngrams (currentVersion)
31 import Gargantext.API.Ngrams.Tools
32 import Gargantext.API.Types
33 import Gargantext.Core.Types.Main
34 import Gargantext.Database.Config
35 import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
36 import Gargantext.Database.Schema.Ngrams
37 import Gargantext.Database.Node.Select
38 import Gargantext.Database.Schema.Node (getNode, defaultList, insertGraph)
39 import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId)
40 import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
41 import Gargantext.Prelude
42 import Gargantext.Viz.Graph
43 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
45 import qualified Data.Map as Map
47 ------------------------------------------------------------------------
49 -- | There is no Delete specific API for Graph since it can be deleted
51 type GraphAPI = Get '[JSON] Graph
52 :<|> Post '[JSON] [GraphId]
56 graphAPI :: UserId -> NodeId -> GargServer GraphAPI
57 graphAPI u n = getGraph u n
61 ------------------------------------------------------------------------
63 getGraph :: UserId -> NodeId -> GargServer (Get '[JSON] Graph)
65 nodeGraph <- getNode nId HyperdataGraph
66 let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
67 let graphVersion = graph ^? _Just
74 let cId = maybe (panic "[ERR:G.V.G.API] Node has no parent")
76 $ nodeGraph ^. node_parentId
79 graph' <- computeGraph cId NgramsTerms v
80 _ <- insertGraph cId uId (HyperdataGraph $ Just graph')
83 Just graph' -> if graphVersion == Just v
86 graph'' <- computeGraph cId NgramsTerms v
87 _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
90 -- TODO use Database Monad only here ?
91 computeGraph :: CorpusId -> NgramsType -> Int -> GargServer (Get '[JSON] Graph)
92 computeGraph cId nt v = do
93 lId <- defaultList cId
95 let metadata = GraphMetadata "Title" [cId]
96 [ LegendField 1 "#FFF" "Cluster"
97 , LegendField 2 "#FFF" "Cluster"
101 -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
103 lIds <- selectNodesWithUsername NodeList userMaster
104 ngs <- filterListWithRoot GraphTerm <$> mapTermListRoot [lId] nt
106 myCooc <- Map.filter (>1) <$> getCoocByNgrams (Diagonal False)
107 <$> groupNodesByNgrams ngs
108 <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
110 graph <- liftIO $ cooc2graph 0 myCooc
111 let graph' = set graph_metadata (Just metadata) graph
116 postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId])
117 postGraph = undefined
119 putGraph :: NodeId -> GargServer (Put '[JSON] Int)