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 RankNTypes         #-}
  16 {-# LANGUAGE NoImplicitPrelude #-}
  17 {-# LANGUAGE OverloadedStrings #-}   -- allows to write Text literals
  18 {-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
  19 {-# LANGUAGE DataKinds            #-}
  20 {-# LANGUAGE TypeOperators      #-}
  21
  22 module Gargantext.Viz.Graph.API
  23   where
  24
  25 import Control.Lens (set)
  26 import Control.Monad.IO.Class (liftIO)
  27 import Gargantext.API.Ngrams.Tools
  28 import Gargantext.API.Types
  29 import Gargantext.Core.Types.Main
  30 import Gargantext.Database.Config
  31 import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
  32 import Gargantext.Database.Schema.Ngrams
  33 import Gargantext.Database.Node.Select
  34 import Gargantext.Database.Schema.Node (getNode)
  35 import Gargantext.Database.Schema.Node (defaultList)
  36 import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId)
  37 import Gargantext.Prelude
  38 import Gargantext.Viz.Graph
  39 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
  40 import Servant
  41 import qualified Data.Map as Map
  42
  43 ------------------------------------------------------------------------
  44
  45 -- | There is no Delete specific API for Graph since it can be deleted
  46 -- as simple Node.
  47 type GraphAPI   =  Get  '[JSON] Graph
  48               :<|> Post '[JSON] [GraphId]
  49               :<|> Put  '[JSON] Int
  50
  51
  52 graphAPI :: NodeId -> GargServer GraphAPI
  53 graphAPI n =  getGraph  n
  54          :<|> postGraph n
  55          :<|> putGraph  n
  56
  57 ------------------------------------------------------------------------
  58
  59 getGraph :: NodeId -> GargServer (Get '[JSON] Graph)
  60 getGraph nId = do
  61   nodeGraph <- getNode nId HyperdataGraph
  62
  63   let metadata = GraphMetadata "Title" [maybe 0 identity $ _node_parentId nodeGraph]
  64                                      [ LegendField 1 "#FFF" "Cluster"
  65                                      , LegendField 2 "#FFF" "Cluster"
  66                                      ]
  67                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
  68   let cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph
  69
  70   lIds <- selectNodesWithUsername NodeList userMaster
  71   lId  <- defaultList cId
  72   ngs  <- filterListWithRoot GraphTerm <$> mapTermListRoot [lId] NgramsTerms
  73
  74   myCooc <- Map.filter (>1) <$> getCoocByNgrams (Diagonal False)
  75                             <$> groupNodesByNgrams ngs
  76                             <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) NgramsTerms (Map.keys ngs)
  77
  78   graph <- liftIO $ cooc2graph 1 myCooc
  79   pure $ set graph_metadata (Just metadata) graph
  80
  81
  82 postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId])
  83 postGraph = undefined
  84
  85 putGraph :: NodeId -> GargServer (Put '[JSON] Int)
  86 putGraph = undefined
  87
  88
  89
  90
  91 -- | Instances
  92