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 cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph
  64   lId  <- defaultList cId
  65
  66   let metadata = GraphMetadata "Title" [maybe 0 identity $ _node_parentId nodeGraph]
  67                                      [ LegendField 1 "#FFF" "Cluster"
  68                                      , LegendField 2 "#FFF" "Cluster"
  69                                      ]
  70                                 lId
  71                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
  72
  73   lIds <- selectNodesWithUsername NodeList userMaster
  74   ngs  <- filterListWithRoot GraphTerm <$> mapTermListRoot [lId] NgramsTerms
  75
  76   myCooc <- Map.filter (>1) <$> getCoocByNgrams (Diagonal False)
  77                             <$> groupNodesByNgrams ngs
  78                             <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) NgramsTerms (Map.keys ngs)
  79
  80   graph <- liftIO $ cooc2graph 0 myCooc
  81   pure $ set graph_metadata (Just metadata) graph
  82
  83
  84 postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId])
  85 postGraph = undefined
  86
  87 putGraph :: NodeId -> GargServer (Put '[JSON] Int)
  88 putGraph = undefined
  89
  90
  91
  92
  93 -- | Instances
  94