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 Gargantext.API.Ngrams (currentVersion, listNgramsChangedSince, Versioned(..))
  30 import Gargantext.API.Ngrams.Tools
  31 import Gargantext.API.Types
  32 import Gargantext.Core.Types.Main
  33 import Gargantext.Database.Config
  34 import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
  35 import Gargantext.Database.Schema.Ngrams
  36 import Gargantext.Database.Node.Select
  37 import Gargantext.Database.Schema.Node (getNode)
  38 import Gargantext.Database.Schema.Node (defaultList)
  39 import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId)
  40 import Gargantext.Prelude
  41 import Gargantext.Viz.Graph
  42 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
  43 import Servant
  44 import qualified Data.Map as Map
  45
  46 ------------------------------------------------------------------------
  47
  48 -- | There is no Delete specific API for Graph since it can be deleted
  49 -- as simple Node.
  50 type GraphAPI   =  Get  '[JSON] Graph
  51               :<|> Post '[JSON] [GraphId]
  52               :<|> Put  '[JSON] Int
  53
  54
  55 graphAPI :: NodeId -> GargServer GraphAPI
  56 graphAPI n =  getGraph  n
  57          :<|> postGraph n
  58          :<|> putGraph  n
  59
  60 ------------------------------------------------------------------------
  61
  62 getGraph :: NodeId -> GargServer (Get '[JSON] Graph)
  63 getGraph nId = do
  64   nodeGraph <- getNode nId HyperdataGraph
  65   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
  66   let graphVersion = graph ^? _Just
  67                             . graph_metadata
  68                             . _Just
  69                             . gm_version
  70
  71   v <- currentVersion
  72
  73   let cId = maybe (panic "[ERR:G.V.G.API] Node has no parent")
  74                   identity
  75                   $ nodeGraph ^. node_parentId
  76
  77   case graph of
  78     Nothing     -> computeGraph 0 nId NgramsTerms v
  79     Just graph' -> if graphVersion == Just v
  80                      then pure graph'
  81                      else computeGraph 0 nId NgramsTerms v
  82
  83 computeGraph cId nId nt v = do
  84   lId  <- defaultList cId
  85
  86   let metadata = GraphMetadata "Title" [cId]
  87                                      [ LegendField 1 "#FFF" "Cluster"
  88                                      , LegendField 2 "#FFF" "Cluster"
  89                                      ]
  90                                 lId
  91                                 v
  92                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
  93
  94   lIds <- selectNodesWithUsername NodeList userMaster
  95   ngs  <- filterListWithRoot GraphTerm <$> mapTermListRoot [lId] nt
  96
  97   myCooc <- Map.filter (>1) <$> getCoocByNgrams (Diagonal False)
  98                             <$> groupNodesByNgrams ngs
  99                             <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 100
 101   graph <- liftIO $ cooc2graph 0 myCooc
 102   pure $ set graph_metadata (Just metadata) graph
 103
 104
 105
 106 postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId])
 107 postGraph = undefined
 108
 109 putGraph :: NodeId -> GargServer (Put '[JSON] Int)
 110 putGraph = undefined
 111
 112
 113
 114
 115 -- | Instances
 116