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