]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Graph/API.hs
[DEV] -> [STABLE]
[gargantext.git] / src / Gargantext / Viz / Graph / API.hs
1 {-|
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
8 Portability : POSIX
9
10 -}
11
12
13 {-# OPTIONS_GHC -fno-warn-orphans #-}
14
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 #-}
23
24 module Gargantext.Viz.Graph.API
25 where
26
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)
44 import Servant
45 import qualified Data.Map as Map
46
47 ------------------------------------------------------------------------
48
49 -- | There is no Delete specific API for Graph since it can be deleted
50 -- as simple Node.
51 type GraphAPI = Get '[JSON] Graph
52 :<|> Post '[JSON] [GraphId]
53 :<|> Put '[JSON] Int
54
55
56 graphAPI :: UserId -> NodeId -> GargServer GraphAPI
57 graphAPI u n = getGraph u n
58 :<|> postGraph n
59 :<|> putGraph n
60
61 ------------------------------------------------------------------------
62
63 getGraph :: UserId -> NodeId -> GargServer (Get '[JSON] Graph)
64 getGraph uId nId = do
65 nodeGraph <- getNode nId HyperdataGraph
66 let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
67 let graphVersion = graph ^? _Just
68 . graph_metadata
69 . _Just
70 . gm_version
71
72 v <- currentVersion
73 nodeUser <- getNode (NodeId uId) HyperdataUser
74
75 let uId' = nodeUser ^. node_userId
76
77 let cId = maybe (panic "[ERR:G.V.G.API] Node has no parent")
78 identity
79 $ nodeGraph ^. node_parentId
80 case graph of
81 Nothing -> do
82 graph' <- computeGraph cId NgramsTerms v
83 _ <- insertGraph cId uId' (HyperdataGraph $ Just graph')
84 pure graph'
85
86 Just graph' -> if graphVersion == Just v
87 then pure graph'
88 else do
89 graph'' <- computeGraph cId NgramsTerms v
90 _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
91 pure graph''
92
93 -- TODO use Database Monad only here ?
94 computeGraph :: CorpusId -> NgramsType -> Int -> GargServer (Get '[JSON] Graph)
95 computeGraph cId nt v = do
96 lId <- defaultList cId
97
98 let metadata = GraphMetadata "Title" [cId]
99 [ LegendField 1 "#FFF" "Cluster"
100 , LegendField 2 "#FFF" "Cluster"
101 ]
102 lId
103 v
104 -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
105
106 lIds <- selectNodesWithUsername NodeList userMaster
107 ngs <- filterListWithRoot GraphTerm <$> mapTermListRoot [lId] nt
108
109 myCooc <- Map.filter (>1)
110 <$> getCoocByNgrams (Diagonal True)
111 <$> groupNodesByNgrams ngs
112 <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
113
114 graph <- liftIO $ cooc2graph 0 myCooc
115 let graph' = set graph_metadata (Just metadata) graph
116 pure graph'
117
118
119
120 postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId])
121 postGraph = undefined
122
123 putGraph :: NodeId -> GargServer (Put '[JSON] Int)
124 putGraph = undefined
125