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