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